Index: trunk/src/vegas/vegas.nw =================================================================== --- trunk/src/vegas/vegas.nw (revision 8323) +++ trunk/src/vegas/vegas.nw (revision 8324) @@ -1,4656 +1,4886 @@ %% -*- 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]]>>= <> module vegas <> <> <> <> <> <> <> contains <> end module vegas @ %def vegas <>= 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. <>= 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. <>= 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. <>= public :: vegas_func_t <>= 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]]. <>= 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. <>= public :: vegas_config_t <>= 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 <> 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. <>= procedure, public :: write => vegas_config_write <>= 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. <>= public :: vegas_grid_t <>= 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 <> end type vegas_grid_t @ %def vegas_grid_t @ Initialise grid. <>= interface vegas_grid_t module procedure vegas_grid_init end interface vegas_grid_t <>= 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. <>= procedure, public :: write => vegas_grid_write <>= 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. <>= public :: operator (==) <>= interface operator (==) module procedure vegas_grid_equal end interface operator (==) <>= 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]]. <>= procedure, private :: resize => vegas_grid_resize <>= 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 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 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). <>= procedure, public :: get_probability => vegas_grid_get_probability <>= 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]]. <>= procedure, public :: broadcast => vegas_grid_broadcast <>= 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]]. <>= public :: vegas_result_t <>= 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 <> end type vegas_result_t @ %def vegas_results_t @ Write out the current status of the integration result. <>= procedure, public :: write => vegas_result_write <>= 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. <>= procedure, public :: send => vegas_result_send <>= 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. <>= procedure, public :: receive => vegas_result_receive <>= 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. <>= public :: vegas_t <>= 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 <> 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. <>= interface vegas_t module procedure vegas_init end interface vegas_t <>= 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. <>= procedure, public :: final => vegas_final <>= 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. <>= procedure, public :: set_limits => vegas_set_limits <>= 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. <>= procedure, public :: set_calls => vegas_set_n_calls <>= 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. <>= procedure, public :: get_grid => vegas_get_grid <>= 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]]. <>= procedure, public :: set_grid => vegas_set_grid <>= 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. <>= procedure, public :: is_parallelizable => vegas_is_parallelizable <>= 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. <>= procedure, public :: get_config => vegas_get_config <>= 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]]. <>= procedure, public :: set_config => vegas_set_config <>= 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. <>= procedure, public :: get_result => vegas_get_result <>= 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]]. <>= procedure, public :: set_result => vegas_set_result <>= 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. <>= procedure, public :: get_calls => vegas_get_n_calls <>= 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. <>= procedure, public :: get_integral => vegas_get_integral <>= 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. <>= procedure, public :: get_variance => vegas_get_variance <>= 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. <>= procedure, public :: get_efficiency => vegas_get_efficiency <>= 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]]. <>= procedure, public :: get_max_abs_f => vegas_get_max_abs_f <>= 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]]. <>= procedure, public :: get_max_abs_f_pos => vegas_get_max_abs_f_pos <>= 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]]. <>= procedure, public :: get_max_abs_f_neg => vegas_get_max_abs_f_neg <>= 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. <>= procedure, public :: get_evt_weight => vegas_get_evt_weight procedure, public :: get_evt_weight_excess => vegas_get_evt_weight_excess <>= 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. <>= procedure, public :: get_distribution => vegas_get_distribution procedure, public :: set_distribution => vegas_set_distribution <>= 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. <>= procedure, public :: send_distribution => vegas_send_distribution <>= 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. <>= procedure, public :: receive_distribution => vegas_receive_distribution <>= 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. <>= procedure, private :: init_grid => vegas_init_grid <>= 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. <>= procedure, public :: reset_result => vegas_reset_result <>= 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. <>= procedure, public :: reset_grid => vegas_reset_grid <>= 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. <>= procedure, public :: refine => vegas_refine_grid <>= 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 <> 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. <>= 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$. <>= procedure, public :: integrate => vegas_integrate <>= 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. <> 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 <> if (verbose) then call msg_message ("Results: [it, calls, integral, error, chi^2, eff.]") end if iteration: do it = 1, self%config%iterations <> 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 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 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 <> end do loop_over_par_boxes <> 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(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 <> 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. <>= 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 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. <>= integer :: n_size integer :: n_dim_par logical :: box_success ! MPI-specific variables below @ Overall 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. <>= 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). <>= @ <>= @ 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. <>= 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. <>= integer :: rank type(vegas_grid_t) :: grid @ MPI procedure-specific 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. <>= 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. <>= 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. <>= 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]]. <>= 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]]. <>= 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). <>= procedure, private :: random_point => vegas_random_point <>= 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 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 end do ndim 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. <>= procedure, private :: simple_random_point => vegas_simple_random_point <>= 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 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 end do ndim end subroutine vegas_simple_random_point @ %def vegas_simple_random_point @ <>= procedure, private :: accumulate_distribution => vegas_accumulate_distribution <>= 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. <>= procedure :: generate_weighted => vegas_generate_weighted_event <>= 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) 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. <>= procedure, public :: generate_unweighted=> vegas_generate_unweighted_event <>= 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) ! 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. <>= 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,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 <>= procedure, public :: write_grid => vegas_write_grid <>= 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. <>= procedure, public :: read_grid => vegas_read_grid <>= 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 -@ +Read and write a grid from an unformatted file. +<>= + procedure :: write_binary_grid => vegas_write_binary_grid + procedure :: read_binary_grid => vegas_read_binary_grid +<>= + subroutine vegas_write_binary_grid (self, unit) + class(vegas_t), intent(in) :: self + integer, intent(in) :: unit + integer :: i, j + write (unit) self%config%n_dim + write (unit) self%config%n_bins_max + write (unit) self%config%alpha + write (unit) self%config%iterations + write (unit) self%config%mode + write (unit) self%config%calls_per_box + write (unit) self%config%n_calls + write (unit) self%config%n_calls_min + write (unit) self%config%n_boxes + write (unit) self%config%n_bins + write (unit) self%result%it_start + write (unit) self%result%it_num + write (unit) self%result%samples + write (unit) self%result%sum_int_wgtd + write (unit) self%result%sum_wgts + write (unit) self%result%sum_chi + write (unit) self%result%chi2 + write (unit) self%result%efficiency + write (unit) self%result%efficiency_pos + write (unit) self%result%efficiency_neg + write (unit) self%result%max_abs_f + write (unit) self%result%max_abs_f_pos + write (unit) self%result%max_abs_f_neg + write (unit) self%result%result + write (unit) self%result%std + write (unit) self%hypercube_volume + write (unit) self%jacobian + do j = 1, self%config%n_dim + write (unit) j, self%grid%x_lower(j) + end do + do j = 1, self%config%n_dim + write (unit) j, self%grid%x_upper(j) + end do + do j = 1, self%config%n_dim + write (unit) j, self%grid%delta_x(j) + end do + write (unit) self%config%n_bins + do j = 1, self%config%n_dim + write (unit) j, self%bin(j) + end do + write (unit) self%config%n_boxes + do j = 1, self%config%n_dim + write (unit) j, self%box(j) + end do + do j = 1, self%config%n_dim + do i = 1, self%config%n_bins_max + write (unit) i, j, self%d(i, j) + end do + end do + do j = 1, self%config%n_dim + do i = 1, self%config%n_bins_max + 1 + write (unit) i, j, self%grid%xi(i, j) + end do + end do + end subroutine vegas_write_binary_grid + + subroutine vegas_read_binary_grid (self, unit) + class(vegas_t), intent(out) :: self + integer, intent(in) :: unit + integer :: i, j + integer :: ibuffer, jbuffer + read (unit) ibuffer + read (unit) jbuffer + select type(self) + type is (vegas_t) + self = vegas_t (n_dim = ibuffer, n_bins_max = jbuffer) + end select + read (unit) self%config%alpha + read (unit) self%config%iterations + read (unit) self%config%mode + read (unit) self%config%calls_per_box + read (unit) self%config%n_calls + read (unit) self%config%n_calls_min + read (unit) self%config%n_boxes + read (unit) self%config%n_bins + self%grid%n_bins = self%config%n_bins + read (unit) self%result%it_start + read (unit) self%result%it_num + read (unit) self%result%samples + read (unit) self%result%sum_int_wgtd + read (unit) self%result%sum_wgts + read (unit) self%result%sum_chi + read (unit) self%result%chi2 + read (unit) self%result%efficiency + read (unit) self%result%efficiency_pos + read (unit) self%result%efficiency_neg + read (unit) self%result%max_abs_f + read (unit) self%result%max_abs_f_pos + read (unit) self%result%max_abs_f_neg + read (unit) self%result%result + read (unit) self%result%std + read (unit) self%hypercube_volume + read (unit) self%jacobian + do j = 1, self%config%n_dim + read (unit) jbuffer, self%grid%x_lower(j) + end do + do j = 1, self%config%n_dim + read (unit) jbuffer, self%grid%x_upper(j) + end do + do j = 1, self%config%n_dim + read (unit) jbuffer, self%grid%delta_x(j) + end do + read (unit) self%config%n_bins + do j = 1, self%config%n_dim + read (unit) jbuffer, self%bin(j) + end do + read (unit) self%config%n_boxes + do j = 1, self%config%n_dim + read (unit) jbuffer, self%box(j) + end do + do j = 1, self%config%n_dim + do i = 1, self%config%n_bins_max + read (unit) ibuffer, jbuffer, self%d(i, j) + end do + end do + do j = 1, self%config%n_dim + do i = 1, self%config%n_bins_max + 1 + read (unit) ibuffer, jbuffer, self%grid%xi(i, j) + end do + end do + end subroutine vegas_read_binary_grid + +@ %def vegas_write_binary_grid, vegas_read_binary_grid + \section{Unit tests} \label{sec:unit-tests} Test module, followed by the corresponding implementation module. <<[[vegas_ut.f90]]>>= <> module vegas_ut use unit_tests use vegas_uti <> <> contains <> end module vegas_ut @ %def vegas_ut @ <<[[vegas_uti.f90]]>>= <> module vegas_uti <> use io_units use constants, only: pi use format_defs, only: FMT_10, FMT_12 use rng_base use rng_stream use vegas <> <> <> contains <> end module vegas_uti @ %def vegas_uti @ API: driver for the unit tests below. <>= public :: vegas_test <>= subroutine vegas_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> 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. <>= type, extends (vegas_func_t) :: vegas_test_func_t ! contains <> end type vegas_test_func_t @ %def vegas_test_func_t @ Evaluate the integrand. <>= procedure, public :: evaluate => vegas_test_func_evaluate <>= 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. <>= type, extends (vegas_func_t) :: vegas_gaussian_test_func_t ! contains <> end type vegas_gaussian_test_func_t @ %def vegas_gaussian_test_func_t @ Evaluate the integrand. <>= procedure, public :: evaluate => vegas_gaussian_evaluate <>= 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} <>= type, extends (vegas_func_t) :: vegas_polynomial_func_t ! contains <> end type vegas_polynomial_func_t @ %def vegas_polynomial_func_t <>= procedure, public :: evaluate => vegas_polynomial_evaluate <>= 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. <>= call test (vegas_1, "vegas_1", "VEGAS initialisation and& & grid preparation", u, results) <>= public :: vegas_1 <>= 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. <>= call test (vegas_2, "vegas_2", "VEGAS configuration and result object", u, results) <>= public :: vegas_2 <>= 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. <>= call test (vegas_3, "vegas_3", "VEGAS integration of multi-dimensional gaussian", u, results) <>= public :: vegas_3 <>= 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. <>= call test (vegas_4, "vegas_4", "VEGAS integration of three& &-dimensional factorisable polynomial function", u, results) <>= public :: vegas_4 <>= 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. <>= call test (vegas_5, "vegas_5", "VEGAS integration and event& & generation of multi-dimensional gaussian", u, results) <>= public :: vegas_5 <>= 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. <>= call test (vegas_6, "vegas_6", "VEGAS integrate and write grid, & & read grid and continue", u, results) <>= public :: vegas_6 <>= 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]]>>= <> module vamp2 <> <> use io_units use format_utils, only: pac_fmt use format_utils, only: write_separator, write_indent use format_defs, only: FMT_17 use diagnostics use rng_base use rng_stream, only: rng_stream_t use vegas <> <> <> <> <> <> contains <> end module vamp2 @ %def vamp2 <>= @ <>= 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. <>= public :: vamp2_func_t <>= 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 <> end type vamp2_func_t @ %def vamp2_func_t @ Init. <>= procedure, public :: init => vamp2_func_init <>= 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. <>= procedure, public :: set_channel => vamp2_func_set_channel <>= 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$. <>= procedure, public :: get_n_calls => vamp2_func_get_n_calls <>= 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. <>= procedure, public :: reset_n_calls => vamp2_func_reset_n_calls <>= 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. <>= procedure(vamp2_func_evaluate_maps), deferred :: evaluate_maps <>= 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. The calling procedure must handle the case of a vanishing overall probability density where either a channel weight or a channel probability vanishes. <>= procedure, private :: evaluate_weight => vamp2_func_evaluate_weight <>= 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]]. <>= procedure(vamp2_func_evaluate_func), deferred :: evaluate_func <>= 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 <>= procedure, public :: evaluate => vamp2_func_evaluate <>= 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 () if (self%g /= 0) then f = self%evaluate_func (x) / self%g self%n_calls = self%n_calls + 1 end if 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]]. <>= public :: vamp2_config_t <>= 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 <> end type vamp2_config_t @ %def vamp2_config_t @ Write. <>= procedure, public :: write => vamp2_config_write <>= 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]]. <>= public :: vamp2_result_t <>= type, extends(vegas_result_t) :: vamp2_result_t contains <> end type vamp2_result_t @ %def vamp2_result_t @ Output. <>= procedure, public :: write => vamp2_result_write <>= 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} <>= integer, parameter, public :: & VEQ_IDENTITY = 0, VEQ_INVERT = 1, VEQ_SYMMETRIC = 2, VEQ_INVARIANT = 3 @ @ Channel equivalences. Store retrieving and sourcing channel. <>= type :: vamp2_equi_t integer :: ch integer :: ch_src integer, dimension(:), allocatable :: perm integer, dimension(:), allocatable :: mode contains <> end type vamp2_equi_t @ %def vamp2_equi_t @ Write equivalence. <>= procedure :: write => vamp2_equi_write <>= 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 @ <>= public :: vamp2_equivalences_t <>= 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 <> end type vamp2_equivalences_t @ %def vamp2_equivalences_t @ Constructor. <>= interface vamp2_equivalences_t module procedure vamp2_equivalences_init end interface vamp2_equivalences_t <>= 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. <>= procedure :: write => vamp2_equivalences_write <>= 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. <>= procedure, public :: is_allocated => vamp2_equivalences_is_allocated <>= 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. <>= procedure, public :: get_channels => vamp2_equivalences_get_channels <>= 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 @ <>= procedure, public :: get_mode => vamp2_equivalences_get_mode procedure, public :: get_perm => vamp2_equivalences_get_perm <>= 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 @ <>= procedure, public :: set_equivalence => vamp2_equivalences_set_equivalence <>= 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.") + ("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.") + ("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.") + ("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.") + ("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. <>= procedure, public :: freeze => vamp2_equivalences_freeze <>= 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: & + 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: & + 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} <>= public :: vamp2_t <>= 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 <> end type vamp2_t <>= interface vamp2_t module procedure vamp2_init end interface vamp2_t @ %def vamp2_t @ Constructor. <>= 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 <>= procedure, public :: final => vamp2_final <>= 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. <>= procedure, public :: write => vamp2_write <>= 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. <>= procedure, public :: get_config => vamp2_get_config <>= 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]]. <>= procedure, public :: set_config => vamp2_set_config <>= 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} <>= procedure, public :: set_calls => vamp2_set_n_calls <>= 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. <>= procedure, public :: set_limits => vamp2_set_limits <>= 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]]. <>= procedure, public :: set_chain => vamp2_set_chain <>= 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.") + 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.") + 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. <>= procedure, public :: set_equivalences => vamp2_set_equivalences <>= 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]]. <>= procedure, public :: get_n_calls => vamp2_get_n_calls <>= 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. <>= procedure, public :: get_integral => vamp2_get_integral <>= 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. <>= procedure, public :: get_variance => vamp2_get_variance <>= 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. <>= procedure, public :: get_efficiency => vamp2_get_efficiency <>= 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. <>= procedure :: get_evt_weight => vamp2_get_evt_weight procedure :: get_evt_weight_excess => vamp2_get_evt_weight_excess <>= 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. <>= procedure :: get_grid => vamp2_get_grid <>= 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.") + 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. <>= procedure, private :: adapt_weights => vamp2_adapt_weights <>= 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 <> end subroutine vamp2_adapt_weights @ %def vamp2_adapt_weights @ We average the weights over their respective chain members. <>= 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 <>= procedure, private :: apply_equivalences => vamp2_apply_equivalences <>= 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: & + 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. <>= procedure, public :: reset_result => vamp2_reset_result <>= 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]]. <>= procedure, public :: integrate => vamp2_integrate <>= 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. <> 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 <> if (verbose) then call msg_message ("Results: [it, calls, integral, error, chi^2, eff.]") end if iteration: do it = 1, self%config%iterations <> 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 <> call func%set_channel (ch) call self%integrator(ch)%integrate ( & & func, rng, iterations, opt_refine_grid = .false., opt_verbose = verbose) end do channel <> 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(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 .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) <> end subroutine vamp2_integrate @ %def vamp2_integrate @ <>= 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. <>= @ <>= cumulative_int = 0. cumulative_std = 0. if (reset_result) call self%reset_result () @ <>= total_integral = 0._default total_sq_integral = 0._default total_variance = 0._default @ <>= @ <>= @ @ Distribute workers up in chunks of [[n_size]]. <>= 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 <>= type(vegas_grid_t) :: grid type(MPI_Request) :: status integer :: rank, n_size, worker @ <>= 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]]. <>= 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. <>= 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. <>= call vamp2_integrate_collect () <>= 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. <>= 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. <>= procedure, public :: generate_weighted => vamp2_generate_weighted_event <>= 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 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) contains <> 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. <>= procedure, public :: generate_unweighted => vamp2_generate_unweighted_event <>= 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) call self%integrator(ch)%generate_weighted (func, rng, x) self%result%evt_weight = self%integrator(ch)%get_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) ! Do not use division, because max_abs_f could be zero. if (event_rescale * max_abs_f * r <= abs(self%result%evt_weight)) then exit generate end if end do generate contains <> 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. <>= 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. <>= 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,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 <>= procedure, public :: write_grids => vamp2_write_grids <>= 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. <>= procedure, public :: read_grids => vamp2_read_grids <>= 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 +@ Read and write grids from an unformatted file. +<>= +procedure :: write_binary_grids => vamp2_write_binary_grids +procedure :: read_binary_grids => vamp2_read_binary_grids +<>= + subroutine vamp2_write_binary_grids (self, unit) + class(vamp2_t), intent(in) :: self + integer, intent(in) :: unit + integer :: ch + write (unit) + write (unit) self%config%n_channel + write (unit) self%config%n_dim + write (unit) self%config%n_calls_min_per_channel + write (unit) self%config%n_calls_threshold + write (unit) self%config%n_chains + write (unit) self%config%stratified + write (unit) self%config%alpha + write (unit) self%config%beta + write (unit) self%config%n_bins_max + write (unit) self%config%iterations + write (unit) self%config%n_calls + write (unit) self%result%it_start + write (unit) self%result%it_num + write (unit) self%result%samples + write (unit) self%result%sum_int_wgtd + write (unit) self%result%sum_wgts + write (unit) self%result%sum_chi + write (unit) self%result%chi2 + write (unit) self%result%efficiency + write (unit) self%result%efficiency_pos + write (unit) self%result%efficiency_neg + write (unit) self%result%max_abs_f + write (unit) self%result%max_abs_f_pos + write (unit) self%result%max_abs_f_neg + write (unit) self%result%result + write (unit) self%result%std + do ch = 1, self%config%n_channel + write (unit) ch, self%weight(ch) + end do + if (self%config%n_chains > 0) then + do ch = 1, self%config%n_channel + write (unit) ch, self%chain(ch) + end do + end if + do ch = 1, self%config%n_channel + call self%integrator(ch)%write_binary_grid (unit) + end do + end subroutine vamp2_write_binary_grids + + subroutine vamp2_read_binary_grids (self, unit) + class(vamp2_t), intent(out) :: self + integer, intent(in) :: unit + integer :: ch, ibuffer, jbuffer + read (unit) + read (unit) ibuffer + read (unit) jbuffer + select type (self) + type is (vamp2_t) + self = vamp2_t (n_channel = ibuffer, n_dim = jbuffer) + end select + read (unit) self%config%n_calls_min_per_channel + read (unit) self%config%n_calls_threshold + read (unit) self%config%n_chains + read (unit) self%config%stratified + read (unit) self%config%alpha + read (unit) self%config%beta + read (unit) self%config%n_bins_max + read (unit) self%config%iterations + read (unit) self%config%n_calls + read (unit) self%result%it_start + read (unit) self%result%it_num + read (unit) self%result%samples + read (unit) self%result%sum_int_wgtd + read (unit) self%result%sum_wgts + read (unit) self%result%sum_chi + read (unit) self%result%chi2 + read (unit) self%result%efficiency + read (unit) self%result%efficiency_pos + read (unit) self%result%efficiency_neg + read (unit) self%result%max_abs_f + read (unit) self%result%max_abs_f_pos + read (unit) self%result%max_abs_f_neg + read (unit) self%result%result + read (unit) self%result%std + do ch = 1, self%config%n_channel + read (unit) ibuffer, self%weight(ch) + end do + if (self%config%n_chains > 0) then + do ch = 1, self%config%n_channel + read (unit) ibuffer, self%chain(ch) + end do + end if + do ch = 1, self%config%n_channel + call self%integrator(ch)%read_binary_grid (unit) + end do + end subroutine vamp2_read_binary_grids + +@ %def vamp2_write_binary_grids, vamp2_read_binary_grids @ \section{Unit tests} \label{sec:unit-tests} Test module, followed by the corresponding implementation module. <<[[vamp2_ut.f90]]>>= <> module vamp2_ut use unit_tests use vamp2_uti <> <> contains <> end module vamp2_ut @ %def vamp2_ut @ <<[[vamp2_uti.f90]]>>= <> module vamp2_uti <> 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 <> <> <> contains <> end module vamp2_uti @ %def vamp2_uti @ API: driver for the unit tests below. <>= public :: vamp2_test <>= subroutine vamp2_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> 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. <>= type, extends (vamp2_func_t) :: vamp2_test_func_t ! contains <> end type vamp2_test_func_t @ %def vegas_test_func_t @ <>= procedure, public :: evaluate_maps => vamp2_test_func_evaluate_maps <>= 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. <>= procedure, public :: evaluate_func => vamp2_test_func_evaluate <>= 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)}$. <>= type, extends(vamp2_func_t) :: vamp2_test_func_2_t ! contains <> end type vamp2_test_func_2_t @ %def vamp2_test_func_2_t @ Evaluate maps. <>= procedure :: evaluate_maps => vamp2_test_func_2_evaluate_maps <>= 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. <>= procedure :: evaluate_func => vamp2_test_func_2_evaluate_func <>= 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{equation} x_1 = u^{1 / 5} \quad \vee \quad x_1 = 1 - v^{1 / 5} \end{equation} 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}}$. <>= type, extends(vamp2_func_t) :: vamp2_test_func_3_t ! contains <> end type vamp2_test_func_3_t @ %def vamp2_test_func_3_t @ Evaluate maps. <>= procedure :: evaluate_maps => vamp2_test_func_3_evaluate_maps <>= 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. <>= procedure :: evaluate_func => vamp2_test_func_3_evaluate_func <>= 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. <>= call test (vamp2_1, "vamp2_1", "VAMP2 initialisation and& & grid preparation", u, results) <>= public :: vamp2_1 <>= 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. <>= call test (vamp2_2, "vamp2_2", "VAMP2 intgeration of two-dimensional & & function with two channels", u, results) <>= public :: vamp2_2 <>= 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. <>= call test (vamp2_3, "vamp2_3", "VAMP2 intgeration of two-dimensional & & function with two channels", u, results) <>= public :: vamp2_3 <>= 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. <>= call test (vamp2_4, "vamp2_4", "VAMP2 intgeration of two-dimensional & & function with two channels with chains", u, results) <>= public :: vamp2_4 <>= 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 @ <>= call test (vamp2_5, "vamp2_5", "VAMP2 intgeration of two-dimensional & & function with two channels with equivalences", u, results) <>= public :: vamp2_5 <>= 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/variables/variables.nw =================================================================== --- trunk/src/variables/variables.nw (revision 8323) +++ trunk/src/variables/variables.nw (revision 8324) @@ -1,6796 +1,6807 @@ % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*- % WHIZARD code as NOWEB source: variables for processes %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Variables for Processes} \includemodulegraph{variables} This part introduces variables as user-controlled objects that influence the behavior of objects and calculations. Variables contain objects of intrinsic type or of a type as introced above. \begin{description} \item[variables] Store values of various kind, used by expressions and accessed by the command interface. This provides an implementation of the [[vars_t]] abstract type. \item[observables] Concrete implementation of observables (functions in the variable tree), applicable for \whizard. abstract type. \end{description} \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Variables: Implementation} The user interface deals with variables that are handled similarly to full-flegded programming languages. The system will add a lot of predefined variables (model parameters, flags, etc.) that are accessible to the user by the same methods. Variables can be of various type: logical (boolean/flag), integer, real (default precision), subevents (used in cut expressions), arrays of PDG codes (aliases for particles), strings. Furthermore, in cut expressions we have unary and binary observables, which are used like real parameters but behave like functions. <<[[variables.f90]]>>= <> module variables <> <> use io_units use format_utils, only: pac_fmt use format_defs, only: FMT_12, FMT_19 use constants, only: eps0 use os_interface, only: paths_t use physics_defs, only: LAMBDA_QCD_REF use system_dependencies use fastjet !NODEP! use diagnostics use pdg_arrays use subevents use var_base <> <> <> <> <> contains <> end module variables @ %def variables @ \subsection{Variable list entries} Variable (and constant) values can be of one of the following types: <>= integer, parameter, public :: V_NONE = 0, V_LOG = 1, V_INT = 2, V_REAL = 3 integer, parameter, public :: V_CMPLX = 4, V_SEV = 5, V_PDG = 6, V_STR = 7 integer, parameter, public :: V_OBS1_INT = 11, V_OBS2_INT = 12 integer, parameter, public :: V_OBS1_REAL = 21, V_OBS2_REAL = 22 integer, parameter, public :: V_UOBS1_INT = 31, V_UOBS2_INT = 32 integer, parameter, public :: V_UOBS1_REAL = 41, V_UOBS2_REAL = 42 @ %def V_NONE V_LOG V_INT V_REAL V_CMPLX V_PRT V_SEV V_PDG @ %def V_OBS1_INT V_OBS2_INT V_OBS1_REAL V_OBS2_REAL @ %def V_UOBS1_INT V_UOBS2_INT V_UOBS1_REAL V_UOBS2_REAL @ \subsubsection{The type} This is an entry in the variable list. It can be of any type; in each case only one value is allocated. It may be physically allocated upon creation, in which case [[is_allocated]] is true, or it may contain just a pointer to a value somewhere else, in which case [[is_allocated]] is false. The flag [[is_defined]] is set when the variable is given a value, even the undefined value. (Therefore it is distinct from [[is_known]].) This matters for variable declaration in the SINDARIN language. The variable is set up in the compilation step and initially marked as defined, but after compilation all variables are set undefined. Each variable becomes defined when it is explicitly set. The difference matters in loops. [[is_locked]] means that it cannot be given a value using the interface routines [[var_list_set_XXX]] below. It can only be initialized, or change automatically due to a side effect. [[is_copy]] means that this is a local copy of a global variable. The copy has a pointer to the original, which can be used to restore a previous value. [[is_intrinsic]] means that this variable is defined by the program, not by the user. Intrinsic variables cannot be (re)declared, but their values can be reset unless they are locked. [[is_user_var]] means that the variable has been declared by the user. It could be a new variable, or a local copy of an intrinsic variable. The flag [[is_known]] is a pointer which parallels the use of the value pointer. For pointer variables, it is set if the value should point to a known value. For ordinary variables, it should be true. The value is implemented as a set of alternative type-specific pointers. This emulates polymorphism, and it allows for actual pointer variables. Observable-type variables have function pointers as values, so they behave like macros. The functions make use of the particle objects accessible via the pointers [[prt1]] and [[prt2]]. Finally, the [[next]] pointer indicates that we are making lists of variables. A more efficient implementation might switch to hashes or similar; the current implementation has $O(N)$ lookup. <>= public :: var_entry_t <>= type :: var_entry_t private integer :: type = V_NONE type(string_t) :: name logical :: is_allocated = .false. logical :: is_defined = .false. logical :: is_locked = .false. logical :: is_intrinsic = .false. logical :: is_user_var = .false. logical, pointer :: is_known => null () logical, pointer :: lval => null () integer, pointer :: ival => null () real(default), pointer :: rval => null () complex(default), pointer :: cval => null () type(subevt_t), pointer :: pval => null () type(pdg_array_t), pointer :: aval => null () type(string_t), pointer :: sval => null () procedure(obs_unary_int), nopass, pointer :: obs1_int => null () procedure(obs_unary_real), nopass, pointer :: obs1_real => null () procedure(obs_binary_int), nopass, pointer :: obs2_int => null () procedure(obs_binary_real), nopass, pointer :: obs2_real => null () type(prt_t), pointer :: prt1 => null () type(prt_t), pointer :: prt2 => null () type(var_entry_t), pointer :: next => null () type(var_entry_t), pointer :: previous => null () type(string_t) :: description end type var_entry_t @ %def var_entry_t @ \subsubsection{Interfaces for the observable functions} <>= public :: obs_unary_int public :: obs_unary_real public :: obs_binary_int public :: obs_binary_real <>= abstract interface function obs_unary_int (prt1) result (ival) import integer :: ival type(prt_t), intent(in) :: prt1 end function obs_unary_int end interface abstract interface function obs_unary_real (prt1) result (rval) import real(default) :: rval type(prt_t), intent(in) :: prt1 end function obs_unary_real end interface abstract interface function obs_binary_int (prt1, prt2) result (ival) import integer :: ival type(prt_t), intent(in) :: prt1, prt2 end function obs_binary_int end interface abstract interface function obs_binary_real (prt1, prt2) result (rval) import real(default) :: rval type(prt_t), intent(in) :: prt1, prt2 end function obs_binary_real end interface @ %def obs_unary_int obs_unary_real obs_binary_real @ \subsubsection{Initialization} Initialize an entry, optionally with a physical value. We also allocate the [[is_known]] flag and set it if the value is set. <>= public :: var_entry_init_int <>= subroutine var_entry_init_log (var, name, lval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name logical, intent(in), optional :: lval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_LOG allocate (var%lval, var%is_known) if (present (lval)) then var%lval = lval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_log subroutine var_entry_init_int (var, name, ival, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name integer, intent(in), optional :: ival logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_INT allocate (var%ival, var%is_known) if (present (ival)) then var%ival = ival var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_int subroutine var_entry_init_real (var, name, rval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name real(default), intent(in), optional :: rval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_REAL allocate (var%rval, var%is_known) if (present (rval)) then var%rval = rval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_real subroutine var_entry_init_cmplx (var, name, cval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name complex(default), intent(in), optional :: cval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_CMPLX allocate (var%cval, var%is_known) if (present (cval)) then var%cval = cval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_cmplx subroutine var_entry_init_subevt (var, name, pval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(subevt_t), intent(in), optional :: pval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_SEV allocate (var%pval, var%is_known) if (present (pval)) then var%pval = pval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_subevt subroutine var_entry_init_pdg_array (var, name, aval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(pdg_array_t), intent(in), optional :: aval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_PDG allocate (var%aval, var%is_known) if (present (aval)) then var%aval = aval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_pdg_array subroutine var_entry_init_string (var, name, sval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(string_t), intent(in), optional :: sval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_STR allocate (var%sval, var%is_known) if (present (sval)) then var%sval = sval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_string @ %def var_entry_init_log @ %def var_entry_init_int @ %def var_entry_init_real @ %def var_entry_init_cmplx @ %def var_entry_init_subevt @ %def var_entry_init_pdg_array @ %def var_entry_init_string @ Initialize an entry with a pointer to the value and, for numeric/logical values, a pointer to the [[is_known]] flag. <>= subroutine var_entry_init_log_ptr (var, name, lval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name logical, intent(in), target :: lval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_LOG var%lval => lval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_log_ptr subroutine var_entry_init_int_ptr (var, name, ival, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name integer, intent(in), target :: ival logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_INT var%ival => ival var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_int_ptr subroutine var_entry_init_real_ptr (var, name, rval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name real(default), intent(in), target :: rval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_REAL var%rval => rval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_real_ptr subroutine var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name complex(default), intent(in), target :: cval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_CMPLX var%cval => cval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_cmplx_ptr subroutine var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(pdg_array_t), intent(in), target :: aval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_PDG var%aval => aval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_pdg_array_ptr subroutine var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(subevt_t), intent(in), target :: pval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_SEV var%pval => pval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_subevt_ptr subroutine var_entry_init_string_ptr (var, name, sval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(string_t), intent(in), target :: sval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_STR var%sval => sval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_string_ptr @ %def var_entry_init_log_ptr @ %def var_entry_init_int_ptr @ %def var_entry_init_real_ptr @ %def var_entry_init_cmplx_ptr @ %def var_entry_init_pdg_array_ptr @ %def var_entry_init_subevt_ptr @ %def var_entry_init_string_ptr @ Initialize an entry with an observable. The procedure pointer is not yet set. <>= subroutine var_entry_init_obs (var, name, type, prt1, prt2) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name integer, intent(in) :: type type(prt_t), intent(in), target :: prt1 type(prt_t), intent(in), optional, target :: prt2 var%type = type var%name = name var%prt1 => prt1 if (present (prt2)) var%prt2 => prt2 var%is_intrinsic = .true. var%is_defined = .true. end subroutine var_entry_init_obs @ %def var_entry_init_obs @ Mark an entry as undefined it it is a user-defined variable object, so force re-initialization. <>= subroutine var_entry_undefine (var) type(var_entry_t), intent(inout) :: var var%is_defined = .not. var%is_user_var var%is_known = var%is_defined .and. var%is_known end subroutine var_entry_undefine @ %def var_entry_undefine @ Clear an entry: mark it as unknown. <>= subroutine var_entry_clear (var) type(var_entry_t), intent(inout) :: var var%is_known = .false. end subroutine var_entry_clear @ %def var_entry_clear @ Lock an entry: forbid resetting the entry after initialization. <>= subroutine var_entry_lock (var, locked) type(var_entry_t), intent(inout) :: var logical, intent(in), optional :: locked if (present (locked)) then var%is_locked = locked else var%is_locked = .true. end if end subroutine var_entry_lock @ %def var_entry_lock @ \subsubsection{Finalizer} <>= subroutine var_entry_final (var) type(var_entry_t), intent(inout) :: var if (var%is_allocated) then select case (var%type) case (V_LOG); deallocate (var%lval) case (V_INT); deallocate (var%ival) case (V_REAL);deallocate (var%rval) case (V_CMPLX);deallocate (var%cval) case (V_SEV); deallocate (var%pval) case (V_PDG); deallocate (var%aval) case (V_STR); deallocate (var%sval) end select deallocate (var%is_known) var%is_allocated = .false. var%is_defined = .false. end if end subroutine var_entry_final @ %def var_entry_final @ \subsubsection{Output} <>= recursive subroutine var_entry_write (var, unit, model_name, & intrinsic, pacified, descriptions, ascii_output) type(var_entry_t), intent(in) :: var integer, intent(in), optional :: unit type(string_t), intent(in), optional :: model_name logical, intent(in), optional :: intrinsic logical, intent(in), optional :: pacified logical, intent(in), optional :: descriptions logical, intent(in), optional :: ascii_output type(string_t) :: col_string logical :: show_desc, ao integer :: u u = given_output_unit (unit); if (u < 0) return show_desc = .false.; if (present (descriptions)) show_desc = descriptions ao = .false.; if (present (ascii_output)) ao = ascii_output if (show_desc) then if (ao) then col_string = create_col_string (COL_BLUE) if (var%is_locked) then write (u, "(A)", advance="no") char (achar(27) // col_string) // & char (var%name) // achar(27) // "[0m" //" fixed-value=" else write (u, "(A)", advance="no") char (achar(27) // col_string) // & char (var%name) // achar(27) // "[0m" //" default=" end if col_string = create_col_string (COL_RED) write (u, "(A)", advance="no") char (achar(27) // col_string) call var_write_val (var, u, "no", pacified=.true.) write (u, "(A)") achar(27) // "[0m" write (u, "(A)") char (var%description) return else write (u, "(A)") "\item" write (u, "(A)", advance="no") "\ttt{" // char ( & replace (replace (var%name, "_", "\_", every=.true.), "$", "\$" )) // & "} " if (var%is_known) then if (var%is_locked) then write (u, "(A)", advance="no") "\qquad (fixed value: \ttt{" else write (u, "(A)", advance="no") "\qquad (default: \ttt{" end if call var_write_val (var, u, "no", pacified=.true., escape_tex=.true.) write (u, "(A)", advance="no") "})" end if write (u, "(A)") " \newline" write (u, "(A)") char (var%description) write (u, "(A)") "%%%%%" return end if end if if (present (intrinsic)) then if (var%is_intrinsic .neqv. intrinsic) return end if if (.not. var%is_defined) then write (u, "(A,1x)", advance="no") "[undefined]" end if if (.not. var%is_intrinsic) then write (u, "(A,1x)", advance="no") "[user variable]" end if if (present (model_name)) then write (u, "(A,A)", advance="no") char(model_name), "." end if write (u, "(A)", advance="no") char (var%name) if (var%is_locked) write (u, "(A)", advance="no") "*" if (var%is_allocated) then write (u, "(A)", advance="no") " = " else if (var%type /= V_NONE) then write (u, "(A)", advance="no") " => " end if call var_write_val (var, u, "yes", pacified) end subroutine var_entry_write @ %def var_entry_write @ <>= subroutine var_write_val (var, u, advance, pacified, escape_tex) type(var_entry_t), intent(in) :: var integer, intent(in) :: u character(*), intent(in) :: advance logical, intent(in), optional :: pacified, escape_tex logical :: num_pac, et real(default) :: rval complex(default) :: cval character(len=7) :: fmt call pac_fmt (fmt, FMT_19, FMT_12, pacified) num_pac = .false.; if (present (pacified)) num_pac = pacified et = .false.; if (present (escape_tex)) et = escape_tex select case (var%type) case (V_NONE); write (u, '()', advance=advance) case (V_LOG) if (var%is_known) then if (var%lval) then write (u, "(A)", advance=advance) "true" else write (u, "(A)", advance=advance) "false" end if else write (u, "(A)", advance=advance) "[unknown logical]" end if case (V_INT) if (var%is_known) then write (u, "(I0)", advance=advance) var%ival else write (u, "(A)", advance=advance) "[unknown integer]" end if case (V_REAL) if (var%is_known) then rval = var%rval if (num_pac) then call pacify (rval, 10 * eps0) end if write (u, "(" // fmt // ")", advance=advance) rval else write (u, "(A)", advance=advance) "[unknown real]" end if case (V_CMPLX) if (var%is_known) then cval = var%cval if (num_pac) then call pacify (cval, 10 * eps0) end if write (u, "('('," // fmt // ",','," // fmt // ",')')", advance=advance) cval else write (u, "(A)", advance=advance) "[unknown complex]" end if case (V_SEV) if (var%is_known) then call subevt_write (var%pval, u, prefix=" ", & pacified = pacified) else write (u, "(A)", advance=advance) "[unknown subevent]" end if case (V_PDG) if (var%is_known) then call pdg_array_write (var%aval, u); write (u, *) else write (u, "(A)", advance=advance) "[unknown PDG array]" end if case (V_STR) if (var%is_known) then if (et) then write (u, "(A)", advance=advance) '"' // char (replace ( & replace (var%sval, "_", "\_", every=.true.), "$", "\$" )) // '"' else write (u, "(A)", advance=advance) '"' // char (var%sval) // '"' end if else write (u, "(A)", advance=advance) "[unknown string]" end if case (V_OBS1_INT); write (u, "(A)", advance=advance) "[int] = unary observable" case (V_OBS2_INT); write (u, "(A)", advance=advance) "[int] = binary observable" case (V_OBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary observable" case (V_OBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary observable" case (V_UOBS1_INT); write (u, "(A)", advance=advance) "[int] = unary user observable" case (V_UOBS2_INT); write (u, "(A)", advance=advance) "[int] = binary user observable" case (V_UOBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary user observable" case (V_UOBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary user observable" end select end subroutine var_write_val @ %def procedure @ \subsubsection{Accessing contents} <>= function var_entry_get_name (var) result (name) type(string_t) :: name type(var_entry_t), intent(in) :: var name = var%name end function var_entry_get_name function var_entry_get_type (var) result (type) integer :: type type(var_entry_t), intent(in) :: var type = var%type end function var_entry_get_type @ %def var_entry_get_name var_entry_get_type @ Return true if the variable is defined. This the case if it is allocated and known, or if it is a pointer. <>= function var_entry_is_defined (var) result (defined) logical :: defined type(var_entry_t), intent(in) :: var defined = var%is_defined end function var_entry_is_defined @ %def var_entry_is_defined @ Return true if the variable is locked. If [[force]] is active, always return false. <>= function var_entry_is_locked (var, force) result (locked) logical :: locked type(var_entry_t), intent(in) :: var logical, intent(in), optional :: force if (present (force)) then if (force) then locked = .false.; return end if end if locked = var%is_locked end function var_entry_is_locked @ %def var_entry_is_locked @ Return true if the variable is intrinsic <>= function var_entry_is_intrinsic (var) result (flag) logical :: flag type(var_entry_t), intent(in) :: var flag = var%is_intrinsic end function var_entry_is_intrinsic @ %def var_entry_is_intrinsic @ Return components <>= function var_entry_is_known (var) result (flag) logical :: flag type(var_entry_t), intent(in) :: var flag = var%is_known end function var_entry_is_known function var_entry_get_lval (var) result (lval) logical :: lval type(var_entry_t), intent(in) :: var lval = var%lval end function var_entry_get_lval function var_entry_get_ival (var) result (ival) integer :: ival type(var_entry_t), intent(in) :: var ival = var%ival end function var_entry_get_ival function var_entry_get_rval (var) result (rval) real(default) :: rval type(var_entry_t), intent(in) :: var rval = var%rval end function var_entry_get_rval function var_entry_get_cval (var) result (cval) complex(default) :: cval type(var_entry_t), intent(in) :: var cval = var%cval end function var_entry_get_cval function var_entry_get_aval (var) result (aval) type(pdg_array_t) :: aval type(var_entry_t), intent(in) :: var aval = var%aval end function var_entry_get_aval function var_entry_get_pval (var) result (pval) type(subevt_t) :: pval type(var_entry_t), intent(in) :: var pval = var%pval end function var_entry_get_pval function var_entry_get_sval (var) result (sval) type(string_t) :: sval type(var_entry_t), intent(in) :: var sval = var%sval end function var_entry_get_sval @ %def var_entry_get_lval @ %def var_entry_get_ival @ %def var_entry_get_rval @ %def var_entry_get_cval @ %def var_entry_get_aval @ %def var_entry_get_pval @ %def var_entry_get_sval @ Return pointers to components. <>= function var_entry_get_known_ptr (var) result (ptr) logical, pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%is_known end function var_entry_get_known_ptr function var_entry_get_lval_ptr (var) result (ptr) logical, pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%lval end function var_entry_get_lval_ptr function var_entry_get_ival_ptr (var) result (ptr) integer, pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%ival end function var_entry_get_ival_ptr function var_entry_get_rval_ptr (var) result (ptr) real(default), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%rval end function var_entry_get_rval_ptr function var_entry_get_cval_ptr (var) result (ptr) complex(default), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%cval end function var_entry_get_cval_ptr function var_entry_get_pval_ptr (var) result (ptr) type(subevt_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%pval end function var_entry_get_pval_ptr function var_entry_get_aval_ptr (var) result (ptr) type(pdg_array_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%aval end function var_entry_get_aval_ptr function var_entry_get_sval_ptr (var) result (ptr) type(string_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%sval end function var_entry_get_sval_ptr @ %def var_entry_get_known_ptr @ %def var_entry_get_lval_ptr var_entry_get_ival_ptr var_entry_get_rval_ptr @ %def var_entry_get_cval_ptr var_entry_get_aval_ptr var_entry_get_pval_ptr @ %def var_entry_get_sval_ptr @ Furthermore, <>= function var_entry_get_prt1_ptr (var) result (ptr) type(prt_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%prt1 end function var_entry_get_prt1_ptr function var_entry_get_prt2_ptr (var) result (ptr) type(prt_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%prt2 end function var_entry_get_prt2_ptr @ %def var_entry_get_prt1_ptr @ %def var_entry_get_prt2_ptr @ Subroutines might be safer than functions for procedure pointer transfer (there was a nagfor bug). <>= subroutine var_entry_assign_obs1_int_ptr (ptr, var) procedure(obs_unary_int), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs1_int end subroutine var_entry_assign_obs1_int_ptr subroutine var_entry_assign_obs1_real_ptr (ptr, var) procedure(obs_unary_real), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs1_real end subroutine var_entry_assign_obs1_real_ptr subroutine var_entry_assign_obs2_int_ptr (ptr, var) procedure(obs_binary_int), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs2_int end subroutine var_entry_assign_obs2_int_ptr subroutine var_entry_assign_obs2_real_ptr (ptr, var) procedure(obs_binary_real), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs2_real end subroutine var_entry_assign_obs2_real_ptr @ %def var_entry_assign_obs1_int_ptr var_entry_assign_obs1_real_ptr @ %def var_entry_assign_obs2_int_ptr var_entry_assign_obs2_real_ptr @ \subsection{Setting values} Undefine the value. <>= subroutine var_entry_clear_value (var) type(var_entry_t), intent(inout) :: var var%is_known = .false. end subroutine var_entry_clear_value @ %def var_entry_clear_value <>= recursive subroutine var_entry_set_log & (var, lval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var logical, intent(in) :: lval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%lval = lval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_log recursive subroutine var_entry_set_int & (var, ival, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var integer, intent(in) :: ival logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%ival = ival var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_int recursive subroutine var_entry_set_real & (var, rval, is_known, verbose, model_name, pacified) type(var_entry_t), intent(inout) :: var real(default), intent(in) :: rval logical, intent(in) :: is_known logical, intent(in), optional :: verbose, pacified type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%rval = rval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write & (var, model_name=model_name, pacified = pacified) call var_entry_write & (var, model_name=model_name, unit=u, pacified = pacified) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_real recursive subroutine var_entry_set_cmplx & (var, cval, is_known, verbose, model_name, pacified) type(var_entry_t), intent(inout) :: var complex(default), intent(in) :: cval logical, intent(in) :: is_known logical, intent(in), optional :: verbose, pacified type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%cval = cval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write & (var, model_name=model_name, pacified = pacified) call var_entry_write & (var, model_name=model_name, unit=u, pacified = pacified) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_cmplx recursive subroutine var_entry_set_pdg_array & (var, aval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var type(pdg_array_t), intent(in) :: aval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%aval = aval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_pdg_array recursive subroutine var_entry_set_subevt & (var, pval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var type(subevt_t), intent(in) :: pval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%pval = pval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_subevt recursive subroutine var_entry_set_string & (var, sval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var type(string_t), intent(in) :: sval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%sval = sval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_string @ %def var_entry_set_log @ %def var_entry_set_int @ %def var_entry_set_real @ %def var_entry_set_cmplx @ %def var_entry_set_pdg_array @ %def var_entry_set_subevt @ %def var_entry_set_string @ <>= public :: var_entry_set_description <>= pure subroutine var_entry_set_description (var_entry, description) type(var_entry_t), intent(inout) :: var_entry type(string_t), intent(in) :: description var_entry%description = description end subroutine var_entry_set_description @ %def var_entry_set_description @ \subsection{Copies and pointer variables} Initialize an entry with a copy of an existing variable entry. The copy is physically allocated with the same type as the original. <>= subroutine var_entry_init_copy (var, original, user) type(var_entry_t), intent(out) :: var type(var_entry_t), intent(in), target :: original logical, intent(in), optional :: user type(string_t) :: name logical :: intrinsic name = var_entry_get_name (original) intrinsic = original%is_intrinsic select case (original%type) case (V_LOG) call var_entry_init_log (var, name, intrinsic=intrinsic, user=user) case (V_INT) call var_entry_init_int (var, name, intrinsic=intrinsic, user=user) case (V_REAL) call var_entry_init_real (var, name, intrinsic=intrinsic, user=user) case (V_CMPLX) call var_entry_init_cmplx (var, name, intrinsic=intrinsic, user=user) case (V_SEV) call var_entry_init_subevt (var, name, intrinsic=intrinsic, user=user) case (V_PDG) call var_entry_init_pdg_array (var, name, intrinsic=intrinsic, user=user) case (V_STR) call var_entry_init_string (var, name, intrinsic=intrinsic, user=user) end select end subroutine var_entry_init_copy @ %def var_entry_init_copy @ Copy the value of an entry. The target variable entry must be initialized correctly. <>= subroutine var_entry_copy_value (var, original) type(var_entry_t), intent(inout) :: var type(var_entry_t), intent(in), target :: original if (var_entry_is_known (original)) then select case (original%type) case (V_LOG) call var_entry_set_log (var, var_entry_get_lval (original), .true.) case (V_INT) call var_entry_set_int (var, var_entry_get_ival (original), .true.) case (V_REAL) call var_entry_set_real (var, var_entry_get_rval (original), .true.) case (V_CMPLX) call var_entry_set_cmplx (var, var_entry_get_cval (original), .true.) case (V_SEV) call var_entry_set_subevt (var, var_entry_get_pval (original), .true.) case (V_PDG) call var_entry_set_pdg_array (var, var_entry_get_aval (original), .true.) case (V_STR) call var_entry_set_string (var, var_entry_get_sval (original), .true.) end select else call var_entry_clear (var) end if end subroutine var_entry_copy_value @ %def var_entry_copy_value @ \subsection{Variable lists} \subsubsection{The type} Variable lists can be linked together. No initializer needed. They are deleted separately. <>= public :: var_list_t <>= type, extends (vars_t) :: var_list_t private type(var_entry_t), pointer :: first => null () type(var_entry_t), pointer :: last => null () type(var_list_t), pointer :: next => null () contains <> end type var_list_t @ %def var_list_t @ \subsubsection{Constructors} Implementation of the [[link]] deferred method. The implementation restricts itself to var lists of the same type. We might need to relax this constraint. <>= procedure :: link => var_list_link <>= subroutine var_list_link (vars, target_vars) class(var_list_t), intent(inout) :: vars class(vars_t), intent(in), target :: target_vars select type (target_vars) type is (var_list_t) vars%next => target_vars class default call msg_bug ("var_list_link: unsupported target type") end select end subroutine var_list_link @ %def var_list_link @ Append a new entry to an existing list. <>= subroutine var_list_append (var_list, var, verbose) type(var_list_t), intent(inout), target :: var_list type(var_entry_t), intent(inout), target :: var logical, intent(in), optional :: verbose if (associated (var_list%last)) then var%previous => var_list%last var_list%last%next => var else var%previous => null () var_list%first => var end if var_list%last => var if (present (verbose)) then if (verbose) call var_entry_write (var) end if end subroutine var_list_append @ %def var_list_append @ Sort a list. <>= procedure :: sort => var_list_sort <>= subroutine var_list_sort (var_list) class(var_list_t), intent(inout) :: var_list type(var_entry_t), pointer :: var, previous if (associated (var_list%first)) then var => var_list%first do while (associated (var)) previous => var%previous do while (associated (previous)) if (larger_var (previous, var)) then call var_list%swap_with_next (previous) end if previous => previous%previous end do var => var%next end do end if end subroutine var_list_sort @ %def var_list_sort @ <>= pure function larger_var (var1, var2) result (larger) logical :: larger type(var_entry_t), intent(in) :: var1, var2 type(string_t) :: str1, str2 str1 = replace (var1%name, "?", "") str1 = replace (str1, "$", "") str2 = replace (var2%name, "?", "") str2 = replace (str2, "$", "") larger = str1 > str2 end function larger_var @ %def larger_var @ <>= procedure :: get_previous => var_list_get_previous <>= function var_list_get_previous (var_list, var_entry) result (previous) type(var_entry_t), pointer :: previous class(var_list_t), intent(in) :: var_list type(var_entry_t), intent(in) :: var_entry previous => var_list%first if (previous%name == var_entry%name) then previous => null () else do while (associated (previous)) if (previous%next%name == var_entry%name) exit previous => previous%next end do end if end function var_list_get_previous @ %def var_list_get_previous @ <>= procedure :: swap_with_next => var_list_swap_with_next <>= subroutine var_list_swap_with_next (var_list, var_entry) class(var_list_t), intent(inout) :: var_list type(var_entry_t), intent(in) :: var_entry type(var_entry_t), pointer :: previous, this, next, next_next previous => var_list%get_previous (var_entry) if (.not. associated (previous)) then this => var_list%first else this => previous%next end if next => this%next next_next => next%next if (associated (previous)) then previous%next => next next%previous => previous else var_list%first => next next%previous => null () end if this%next => next_next if (associated (next_next)) then next_next%previous => this end if next%next => this this%previous => next if (.not. associated (next%next)) then var_list%last => next end if end subroutine var_list_swap_with_next @ %def var_list_swap_with_next @ Public methods for expanding the variable list (as subroutines) <>= generic :: append_log => var_list_append_log_s, var_list_append_log_c procedure, private :: var_list_append_log_s procedure, private :: var_list_append_log_c generic :: append_int => var_list_append_int_s, var_list_append_int_c procedure, private :: var_list_append_int_s procedure, private :: var_list_append_int_c generic :: append_real => var_list_append_real_s, var_list_append_real_c procedure, private :: var_list_append_real_s procedure, private :: var_list_append_real_c generic :: append_cmplx => var_list_append_cmplx_s, var_list_append_cmplx_c procedure, private :: var_list_append_cmplx_s procedure, private :: var_list_append_cmplx_c generic :: append_subevt => var_list_append_subevt_s, var_list_append_subevt_c procedure, private :: var_list_append_subevt_s procedure, private :: var_list_append_subevt_c generic :: append_pdg_array => var_list_append_pdg_array_s, var_list_append_pdg_array_c procedure, private :: var_list_append_pdg_array_s procedure, private :: var_list_append_pdg_array_c generic :: append_string => var_list_append_string_s, var_list_append_string_c procedure, private :: var_list_append_string_s procedure, private :: var_list_append_string_c <>= public :: var_list_append_log public :: var_list_append_int public :: var_list_append_real public :: var_list_append_cmplx public :: var_list_append_subevt public :: var_list_append_pdg_array public :: var_list_append_string <>= interface var_list_append_log module procedure var_list_append_log_s module procedure var_list_append_log_c end interface interface var_list_append_int module procedure var_list_append_int_s module procedure var_list_append_int_c end interface interface var_list_append_real module procedure var_list_append_real_s module procedure var_list_append_real_c end interface interface var_list_append_cmplx module procedure var_list_append_cmplx_s module procedure var_list_append_cmplx_c end interface interface var_list_append_subevt module procedure var_list_append_subevt_s module procedure var_list_append_subevt_c end interface interface var_list_append_pdg_array module procedure var_list_append_pdg_array_s module procedure var_list_append_pdg_array_c end interface interface var_list_append_string module procedure var_list_append_string_s module procedure var_list_append_string_c end interface <>= subroutine var_list_append_log_s & (var_list, name, lval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name logical, intent(in), optional :: lval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_log (var, name, lval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_log_s subroutine var_list_append_int_s & (var_list, name, ival, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name integer, intent(in), optional :: ival logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_int (var, name, ival, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_int_s subroutine var_list_append_real_s & (var_list, name, rval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name real(default), intent(in), optional :: rval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_real (var, name, rval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_real_s subroutine var_list_append_cmplx_s & (var_list, name, cval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name complex(default), intent(in), optional :: cval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_cmplx (var, name, cval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_cmplx_s subroutine var_list_append_subevt_s & (var_list, name, pval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(subevt_t), intent(in), optional :: pval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_subevt (var, name, pval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_subevt_s subroutine var_list_append_pdg_array_s & (var_list, name, aval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(pdg_array_t), intent(in), optional :: aval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_pdg_array (var, name, aval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_pdg_array_s subroutine var_list_append_string_s & (var_list, name, sval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(string_t), intent(in), optional :: sval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_string (var, name, sval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_string_s subroutine var_list_append_log_c & (var_list, name, lval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name logical, intent(in), optional :: lval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_log_s & (var_list, var_str (name), lval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_log_c subroutine var_list_append_int_c & (var_list, name, ival, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name integer, intent(in), optional :: ival logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_int_s & (var_list, var_str (name), ival, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_int_c subroutine var_list_append_real_c & (var_list, name, rval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name real(default), intent(in), optional :: rval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_real_s & (var_list, var_str (name), rval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_real_c subroutine var_list_append_cmplx_c & (var_list, name, cval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name complex(default), intent(in), optional :: cval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_cmplx_s & (var_list, var_str (name), cval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_cmplx_c subroutine var_list_append_subevt_c & (var_list, name, pval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name type(subevt_t), intent(in), optional :: pval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_subevt_s & (var_list, var_str (name), pval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_subevt_c subroutine var_list_append_pdg_array_c & (var_list, name, aval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name type(pdg_array_t), intent(in), optional :: aval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_pdg_array_s & (var_list, var_str (name), aval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_pdg_array_c subroutine var_list_append_string_c & (var_list, name, sval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name character(*), intent(in), optional :: sval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description if (present (sval)) then call var_list_append_string_s & (var_list, var_str (name), var_str (sval), & locked, verbose, intrinsic, user, description) else call var_list_append_string_s & (var_list, var_str (name), & locked=locked, verbose=verbose, intrinsic=intrinsic, & user=user, description=description) end if end subroutine var_list_append_string_c @ %def var_list_append_log @ %def var_list_append_int @ %def var_list_append_real @ %def var_list_append_cmplx @ %def var_list_append_subevt @ %def var_list_append_pdg_array @ %def var_list_append_string <>= public :: var_list_append_log_ptr public :: var_list_append_int_ptr public :: var_list_append_real_ptr public :: var_list_append_cmplx_ptr public :: var_list_append_pdg_array_ptr public :: var_list_append_subevt_ptr public :: var_list_append_string_ptr <>= procedure :: append_log_ptr => var_list_append_log_ptr procedure :: append_int_ptr => var_list_append_int_ptr procedure :: append_real_ptr => var_list_append_real_ptr procedure :: append_cmplx_ptr => var_list_append_cmplx_ptr procedure :: append_pdg_array_ptr => var_list_append_pdg_array_ptr procedure :: append_subevt_ptr => var_list_append_subevt_ptr procedure :: append_string_ptr => var_list_append_string_ptr <>= subroutine var_list_append_log_ptr & (var_list, name, lval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name logical, intent(in), target :: lval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_log_ptr (var, name, lval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_log_ptr subroutine var_list_append_int_ptr & (var_list, name, ival, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name integer, intent(in), target :: ival logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_int_ptr (var, name, ival, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_int_ptr subroutine var_list_append_real_ptr & (var_list, name, rval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name real(default), intent(in), target :: rval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_real_ptr (var, name, rval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_real_ptr subroutine var_list_append_cmplx_ptr & (var_list, name, cval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name complex(default), intent(in), target :: cval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_cmplx_ptr subroutine var_list_append_pdg_array_ptr & (var_list, name, aval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(pdg_array_t), intent(in), target :: aval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_pdg_array_ptr subroutine var_list_append_subevt_ptr & (var_list, name, pval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(subevt_t), intent(in), target :: pval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_subevt_ptr subroutine var_list_append_string_ptr & (var_list, name, sval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(string_t), intent(in), target :: sval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_string_ptr (var, name, sval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_string_ptr @ %def var_list_append_log_ptr @ %def var_list_append_int_ptr @ %def var_list_append_real_ptr @ %def var_list_append_cmplx_ptr @ %def var_list_append_pdg_array_ptr @ %def var_list_append_subevt_ptr @ \subsubsection{Finalizer} Finalize, delete the list entry by entry. The link itself is kept intact. Follow link and delete recursively only if requested explicitly. <>= procedure :: final => var_list_final <>= recursive subroutine var_list_final (vars, follow_link) class(var_list_t), intent(inout) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var vars%last => null () do while (associated (vars%first)) var => vars%first vars%first => var%next call var_entry_final (var) deallocate (var) end do if (present (follow_link)) then if (follow_link) then if (associated (vars%next)) then call vars%next%final (follow_link) deallocate (vars%next) end if end if end if end subroutine var_list_final @ %def var_list_final @ \subsubsection{Output} Show variable list with precise control over options. E.g., show only variables of a certain type. Many options, thus not an ordinary [[write]] method. <>= public :: var_list_write <>= procedure :: write => var_list_write <>= recursive subroutine var_list_write & (var_list, unit, follow_link, only_type, prefix, model_name, & intrinsic, pacified, descriptions, ascii_output) class(var_list_t), intent(in), target :: var_list integer, intent(in), optional :: unit logical, intent(in), optional :: follow_link integer, intent(in), optional :: only_type character(*), intent(in), optional :: prefix type(string_t), intent(in), optional :: model_name logical, intent(in), optional :: intrinsic logical, intent(in), optional :: pacified logical, intent(in), optional :: descriptions logical, intent(in), optional :: ascii_output type(var_entry_t), pointer :: var integer :: u, length logical :: write_this, write_next u = given_output_unit (unit); if (u < 0) return if (present (prefix)) length = len (prefix) var => var_list%first if (associated (var)) then do while (associated (var)) if (present (only_type)) then write_this = only_type == var%type else write_this = .true. end if if (write_this .and. present (prefix)) then if (prefix /= extract (var%name, 1, length)) & write_this = .false. end if if (write_this) then call var_entry_write & (var, unit, model_name=model_name, & intrinsic=intrinsic, pacified=pacified, & descriptions=descriptions, ascii_output=ascii_output) end if var => var%next end do end if if (present (follow_link)) then write_next = follow_link .and. associated (var_list%next) else write_next = associated (var_list%next) end if if (write_next) then call var_list_write (var_list%next, & unit, follow_link, only_type, prefix, model_name, & intrinsic, pacified) end if end subroutine var_list_write @ %def var_list_write @ Write only a certain variable. <>= public :: var_list_write_var <>= procedure :: write_var => var_list_write_var <>= recursive subroutine var_list_write_var & (var_list, name, unit, type, follow_link, & model_name, pacified, defined, descriptions, ascii_output) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(in), optional :: unit integer, intent(in), optional :: type logical, intent(in), optional :: follow_link type(string_t), intent(in), optional :: model_name logical, intent(in), optional :: pacified logical, intent(in), optional :: defined logical, intent(in), optional :: descriptions logical, intent(in), optional :: ascii_output type(var_entry_t), pointer :: var integer :: u u = given_output_unit (unit); if (u < 0) return var => var_list_get_var_ptr & (var_list, name, type, follow_link=follow_link, defined=defined) if (associated (var)) then call var_entry_write & (var, unit, model_name = model_name, & pacified = pacified, & descriptions=descriptions, ascii_output=ascii_output) else write (u, "(A)") char (name) // " = [undefined]" end if end subroutine var_list_write_var @ %def var_list_write_var @ \subsection{Tools} Return a pointer to the variable list linked to by the current one. <>= function var_list_get_next_ptr (var_list) result (next_ptr) type(var_list_t), pointer :: next_ptr type(var_list_t), intent(in) :: var_list next_ptr => var_list%next end function var_list_get_next_ptr @ %def var_list_get_next_ptr @ Used by [[eval_trees]]: Return a pointer to the variable with the requested name. If no such name exists, return a null pointer. In that case, try the next list if present, unless [[follow_link]] is unset. If [[defined]] is set, ignore entries that exist but are undefined. <>= public :: var_list_get_var_ptr <>= recursive function var_list_get_var_ptr & (var_list, name, type, follow_link, defined) result (var) type(var_entry_t), pointer :: var type(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(in), optional :: type logical, intent(in), optional :: follow_link, defined logical :: ignore_undef, search_next ignore_undef = .true.; if (present (defined)) ignore_undef = .not. defined var => var_list%first if (present (type)) then do while (associated (var)) if (var%type == type) then if (var%name == name) then if (ignore_undef .or. var%is_defined) return end if end if var => var%next end do else do while (associated (var)) if (var%name == name) then if (ignore_undef .or. var%is_defined) return end if var => var%next end do end if search_next = associated (var_list%next) if (present (follow_link)) & search_next = search_next .and. follow_link if (search_next) & var => var_list_get_var_ptr & (var_list%next, name, type, defined=defined) end function var_list_get_var_ptr @ %def var_list_get_var_ptr @ Return the variable type <>= procedure :: get_type => var_list_get_type <>= function var_list_get_type (var_list, name, follow_link) result (type) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name logical, intent(in), optional :: follow_link integer :: type type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, follow_link=follow_link) if (associated (var)) then type = var%type else type = V_NONE end if end function var_list_get_type @ %def var_list_get_type @ Return true if the variable exists in the current list. <>= procedure :: contains => var_list_exists <>= function var_list_exists (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) lval = associated (var) end function var_list_exists @ %def var_list_exists @ Return true if the variable is declared as intrinsic. (This is not a property of the abstract [[vars_t]] type, and therefore the method is not inherited.) <>= procedure :: is_intrinsic => var_list_is_intrinsic <>= function var_list_is_intrinsic (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then lval = var%is_intrinsic else lval = .false. end if end function var_list_is_intrinsic @ %def var_list_is_intrinsic @ Return true if the value is known. <>= procedure :: is_known => var_list_is_known <>= function var_list_is_known (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then lval = var%is_known else lval = .false. end if end function var_list_is_known @ %def var_list_is_known @ Return true if the value is locked. (This is not a property of the abstract [[vars_t]] type, and therefore the method is not inherited.) <>= procedure :: is_locked => var_list_is_locked <>= function var_list_is_locked (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then lval = var_entry_is_locked (var) else lval = .false. end if end function var_list_is_locked @ %def var_list_is_locked @ Return several properties at once. <>= procedure :: get_var_properties => var_list_get_var_properties <>= subroutine var_list_get_var_properties (vars, name, req_type, follow_link, & type, is_defined, is_known, is_locked) class(var_list_t), intent(in) :: vars type(string_t), intent(in) :: name integer, intent(in), optional :: req_type logical, intent(in), optional :: follow_link integer, intent(out), optional :: type logical, intent(out), optional :: is_defined, is_known, is_locked type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, type=req_type, follow_link=follow_link) if (associated (var)) then if (present (type)) type = var_entry_get_type (var) if (present (is_defined)) is_defined = var_entry_is_defined (var) if (present (is_known)) is_known = var_entry_is_known (var) if (present (is_locked)) is_locked = var_entry_is_locked (var) else if (present (type)) type = V_NONE if (present (is_defined)) is_defined = .false. if (present (is_known)) is_known = .false. if (present (is_locked)) is_locked = .false. end if end subroutine var_list_get_var_properties @ %def var_list_get_var_properties @ Return the value, assuming that the type is correct. We consider only variable entries that have been [[defined]]. For convenience, allow both variable and fixed-length (literal) strings. <>= procedure :: get_lval => var_list_get_lval procedure :: get_ival => var_list_get_ival procedure :: get_rval => var_list_get_rval procedure :: get_cval => var_list_get_cval procedure :: get_pval => var_list_get_pval procedure :: get_aval => var_list_get_aval procedure :: get_sval => var_list_get_sval <>= function var_list_get_lval (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_LOG, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then lval = var%lval else lval = .false. end if else lval = .false. end if end function var_list_get_lval function var_list_get_ival (vars, name, follow_link) result (ival) integer :: ival type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_INT, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then ival = var%ival else ival = 0 end if else ival = 0 end if end function var_list_get_ival function var_list_get_rval (vars, name, follow_link) result (rval) real(default) :: rval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_REAL, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then rval = var%rval else rval = 0 end if else rval = 0 end if end function var_list_get_rval function var_list_get_cval (vars, name, follow_link) result (cval) complex(default) :: cval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_CMPLX, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then cval = var%cval else cval = 0 end if else cval = 0 end if end function var_list_get_cval function var_list_get_aval (vars, name, follow_link) result (aval) type(pdg_array_t) :: aval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_PDG, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then aval = var%aval end if end if end function var_list_get_aval function var_list_get_pval (vars, name, follow_link) result (pval) type(subevt_t) :: pval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_SEV, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then pval = var%pval end if end if end function var_list_get_pval function var_list_get_sval (vars, name, follow_link) result (sval) type(string_t) :: sval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_STR, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then sval = var%sval else sval = "" end if else sval = "" end if end function var_list_get_sval @ %def var_list_get_lval @ %def var_list_get_ival @ %def var_list_get_rval @ %def var_list_get_cval @ %def var_list_get_pval @ %def var_list_get_aval @ %def var_list_get_sval @ Check for a valid value, given a pointer. Issue error messages if invalid. <>= function var_has_value (var) result (valid) logical :: valid type(var_entry_t), pointer :: var if (associated (var)) then if (var%is_known) then valid = .true. else call msg_error ("The value of variable '" // char (var%name) & // "' is unknown but must be known at this point.") valid = .false. end if else call msg_error ("Variable '" // char (var%name) & // "' is undefined but must have a known value at this point.") valid = .false. end if end function var_has_value @ %def var_has_value @ Return pointers instead of values, including a pointer to the [[known]] entry. <>= procedure :: get_lptr => var_list_get_lptr procedure :: get_iptr => var_list_get_iptr procedure :: get_rptr => var_list_get_rptr procedure :: get_cptr => var_list_get_cptr procedure :: get_aptr => var_list_get_aptr procedure :: get_pptr => var_list_get_pptr procedure :: get_sptr => var_list_get_sptr <>= subroutine var_list_get_lptr (var_list, name, lptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name logical, pointer, intent(out) :: lptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_LOG) if (associated (var)) then lptr => var_entry_get_lval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else lptr => null () if (present (known)) known => null () end if end subroutine var_list_get_lptr subroutine var_list_get_iptr (var_list, name, iptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name integer, pointer, intent(out) :: iptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_INT) if (associated (var)) then iptr => var_entry_get_ival_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else iptr => null () if (present (known)) known => null () end if end subroutine var_list_get_iptr subroutine var_list_get_rptr (var_list, name, rptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name real(default), pointer, intent(out) :: rptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_REAL) if (associated (var)) then rptr => var_entry_get_rval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else rptr => null () if (present (known)) known => null () end if end subroutine var_list_get_rptr subroutine var_list_get_cptr (var_list, name, cptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name complex(default), pointer, intent(out) :: cptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_CMPLX) if (associated (var)) then cptr => var_entry_get_cval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else cptr => null () if (present (known)) known => null () end if end subroutine var_list_get_cptr subroutine var_list_get_aptr (var_list, name, aptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name type(pdg_array_t), pointer, intent(out) :: aptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_PDG) if (associated (var)) then aptr => var_entry_get_aval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else aptr => null () if (present (known)) known => null () end if end subroutine var_list_get_aptr subroutine var_list_get_pptr (var_list, name, pptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name type(subevt_t), pointer, intent(out) :: pptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_SEV) if (associated (var)) then pptr => var_entry_get_pval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else pptr => null () if (present (known)) known => null () end if end subroutine var_list_get_pptr subroutine var_list_get_sptr (var_list, name, sptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name type(string_t), pointer, intent(out) :: sptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_STR) if (associated (var)) then sptr => var_entry_get_sval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else sptr => null () if (present (known)) known => null () end if end subroutine var_list_get_sptr @ %def var_list_get_lptr @ %def var_list_get_iptr @ %def var_list_get_rptr @ %def var_list_get_cptr @ %def var_list_get_aptr @ %def var_list_get_pptr @ %def var_list_get_sptr @ This bunch of methods handles the procedure-pointer cases. <>= procedure :: get_obs1_iptr => var_list_get_obs1_iptr procedure :: get_obs2_iptr => var_list_get_obs2_iptr procedure :: get_obs1_rptr => var_list_get_obs1_rptr procedure :: get_obs2_rptr => var_list_get_obs2_rptr <>= subroutine var_list_get_obs1_iptr (var_list, name, obs1_iptr, p1) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_int), pointer, intent(out) :: obs1_iptr type(prt_t), pointer, intent(out) :: p1 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS1_INT) if (associated (var)) then call var_entry_assign_obs1_int_ptr (obs1_iptr, var) p1 => var_entry_get_prt1_ptr (var) else obs1_iptr => null () p1 => null () end if end subroutine var_list_get_obs1_iptr subroutine var_list_get_obs2_iptr (var_list, name, obs2_iptr, p1, p2) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_int), pointer, intent(out) :: obs2_iptr type(prt_t), pointer, intent(out) :: p1, p2 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS2_INT) if (associated (var)) then call var_entry_assign_obs2_int_ptr (obs2_iptr, var) p1 => var_entry_get_prt1_ptr (var) p2 => var_entry_get_prt2_ptr (var) else obs2_iptr => null () p1 => null () p2 => null () end if end subroutine var_list_get_obs2_iptr subroutine var_list_get_obs1_rptr (var_list, name, obs1_rptr, p1) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_real), pointer, intent(out) :: obs1_rptr type(prt_t), pointer, intent(out) :: p1 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS1_REAL) if (associated (var)) then call var_entry_assign_obs1_real_ptr (obs1_rptr, var) p1 => var_entry_get_prt1_ptr (var) else obs1_rptr => null () p1 => null () end if end subroutine var_list_get_obs1_rptr subroutine var_list_get_obs2_rptr (var_list, name, obs2_rptr, p1, p2) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_real), pointer, intent(out) :: obs2_rptr type(prt_t), pointer, intent(out) :: p1, p2 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS2_REAL) if (associated (var)) then call var_entry_assign_obs2_real_ptr (obs2_rptr, var) p1 => var_entry_get_prt1_ptr (var) p2 => var_entry_get_prt2_ptr (var) else obs2_rptr => null () p1 => null () p2 => null () end if end subroutine var_list_get_obs2_rptr @ %def var_list_get_obs1_iptr @ %def var_list_get_obs2_iptr @ %def var_list_get_obs1_rptr @ %def var_list_get_obs2_rptr @ \subsection{Process Result Variables} These variables are associated to process (integration) runs and their results. Their names contain brackets (so they look like function evaluations), therefore we need to special-case them. <>= public :: var_list_set_procvar_int public :: var_list_set_procvar_real <>= subroutine var_list_set_procvar_int (var_list, proc_id, name, ival) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id type(string_t), intent(in) :: name integer, intent(in), optional :: ival type(string_t) :: var_name type(var_entry_t), pointer :: var var_name = name // "(" // proc_id // ")" var => var_list_get_var_ptr (var_list, var_name) if (.not. associated (var)) then call var_list%append_int (var_name, ival, intrinsic=.true.) else if (present (ival)) then call var_list%set_int (var_name, ival, is_known=.true.) end if end subroutine var_list_set_procvar_int subroutine var_list_set_procvar_real (var_list, proc_id, name, rval) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id type(string_t), intent(in) :: name real(default), intent(in), optional :: rval type(string_t) :: var_name type(var_entry_t), pointer :: var var_name = name // "(" // proc_id // ")" var => var_list_get_var_ptr (var_list, var_name) if (.not. associated (var)) then call var_list%append_real (var_name, rval, intrinsic=.true.) else if (present (rval)) then call var_list%set_real (var_name, rval, is_known=.true.) end if end subroutine var_list_set_procvar_real @ %def var_list_set_procvar_int @ %def var_list_set_procvar_real @ \subsection{Observable initialization} Observables are formally treated as variables, which however are evaluated each time the observable is used. The arguments (pointers) to evaluate and the function are part of the variable-list entry. <>= public :: var_list_append_obs1_iptr public :: var_list_append_obs2_iptr public :: var_list_append_obs1_rptr public :: var_list_append_obs2_rptr <>= subroutine var_list_append_obs1_iptr (var_list, name, obs1_iptr, p1) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_int) :: obs1_iptr type(prt_t), intent(in), target :: p1 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS1_INT, p1) var%obs1_int => obs1_iptr call var_list_append (var_list, var) end subroutine var_list_append_obs1_iptr subroutine var_list_append_obs2_iptr (var_list, name, obs2_iptr, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_int) :: obs2_iptr type(prt_t), intent(in), target :: p1, p2 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS2_INT, p1, p2) var%obs2_int => obs2_iptr call var_list_append (var_list, var) end subroutine var_list_append_obs2_iptr subroutine var_list_append_obs1_rptr (var_list, name, obs1_rptr, p1) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_real) :: obs1_rptr type(prt_t), intent(in), target :: p1 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS1_REAL, p1) var%obs1_real => obs1_rptr call var_list_append (var_list, var) end subroutine var_list_append_obs1_rptr subroutine var_list_append_obs2_rptr (var_list, name, obs2_rptr, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_real) :: obs2_rptr type(prt_t), intent(in), target :: p1, p2 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS2_REAL, p1, p2) var%obs2_real => obs2_rptr call var_list_append (var_list, var) end subroutine var_list_append_obs2_rptr @ %def var_list_append_obs1_iptr @ %def var_list_append_obs2_iptr @ %def var_list_append_obs1_rptr @ %def var_list_append_obs2_rptr @ User observables: no pointer needs to be stored. <>= public :: var_list_append_uobs_int public :: var_list_append_uobs_real <>= subroutine var_list_append_uobs_int (var_list, name, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(prt_t), intent(in), target :: p1 type(prt_t), intent(in), target, optional :: p2 type(var_entry_t), pointer :: var allocate (var) if (present (p2)) then call var_entry_init_obs (var, name, V_UOBS2_INT, p1, p2) else call var_entry_init_obs (var, name, V_UOBS1_INT, p1) end if call var_list_append (var_list, var) end subroutine var_list_append_uobs_int subroutine var_list_append_uobs_real (var_list, name, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(prt_t), intent(in), target :: p1 type(prt_t), intent(in), target, optional :: p2 type(var_entry_t), pointer :: var allocate (var) if (present (p2)) then call var_entry_init_obs (var, name, V_UOBS2_REAL, p1, p2) else call var_entry_init_obs (var, name, V_UOBS1_REAL, p1) end if call var_list_append (var_list, var) end subroutine var_list_append_uobs_real @ %def var_list_append_uobs_int @ %def var_list_append_uobs_real @ \subsection{API for variable lists} Set a new value. If the variable holds a pointer, this pointer is followed, e.g., a model parameter is actually set. If [[ignore]] is set, do nothing if the variable does not exist. If [[verbose]] is set, echo the new value. Clear a variable (all variables), i.e., undefine the value. <>= procedure :: unset => var_list_clear <>= subroutine var_list_clear (vars, name, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_clear (var) end if end subroutine var_list_clear @ %def var_list_clear @ Setting the value, concise specific versions (implementing deferred TBP): <>= procedure :: set_ival => var_list_set_ival procedure :: set_rval => var_list_set_rval procedure :: set_cval => var_list_set_cval procedure :: set_lval => var_list_set_lval procedure :: set_sval => var_list_set_sval <>= subroutine var_list_set_ival (vars, name, ival, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name integer, intent(in) :: ival logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_int (var, ival, is_known=.true.) end if end subroutine var_list_set_ival subroutine var_list_set_rval (vars, name, rval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name real(default), intent(in) :: rval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_real (var, rval, is_known=.true.) end if end subroutine var_list_set_rval subroutine var_list_set_cval (vars, name, cval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name complex(default), intent(in) :: cval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_cmplx (var, cval, is_known=.true.) end if end subroutine var_list_set_cval subroutine var_list_set_lval (vars, name, lval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name logical, intent(in) :: lval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_log (var, lval, is_known=.true.) end if end subroutine var_list_set_lval subroutine var_list_set_sval (vars, name, sval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name type(string_t), intent(in) :: sval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_string (var, sval, is_known=.true.) end if end subroutine var_list_set_sval @ %def var_list_set_ival @ %def var_list_set_rval @ %def var_list_set_cval @ %def var_list_set_lval @ %def var_list_set_sval @ Setting the value, verbose specific versions (as subroutines): <>= procedure :: set_log => var_list_set_log procedure :: set_int => var_list_set_int procedure :: set_real => var_list_set_real procedure :: set_cmplx => var_list_set_cmplx procedure :: set_subevt => var_list_set_subevt procedure :: set_pdg_array => var_list_set_pdg_array procedure :: set_string => var_list_set_string <>= subroutine var_list_set_log & (var_list, name, lval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name logical, intent(in) :: lval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_LOG) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_LOG) call var_entry_set_log (var, lval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_log subroutine var_list_set_int & (var_list, name, ival, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name integer, intent(in) :: ival logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_INT) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_INT) call var_entry_set_int (var, ival, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_int subroutine var_list_set_real & (var_list, name, rval, is_known, ignore, force, & verbose, model_name, pacified) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name real(default), intent(in) :: rval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose, pacified type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_REAL) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_REAL) call var_entry_set_real & (var, rval, is_known, verbose, model_name, pacified) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_real subroutine var_list_set_cmplx & (var_list, name, cval, is_known, ignore, force, & verbose, model_name, pacified) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name complex(default), intent(in) :: cval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose, pacified type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_CMPLX) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_CMPLX) call var_entry_set_cmplx & (var, cval, is_known, verbose, model_name, pacified) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_cmplx subroutine var_list_set_pdg_array & (var_list, name, aval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name type(pdg_array_t), intent(in) :: aval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_PDG) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_PDG) call var_entry_set_pdg_array & (var, aval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_pdg_array subroutine var_list_set_subevt & (var_list, name, pval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name type(subevt_t), intent(in) :: pval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_SEV) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_SEV) call var_entry_set_subevt & (var, pval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_subevt subroutine var_list_set_string & (var_list, name, sval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name type(string_t), intent(in) :: sval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_STR) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_STR) call var_entry_set_string & (var, sval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_string subroutine var_mismatch_error (name) type(string_t), intent(in) :: name call msg_fatal ("Type mismatch for variable '" // char (name) // "'") end subroutine var_mismatch_error subroutine var_locked_error (name) type(string_t), intent(in) :: name call msg_error ("Variable '" // char (name) // "' is not user-definable") end subroutine var_locked_error subroutine var_missing_error (name, ignore) type(string_t), intent(in) :: name logical, intent(in), optional :: ignore logical :: error if (present (ignore)) then error = .not. ignore else error = .true. end if if (error) then call msg_fatal ("Variable '" // char (name) // "' has not been declared") end if end subroutine var_missing_error @ %def var_list_set_log @ %def var_list_set_int @ %def var_list_set_real @ %def var_list_set_cmplx @ %def var_list_set_subevt @ %def var_list_set_pdg_array @ %def var_list_set_string @ %def var_mismatch_error @ %def var_missing_error @ Import values for the current variable list from another list. <>= public :: var_list_import <>= procedure :: import => var_list_import <>= subroutine var_list_import (var_list, src_list) class(var_list_t), intent(inout) :: var_list type(var_list_t), intent(in) :: src_list type(var_entry_t), pointer :: var, src var => var_list%first do while (associated (var)) src => var_list_get_var_ptr (src_list, var%name) if (associated (src)) then call var_entry_copy_value (var, src) end if var => var%next end do end subroutine var_list_import @ %def var_list_import @ Mark all entries in the current variable list as undefined. This is done when a local variable list is discarded. If the local list is used again (by a loop), the entries will be re-initialized. <>= public :: var_list_undefine <>= procedure :: undefine => var_list_undefine <>= recursive subroutine var_list_undefine (var_list, follow_link) class(var_list_t), intent(inout) :: var_list logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var logical :: rec rec = .true.; if (present (follow_link)) rec = follow_link var => var_list%first do while (associated (var)) call var_entry_undefine (var) var => var%next end do if (rec .and. associated (var_list%next)) then call var_list_undefine (var_list%next, follow_link=follow_link) end if end subroutine var_list_undefine @ %def var_list_undefine @ Make a deep copy of a variable list. <>= public :: var_list_init_snapshot <>= procedure :: init_snapshot => var_list_init_snapshot <>= recursive subroutine var_list_init_snapshot (var_list, vars_in, follow_link) class(var_list_t), intent(out) :: var_list type(var_list_t), intent(in) :: vars_in logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var, var_in type(var_list_t), pointer :: var_list_next logical :: rec rec = .true.; if (present (follow_link)) rec = follow_link var_in => vars_in%first do while (associated (var_in)) allocate (var) call var_entry_init_copy (var, var_in) call var_entry_copy_value (var, var_in) call var_list_append (var_list, var) var_in => var_in%next end do if (rec .and. associated (vars_in%next)) then allocate (var_list_next) call var_list_init_snapshot (var_list_next, vars_in%next) call var_list%link (var_list_next) end if end subroutine var_list_init_snapshot @ %def var_list_init_snapshot @ Check if a user variable can be set. The [[new]] flag is set if the user variable has an explicit declaration. If an error occurs, return [[V_NONE]] as variable type. Also determine the actual type of generic numerical variables, which enter the procedure with type [[V_NONE]]. <>= public :: var_list_check_user_var <>= procedure :: check_user_var => var_list_check_user_var <>= subroutine var_list_check_user_var (var_list, name, type, new) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(inout) :: type logical, intent(in) :: new type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name) if (associated (var)) then if (type == V_NONE) then type = var_entry_get_type (var) end if if (var_entry_is_locked (var)) then call msg_fatal ("Variable '" // char (name) & // "' is not user-definable") type = V_NONE return else if (new) then if (var_entry_is_intrinsic (var)) then call msg_fatal ("Intrinsic variable '" & // char (name) // "' redeclared") type = V_NONE return end if if (var_entry_get_type (var) /= type) then call msg_fatal ("Variable '" // char (name) // "' " & // "redeclared with different type") type = V_NONE return end if end if end if end subroutine var_list_check_user_var @ %def var_list_check_user_var @ \subsection{Default values for global var list} <>= procedure :: init_defaults => var_list_init_defaults <>= subroutine var_list_init_defaults (var_list, seed, paths) class(var_list_t), intent(out) :: var_list integer, intent(in) :: seed type(paths_t), intent(in), optional :: paths call var_list%set_beams_defaults (paths) call var_list%set_core_defaults (seed) call var_list%set_integration_defaults () call var_list%set_phase_space_defaults () call var_list%set_gamelan_defaults () call var_list%set_clustering_defaults () call var_list%set_isolation_defaults () call var_list%set_eio_defaults () call var_list%set_shower_defaults () call var_list%set_hadronization_defaults () call var_list%set_tauola_defaults () call var_list%set_mlm_matching_defaults () call var_list%set_powheg_matching_defaults () call var_list%append_log (var_str ("?ckkw_matching"), .false., & intrinsic=.true., description=var_str ('Master flag that switches ' // & 'on the CKKW(-L) (LO) matching between hard scattering matrix ' // & 'elements and QCD parton showers. Note that this is not yet ' // & '(completely) implemented in \whizard. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})')) call var_list%set_openmp_defaults () call var_list%set_mpi_defaults () call var_list%set_nlo_defaults () end subroutine var_list_init_defaults @ %def var_list_init_defaults @ <>= procedure :: set_beams_defaults => var_list_set_beams_defaults <>= subroutine var_list_set_beams_defaults (var_list, paths) type(paths_t), intent(in), optional :: paths class(var_list_t), intent(inout) :: var_list call var_list%append_real (var_str ("sqrts"), & intrinsic=.true., & description=var_str ('Real variable in order to set the center-of-mass ' // & 'energy for the collisions (collider energy $\sqrt{s}$, not ' // & 'hard interaction energy $\sqrt{\hat{s}}$): \ttt{sqrts = {\em ' // & '} [ {\em } ]}. The physical unit can be one ' // & 'of the following \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV}, ' // & 'and \ttt{TeV}. If absent, \whizard\ takes \ttt{GeV} as its ' // & 'standard unit. Note that this variable is absolutely mandatory ' // & 'for integration and simulation of scattering processes.')) call var_list%append_real (var_str ("luminosity"), 0._default, & intrinsic=.true., & description=var_str ('This specifier \ttt{luminosity = {\em ' // & '}} sets the integrated luminosity (in inverse femtobarns, ' // & 'fb${}^{-1}$) for the event generation of the processes in the ' // & '\sindarin\ input files. Note that WHIZARD itself chooses the ' // & 'number from the \ttt{luminosity} or from the \ttt{n\_events} ' // & 'specifier, whichever would give the larger number of events. ' // & 'As this depends on the cross section under consideration, it ' // & 'might be different for different processes in the process list. ' // & '(cf. \ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format}, \ttt{?unweighted})')) call var_list%append_log (var_str ("?sf_trace"), .false., & intrinsic=.true., & description=var_str ('Debug flag that writes out detailed information ' // & 'about the structure function setup into the file \ttt{{\em ' // & '}\_sftrace.dat}. This file name can be changed ' // & 'with ($\to$) \ttt{\$sf\_trace\_file}.')) call var_list%append_string (var_str ("$sf_trace_file"), var_str (""), & intrinsic=.true., & description=var_str ('\ttt{\$sf\_trace\_file = "{\em }"} ' // & 'allows to change the detailed structure function information ' // & 'switched on by the debug flag ($\to$) \ttt{?sf\_trace} into ' // & 'a different file \ttt{{\em }} than the default ' // & '\ttt{{\em }\_sftrace.dat}.')) call var_list%append_log (var_str ("?sf_allow_s_mapping"), .true., & intrinsic=.true., & description=var_str ('Flag that determines whether special mappings ' // & 'for processes with structure functions and $s$-channel resonances ' // & 'are applied, e.g. Drell-Yan at hadron colliders, or $Z$ production ' // & 'at linear colliders with beamstrahlung and ISR.')) if (present (paths)) then call var_list%append_string (var_str ("$lhapdf_dir"), paths%lhapdfdir, & intrinsic=.true., & description=var_str ('String variable that tells the path ' // & 'where the \lhapdf\ library and PDF sets can be found. When ' // & 'the library has been correctly recognized during configuration, ' // & 'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // & '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // & '\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})')) else call var_list%append_string (var_str ("$lhapdf_dir"), var_str(""), & intrinsic=.true., & description=var_str ('String variable that tells the path ' // & 'where the \lhapdf\ library and PDF sets can be found. When ' // & 'the library has been correctly recognized during configuration, ' // & 'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // & '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // & '\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})')) end if call var_list%append_string (var_str ("$lhapdf_file"), var_str (""), & intrinsic=.true., & description=var_str ('This string variable \ttt{\$lhapdf\_file ' // & '= "{\em }"} allows to specify the PDF set \ttt{{\em ' // & '}} from the external \lhapdf\ library. It must match ' // & 'the exact name of the PDF set from the \lhapdf\ library. The ' // & 'default is empty, and the default set from \lhapdf\ is taken. ' // & 'Only one argument is possible, the PDF set must be identical ' // & 'for both beams, unless there are fundamentally different beam ' // & 'particles like proton and photon. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // & '\ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_photon\_scheme}, ' // & '\ttt{lhapdf\_member})')) call var_list%append_string (var_str ("$lhapdf_photon_file"), var_str (""), & intrinsic=.true., & description=var_str ('String variable \ttt{\$lhapdf\_photon\_file ' // & '= "{\em }"} analagous to ($\to$) \ttt{\$lhapdf\_file} ' // & 'for photon PDF structure functions from the external \lhapdf\ ' // & 'library. The name must exactly match the one of the set from ' // & '\lhapdf. (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // & '\ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member}, ' // & '\ttt{lhapdf\_photon\_scheme})')) call var_list%append_int (var_str ("lhapdf_member"), 0, & intrinsic=.true., & description=var_str ('Integer variable that specifies the number ' // & 'of the corresponding PDF set chosen via the command ($\to$) ' // & '\ttt{\$lhapdf\_file} or ($\to$) \ttt{\$lhapdf\_photon\_file} ' // & 'from the external \lhapdf\ library. E.g. error PDF sets can ' // & 'be chosen by this. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // & '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // & '\ttt{lhapdf\_photon\_scheme})')) call var_list%append_int (var_str ("lhapdf_photon_scheme"), 0, & intrinsic=.true., & description=var_str ('Integer parameter that controls the different ' // & 'available schemes for photon PDFs inside the external \lhapdf\ ' // & 'library. For more details see the \lhapdf\ manual. (cf. also ' // & '\ttt{lhapdf}, \ttt{\$lhapdf\_dir}, \ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, ' // & '\ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member})')) call var_list%append_string (var_str ("$pdf_builtin_set"), var_str ("CTEQ6L"), & intrinsic=.true., & description=var_str ("For \whizard's internal PDF structure functions " // & 'for hadron colliders, this string variable allows to set the ' // & 'particular PDF set. (cf. also \ttt{pdf\_builtin}, \ttt{pdf\_builtin\_photon})')) call var_list%append_log (var_str ("?hoppet_b_matching"), .false., & intrinsic=.true., & description=var_str ('Flag that switches on the matching between ' // & '4- and 5-flavor schemes for hadron collider $b$-parton initiated ' // & 'processes. Works either with builtin PDFs or with the external ' // & '\lhapdf\ interface. Needs the external \ttt{HOPPET} library ' // & 'to be linked. (cf. \ttt{beams}, \ttt{pdf\_builtin}, \ttt{lhapdf})')) call var_list%append_real (var_str ("isr_alpha"), 0._default, & intrinsic=.true., & description=var_str ('For lepton collider initial-state QED ' // & 'radiation (ISR), this real parameter sets the value of $\alpha_{em}$ ' // & 'used in the structure function. If not set, it is taken from ' // & 'the parameter set of the physics model in use (cf. also \ttt{isr}, ' // & '\ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // & '\ttt{?isr\_keep\_energy})')) call var_list%append_real (var_str ("isr_q_max"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set the ' // & 'scale of the initial-state QED radiation (ISR) structure function. ' // & 'If not set, it is taken internally to be $\sqrt{s}$. (cf. ' // & 'also \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // & '\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})')) call var_list%append_real (var_str ("isr_mass"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set by hand ' // & 'the mass of the incoming particle for lepton collider initial-state ' // & 'QED radiation (ISR). If not set, the mass for the initial beam ' // & 'particle is taken from the model in use. (cf. also \ttt{isr}, ' // & '\ttt{isr\_q\_max}, \ttt{isr\_alpha}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // & '\ttt{?isr\_keep\_energy})')) call var_list%append_int (var_str ("isr_order"), 3, & intrinsic=.true., & description=var_str ('For lepton collider initial-state QED ' // & 'radiation (ISR), this integer parameter allows to set the order ' // & 'up to which hard-collinear radiation is taken into account. ' // & 'Default is the highest available, namely third order. (cf. ' // & 'also \ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_alpha}, ' // & '\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})')) call var_list%append_log (var_str ("?isr_recoil"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // & '$p_T$-kick for the lepton collider initial-state QED radiation ' // & '(ISR). (cf. also \ttt{isr}, \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, ' // & '\ttt{isr\_order}, \ttt{isr\_q\_max})')) call var_list%append_log (var_str ("?isr_keep_energy"), .false., & intrinsic=.true., & description=var_str ('As the splitting kinematics for the ISR ' // & 'structure function violates Lorentz invariance when the recoil ' // & 'is switched on, this flag forces energy conservation when set ' // & 'to true, otherwise violating energy conservation. (cf. also ' // & '\ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // & '\ttt{?isr\_recoil}, \ttt{?isr\_alpha})')) call var_list%append_log (var_str ("?isr_handler"), .false., & intrinsic=.true., & description=var_str ('Activate ISR ' // & 'handler for event generation (no effect on integration). ' // & 'Requires \ttt{isr\_recoil = false}')) call var_list%append_string (var_str ("$isr_handler_mode"), & var_str ("trivial"), & intrinsic=.true., & description=var_str ('Operation mode for the ISR ' // & 'event handler. Allowed values: \ttt{trivial} (no effect), ' // & '\ttt{recoil} (recoil kinematics with two photons)')) call var_list%append_real (var_str ("epa_alpha"), 0._default, & intrinsic=.true., & description=var_str ('For the equivalent photon approximation ' // & '(EPA), this real parameter sets the value of $\alpha_{em}$ ' // & 'used in the structure function. If not set, it is taken from ' // & 'the parameter set of the physics model in use (cf. also \ttt{epa}, ' // & '\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, \ttt{epa\_q\_min}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})')) call var_list%append_real (var_str ("epa_x_min"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the lower cutoff ' // & 'for the energy fraction in the splitting for the equivalent-photon ' // & 'approximation (EPA). This parameter has to be set by the user ' // & 'to a non-zero value smaller than one. (cf. also \ttt{epa}, ' // & '\ttt{epa\_e\_max}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})')) call var_list%append_real (var_str ("epa_q_min"), 0._default, & intrinsic=.true., & description=var_str ('In the equivalent-photon approximation ' // & '(EPA), this real parameters sets the minimal value for the ' // & 'transferred momentum. Either this parameter or the mass of ' // & 'the beam particle has to be non-zero. (cf. also \ttt{epa}, ' // & '\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_max}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})')) call var_list%append_real (var_str ("epa_q_max"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set the ' // & 'upper energy cutoff for the equivalent-photon approximation ' // & '(EPA). If not set, \whizard\ simply takes the collider energy, ' // & '$\sqrt{s}$. (cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, ' // & '\ttt{epa\_alpha}, \ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})')) call var_list%append_real (var_str ("epa_mass"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set by hand ' // & 'the mass of the incoming particle for the equivalent-photon ' // & 'approximation (EPA). If not set, the mass for the initial beam ' // & 'particle is taken from the model in use. (cf. also \ttt{epa}, ' // & '\ttt{epa\_x\_min}, \ttt{epa\_e\_max}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})')) call var_list%append_log (var_str ("?epa_recoil"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // & '$p_T$-kick for the equivalent-photon approximation (EPA). ' // & '(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // & '\ttt{epa\_e\_max}, \ttt{epa\_q\_min}, \ttt{?epa\_keep\_energy})')) call var_list%append_log (var_str ("?epa_keep_energy"), .false., & intrinsic=.true., & description=var_str ('As the splitting kinematics for the EPA ' // & 'structure function violates Lorentz invariance when the recoil ' // & 'is switched on, this flag forces energy conservation when set ' // & 'to true, otherwise violating energy conservation. (cf. also ' // & '\ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // & '\ttt{epa\_q\_min}, \ttt{?epa\_recoil})')) call var_list%append_log (var_str ("?epa_handler"), .false., & intrinsic=.true., & description=var_str ('Activate EPA ' // & 'handler for event generation (no effect on integration). ' // & 'Requires \ttt{epa\_recoil = false}')) call var_list%append_string (var_str ("$epa_handler_mode"), & var_str ("trivial"), & intrinsic=.true., & description=var_str ('Operation mode for the EPA ' // & 'event handler. Allowed values: \ttt{trivial} (no effect), ' // & '\ttt{recoil} (recoil kinematics with two beams)')) call var_list%append_real (var_str ("ewa_x_min"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the lower cutoff ' // & 'for the energy fraction in the splitting for the equivalent ' // & '$W$ approximation (EWA). This parameter has to be set by the ' // & 'user to a non-zero value smaller than one. (cf. also \ttt{ewa}, ' // & '\ttt{ewa\_pt\_max}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // & '\ttt{?ewa\_recoil})')) call var_list%append_real (var_str ("ewa_pt_max"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set the ' // & 'upper $p_T$ cutoff for the equivalent $W$ approximation (EWA). ' // & 'If not set, \whizard\ simply takes the collider energy, $\sqrt{s}$. ' // & '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // & '\ttt{?ewa\_recoil})')) call var_list%append_real (var_str ("ewa_mass"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set by hand ' // & 'the mass of the incoming particle for the equivalent $W$ approximation ' // & '(EWA). If not set, the mass for the initial beam particle is ' // & 'taken from the model in use. (cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, ' // & '\ttt{ewa\_pt\_max}, \ttt{?ewa\_keep\_energy}, \ttt{?ewa\_recoil})')) call var_list%append_log (var_str ("?ewa_recoil"), .false., & intrinsic=.true., & description=var_str ('For the equivalent $W$ approximation (EWA), ' // & 'this flag switches on recoil, i.e. non-collinear splitting. ' // & '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // & '\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy})')) call var_list%append_log (var_str ("?ewa_keep_energy"), .false., & intrinsic=.true., & description=var_str ('As the splitting kinematics for the equivalent ' // & '$W$ approximation (EWA) violates Lorentz invariance when the ' // & 'recoil is switched on, this flag forces energy conservation ' // & 'when set to true, otherwise violating energy conservation. ' // & '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // & '\ttt{ewa\_mass}, \ttt{?ewa\_recoil})')) call var_list%append_log (var_str ("?circe1_photon1"), .false., & intrinsic=.true., & description=var_str ('Flag to tell \whizard\ to use the photon ' // & 'of the \circeone\ beamstrahlung structure function as initiator ' // & 'for the hard scattering process in the first beam. (cf. also ' // & '\ttt{circe1}, \ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_photon2"), .false., & intrinsic=.true., & description=var_str ('Flag to tell \whizard\ to use the photon ' // & 'of the \circeone\ beamstrahlung structure function as initiator ' // & 'for the hard scattering process in the second beam. (cf. also ' // & '\ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{circe1\_sqrts}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // & '\newline\ttt{?circe1\_with\_radiation})')) call var_list%append_real (var_str ("circe1_sqrts"), & intrinsic=.true., & description=var_str ('Real parameter that allows to set the ' // & 'value of the collider energy for the lepton collider beamstrahlung ' // & 'structure function \circeone. If not set, $\sqrt{s}$ is taken. ' // & '(cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_generate"), .true., & intrinsic=.true., & description=var_str ('Flag that determines whether the \circeone\ ' // & 'structure function for lepton collider beamstrahlung uses the ' // & 'generator mode for the spectrum, or a pre-defined (semi-)analytical ' // & 'parameterization. Default is the generator mode. (cf. also ' // & '\ttt{circe1}, \ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_map}, \ttt{circe1\_mapping\_slope}, ' // & '\ttt{circe1\_eps}, \newline \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // & '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_map"), .true., & intrinsic=.true., & description=var_str ('Flag that determines whether the \circeone\ ' // & 'structure function for lepton collider beamstrahlung uses special ' // & 'mappings for $s$-channel resonances. (cf. also \ttt{circe1}, ' // & '\ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // & '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_eps}, \newline ' // & '\ttt{circe1\_ver}, \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, ' // & '\ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_real (var_str ("circe1_mapping_slope"), 2._default, & intrinsic=.true., & description=var_str ('Real parameter that allows to vary the ' // & 'slope of the mapping function for the \circeone\ structure ' // & 'function for lepton collider beamstrahlung from the default ' // & 'value \ttt{2.}. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // & '\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // & '\ttt{?circe1\_map}, \ttt{circe1\_eps}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_real (var_str ("circe1_eps"), 1e-5_default, & intrinsic=.true., & description=var_str ('Real parameter, that takes care of the ' // & 'mapping of the peak in the lepton collider beamstrahlung structure ' // & 'function spectrum of \circeone. (cf. also \ttt{circe1}, \ttt{?circe1\_photons}, ' // & '\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // & '\ttt{?circe1\_map}, \ttt{circe1\_eps}, \newline ' // & '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // & '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline\ttt{?circe1\_with\_radiation})')) call var_list%append_int (var_str ("circe1_ver"), 0, intrinsic=.true., & description=var_str ('Integer parameter that sets the internal ' // & 'versioning number of the \circeone\ structure function for lepton-collider ' // & 'beamstrahlung. It has to be set by the user explicitly, it takes ' // & 'values from one to ten. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // & '\ttt{?circe1\_photon2}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_int (var_str ("circe1_rev"), 0, intrinsic=.true., & description=var_str ('Integer parameter that sets the internal ' // & 'revision number of the \circeone\ structure function for lepton-collider ' // & 'beamstrahlung. The default \ttt{0} translates always into the ' // & 'most recent version; older versions have to be accessed through ' // & 'the explicit revision date. For more details cf.~the \circeone ' // & 'manual. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, \ttt{circe1\_ver}, ' // & '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_string (var_str ("$circe1_acc"), var_str ("SBAND"), & intrinsic=.true., & description=var_str ('String variable that specifies the accelerator ' // & 'type for the \circeone\ structure function for lepton-collider ' // & 'beamstrahlung. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\newline \ttt{circe1\_rev}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_int (var_str ("circe1_chat"), 0, intrinsic=.true., & description=var_str ('Chattiness of the \circeone\ structure ' // & 'function for lepton-collider beamstrahlung. The higher the integer ' // & 'value, the more information will be given out by the \circeone\ ' // & 'package. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_with_radiation"), .false., & intrinsic=.true., & description=var_str ('This logical decides whether the additional photon ' // & 'or electron ("beam remnant") will be considered in the event record or ' // & 'not. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc})')) call var_list%append_log (var_str ("?circe2_polarized"), .true., & intrinsic=.true., & description=var_str ('Flag whether the photon spectra from the ' // & '\circetwo\ structure function for lepton colliders should be ' // & 'treated polarized. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, ' // & '\ttt{\$circe2\_design})')) call var_list%append_string (var_str ("$circe2_file"), & intrinsic=.true., & description=var_str ('String variable by which the corresponding ' // & 'photon collider spectrum for the \circetwo\ structure function ' // & 'can be selected. (cf. also \ttt{circe2}, \ttt{?circe2\_polarized}, ' // & '\ttt{\$circe2\_design})')) call var_list%append_string (var_str ("$circe2_design"), var_str ("*"), & intrinsic=.true., & description=var_str ('String variable that sets the collider ' // & 'design for the \circetwo\ structure function for photon collider ' // & 'spectra. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, \ttt{?circe2\_polarized})')) call var_list%append_real (var_str ("gaussian_spread1"), 0._default, & intrinsic=.true., & description=var_str ('Parameter that sets the energy spread ' // & '($\sigma$ value) of the first beam for a Gaussian spectrum. ' // & '(cf. \ttt{gaussian})')) call var_list%append_real (var_str ("gaussian_spread2"), 0._default, & intrinsic=.true., & description=var_str ('Ditto, for the second beam.')) call var_list%append_string (var_str ("$beam_events_file"), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & "name of the external file from which a beamstrahlung's spectrum " // & 'for lepton colliders as pairs of energy fractions is read in. ' // & '(cf. also \ttt{beam\_events}, \ttt{?beam\_events\_warn\_eof})')) call var_list%append_log (var_str ("?beam_events_warn_eof"), .true., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to ' // & 'issue a warning when in a simulation the end of an external ' // & "file for beamstrahlung's spectra for lepton colliders are reached, " // & 'and energy fractions from the beginning of the file are reused. ' // & '(cf. also \ttt{beam\_events}, \ttt{\$beam\_events\_file})')) call var_list%append_log (var_str ("?energy_scan_normalize"), .false., & intrinsic=.true., & description=var_str ('Normalization flag for the energy scan ' // & 'structure function: if set the total cross section is normalized ' // & 'to unity. (cf. also \ttt{energy\_scan})')) end subroutine var_list_set_beams_defaults @ %def var_list_set_beams_defaults @ <>= procedure :: set_core_defaults => var_list_set_core_defaults <>= subroutine var_list_set_core_defaults (var_list, seed) class(var_list_t), intent(inout) :: var_list integer, intent(in) :: seed logical, target, save :: known = .true. !!! ?????? real(default), parameter :: real_specimen = 1. call var_list_append_log_ptr & (var_list, var_str ("?logging"), logging, known, & intrinsic=.true., & description=var_str ('This logical -- when set to \ttt{false} ' // & '-- suppresses writing out a logfile (default: \ttt{whizard.log}) ' // & 'for the whole \whizard\ run, or when \whizard\ is run with the ' // & '\ttt{--no-logging} option, to suppress parts of the logging ' // & 'when setting it to \ttt{true} again at a later part of the ' // & '\sindarin\ input file. Mainly for debugging purposes. ' // & '(cf. also \ttt{?openmp\_logging}, \ttt{?mpi\_logging})')) call var_list%append_string (var_str ("$job_id"), & intrinsic=.true., & description=var_str ('Arbitrary string that can be used for ' // & 'creating unique names. The variable is initialized with the ' // & 'value of the \ttt{job\_id} option on startup. (cf. also ' // & '\ttt{\$compile\_workspace}, \ttt{\$run\_id})')) call var_list%append_string (var_str ("$compile_workspace"), & intrinsic=.true., & description=var_str ('If set, create process source code ' // & 'and process-driver library code in a subdirectory with this ' // & 'name. If non-existent, the directory will be created. (cf. ' // & 'also \ttt{\$job\_id}, \ttt{\$run\_id}, \ttt{\$integrate\_workspace})')) call var_list%append_int (var_str ("seed"), seed, & intrinsic=.true., & description=var_str ('Integer variable \ttt{seed = {\em }} ' // & 'that allows to set a specific random seed \ttt{num}. If not ' // & 'set, \whizard\ takes the time from the system clock to determine ' // & 'the random seed.')) call var_list%append_string (var_str ("$model_name"), & intrinsic=.true., & description=var_str ('This variable makes the locally used physics ' // & 'model available as a string, e.g. as \ttt{show (\$model\_name)}. ' // & 'However, the user is not able to change the current model by ' // & 'setting this variable to a different string. (cf. also \ttt{model}, ' // & '\ttt{\$library\_name}, \ttt{printf}, \ttt{show})')) call var_list%append_int (var_str ("process_num_id"), & intrinsic=.true., & description=var_str ('Using the integer \ttt{process\_num\_id ' // & '= {\em }} one can set a numerical identifier for processes ' // & 'within a process library. This can be set either just before ' // & 'the corresponding \ttt{process} definition or as an optional ' // & 'local argument of the latter. (cf. also \ttt{process})')) call var_list%append_string (var_str ("$method"), var_str ("omega"), & intrinsic=.true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation. The default ' // & "is the intrinsic \oMega\ matrix element generator " // & '(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // & '\ttt{"template\_unity"}, \ttt{"threshold"}. For processes defined ' // & '\ttt{"template"}, with \ttt{nlo\_calculation = ...}, please refer to ' // & '\ttt{\$born\_me\_method}, \ttt{\$real\_tree\_me\_method}, ' // & '\ttt{\$loop\_me\_method} and \ttt{\$correlation\_me\_method}.')) call var_list%append_log (var_str ("?report_progress"), .true., & intrinsic=.true., & description=var_str ('Flag for the \oMega\ matrix element generator ' // & 'whether to print out status messages about progress during ' // & 'matrix element generation. (cf. also \ttt{\$method}, \ttt{\$omega\_flags})')) call var_list%append_log (var_str ("?me_verbose"), .false., & description=var_str ("Flag determining whether " // & "the makefile command for generating and compiling the \oMega\ matrix " // & "element code is silent or verbose. Default is silent.")) call var_list%append_string (var_str ("$restrictions"), var_str (""), & intrinsic=.true., & description=var_str ('This is an optional argument for process ' // & 'definitions for the matrix element method \ttt{"omega"}. Using ' // & 'the following construction, it defines a string variable, \ttt{process ' // & '\newline {\em } = {\em }, {\em } ' // & '=> {\em }, {\em }, ... \{ \$restrictions ' // & '= "{\em }" \}}. The string argument \ttt{{\em ' // & '}} is directly transferred during the code ' // & 'generation to the ME generator \oMega. It has to be of the form ' // & '\ttt{n1 + n2 + ... \url{~} {\em }}, where ' // & '\ttt{n1} and so on are the numbers of the particles above in ' // & 'the process definition. The tilde specifies a certain intermediate ' // & 'state to be equal to the particle(s) in \ttt{particle (list)}. ' // & 'An example is \ttt{process eemm\_z = e1, E1 => e2, E2 ' // & '\{ \$restrictions = "1+2 \url{~} Z" \} } restricts the code ' // & 'to be generated for the process $e^- e^+ \to \mu^- \mu^+$ to ' // & 'the $s$-channel $Z$-boson exchange. For more details see Sec.~\ref{sec:omega_me} ' // & '(cf. also \ttt{process})')) call var_list%append_log (var_str ("?omega_write_phs_output"), .false., & intrinsic=.true., & description=var_str ('This flag decides whether a the phase-space ' // & 'output is produced by the \oMega\ matrix element generator. This ' // & 'output is written to file(s) and contains the Feynman diagrams ' // & 'which belong to the process(es) under consideration. The file is ' // & 'mandatory whenever the variable \ttt{\$phs\_method} has the value ' // & '\ttt{fast\_wood}, i.e. if the phase-space file is provided by ' // & 'cascades2.')) call var_list%append_string (var_str ("$omega_flags"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass flags ' // & 'to the \oMega\ matrix element generator. Normally, \whizard\ ' // & 'takes care of all flags automatically. Note that for restrictions ' // & 'of intermediate states, there is a special string variable: ' // & '(cf. $\to$) \ttt{\$restrictions}.')) call var_list%append_log (var_str ("?read_color_factors"), .true., & intrinsic=.true., & description=var_str ('This flag decides whether to read QCD ' // & 'color factors from the matrix element provided by each method, ' // & 'or to try and calculate the color factors in \whizard\ internally.')) !!! JRR: WK please check (#529) ! call var_list_append_string & ! (var_list, var_str ("$user_procs_cut"), var_str (""), & ! intrinsic=.true.) ! call var_list_append_string & ! (var_list, var_str ("$user_procs_event_shape"), var_str (""), & ! intrinsic=.true.) ! call var_list_append_string & ! (var_list, var_str ("$user_procs_obs1"), var_str (""), & ! intrinsic=.true.) ! call var_list_append_string & ! (var_list, var_str ("$user_procs_obs2"), var_str (""), & ! intrinsic=.true.) ! call var_list_append_string & ! (var_list, var_str ("$user_procs_sf"), var_str (""), & ! intrinsic=.true.) call var_list%append_log (var_str ("?slha_read_input"), .true., & intrinsic=.true., & description=var_str ('Flag which decides whether \whizard\ reads ' // & 'in the SM and parameter information from the \ttt{SMINPUTS} ' // & 'and \ttt{MINPAR} common blocks of the SUSY Les Houches Accord ' // & 'files. (cf. also \ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, ' // & '\ttt{?slha\_read\_decays})')) call var_list%append_log (var_str ("?slha_read_spectrum"), .true., & intrinsic=.true., & description=var_str ('Flag which decides whether \whizard\ reads ' // & 'in the whole spectrum and mixing angle information from the ' // & 'common blocks of the SUSY Les Houches Accord files. (cf. also ' // & '\ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_decays}, ' // & '\ttt{?slha\_read\_input})')) call var_list%append_log (var_str ("?slha_read_decays"), .false., & intrinsic=.true., & description=var_str ('Flag which decides whether \whizard\ reads ' // & 'in the widths and branching ratios from the \ttt{DCINFO} common ' // & 'block of the SUSY Les Houches Accord files. (cf. also \ttt{read\_slha}, ' // & '\ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, \ttt{?slha\_read\_input})')) call var_list%append_string (var_str ("$library_name"), & intrinsic=.true., & description=var_str ('Similar to \ttt{\$model\_name}, this string ' // & 'variable is used solely to access the name of the active process ' // & 'library, e.g. in \ttt{printf} statements. (cf. \ttt{compile}, ' // & '\ttt{library}, \ttt{printf}, \ttt{show}, \ttt{\$model\_name})')) call var_list%append_log (var_str ("?alphas_is_fixed"), .true., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use a non-running ' // & '$\alpha_s$. Note that this has to be set explicitly to $\ttt{false}$ ' // & 'if the user wants to use one of the running $\alpha_s$ options. ' // & '(cf. also \ttt{alphas\_order}, \ttt{?alphas\_from\_lhapdf}, ' // & '\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // & '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_lhapdf"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use a running ' // & '$\alpha_s$ from the \lhapdf\ library (which has to be correctly ' // & 'linked). Note that \ttt{?alphas\_is\_fixed} has to be set ' // & 'explicitly to $\ttt{false}$. (cf. also \ttt{alphas\_order}, ' // & '\ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // & '\ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_pdf_builtin"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use a running ' // & '$\alpha_s$ from the internal PDFs. Note that in that case \ttt{?alphas\_is\_fixed} ' // & 'has to be set explicitly to $\ttt{false}$. (cf. also ' // & '\ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // & '\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \newline \ttt{?alphas\_from\_lambda\_qcd}, ' // & '\ttt{lambda\_qcd})')) call var_list%append_int (var_str ("alphas_order"), 0, & intrinsic=.true., & description=var_str ('Integer parameter that sets the order ' // & 'of the internal evolution for running $\alpha_s$ in \whizard: ' // & 'the default, \ttt{0}, is LO running, \ttt{1} is NLO, \ttt{2} ' // & 'is NNLO. (cf. also \ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // & '\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // & '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_int (var_str ("alphas_nf"), 5, & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of active quark flavors for the internal evolution for running ' // & '$\alpha_s$ in \whizard: the default is \ttt{5}. (cf. also ' // & '\ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\ttt{alphas\_order}, \ttt{?alphas\_from\_mz}, \newline ' // & '\ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_mz"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use its internal ' // & 'running $\alpha_s$ from $\alpha_s(M_Z)$. Note that in that ' // & 'case \ttt{?alphas\_is\_fixed} has to be set explicitly to ' // & '$\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // & '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_lambda_qcd"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use its internal ' // & 'running $\alpha_s$ from $\alpha_s(\Lambda_{QCD})$. Note that ' // & 'in that case \ttt{?alphas\_is\_fixed} has to be set explicitly ' // & 'to $\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // & '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\newline \ttt{?alphas\_from\_mz}, \ttt{lambda\_qcd})')) call var_list%append_real (var_str ("lambda_qcd"), 200.e-3_default, & intrinsic=.true., & description=var_str ('Real parameter that sets the value for ' // & '$\Lambda_{QCD}$ used in the internal evolution for running ' // & '$\alpha_s$ in \whizard. (cf. also \ttt{alphas\_is\_fixed}, ' // & '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, ' // & '\newline \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // & '\ttt{alphas\_order})')) call var_list%append_log (var_str ("?fatal_beam_decay"), .true., & intrinsic=.true., & description=var_str ('Logical variable that let the user decide ' // & 'whether the possibility of a beam decay is treated as a fatal ' // & 'error or only as a warning. An example is a process $b t \to ' // & 'X$, where the bottom quark as an inital state particle appears ' // & 'as a possible decay product of the second incoming particle, ' // & 'the top quark. This might trigger inconsistencies or instabilities ' // & 'in the phase space set-up.')) call var_list%append_log (var_str ("?helicity_selection_active"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether \whizard\ uses ' // & 'a numerical selection rule for vanishing helicities: if active, ' // & 'then, if a certain helicity combination yields an absolute ' // & '(\oMega) matrix element smaller than a certain threshold ($\to$ ' // & '\ttt{helicity\_selection\_threshold}) more often than a certain ' // & 'cutoff ($\to$ \ttt{helicity\_selection\_cutoff}), it will be dropped.')) call var_list%append_real (var_str ("helicity_selection_threshold"), & 1E10_default, & intrinsic=.true., & description=var_str ('Real parameter that gives the threshold ' // & 'for the absolute value of a certain helicity combination of ' // & 'an (\oMega) amplitude. If a certain number ($\to$ ' // & '\ttt{helicity\_selection\_cutoff}) of calls stays below this ' // & 'threshold, that combination will be dropped from then on. (cf. ' // & 'also \ttt{?helicity\_selection\_active})')) call var_list%append_int (var_str ("helicity_selection_cutoff"), 1000, & intrinsic=.true., & description=var_str ('Integer parameter that gives the number ' // & "a certain helicity combination of an (\oMega) amplitude has " // & 'to be below a certain threshold ($\to$ \ttt{helicity\_selection\_threshold}) ' // & 'in order to be dropped from then on. (cf. also \ttt{?helicity\_selection\_active})')) call var_list%append_string (var_str ("$rng_method"), var_str ("tao"), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'method for the random number generation. Default is Donald ' // & "Knuth' RNG method \ttt{TAO}.")) call var_list%append_log (var_str ("?vis_diags"), .false., & intrinsic=.true., & description=var_str ('Logical variable that allows to give out ' // & "a Postscript or PDF file for the Feynman diagrams for a \oMega\ " // & 'process. (cf. \ttt{?vis\_diags\_color}).')) call var_list%append_log (var_str ("?vis_diags_color"), .false., & intrinsic=.true., & description=var_str ('Same as \ttt{?vis\_diags}, but switches ' // & 'on color flow instead of Feynman diagram generation. (cf. \ttt{?vis\_diags}).')) call var_list%append_log (var_str ("?check_event_file"), .true., & intrinsic=.true., & description=var_str ('Setting this to false turns off all sanity ' // & 'checks when reading a raw event file with previously generated ' // & 'events. Use this at your own risk; the program may return ' // & 'wrong results or crash if data do not match. (cf. also \ttt{?check\_grid\_file}, ' // & '\ttt{?check\_phs\_file})')) call var_list%append_string (var_str ("$event_file_version"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'format version of the \whizard\ internal binary event format.')) call var_list%append_int (var_str ("n_events"), 0, & intrinsic=.true., & description=var_str ('This specifier \ttt{n\_events = {\em }} ' // & 'sets the number of events for the event generation of the processes ' // & 'in the \sindarin\ input files. Note that WHIZARD itself chooses ' // & 'the number from the \ttt{n\_events} or from the \ttt{luminosity} ' // & 'specifier, whichever would give the larger number of events. ' // & 'As this depends on the cross section under consideration, it ' // & 'might be different for different processes in the process list. ' // & '(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?unweighted}, \ttt{event\_index\_offset})')) call var_list%append_int (var_str ("event_index_offset"), 0, & intrinsic=.true., & description=var_str ('The value ' // & '\ttt{event\_index\_offset = {\em }} ' // & 'initializes the event counter for a subsequent ' // & 'event sample. By default (value 0), the first event ' // & 'gets index value 1, incrementing by one for each generated event ' // & 'within a sample. The event counter is initialized again ' // & 'for each new sample (i.e., \ttt{integrate} command). ' // & 'If events are read from file, and the ' // & 'event file format supports event numbering, the event numbers ' // & 'will be taken from file instead, and the value of ' // & '\ttt{event\_index\_offset} has no effect. ' // & '(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?unweighted}, \ttt{n\_events})')) call var_list%append_log (var_str ("?unweighted"), .true., & intrinsic=.true., & description=var_str ('Flag that distinguishes between unweighted ' // & 'and weighted event generation. (cf. also \ttt{simulate}, \ttt{n\_events}, ' // & '\ttt{luminosity}, \ttt{event\_index\_offset})')) call var_list%append_real (var_str ("safety_factor"), 1._default, & intrinsic=.true., & description=var_str ('This real variable \ttt{safety\_factor ' // & '= {\em }} reduces the acceptance probability for unweighting. ' // & 'If greater than one, excess events become less likely, but ' // & 'the reweighting efficiency also drops. (cf. \ttt{simulate}, \ttt{?unweighted})')) call var_list%append_log (var_str ("?negative_weights"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to allow negative ' // & 'weights in integration and simulation. (cf. also \ttt{simulate}, ' // & '\ttt{?unweighted})')) call var_list%append_log (var_str ("?resonance_history"), .false., & intrinsic=.true., & description=var_str ( & 'The logical variable \texttt{?resonance\_history ' // & '= true/false} specifies whether during a simulation pass, ' // & 'the event generator should try to reconstruct intermediate ' // & 'resonances. If activated, appropriate resonant subprocess ' // & 'matrix element code will be automatically generated. ')) call var_list%append_real (var_str ("resonance_on_shell_limit"), & 4._default, & intrinsic=.true., & description=var_str ( & 'The real variable \texttt{resonance\_on\_shell\_limit ' // & '= {\em }} specifies the maximum relative distance from a ' // & 'resonance peak, such that the kinematical configuration ' // & 'can still be considered on-shell. This is relevant only if ' // & '\texttt{?resonance\_history = true}.')) call var_list%append_real (var_str ("resonance_on_shell_turnoff"), & 0._default, & intrinsic=.true., & description=var_str ( & 'The real variable \texttt{resonance\_on\_shell\_turnoff ' // & '= {\em }}, if positive, ' // & 'controls the smooth transition from resonance-like ' // & 'to background-like events. The relative strength of a ' // & 'resonance is reduced by a Gaussian with width given by this ' // & 'variable. In any case, events are treated as background-like ' // & 'when the off-shellness is greater than ' // & '\texttt{resonance\_on\_shell\_limit}. All of this applies ' // & 'only if \texttt{?resonance\_history = true}.')) call var_list%append_real (var_str ("resonance_background_factor"), & 1._default, & intrinsic=.true., & description=var_str ( & 'The real variable \texttt{resonance\_background\_factor} ' // & 'controls resonance insertion if a resonance ' // & 'history applies to a particular event. In determining '// & 'whether event kinematics qualifies as resonant or non-resonant, ' //& 'the non-resonant probability is multiplied by this factor ' // & 'Setting the factor to zero removes the background ' // & 'configuration as long as the kinematics qualifies as on-shell ' // & 'as qualified by \texttt{resonance\_on\_shell\_limit}.')) call var_list%append_log (var_str ("?keep_beams"), .false., & intrinsic=.true., & description=var_str ('The logical variable \ttt{?keep\_beams ' // & '= true/false} specifies whether beam particles and beam remnants ' // & 'are included when writing event files. For example, in order ' // & 'to read Les Houches accord event files into \pythia, no beam ' // & 'particles are allowed.')) call var_list%append_log (var_str ("?keep_remnants"), .true., & intrinsic=.true., & description=var_str ('The logical variable \ttt{?keep\_beams ' // & '= true/false} is respected only if \ttt{?keep\_beams} is set. ' // & 'If \ttt{true}, beam remnants are tagged as outgoing particles ' // & 'if they have been neither showered nor hadronized, i.e., have ' // & 'no children. If \ttt{false}, beam remnants are also included ' // & 'in the event record, but tagged as unphysical. Note that for ' // & 'ISR and/or beamstrahlung spectra, the radiated photons are ' // & 'considered as beam remnants.')) call var_list%append_log (var_str ("?recover_beams"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether the beam particles ' // & 'should be reconstructed when reading event/rescanning files ' // & 'into \whizard. (cf. \ttt{rescan}, \ttt{?update\_event}, \ttt{?update\_sqme}, ' // & '\newline \ttt{?update\_weight})')) call var_list%append_log (var_str ("?update_event"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the events in ' // & 'an event file should be rebuilt from the hard process when ' // & 'reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // & '\ttt{?recover\_beams}, \ttt{?update\_sqme}, \ttt{?update\_weight})')) call var_list%append_log (var_str ("?update_sqme"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whehter the squared ' // & 'matrix element in an event file should be updated/recalculated ' // & 'when reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // & '\newline \ttt{?recover\_beams}, \ttt{?update\_event}, \ttt{?update\_weight})')) call var_list%append_log (var_str ("?update_weight"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the weights ' // & 'in an event file should be updated/recalculated when reading ' // & 'event/rescanning files into \whizard. (cf. \ttt{rescan}, \ttt{?recover\_beams}, ' // & '\newline \ttt{?update\_event}, \ttt{?update\_sqme})')) call var_list%append_log (var_str ("?use_alphas_from_file"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the current ' // & '$\alpha_s$ definition should be used when recalculating matrix ' // & 'elements for events read from file, or the value that is stored ' // & 'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // & '\ttt{?use\_scale\_from\_file})')) call var_list%append_log (var_str ("?use_scale_from_file"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the current ' // & 'energy-scale expression should be used when recalculating matrix ' // & 'elements for events read from file, or the value that is stored ' // & 'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // & '\ttt{?use\_alphas\_from\_file})')) call var_list%append_log (var_str ("?allow_decays"), .true., & intrinsic=.true., & description=var_str ('Master flag to switch on cascade decays ' // & 'for final state particles as an event transform. As a default, ' // & 'it is switched on. (cf. also \ttt{?auto\_decays}, ' // & '\ttt{auto\_decays\_multiplicity}, \ttt{?auto\_decays\_radiative}, ' // & '\ttt{?decay\_rest\_frame})')) call var_list%append_log (var_str ("?auto_decays"), .false., & intrinsic=.true., & description=var_str ('Flag, particularly as optional argument of the ($\to$) ' // & '\ttt{unstable} command, that tells \whizard\ to automatically ' // & 'determine the decays of that particle up to the final state ' // & 'multplicity ($\to$) \ttt{auto\_decays\_multiplicity}. Depending ' // & 'on the flag ($\to$) \ttt{?auto\_decays\_radiative}, radiative ' // & 'decays will be taken into account or not. (cf. also \ttt{unstable}, ' // & '\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay})')) call var_list%append_int (var_str ("auto_decays_multiplicity"), 2, & intrinsic=.true., & description=var_str ('Integer parameter, that sets -- ' // & 'for the ($\to$) \ttt{?auto\_decays} option to let \whizard\ ' // & 'automatically determine the decays of a particle set as ($\to$) ' // & '\ttt{unstable} -- the maximal final state multiplicity that ' // & 'is taken into account. The default is \ttt{2}. The flag \ttt{?auto\_decays\_radiative} ' // & 'decides whether radiative decays are taken into account. (cf.\ ' // & 'also \ttt{unstable}, \ttt{?auto\_decays})')) call var_list%append_log (var_str ("?auto_decays_radiative"), .false., & intrinsic=.true., & description=var_str ("If \whizard's automatic detection " // & 'of decay channels are switched on ($\to$ \ttt{?auto\_decays} ' // & 'for the ($\to$) \ttt{unstable} command, this flags decides ' // & 'whether radiative decays (e.g. containing additional photon(s)/gluon(s)) ' // & 'are taken into account or not. (cf. also \ttt{unstable}, \ttt{auto\_decays\_multiplicity})')) call var_list%append_log (var_str ("?decay_rest_frame"), .false., & intrinsic=.true., & description=var_str ('Flag that allows to force a particle decay ' // & 'to be simulated in its rest frame. This simplifies the calculation ' // & 'for decays as stand-alone processes, but makes the process ' // & 'unsuitable for use in a decay chain.')) call var_list%append_log (var_str ("?isotropic_decay"), .false., & intrinsic=.true., & description=var_str ('Flag that -- in case of using factorized ' // & 'production and decays using the ($\to$) \ttt{unstable} command ' // & '-- tells \whizard\ to switch off spin correlations completely ' // & '(isotropic decay). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // & '\ttt{decay\_helicity}, \ttt{?diagonal\_decay})')) call var_list%append_log (var_str ("?diagonal_decay"), .false., & intrinsic=.true., & description=var_str ('Flag that -- in case of using factorized ' // & 'production and decays using the ($\to$) \ttt{unstable} command ' // & '-- tells \whizard\ instead of full spin correlations to take ' // & 'only the diagonal entries in the spin-density matrix (i.e. ' // & 'classical spin correlations). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // & '\ttt{decay\_helicity}, \ttt{?isotropic\_decay})')) call var_list%append_int (var_str ("decay_helicity"), & intrinsic=.true., & description=var_str ('If this parameter is given an integer ' // & 'value, any particle decay triggered by a subsequent \ttt{unstable} ' // & 'declaration will receive a projection on the given helicity ' // & 'state for the unstable particle. (cf. also \ttt{unstable}, ' // & '\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay}. The latter ' // & 'parameters, if true, take precdence over any \ttt{?decay\_helicity} setting.)')) call var_list%append_log (var_str ("?polarized_events"), .false., & intrinsic=.true., & description=var_str ('Flag that allows to select certain helicity ' // & 'combinations in final state particles in the event files, ' // & 'and perform analysis on polarized event samples. (cf. also ' // & '\ttt{simulate}, \ttt{polarized}, \ttt{unpolarized})')) call var_list%append_string (var_str ("$polarization_mode"), & var_str ("helicity"), & intrinsic=.true., & description=var_str ('String variable that specifies the mode in ' // & 'which the polarization of particles is handled when polarized events ' // & 'are written out. Possible options are \ttt{"ignore"}, \ttt{"helicity"}, ' // & '\ttt{"factorized"}, and \ttt{"correlated"}. For more details cf. the ' // & 'detailed section.')) call var_list%append_log (var_str ("?colorize_subevt"), .false., & intrinsic=.true., & description=var_str ('Flag that enables color-index tracking ' // & 'in the subevent (\ttt{subevt}) objects that are used for ' // & 'internal event analysis.')) call var_list%append_real (var_str ("tolerance"), 0._default, & intrinsic=.true., & description=var_str ('Real variable that defines the absolute ' // & 'tolerance with which the (logical) function \ttt{expect} accepts ' // & 'equality or inequality: \ttt{tolerance = {\em }}. This ' // & 'can e.g. be used for cross-section tests and backwards compatibility ' // & 'checks. (cf. also \ttt{expect})')) call var_list%append_int (var_str ("checkpoint"), 0, & intrinsic = .true., & description=var_str ('Setting this integer variable to a positive ' // & 'integer $n$ instructs simulate to print out a progress summary ' // & 'every $n$ events.')) call var_list%append_int (var_str ("event_callback_interval"), 0, & intrinsic = .true., & description=var_str ('Setting this integer variable to a positive ' // & 'integer $n$ instructs simulate to print out a progress summary ' // & 'every $n$ events.')) call var_list%append_log (var_str ("?pacify"), .false., & intrinsic=.true., & description=var_str ('Flag that allows to suppress numerical ' // & 'noise and give screen and log file output with a lower number ' // & 'of significant digits. Mainly for debugging purposes. (cf. also ' // & '\ttt{?sample\_pacify})')) call var_list%append_string (var_str ("$out_file"), var_str (""), & intrinsic=.true., & description=var_str ('This character variable allows to specify ' // & 'the name of the data file to which the histogram and plot data ' // & 'are written (cf. also \ttt{write\_analysis}, \ttt{open\_out}, ' // & '\ttt{close\_out})')) call var_list%append_log (var_str ("?out_advance"), .true., & intrinsic=.true., & description=var_str ('Flag that sets advancing in the \ttt{printf} ' // & 'output commands, i.e. continuous printing with no line feed ' // & 'etc. (cf. also \ttt{printf})')) !!! JRR: WK please check (#542) ! call var_list%append_log (var_str ("?out_custom"), .false., & ! intrinsic=.true.) ! call var_list%append_string (var_str ("$out_comment"), var_str ("# "), & ! intrinsic=.true.) ! call var_list%append_log (var_str ("?out_header"), .true., & ! intrinsic=.true.) ! call var_list%append_log (var_str ("?out_yerr"), .true., & ! intrinsic=.true.) ! call var_list%append_log (var_str ("?out_xerr"), .true., & ! intrinsic=.true.) call var_list%append_int (var_str ("real_range"), & range (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This integer gives the decimal exponent ' // & 'range of the numeric model for the real float type in use. It cannot ' // & 'be set by the user. (cf. also \ttt{real\_precision}, ' // & '\ttt{real\_epsilon}, \ttt{real\_tiny}).')) call var_list%append_int (var_str ("real_precision"), & precision (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This integer gives the precision of ' // & 'the numeric model for the real float type in use. It cannot ' // & 'be set by the user. (cf. also \ttt{real\_range}, ' // & '\ttt{real\_epsilon}, \ttt{real\_tiny}).')) call var_list%append_real (var_str ("real_epsilon"), & epsilon (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This gives the smallest number $E$ ' // & 'of the same kind as the float type for which $1 + E > 1$. ' // & 'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // & '\ttt{real\_tiny}, \ttt{real\_precision}).')) call var_list%append_real (var_str ("real_tiny"), & tiny (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This gives the smallest positive (non-zero) ' // & 'number in the numeric model for the real float type in use. ' // & 'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // & '\ttt{real\_epsilon}, \ttt{real\_precision}).')) end subroutine var_list_set_core_defaults @ %def var_list_set_core_defaults @ <>= procedure :: set_integration_defaults => var_list_set_integration_defaults <>= subroutine var_list_set_integration_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$integration_method"), var_str ("vamp"), & intrinsic=.true., & description=var_str ('This string variable specifies the method ' // & 'for performing the multi-dimensional phase-space integration. ' // & 'The default is the \vamp\ algorithm (\ttt{"vamp"}), other options ' // & 'are via the numerical midpoint rule (\ttt{"midpoint"}) or an ' // & 'alternate \vamptwo\ implementation that is MPI-parallelizable ' // & '(\ttt{"vamp2"}).')) call var_list%append_int (var_str ("threshold_calls"), 10, & intrinsic=.true., & description=var_str ('This integer variable gives a limit for ' // & 'the number of calls in a given channel which acts as a lower ' // & 'threshold for the channel weight. If the number of calls in ' // & 'that channel falls below this threshold, the weight is not ' // & 'lowered further but kept at this threshold. (cf. also ' // & '\ttt{channel\_weights\_power})')) call var_list%append_int (var_str ("min_calls_per_channel"), 10, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the minimal " // & 'number every channel must be called. If the number of calls ' // & 'from the iterations is too small, \whizard\ will automatically ' // & 'increase the number of calls. (cf. \ttt{iterations}, \ttt{min\_calls\_per\_bin}, ' // & '\ttt{min\_bins}, \ttt{max\_bins})')) call var_list%append_int (var_str ("min_calls_per_bin"), 10, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the minimal " // & 'number every bin in an integration dimension must be called. ' // & 'If the number of calls from the iterations is too small, \whizard\ ' // & 'will automatically increase the number of calls. (cf. \ttt{iterations}, ' // & '\ttt{min\_calls\_per\_channel}, \ttt{min\_bins}, \ttt{max\_bins})')) call var_list%append_int (var_str ("min_bins"), 3, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the minimal " // & 'number of bins per integration dimension. (cf. \ttt{iterations}, ' // & '\ttt{max\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})')) call var_list%append_int (var_str ("max_bins"), 20, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the maximal " // & 'number of bins per integration dimension. (cf. \ttt{iterations}, ' // & '\ttt{min\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})')) call var_list%append_log (var_str ("?stratified"), .true., & intrinsic=.true., & description=var_str ('Flag that switches between stratified ' // & 'and importance sampling for the \vamp\ integration method.')) call var_list%append_log (var_str ("?use_vamp_equivalences"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether equivalence ' // & 'relations (symmetries) between different integration channels ' // & 'are used by the \vamp\ integrator.')) call var_list%append_log (var_str ("?vamp_verbose"), .false., & intrinsic=.true., & description=var_str ('Flag that sets the chattiness of the \vamp\ ' // & 'integrator. If set, not only errors, but also all warnings and ' // & 'messages will be written out (not the default). (cf. also \newline ' // & '\ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_global\_verbose}, ' // & '\ttt{?vamp\_history\_channels}, \newline \ttt{?vamp\_history\_channels\_verbose})')) call var_list%append_log (var_str ("?vamp_history_global"), & .true., intrinsic=.true., & description=var_str ('Flag that decides whether the global history ' // & 'of the grid adaptation of the \vamp\ integrator are written ' // & 'into the process logfiles. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // & '\ttt{?vamp\_history\_channels}, \ttt{?vamp\_history\_channels\_verbose}, ' // & '\ttt{?vamp\_verbose})')) call var_list%append_log (var_str ("?vamp_history_global_verbose"), & .false., intrinsic=.true., & description=var_str ('Flag that decides whether the global history ' // & 'of the grid adaptation of the \vamp\ integrator are written ' // & 'into the process logfiles in an extended version. Only for debugging ' // & 'purposes. (cf. also \ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_channels}, ' // & '\ttt{?vamp\_verbose}, \ttt{?vamp\_history\_channels\_verbose})')) call var_list%append_log (var_str ("?vamp_history_channels"), & .false., intrinsic=.true., & description=var_str ('Flag that decides whether the history of ' // & 'the grid adaptation of the \vamp\ integrator for every single ' // & 'channel are written into the process logfiles. Only for debugging ' // & 'purposes. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // & '\ttt{?vamp\_history\_global}, \ttt{?vamp\_verbose}, \newline ' // & '\ttt{?vamp\_history\_channels\_verbose})')) call var_list%append_log (var_str ("?vamp_history_channels_verbose"), & .false., intrinsic=.true., & description=var_str ('Flag that decides whether the history of ' // & 'the grid adaptation of the \vamp\ integrator for every single ' // & 'channel are written into the process logfiles in an extended ' // & 'version. Only for debugging purposes. (cf. also \ttt{?vamp\_history\_global}, ' // & '\ttt{?vamp\_history\_channels}, \ttt{?vamp\_verbose}, \ttt{?vamp\_history\_global\_verbose})')) call var_list%append_string (var_str ("$run_id"), var_str (""), & intrinsic=.true., & description=var_str ('String variable \ttt{\$run\_id = "{\em ' // & '}"} that allows to set a special ID for a particular process ' // & 'run, e.g. in a scan. The run ID is then attached to the process ' // & 'log file: \newline \ttt{{\em }\_{\em }.{\em ' // & '}.log}, the \vamp\ grid file: \newline \ttt{{\em }\_{\em ' // & '}.{\em }.vg}, and the phase space file: \newline ' // & '\ttt{{\em }\_{\em }.{\em }.phs}. ' // & 'The run ID string distinguishes among several runs for the ' // & 'same process. It identifies process instances with respect ' // & 'to adapted integration grids and similar run-specific data. ' // & 'The run ID is kept when copying processes for creating instances, ' // & 'however, so it does not distinguish event samples. (cf.\ also ' // & '\ttt{\$job\_id}, \ttt{\$compile\_workspace}')) call var_list%append_int (var_str ("n_calls_test"), 0, & intrinsic=.true., & description=var_str ('Integer variable that allows to set a ' // & 'certain number of matrix element sampling test calls without ' // & 'actually integrating the process under consideration. (cf. ' // & '\ttt{integrate})')) call var_list%append_log (var_str ("?integration_timer"), .true., & intrinsic=.true., & description=var_str ('This flag switches the integration timer ' // & 'on and off, that gives the estimate for the duration of the ' // & 'generation of 10,000 unweighted events for each integrated ' // & 'process.')) call var_list%append_log (var_str ("?check_grid_file"), .true., & intrinsic=.true., & description=var_str ('Setting this to false turns off all sanity ' // & 'checks when reading a grid file with previous integration data. ' // & 'Use this at your own risk; the program may return wrong results ' // & 'or crash if data do not match. (cf. also \ttt{?check\_event\_file}, \ttt{?check\_phs\_file}) ')) call var_list%append_real (var_str ("accuracy_goal"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that allows the user to ' // & 'set a minimal accuracy that should be achieved in the Monte-Carlo ' // & 'integration of a certain process. If that goal is reached, ' // & 'grid and weight adapation stop, and this result is used for ' // & 'simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // & '\ttt{error\_goal}, \ttt{relative\_error\_goal}, ' // & '\ttt{error\_threshold})')) call var_list%append_real (var_str ("error_goal"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that allows the user to ' // & 'set a minimal absolute error that should be achieved in the ' // & 'Monte-Carlo integration of a certain process. If that goal ' // & 'is reached, grid and weight adapation stop, and this result ' // & 'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // & '\ttt{accuracy\_goal}, \ttt{relative\_error\_goal}, \ttt{error\_threshold})')) call var_list%append_real (var_str ("relative_error_goal"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that allows the user to ' // & 'set a minimal relative error that should be achieved in the ' // & 'Monte-Carlo integration of a certain process. If that goal ' // & 'is reached, grid and weight adaptation stop, and this result ' // & 'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // & '\ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{error\_threshold})')) call var_list%append_int (var_str ("integration_results_verbosity"), 1, & intrinsic=.true., & description=var_str ('Integer parameter for the verbosity of ' // & 'the integration results in the process-specific logfile.')) call var_list%append_real (var_str ("error_threshold"), & 0._default, intrinsic=.true., & description=var_str ('The real parameter \ttt{error\_threshold ' // & '= {\em }} declares that any error value (in absolute numbers) ' // & 'smaller than \ttt{{\em }} is to be considered zero. The ' // & 'units are \ttt{fb} for scatterings and \ttt{GeV} for decays. ' // & '(cf. also \ttt{integrate}, \ttt{iterations}, \ttt{accuracy\_goal}, ' // & '\ttt{error\_goal}, \ttt{relative\_error\_goal})')) call var_list%append_real (var_str ("channel_weights_power"), 0.25_default, & intrinsic=.true., & description=var_str ('Real parameter that allows to vary the ' // & 'exponent of the channel weights for the \vamp\ integrator.')) call var_list%append_string (var_str ("$integrate_workspace"), & intrinsic=.true., & description=var_str ('Character string that tells \whizard\ ' // & 'the subdirectory where to find the run-specific phase-space ' // & 'configuration and the \vamp\ and \vamptwo\ grid files. ' // & 'If undefined (as per default), \whizard\ creates them and ' // & 'searches for them in the ' // & 'current directory. (cf. also \ttt{\$job\_id}, ' // & '\ttt{\$run\_id}, \ttt{\$compile\_workspace})')) + call var_list%append_string (var_str ("$vamp_grid_format"), var_str ("ascii"), & + intrinsic=.true., & + description=var_str ('Character string that tells \whizard\ ' // & + 'the file format for \ttt{vamp2} to use for writing and reading ' // & + 'the configuration for the multi-channel integration setup and the ' // & + '\vamptwo\ (only) grid data. The values can be \ttt{ascii} for a single ' // & + 'human-readable grid file with ending \ttt{.vg2} or \ttt{binary} for two files, ' // & + 'a human-readable header file with ending \ttt{.vg2} and binary file with ending ' // & + '\ttt{.vgx2} storing the grid data.' // & + 'The main purpose of the binary format is to perform faster I/O, e.g. for HPC runs.' // & + '\whizard\ can convert between the different file formats automatically.')) end subroutine var_list_set_integration_defaults @ %def var_list_set_integration_defaults @ <>= procedure :: set_phase_space_defaults => var_list_set_phase_space_defaults <>= subroutine var_list_set_phase_space_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$phs_method"), var_str ("default"), & intrinsic=.true., & description=var_str ('String variable that allows to choose ' // & 'the phase-space parameterization method. The default is the ' // & '\ttt{"wood"} method that takes into account electroweak/BSM ' // & 'resonances. Note that this might not be the best choice for ' // & '(pure) QCD amplitudes. (cf. also \ttt{\$phs\_file})')) call var_list%append_log (var_str ("?vis_channels"), .false., & intrinsic=.true., & description=var_str ('Optional logical argument for the \ttt{integrate} ' // & 'command that demands \whizard\ to generate a PDF or postscript ' // & 'output showing the classification of the found phase space ' // & 'channels (if the phase space method \ttt{wood} has been used) ' // & 'according to their properties: \ttt{integrate (foo) \{ iterations=3:10000 ' // & '?vis\_channels = true \}}. The default is \ttt{false}. (cf. ' // & 'also \ttt{integrate}, \ttt{?vis\_history})')) call var_list%append_log (var_str ("?check_phs_file"), .true., & intrinsic=.true., & description=var_str ('Setting this to false turns off all sanity ' // & 'checks when reading a previously generated phase-space configuration ' // & 'file. Use this at your own risk; the program may return wrong ' // & 'results or crash if data do not match. (cf. also \ttt{?check\_event\_file}, ' // & '\ttt{?check\_grid\_file})')) call var_list%append_string (var_str ("$phs_file"), var_str (""), & intrinsic=.true., & description=var_str ('This string variable allows the user to ' // & 'set an individual file name for the phase space parameterization ' // & 'for a particular process: \ttt{\$phs\_file = "{\em }"}. ' // & 'If not set, the default is \ttt{{\em }\_{\em }.{\em ' // & '}.phs}. (cf. also \ttt{\$phs\_method})')) call var_list%append_log (var_str ("?phs_only"), .false., & intrinsic=.true., & description=var_str ('Flag (particularly as optional argument ' // & 'of the $\to$ \ttt{integrate} command) that allows to only generate ' // & 'the phase space file, but not perform the integration. (cf. ' // & 'also \ttt{\$phs\_method}, \ttt{\$phs\_file})')) call var_list%append_real (var_str ("phs_threshold_s"), 50._default, & intrinsic=.true., & description=var_str ('For the phase space method \ttt{wood}, ' // & 'this real parameter sets the threshold below which particles ' // & 'are assumed to be massless in the $s$-channel like kinematic ' // & 'regions. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_off\_shell}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // & '\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_threshold_t"), 100._default, & intrinsic=.true., & description=var_str ('For the phase space method \ttt{wood}, ' // & 'this real parameter sets the threshold below which particles ' // & 'are assumed to be massless in the $t$-channel like kinematic ' // & 'regions. (cf. also \ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // & '\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})')) call var_list%append_int (var_str ("phs_off_shell"), 2, & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of off-shell (not $t$-channel-like, non-resonant) lines that ' // & 'are taken into account to find a valid phase-space setup in ' // & 'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // & '\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // & '\ttt{?phs\_s\_mapping})')) call var_list%append_int (var_str ("phs_t_channel"), 6, & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of $t$-channel propagators in multi-peripheral diagrams that ' // & 'are taken into account to find a valid phase-space setup in ' // & 'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // & '\ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // & '\ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_e_scale"), 10._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the energy scale ' // & 'that acts as a cutoff for parameterizing radiation-like kinematics ' // & 'in the \ttt{wood} phase space method. \whizard\ takes the maximum ' // & 'of this value and the width of the propagating particle as ' // & 'a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // & '\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_m_scale"), 10._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the mass scale ' // & 'that acts as a cutoff for parameterizing collinear and infrared ' // & 'kinematics in the \ttt{wood} phase space method. \whizard\ ' // & 'takes the maximum of this value and the mass of the propagating ' // & 'particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_q_scale"), 10._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the momentum ' // & 'transfer scale that acts as a cutoff for parameterizing $t$- ' // & 'and $u$-channel like kinematics in the \ttt{wood} phase space ' // & 'method. \whizard\ takes the maximum of this value and the mass ' // & 'of the propagating particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, ' // & '\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, ' // & '\ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp}, ' // & '\newline \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_keep_nonresonant"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether the \ttt{wood} ' // & 'phase space method takes into account also non-resonant contributions. ' // & '(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // & '\ttt{phs\_q\_scale}, \ttt{phs\_e\_scale}, \ttt{?phs\_step\_mapping}, ' // & '\newline \ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_step_mapping"), .true., & intrinsic=.true., & description=var_str ('Flag that switches on (or off) a particular ' // & 'phase space mapping for resonances, where the mass and width ' // & 'of the resonance are explicitly set as channel cutoffs. (cf. ' // & 'also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, ' // & '\ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, \newline \ttt{phs\_m\_scale}, ' // & '\ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, \ttt{?phs\_step\_mapping\_exp}, ' // & '\newline \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_step_mapping_exp"), .true., & intrinsic=.true., & description=var_str ('Flag that switches on (or off) a particular ' // & 'phase space mapping for resonances, where the mass and width ' // & 'of the resonance are explicitly set as channel cutoffs. This ' // & 'is an exponential mapping in contrast to ($\to$) \ttt{?phs\_step\_mapping}. ' // & '(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \newline \ttt{?phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_s_mapping"), .true., & intrinsic=.true., & description=var_str ('Flag that allows special mapping for $s$-channel ' // & 'resonances. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, ' // & '\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp})')) call var_list%append_log (var_str ("?vis_history"), .false., & intrinsic=.true., & description=var_str ('Optional logical argument for the \ttt{integrate} ' // & 'command that demands \whizard\ to generate a PDF or postscript ' // & 'output showing the adaptation history of the Monte-Carlo integration ' // & 'of the process under consideration. (cf. also \ttt{integrate}, ' // & '\ttt{?vis\_channels})')) end subroutine var_list_set_phase_space_defaults @ %def var_list_set_phase_space_defaults @ <>= procedure :: set_gamelan_defaults => var_list_set_gamelan_defaults <>= subroutine var_list_set_gamelan_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_int (& var_str ("n_bins"), 20, & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: integer value that sets the number of bins in histograms. ' // & '(cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // & '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // & '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, ' // & '\ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (& var_str ("?normalize_bins"), .false., & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that determines whether the weights shall be normalized ' // & 'to the bin width or not. (cf. also \ttt{n\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\newline \ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \newline ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options})')) call var_list%append_string (var_str ("$obs_label"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: this is a string variable \ttt{\$obs\_label = "{\em ' // & '}"} that allows to attach a label to a plotted ' // & 'or histogrammed observable. (cf. also \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$obs_unit"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: this is a string variable \ttt{\$obs\_unit = "{\em ' // & '}"} that allows to attach a \LaTeX\ physical unit ' // & 'to a plotted or histogrammed observable. (cf. also \ttt{n\_bins}, ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$title"), var_str (""), & intrinsic=.true., & description=var_str ('This string variable sets the title of ' // & 'a plot in a \whizard\ analysis setup, e.g. a histogram or an ' // & 'observable. The syntax is \ttt{\$title = "{\em }"}. ' // & 'This title appears as a section header in the analysis file, ' // & 'but not in the screen output of the analysis. (cf. also \ttt{n\_bins}, ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \newline \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$description"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to specify ' // & 'a description text for the analysis, \ttt{\$description = "{\em ' // & '}"}. This line appears below the title ' // & 'of a corresponding analysis, on top of the respective plot. ' // & '(cf. also \ttt{analysis}, \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_unit}, \ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, ' // & '\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$x_label"), var_str (""), & intrinsic=.true., & description=var_str ('String variable, \ttt{\$x\_label = "{\em ' // & '}"}, that sets the $x$ axis label in a plot or ' // & 'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // & '\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$y\_label}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$y_label"), var_str (""), & intrinsic=.true., & description=var_str ('String variable, \ttt{\$y\_label = "{\em ' // & '}"}, that sets the $y$ axis label in a plot or ' // & 'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // & '\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{?y\_log}, ' // & '\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_int (var_str ("graph_width_mm"), 130, & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: integer value that sets the width of a graph or histogram ' // & 'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // & '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_int (var_str ("graph_height_mm"), 90, & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: integer value that sets the height of a graph or histogram ' // & 'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // & '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?y_log"), .false., & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that makes the $y$ axis logarithmic. (cf. also ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // & '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // & '\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (var_str ("?x_log"), .false., & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that makes the $x$ axis logarithmic. (cf. also ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // & '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // & '\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_real (var_str ("x_min"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the lower limit of the $x$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_real (var_str ("x_max"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the upper limit of the $x$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_min}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_real (var_str ("y_min"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the lower limit of the $y$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_max}, \ttt{y\_max}, \ttt{x\_min}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_real (var_str ("y_max"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the upper limit of the $y$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_max}, \ttt{x\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$gmlcode_bg"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: string variable that allows to define a background ' // & 'for plots and histograms (i.e. it is overwritten by the plot/histogram), ' // & 'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // & 'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$gmlcode_fg"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: string variable that allows to define a foreground ' // & 'for plots and histograms (i.e. it overwrites the plot/histogram), ' // & 'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // & 'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_histogram"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to either plot data as a ' // & 'histogram or as a continuous line (if $\to$ \ttt{?draw\_curve} ' // & 'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_base"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to insert a \ttt{base} statement ' // & 'in the analysis code to calculate the plot data from a data ' // & 'set. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{\$symbol}, \newline \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\newline \ttt{\$err\_options})')) call var_list%append_log (var_str ("?draw_piecewise"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to data from a data set piecewise, ' // & 'i.e. histogram style. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, ' // & '\ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_base}, \ttt{?fill\_curve}, ' // & '\ttt{\$symbol}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options})')) call var_list%append_log (var_str ("?fill_curve"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to fill data curves (e.g. ' // & 'as a histogram). The style can be set with $\to$ \ttt{\$fill\_options ' // & '= "{\em }"}. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_curve"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to either plot data as a ' // & 'continuous line or as a histogram (if $\to$ \ttt{?draw\_histogram} ' // & 'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_errors"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that determines whether error bars should be drawn ' // & 'or not. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\newline \ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_symbols"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that determines whether particular symbols (specified ' // & 'by $\to$ \ttt{\$symbol = "{\em }"}) should be ' // & 'used for plotting data points (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\newline \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$fill_options"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$fill\_options = "{\em }"} is a ' // & 'string variable that allows to set fill options when plotting ' // & 'data as filled curves with the $\to$ \ttt{?fill\_curve} flag. ' // & 'For more details see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\newline \ttt{?draw\_symbols}, \ttt{?fill\_curve}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$draw_options"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$draw\_options = "{\em }"} is a ' // & 'string variable that allows to set specific drawing options ' // & 'for plots and histograms. For more details see the \gamelan\ ' // & 'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // & '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // & '\ttt{?draw\_histogram}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$err_options"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$err\_options = "{\em }"} is a string ' // & 'variable that allows to set specific drawing options for errors ' // & 'in plots and histograms. For more details see the \gamelan\ ' // & 'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{?draw\_histogram}, \ttt{\$draw\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$symbol"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$symbol = "{\em }"} is a string ' // & 'variable for the symbols that should be used for plotting data ' // & 'points. (cf. also \ttt{\$obs\_label}, \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \newline \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\newline \ttt{?draw\_histogram}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \newline \ttt{\$err\_options}, ' // & '\ttt{?draw\_symbols})')) call var_list%append_log (& var_str ("?analysis_file_only"), .false., & intrinsic=.true., & description=var_str ('Allows to specify that only \LaTeX\ files ' // & "for \whizard's graphical analysis are written out, but not processed. " // & '(cf. \ttt{compile\_analysis}, \ttt{write\_analysis})')) end subroutine var_list_set_gamelan_defaults @ %def var_list_set_gamelan_defaults @ FastJet parameters and friends <>= procedure :: set_clustering_defaults => var_list_set_clustering_defaults <>= subroutine var_list_set_clustering_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_int (& var_str ("kt_algorithm"), & kt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the ' // & 'interfaced external \fastjet\ package. (cf. also ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, ' // & '\ttt{plugin\_algorithm}, ' // & '\newline\ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})')) call var_list%append_int (& var_str ("cambridge_algorithm"), & cambridge_algorithm, intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("antikt_algorithm"), & antikt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("genkt_algorithm"), & genkt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_for\_passive\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("cambridge_for_passive_algorithm"), & cambridge_for_passive_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_algorithm}, \ttt{plugin\_algorithm}, \newline ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("genkt_for_passive_algorithm"), & genkt_for_passive_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})')) call var_list%append_int (& var_str ("ee_kt_algorithm"), & ee_kt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_genkt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("ee_genkt_algorithm"), & ee_genkt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("plugin_algorithm"), & plugin_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("undefined_jet_algorithm"), & undefined_jet_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('This is just a place holder for any kind of jet ' // & 'jet algorithm that is not further specified. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r}, \ttt{plugin\_algorithm})')) call var_list%append_int (& var_str ("jet_algorithm"), undefined_jet_algorithm, & intrinsic = .true., & description=var_str ('Variable that allows to set the type of ' // & 'jet algorithm when using the external \fastjet\ library. It ' // & 'accepts one of the following algorithms: ($\to$) \ttt{kt\_algorithm}, ' // & '\newline ($\to$) \ttt{cambridge\_[for\_passive\_]algorithm}, ' // & '($\to$) \ttt{antikt\_algorithm}, ($\to$) \ttt{plugin\_algorithm}, ' // & '($\to$) \ttt{genkt\_[for\_passive\_]algorithm}, ($\to$) ' // & '\ttt{ee\_[gen]kt\_algorithm}). (cf. also \ttt{cluster}, ' // & '\ttt{jet\_p}, \ttt{jet\_r}, \ttt{jet\_ycut})')) call var_list%append_real (& var_str ("jet_r"), 0._default, & intrinsic = .true., & description=var_str ('Value for the distance measure $R$ used in ' // & 'the (non-Cambridge) algorithms that are available via the interface ' // & 'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // & '\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // & '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_ycut})')) call var_list%append_real (& var_str ("jet_p"), 0._default, & intrinsic = .true., & description=var_str ('Value for the exponent of the distance measure $R$ in ' // & 'the generalized $k_T$ algorithms that are available via the interface ' // & 'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // & '\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // & '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r}, \newline\ttt{jet\_ycut})')) call var_list%append_real (& var_str ("jet_ycut"), 0._default, & intrinsic = .true., & description=var_str ('Value for the $y$ separation measure used in ' // & 'the Cambridge-Aachen algorithms that are available via the interface ' // & 'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // & '\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // & '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})')) call var_list%append_log (& var_str ("?keep_flavors_when_clustering"), .false., & intrinsic = .true., & description=var_str ('The logical variable \ttt{?keep\_flavors\_when\_clustering ' // & '= true/false} specifies whether the flavor of a jet should be ' // & 'kept during \ttt{cluster} when a jet consists of one quark and ' // & 'zero or more gluons. Especially useful for cuts on b-tagged ' // & 'jets (cf. also \ttt{cluster}).')) end subroutine var_list_set_clustering_defaults @ %def var_list_set_clustering_defaults @ Frixione isolation parameters and all that: <>= procedure :: set_isolation_defaults => var_list_set_isolation_defaults <>= subroutine var_list_set_isolation_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_real (var_str ("photon_iso_eps"), 1._default, & intrinsic=.true., & description=var_str ('Photon isolation parameter $\epsilon_\gamma$ ' // & '(energy fraction) from hep-ph/9801442 (cf. also ' // & '\ttt{photon\_iso\_n}, \ttt{photon\_iso\_r0})')) call var_list%append_real (var_str ("photon_iso_n"), 1._default, & intrinsic=.true., & description=var_str ('Photon isolation parameter $n$ ' // & '(cone function exponent) from hep-ph/9801442 (cf. also ' // & '\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_r0})')) call var_list%append_real (var_str ("photon_iso_r0"), 0.4_default, & intrinsic=.true., & description=var_str ('Photon isolation parameter $R_0^\gamma$ ' // & '(isolation cone radius) from hep-ph/9801442 (cf. also ' // & '\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_n})')) end subroutine var_list_set_isolation_defaults @ %def var_list_set_isolation_defaults <>= procedure :: set_eio_defaults => var_list_set_eio_defaults <>= subroutine var_list_set_eio_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$sample"), var_str (""), & intrinsic=.true., & description=var_str ('String variable to set the (base) name ' // & 'of the event output format, e.g. \ttt{\$sample = "foo"} will ' // & 'result in an intrinsic binary format event file \ttt{foo.evx}. ' // & '(cf. also \ttt{sample\_format}, \ttt{simulate}, \ttt{hepevt}, ' // & '\ttt{ascii}, \ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, ' // & '\ttt{hepmc}, \ttt{lhef}, \ttt{lha}, \ttt{stdhep}, \ttt{stdhep\_up}, ' // & '\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, \ttt{sample\_max\_tries})')) call var_list%append_string (var_str ("$sample_normalization"), var_str ("auto"),& intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'normalization of generated events. There are four options: ' // & 'option \ttt{"1"} (events normalized to one), \ttt{"1/n"} (sum ' // & 'of all events in a sample normalized to one), \ttt{"sigma"} ' // & '(events normalized to the cross section of the process), and ' // & '\ttt{"sigma/n"} (sum of all events normalized to the cross ' // & 'section). The default is \ttt{"auto"} where unweighted events ' // & 'are normalized to one, and weighted ones to the cross section. ' // & '(cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?sample\_pacify}, \ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // & '\ttt{sample\_split\_n\_kbytes})')) call var_list%append_log (var_str ("?sample_pacify"), .false., & intrinsic=.true., & description=var_str ('Flag, mainly for debugging purposes: suppresses ' // & 'numerical noise in the output of a simulation. (cf. also \ttt{simulate}, ' // & '\ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}, ' // & '\ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // & '\ttt{sample\_split\_n\_kbytes})')) call var_list%append_log (var_str ("?sample_select"), .true., & intrinsic=.true., & description=var_str ('Logical that determines whether a selection should ' // & 'be applied to the output event format or not. If set to \ttt{false} a ' // & 'selection is only considered for the evaluation of observables. (cf. ' // & '\ttt{select}, \ttt{selection}, \ttt{analysis})')) call var_list%append_int (var_str ("sample_max_tries"), 10000, & intrinsic = .true., & description=var_str ('Integer variable that sets the maximal ' // & 'number of tries for generating a single event. The event might ' // & 'be vetoed because of a very low unweighting efficiency, errors ' // & 'in the event transforms like decays, shower, matching, hadronization ' // & 'etc. (cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?sample\_pacify}, \ttt{\$sample\_normalization}, ' // & '\ttt{sample\_split\_n\_evt}, \newline\ttt{sample\_split\_n\_kbytes})')) call var_list%append_int (var_str ("sample_split_n_evt"), 0, & intrinsic = .true., & description=var_str ('When generating events, this integer parameter ' // & '\ttt{sample\_split\_n\_evt = {\em }} gives the number \ttt{{\em ' // & '}} of breakpoints in the event files, i.e. it splits the ' // & 'event files into \ttt{{\em } + 1} parts. The parts are ' // & 'denoted by \ttt{{\em }.{\em }.{\em ' // & '}}. Here, \ttt{{\em }} is an integer ' // & 'running from \ttt{0} to \ttt{{\em }}. The start can be ' // & 'reset by ($\to$) \ttt{sample\_split\_index}. (cf. also \ttt{simulate}, ' // & '\ttt{\$sample}, \ttt{sample\_format}, \ttt{sample\_max\_tries}, ' // & '\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, ' // & '\ttt{sample\_split\_n\_kbytes})')) call var_list%append_int (var_str ("sample_split_n_kbytes"), 0, & intrinsic = .true., & description=var_str ('When generating events, this integer parameter ' // & '\ttt{sample\_split\_n\_kbytes = {\em }} limits the file ' // & 'size of event files. Whenever an event file has exceeded this ' // & 'size, counted in kilobytes, the following events will be written ' // & 'to a new file. The naming conventions are the same as for ' // & '\ttt{sample\_split\_n\_evt}. (cf. also \ttt{simulate}, \ttt{\$sample}, ' // & '\ttt{sample\_format}, \ttt{sample\_max\_tries}, \ttt{\$sample\_normalization}, ' // & '\ttt{?sample\_pacify})')) call var_list%append_int (var_str ("sample_split_index"), 0, & intrinsic = .true., & description=var_str ('Integer number that gives the starting ' // & 'index \ttt{sample\_split\_index = {\em }} for ' // & 'the numbering of event samples \ttt{{\em }.{\em ' // & '}.{\em }} split by the \ttt{sample\_split\_n\_evt ' // & '= {\em }}. The index runs from \ttt{{\em }} ' // & 'to \newline \ttt{{\em } + {\em }}. (cf. also \ttt{simulate}, ' // & '\ttt{\$sample}, \ttt{sample\_format}, \newline\ttt{\$sample\_normalization}, ' // & '\ttt{sample\_max\_tries}, \ttt{?sample\_pacify})')) call var_list%append_string (var_str ("$rescan_input_format"), var_str ("raw"), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'event format of the event file that is to be rescanned by the ' // & '($\to$) \ttt{rescan} command.')) call var_list%append_log (var_str ("?read_raw"), .true., & intrinsic=.true., & description=var_str ('This flag demands \whizard\ to (try to) ' // & 'read events (from the internal binary format) first before ' // & 'generating new ones. (cf. \ttt{simulate}, \ttt{?write\_raw}, ' // & '\ttt{\$sample}, \ttt{sample\_format})')) call var_list%append_log (var_str ("?write_raw"), .true., & intrinsic=.true., & description=var_str ("Flag to write out events in \whizard's " // & 'internal binary format. (cf. \ttt{simulate}, \ttt{?read\_raw}, ' // & '\ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_raw"), var_str ("evx"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_raw ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & "to which events in \whizard's internal format are written. If " // & 'not set, the default file name and suffix is \ttt{{\em }.evx}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_default"), var_str ("evt"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_default ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in a the standard \whizard\ verbose ASCII format ' // & 'are written. If not set, the default file name and suffix is ' // & '\ttt{{\em }.evt}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) call var_list%append_string (var_str ("$debug_extension"), var_str ("debug"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$debug\_extension ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in a long verbose format with debugging information ' // & 'are written. If not set, the default file name and suffix is ' // & '\ttt{{\em }.debug}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{?debug\_process}, \ttt{?debug\_transforms}, ' // & '\ttt{?debug\_decay}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_process"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether process information ' // & 'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // & '\ttt{?debug\_decay}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_transforms"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether information ' // & 'about event transforms will be displayed in the ASCII debug ' // & 'event format ($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{?debug\_decay}, \ttt{\$debug\_extension}, ' // & '\ttt{?debug\_process}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_decay"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether decay information ' // & 'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // & '\ttt{?debug\_process}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_verbose"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether extensive verbose ' // & 'information will be included in the ASCII debug event format ' // & '($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, \ttt{\$sample}, ' // & '\ttt{\$debug\_extension}, \ttt{?debug\_decay}, \ttt{?debug\_transforms}, ' // & '\ttt{?debug\_process})')) call var_list%append_string (var_str ("$dump_extension"), var_str ("pset.dat"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$dump\_extension ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & "to which events in \whizard's internal particle set format " // & 'are written. If not set, the default file name and suffix is ' // & '\ttt{{\em }.pset.dat}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?dump_compressed"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, issues ' // & 'a very compressed and clear version of the \ttt{dump} ($\to$) ' // & 'event format. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{\$dump\_extension}, ' // & '\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?dump_weights"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, includes ' // & 'cross sections, weights and excess in the \ttt{dump} ($\to$) ' // & 'event format. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_summary})')) call var_list%append_log (var_str ("?dump_summary"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, includes ' // & 'a summary with momentum sums for incoming and outgoing particles ' // & 'as well as for beam remnants in the \ttt{dump} ($\to$) ' // & 'event format. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?dump_screen"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, outputs ' // & 'events for the \ttt{dump} ($\to$) event format on screen ' // & ' instead of to a file. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{\$dump\_extension}, \ttt{?dump\_summary}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?hepevt_ensure_order"), .false., & intrinsic=.true., & description=var_str ('Flag to ensure that the particle set confirms ' // & 'the HEPEVT standard. This involves some copying and reordering ' // & 'to guarantee that mothers and daughters are always next to ' // & 'each other. Usually this is not necessary.')) call var_list%append_string (var_str ("$extension_hepevt"), var_str ("hepevt"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_hepevt ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the \whizard\ version 1 style HEPEVT ASCII ' // & 'format are written. If not set, the default file name and suffix ' // & 'is \ttt{{\em }.hepevt}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) call var_list%append_string (var_str ("$extension_ascii_short"), & var_str ("short.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_short ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the so called short variant of the \whizard\ ' // & 'version 1 style HEPEVT ASCII format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.short.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_ascii_long"), & var_str ("long.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_long ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the so called long variant of the \whizard\ ' // & 'version 1 style HEPEVT ASCII format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.long.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_athena"), & var_str ("athena.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_athena ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the ATHENA file format are written. If not ' // & 'set, the default file name and suffix is \ttt{{\em }.athena.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_mokka"), & var_str ("mokka.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_mokka ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the MOKKA format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.mokka.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$lhef_version"), var_str ("2.0"), & intrinsic = .true., & description=var_str ('Specifier for the Les Houches Accord (LHEF) ' // & 'event format files with XML headers to discriminate among different ' // & 'versions of this format. (cf. also \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // & '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref}, ' // & '\ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_string (var_str ("$lhef_extension"), var_str ("lhe"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$lhef\_extension ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the LHEF format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.lhe}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{lhef}, ' // & '\ttt{\$lhef\_extension}, \ttt{\$lhef\_version}, \ttt{?lhef\_write\_sqme\_prc}, ' // & '\ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_log (var_str ("?lhef_write_sqme_prc"), .true., & intrinsic = .true., & description=var_str ('Flag that decides whether in the ($\to$) ' // & '\ttt{lhef} event format the weights of the squared matrix element ' // & 'of the corresponding process shall be written in the LHE file. ' // & '(cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{lhef}, ' // & '\ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_ref}, ' // & '\newline \ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_log (var_str ("?lhef_write_sqme_ref"), .false., & intrinsic = .true., & description=var_str ('Flag that decides whether in the ($\to$) ' // & '\ttt{lhef} event format reference weights of the squared matrix ' // & 'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // & '\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // & '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_log (var_str ("?lhef_write_sqme_alt"), .true., & intrinsic = .true., & description=var_str ('Flag that decides whether in the ($\to$) ' // & '\ttt{lhef} event format alternative weights of the squared matrix ' // & 'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // & '\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // & '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref})')) call var_list%append_string (var_str ("$extension_lha"), var_str ("lha"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_lha ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the (deprecated) LHA format are written. ' // & 'If not set, the default file name and suffix is \ttt{{\em }.lha}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_hepmc"), var_str ("hepmc"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_hepmc ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the HepMC format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.hepmc}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_log (var_str ("?hepmc_output_cross_section"), .false., & intrinsic = .true., & description=var_str ('Flag for the HepMC event format that allows ' // & 'to write out the cross section (and error) from the integration ' // & 'together with each HepMC event. This can be used by programs ' // & 'like Rivet to scale histograms according to the cross section. ' // & '(cf. also \ttt{hepmc})')) call var_list%append_log (var_str ("?hepmc3_hepmc2mode"), .false., & intrinsic = .true., & description=var_str ('Flag for the HepMC event format that allows ' // & 'to use HepMC3 to write in HepMC2 backwards compatibility mode. ' // & 'This option has no effect when HepMC2 is linked. ' // & '(cf. also \ttt{hepmc})')) call var_list%append_string (var_str ("$extension_lcio"), var_str ("slcio"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_lcio ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the LCIO format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.slcio}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_stdhep"), var_str ("hep"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_stdhep ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the StdHEP format via the HEPEVT common ' // & 'block are written. If not set, the default file name and suffix ' // & 'is \ttt{{\em }.hep}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) call var_list%append_string (var_str ("$extension_stdhep_up"), & var_str ("up.hep"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_up ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the StdHEP format via the HEPRUP/HEPEUP ' // & 'common blocks are written. \ttt{{\em }.up.hep} ' // & 'is the default file name and suffix, if this variable not set. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_stdhep_ev4"), & var_str ("ev4.hep"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_ev4 ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the StdHEP format via the HEPEVT/HEPEV4 ' // & 'common blocks are written. \ttt{{\em }.up.hep} ' // & 'is the default file name and suffix, if this variable not set. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_hepevt_verb"), & var_str ("hepevt.verb"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_hepevt\_verb ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the \whizard\ version 1 style extended or ' // & 'verbose HEPEVT ASCII format are written. If not set, the default ' // & 'file name and suffix is \ttt{{\em }.hepevt.verb}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_lha_verb"), & var_str ("lha.verb"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_lha\_verb ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the (deprecated) extended or verbose LHA ' // & 'format are written. If not set, the default file name and suffix ' // & 'is \ttt{{\em }.lha.verb}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) end subroutine var_list_set_eio_defaults @ %def var_list_set_eio_defaults @ <>= procedure :: set_shower_defaults => var_list_set_shower_defaults <>= subroutine var_list_set_shower_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?allow_shower"), .true., & intrinsic=.true., & description=var_str ('Master flag to switch on (initial and ' // & 'final state) parton shower, matching/merging as an event ' // & 'transform. As a default, it is switched on. (cf. also \ttt{?ps\_ ' // & '....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_fsr_active"), .false., & intrinsic=.true., & description=var_str ('Flag that switches final-state QCD radiation ' // & '(FSR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_active"), .false., & intrinsic=.true., & description=var_str ('Flag that switches initial-state QCD ' // & 'radiation (ISR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_taudec_active"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on $\tau$ decays, at ' // & 'the moment only via the included external package \ttt{TAUOLA} ' // & 'and \ttt{PHOTOS}. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?muli_active"), .false., & intrinsic=.true., & description=var_str ("Master flag that switches on \whizard's " // & 'module for multiple interaction with interleaved QCD parton ' // & 'showers for hadron colliders. Note that this feature is still ' // & 'experimental. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})')) call var_list%append_string (var_str ("$shower_method"), var_str ("WHIZARD"), & intrinsic=.true., & description=var_str ('String variable that allows to specify ' // & 'which parton shower is being used, the default, \ttt{"WHIZARD"}, ' // & 'is one of the in-house showers of \whizard. Other possibilities ' // & 'at the moment are only \ttt{"PYTHIA6"}.')) call var_list%append_log (var_str ("?shower_verbose"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on verbose messages when ' // & 'using shower and/or hadronization. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...},')) call var_list%append_string (var_str ("$ps_PYTHIA_PYGIVE"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass options ' // & 'for tunes etc. to the attached \pythia\ parton shower or hadronization, ' // & 'e.g.: \ttt{\$ps\_PYTHIA\_PYGIVE = "MSTJ(41)=1"}. (cf. also ' // & '\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_string (var_str ("$ps_PYTHIA8_config"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass options ' // & 'for tunes etc. to the attached \pythia\ttt{8} parton shower or hadronization, ' // & 'e.g.: \ttt{\$ps\_PYTHIA8\_config = "PartonLevel:MPI = off"}. (cf. also ' // & '\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_string (var_str ("$ps_PYTHIA8_config_file"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass a filename to a ' // & '\pythia\ttt{8} configuration file.')) call var_list%append_real (& var_str ("ps_mass_cutoff"), 1._default, intrinsic = .true., & description=var_str ('Real value that sets the QCD parton shower ' // & 'lower cutoff scale, where hadronization sets in. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (& var_str ("ps_fsr_lambda"), 0.29_default, intrinsic = .true., & description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // & 'used in running $\alpha_s$ for time-like showers is set (except ' // & 'for showers in the decay of a resonance). (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (& var_str ("ps_isr_lambda"), 0.29_default, intrinsic = .true., & description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // & 'used in running $\alpha_s$ for space-like showers is set. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_int (& var_str ("ps_max_n_flavors"), 5, intrinsic = .true., & description=var_str ('This integer parameter sets the maxmimum ' // & 'number of flavors that can be produced in a QCD shower $g\to ' // & 'q\bar q$. It is also used as the maximal number of active flavors ' // & 'for the running of $\alpha_s$ in the shower (with a minimum ' // & 'of 3). (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_alphas_running"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether a running ' // & '$\alpha_s$ is taken in space-like QCD parton showers. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_fsr_alphas_running"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether a running ' // & '$\alpha_s$ is taken in time-like QCD parton showers. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str ("ps_fixed_alphas"), & 0._default, intrinsic = .true., & description=var_str ('This real parameter sets the value of $\alpha_s$ ' // & 'if it is (cf. $\to$ \ttt{?ps\_isr\_alphas\_running}, \newline ' // & '\ttt{?ps\_fsr\_alphas\_running}) not running in initial and/or ' // & 'final-state QCD showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_pt_ordered"), .false., & intrinsic=.true., & description=var_str ('By this flag, it can be switched between ' // & 'the analytic QCD ISR shower (\ttt{false}, default) and the ' // & '$p_T$ ISR QCD shower (\ttt{true}). (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_angular_ordered"), .true., & intrinsic=.true., & description=var_str ('If switched one, this flag forces opening ' // & 'angles of emitted partons in the QCD ISR shower to be strictly ' // & 'ordered, i.e. increasing towards the hard interaction. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_primordial_kt_width"), 0._default, intrinsic = .true., & description=var_str ('This real parameter sets the width $\sigma ' // & '= \braket{k_T^2}$ for the Gaussian primordial $k_T$ distribution ' // & 'inside the hadron, given by: $\exp[-k_T^2/\sigma^2] k_T dk_T$. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_primordial_kt_cutoff"), 5._default, intrinsic = .true., & description=var_str ('Real parameter that sets the upper cutoff ' // & 'for the primordial $k_T$ distribution inside a hadron. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?hadronization\_active}, \ttt{?mlm\_ ...})')) call var_list%append_real (var_str & ("ps_isr_z_cutoff"), 0.999_default, intrinsic = .true., & description=var_str ('This real parameter allows to set the upper ' // & 'cutoff on the splitting variable $z$ in space-like QCD parton ' // & 'showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_minenergy"), 1._default, intrinsic = .true., & description=var_str ('By this real parameter, the minimal effective ' // & 'energy (in the c.m. frame) of a time-like or on-shell-emitted ' // & 'parton in a space-like QCD shower is set. For a hard subprocess ' // & 'that is not in the rest frame, this number is roughly reduced ' // & 'by a boost factor $1/\gamma$ to the rest frame of the hard scattering ' // & 'process. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_tscalefactor"), 1._default, intrinsic = .true., & description=var_str ('The $Q^2$ scale of the hard scattering ' // & 'process is multiplied by this real factor to define the maximum ' // & 'parton virtuality allowed in time-like QCD showers. This does ' // & 'only apply to $t$- and $u$-channels, while for $s$-channel resonances ' // & 'the maximum virtuality is set by $m^2$. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str & ("?ps_isr_only_onshell_emitted_partons"), .false., intrinsic=.true., & description=var_str ('This flag if set true sets all emitted ' // & 'partons off space-like showers on-shell, i.e. it would not allow ' // & 'associated time-like showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) end subroutine var_list_set_shower_defaults @ %def var_list_set_shower_defaults @ <>= procedure :: set_hadronization_defaults => var_list_set_hadronization_defaults <>= subroutine var_list_set_hadronization_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log & (var_str ("?allow_hadronization"), .true., intrinsic=.true., & description=var_str ('Master flag to switch on hadronization ' // & 'as an event transform. As a default, it is switched on. (cf. ' // & 'also \ttt{?ps\_ ....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, ' // & '\ttt{?hadronization\_active})')) call var_list%append_log & (var_str ("?hadronization_active"), .false., intrinsic=.true., & description=var_str ('Master flag to switch hadronization (through ' // & 'the attached \pythia\ package) on or off. As a default, it is ' // & 'off. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...})')) call var_list%append_string & (var_str ("$hadronization_method"), var_str ("PYTHIA6"), intrinsic = .true., & description=var_str ("Determines whether \whizard's own " // & "hadronization or the (internally included) \pythiasix\ should be used.")) call var_list%append_real & (var_str ("hadron_enhanced_fraction"), 0.01_default, intrinsic = .true., & description=var_str ('Fraction of Lund strings that break with enhanced ' // & 'width. [not yet active]')) call var_list%append_real & (var_str ("hadron_enhanced_width"), 2.0_default, intrinsic = .true., & description=var_str ('Enhancement factor for the width of breaking ' // & 'Lund strings. [not yet active]')) end subroutine var_list_set_hadronization_defaults @ %def var_list_set_hadronization_defaults @ <>= procedure :: set_tauola_defaults => var_list_set_tauola_defaults <>= subroutine var_list_set_tauola_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (& var_str ("?ps_tauola_photos"), .false., intrinsic=.true., & description=var_str ('Flag to switch on \ttt{PHOTOS} for photon ' // & 'showering inside the \ttt{TAUOLA} package. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_log (& var_str ("?ps_tauola_transverse"), .false., intrinsic=.true., & description=var_str ('Flag to switch transverse $\tau$ polarization ' // & 'on or off for Higgs decays into $\tau$ leptons. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_log (& var_str ("?ps_tauola_dec_rad_cor"), .true., intrinsic=.true., & description=var_str ('Flag to switch radiative corrections for ' // & '$\tau$ decays in \ttt{TAUOLA} on or off. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_int (& var_str ("ps_tauola_dec_mode1"), 0, intrinsic = .true., & description=var_str ('Integer code to request a specific $\tau$ ' // & 'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // & 'in correlated decays -- for the second $\tau$. For more information ' // & 'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_int (& var_str ("ps_tauola_dec_mode2"), 0, intrinsic = .true., & description=var_str ('Integer code to request a specific $\tau$ ' // & 'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // & 'in correlated decays -- for the second $\tau$. For more information ' // & 'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_real (& var_str ("ps_tauola_mh"), 125._default, intrinsic = .true., & description=var_str ('Real option to set the Higgs mass for Higgs ' // & 'decays into $\tau$ leptons in the interface to \ttt{TAUOLA}. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_real (& var_str ("ps_tauola_mix_angle"), 90._default, intrinsic = .true., & description=var_str ('Option to set the mixing angle between ' // & 'scalar and pseudoscalar Higgs bosons for Higgs decays into $\tau$ ' // & 'leptons in the interface to \ttt{TAUOLA}. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_log (& var_str ("?ps_tauola_pol_vector"), .false., intrinsic = .true., & description=var_str ('Flag to decide whether for transverse $\tau$ ' // & 'polarization, polarization information should be taken from ' // & '\ttt{TAUOLA} or not. The default is just based on random numbers. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) end subroutine var_list_set_tauola_defaults @ %def var_list_set_tauola_defaults @ <>= procedure :: set_mlm_matching_defaults => var_list_set_mlm_matching_defaults <>= subroutine var_list_set_mlm_matching_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?mlm_matching"), .false., & intrinsic=.true., & description=var_str ('Master flag to switch on MLM (LO) jet ' // & 'matching between hard matrix elements and the QCD parton ' // & 'shower. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Qcut_ME"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that in the MLM jet matching ' // & 'between hard matrix elements and QCD parton shower sets a possible ' // & 'virtuality cut on jets from the hard matrix element. (cf. also ' // & '\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // & '...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Qcut_PS"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that in the MLM jet matching ' // & 'between hard matrix elements and QCD parton shower sets a possible ' // & 'virtuality cut on jets from the parton shower. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_ptmin"), 0._default, intrinsic = .true., & description=var_str ('This real parameter sets a minimal $p_T$ ' // & 'that enters the $y_{cut}$ jet clustering measure in the MLM ' // & 'jet matching between hard matrix elements and QCD parton showers. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_etamax"), 0._default, intrinsic = .true., & description=var_str ('This real parameter sets a maximal pseudorapidity ' // & 'that enters the MLM jet matching between hard matrix elements ' // & 'and QCD parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Rmin"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that sets a minimal $R$ ' // & 'distance value that enters the $y_{cut}$ jet clustering measure ' // & 'in the MLM jet matching between hard matrix elements and QCD ' // & 'parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Emin"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that sets a minimal energy ' // & '$E_{min}$ value as an infrared cutoff in the MLM jet matching ' // & 'between hard matrix elements and QCD parton showers. (cf. also ' // & '\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // & '...}, \ttt{?hadronization\_active})')) call var_list%append_int (var_str & ("mlm_nmaxMEjets"), 0, intrinsic = .true., & description=var_str ('This integer sets the maximal number of ' // & 'jets that are available from hard matrix elements in the MLM ' // & 'jet matching between hard matrix elements and QCD parton shower. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_ETclusfactor"), 0.2_default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_ETclusminE"), 5._default, intrinsic = .true., & description=var_str ('This real parameter is a minimal energy ' // & 'that enters the calculation of the $y_{cut}$ measure for jet ' // & 'clustering after the parton shower in the MLM jet matching between ' // & 'hard matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_etaclusfactor"), 1._default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Rclusfactor"), 1._default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Eclusfactor"), 1._default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) end subroutine var_list_set_mlm_matching_defaults @ %def var_list_set_mlm_matching_defaults @ <>= procedure :: set_powheg_matching_defaults => & var_list_set_powheg_matching_defaults <>= subroutine var_list_set_powheg_matching_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?powheg_matching"), & .false., intrinsic = .true., & description=var_str ('Activates Powheg matching. Needs to be ' // & 'combined with the \ttt{?combined\_nlo\_integration}-method.')) call var_list%append_log (var_str ("?powheg_use_singular_jacobian"), & .false., intrinsic = .true., & description=var_str ('This allows to give a different ' // & 'normalization of the Jacobian, resulting in an alternative ' // & 'POWHEG damping in the singular regions.')) call var_list%append_int (var_str ("powheg_grid_size_xi"), & 5, intrinsic = .true., & description=var_str ('Number of $\xi$ points in the POWHEG grid.')) call var_list%append_int (var_str ("powheg_grid_size_y"), & 5, intrinsic = .true., & description=var_str ('Number of $y$ points in the POWHEG grid.')) call var_list%append_int (var_str ("powheg_grid_sampling_points"), & 500000, intrinsic = .true., & description=var_str ('Number of calls used to initialize the ' // & 'POWHEG grid.')) call var_list%append_real (var_str ("powheg_pt_min"), & 1._default, intrinsic = .true., & description=var_str ('Lower $p_T$-cut-off for the POWHEG ' // & 'hardest emission.')) call var_list%append_real (var_str ("powheg_lambda"), & LAMBDA_QCD_REF, intrinsic = .true., & description=var_str ('Reference scale of the $\alpha_s$ evolution ' // & 'in the POWHEG matching algorithm.')) call var_list%append_log (var_str ("?powheg_rebuild_grids"), & .false., intrinsic = .true., & description=var_str ('If set to \ttt{true}, the existing POWHEG ' // & 'grid is discarded and a new one is generated.')) call var_list%append_log (var_str ("?powheg_test_sudakov"), & .false., intrinsic = .true., & description=var_str ('Performs an internal consistency check ' // & 'on the POWHEG event generation.')) call var_list%append_log (var_str ("?powheg_disable_sudakov"), & .false., intrinsic = .true., & description=var_str ('This flag allows to set the Sudakov form ' // & 'factor to one. This effectively results in a version of ' // & 'the matrix-element method (MEM) at NLO.')) end subroutine var_list_set_powheg_matching_defaults @ %def var_list_set_powheg_matching_defaults @ <>= procedure :: set_openmp_defaults => var_list_set_openmp_defaults <>= subroutine var_list_set_openmp_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?omega_openmp"), & openmp_is_active (), & intrinsic=.true., & description=var_str ('Flag to switch on or off OpenMP multi-threading ' // & "for \oMega\ matrix elements. (cf. also \ttt{\$method}, \ttt{\$omega\_flag})")) call var_list%append_log (var_str ("?openmp_is_active"), & openmp_is_active (), & locked=.true., intrinsic=.true., & description=var_str ('Flag to switch on or off OpenMP multi-threading ' // & 'for \whizard. (cf. also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, ' // & '\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})')) call var_list%append_int (var_str ("openmp_num_threads_default"), & openmp_get_default_max_threads (), & locked=.true., intrinsic=.true., & description=var_str ('Integer parameter that shows the number ' // & 'of default OpenMP threads for multi-threading. Note that this ' // & 'parameter can only be accessed, but not reset by the user. (cf. ' // & 'also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, \ttt{?omega\_openmp})')) call var_list%append_int (var_str ("openmp_num_threads"), & openmp_get_max_threads (), & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of OpenMP threads for multi-threading. (cf. also \ttt{?openmp\_logging}, ' // & '\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})')) call var_list%append_log (var_str ("?openmp_logging"), & .true., intrinsic=.true., & description=var_str ('This logical -- when set to \ttt{false} ' // & '-- suppresses writing out messages about OpenMP parallelization ' // & '(number of used threads etc.) on screen and into the logfile ' // & '(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // & 'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // & '\ttt{?mpi\_logging})')) end subroutine var_list_set_openmp_defaults @ %def var_list_set_openmp_defaults @ <>= procedure :: set_mpi_defaults => var_list_set_mpi_defaults <>= subroutine var_list_set_mpi_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?mpi_logging"), & .false., intrinsic=.true., & description=var_str('This logical -- when set to \ttt{false} ' // & '-- suppresses writing out messages about MPI parallelization ' // & '(number of used workers etc.) on screen and into the logfile ' // & '(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // & 'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // & '\ttt{?openmp\_logging})')) end subroutine var_list_set_mpi_defaults @ %def var_list_set_mpi_defaults @ <>= procedure :: set_nlo_defaults => var_list_set_nlo_defaults <>= subroutine var_list_set_nlo_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$born_me_method"), & var_str (""), intrinsic = .true., & description=var_str ("This string variable specifies the method " // & "for the matrix elements to be used in the evaluation of the " // & "Born part of the NLO computation. The default is the empty string, " // & "i.e. the \ttt{\$method} being the intrinsic \oMega\ matrix element " // & 'generator (\ttt{"omega"}), other options ' // & 'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, ' // & '\ttt{"template\_unity"}, \ttt{"threshold"}, \ttt{"gosam"}, ' // & '\ttt{"openloops"}. Note that this option is inoperative if ' // & 'no NLO calculation is specified in the process definition. ' // & 'If you want ot use different matrix element methods in a LO ' // & 'computation, use the usual \ttt{method} command. (cf. also ' // & '\ttt{\$correlation\_me\_method}, ' // & '\ttt{\$dglap\_me\_method}, \ttt{\$loop\_me\_method} and ' // & '\ttt{\$real\_tree\_me\_method}.)')) call var_list%append_string (var_str ("$loop_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation of the ' // & 'virtual part of the NLO computation. The default is the empty string,' // & 'i.e. the same as \ttt{\$method}. Working options are: ' // & '\ttt{"threshold"}, \ttt{"openloops"}, \ttt{"recola"}, \ttt{gosam}. ' // & '(cf. also \ttt{\$real\_tree\_me\_method}, \ttt{\$correlation\_me\_method} ' // & 'and \ttt{\$born\_me\_method}.)')) call var_list%append_string (var_str ("$correlation_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies ' // & 'the method for the matrix elements to be used in the evaluation ' // & 'of the color (and helicity) correlated part of the NLO computation. ' // & "The default is the same as the \ttt{\$method}, i.e. the intrinsic " // & "\oMega\ matrix element generator " // & '(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // & '\ttt{"template"}, \ttt{"template\_unity"}, \ttt{"threshold"}, ' // & '\ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // & '\ttt{\$born\_me\_method}, \ttt{\$dglap\_me\_method}, ' // & '\ttt{\$loop\_me\_method} and \newline' // & '\ttt{\$real\_tree\_me\_method}.)')) call var_list%append_string (var_str ("$real_tree_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation of the ' // & 'real part of the NLO computation. The default is the same as ' // & 'the \ttt{\$method}, i.e. the intrinsic ' // & "\oMega\ matrix element generator " // & '(\ttt{"omega"}), other options ' // & 'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // & '\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // & '\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // & '\ttt{\$dglap\_me\_method} and \ttt{\$loop\_me\_method}.)')) call var_list%append_string (var_str ("$dglap_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation of the ' // & 'DGLAP remnants of the NLO computation. The default is the same as ' // & "\ttt{\$method}, i.e. the \oMega\ matrix element generator " // & '(\ttt{"omega"}), other options ' // & 'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // & '\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also \newline' // & '\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // & '\ttt{\$loop\_me\_method} and \ttt{\$real\_tree\_me\_method}.)')) call var_list%append_log (& var_str ("?test_soft_limit"), .false., intrinsic = .true., & description=var_str ('Sets the fixed values $\tilde{\xi} = 0.00001$ ' // & 'and $y = 0.5$ as radiation variables. This way, only soft, ' // & 'but non-collinear phase space points are generated, which allows ' // & 'for testing subtraction in this region.')) call var_list%append_log (& var_str ("?test_coll_limit"), .false., intrinsic = .true., & description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // & 'and $y = 0.9999999$ as radiation variables. This way, only collinear, ' // & 'but non-soft phase space points are generated, which allows ' // & 'for testing subtraction in this region. Can be combined with ' // & '\ttt{?test\_soft\_limit} to probe soft-collinear regions.')) call var_list%append_log (& var_str ("?test_anti_coll_limit"), .false., intrinsic = .true., & description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // & 'and $y = -0.9999999$ as radiation variables. This way, only anti-collinear, ' // & 'but non-soft phase space points are generated, which allows ' // & 'for testing subtraction in this region. Can be combined with ' // & '\ttt{?test\_soft\_limit} to probe soft-collinear regions.')) call var_list%append_string (var_str ("$select_alpha_regions"), & var_str (""), intrinsic = .true., & description=var_str ('Fixes the $\alpha_r$ in the real ' // & ' subtraction component. Allows for testing in one individual ' // & 'singular region.')) call var_list%append_string (var_str ("$virtual_selection"), & var_str ("Full"), intrinsic = .true., & description=var_str ('String variable to select either the full ' // & 'or only parts of the virtual components of an NLO calculation. ' // & 'Possible modes are \ttt{"Full"}, \ttt{"OLP"} and ' // & '\ttt{"Subtraction."}. Mainly for debugging purposes.')) call var_list%append_log (var_str ("?virtual_collinear_resonance_aware"), & .true., intrinsic = .true., & description=var_str ('This flag allows to switch between two ' // & 'different implementations of the collinear subtraction in the ' // & 'resonance-aware FKS setup.')) call var_list%append_real (& var_str ("blha_top_yukawa"), -1._default, intrinsic = .true., & description=var_str ('If this value is set, the given value will ' // & 'be used as the top Yukawa coupling instead of the top mass. ' // & 'Note that having different values for $y_t$ and $m_t$ must be ' // & 'supported by your OLP-library and yield errors if this is not the case.')) call var_list%append_string (var_str ("$blha_ew_scheme"), & var_str ("alpha_qed"), intrinsic = .true., & description=var_str ('String variable that transfers the electroweak ' // & 'renormalization scheme via BLHA to the one-loop provider. Possible ' // & 'values are \ttt{GF} or \ttt{Gmu} for the $G_\mu$ scheme, ' // & '\ttt{alpha\_qed}, \ttt{alpha\_mz} and \ttt{alpha\_0} or ' // & '\ttt{alpha\_thompson} for different schemes with $\alpha$ as input.')) call var_list%append_int (var_str ("openloops_verbosity"), 1, & intrinsic = .true., & description=var_str ('Decides how much \openloops\ output is printed. ' // & 'Can have values 0, 1 and 2, where 2 is the highest verbosity level.')) call var_list%append_log (var_str ("?openloops_use_cms"), & .true., intrinsic = .true., & description=var_str ('Activates the complex mass scheme in ' // & '\openloops. (cf. also ' // & '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // & '\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // & '\ttt{openloops\_stability\_log}, \newline' // & '\ttt{\$openloops\_extra\_cmd})')) call var_list%append_int (var_str ("openloops_phs_tolerance"), 7, & intrinsic = .true., & description=var_str ('This integer parameter gives via ' // & '\ttt{openloops\_phs\_tolerance = } the relative numerical ' // & 'tolerance $10^{-n}$ for the momentum conservation of the ' // & 'external particles within \openloops. (cf. also ' // & '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // & '\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // & '\newline\ttt{openloops\_stability\_log}, ' // & '\ttt{\$openloops\_extra\_cmd})')) call var_list%append_int (var_str ("openloops_stability_log"), 0, & intrinsic = .true., & description=var_str ('Creates the directory \ttt{stability\_log} ' // & 'containing information about the performance of the \openloops ' // & 'matrix elements. Possible values are 0 (No output), 1 (On ' // & '\ttt{finish()}-call), 2 (Adaptive) and 3 (Always).')) call var_list%append_log (var_str ("?openloops_switch_off_muon_yukawa"), & .false., intrinsic = .true., & description=var_str ('Sets the Yukawa coupling of muons for ' // & '\openloops\ to zero. (cf. also ' // & '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // & '\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // & '\ttt{\$openloops\_extra\_cmd})')) call var_list%append_string (var_str ("$openloops_extra_cmd"), & var_str (""), intrinsic = .true., & description=var_str ('String variable to transfer customized ' // & 'special commands to \openloops. The three supported examples ' // & '\ttt{\$openloops\_extra\_command = "extra approx top/stop/not"} ' // & 'are for selection of subdiagrams in top production. (cf. also ' // & '\ttt{\$method}, \ttt{openloos\_verbosity}, ' // & '\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // & '\ttt{?openloops\_switch\_off\_muon\_yukawa})')) call var_list%append_log (var_str ("?openloops_use_collier"), & .true., intrinsic = .true., & description=var_str ('Use \collier\ as the reduction method of ' // & '\openloops. Otherwise, \ttt{CutTools} will be used. (cf. also ' // & '\ttt{\$method}, \ttt{openloos\_verbosity}, ' // & '\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // & '\ttt{?openloops\_switch\_off\_muon\_yukawa})')) call var_list%append_log (var_str ("?disable_subtraction"), & .false., intrinsic = .true., & description=var_str ('Disables the subtraction of soft and collinear ' // & 'divergences from the real matrix element.')) call var_list%append_real (var_str ("fks_dij_exp1"), & 1._default, intrinsic = .true., & description=var_str ('Fine-tuning parameters of the FKS ' // & 'partition functions. The exact meaning depends on the mapping ' // & 'implementation. (cf. also \ttt{fks\_dij\_exp2}, ' // & '\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})')) call var_list%append_real (var_str ("fks_dij_exp2"), & 1._default, intrinsic = .true., & description=var_str ('Fine-tuning parameters of the FKS ' // & 'partition functions. The exact meaning depends on the mapping ' // & 'implementation. (cf. also \ttt{fks\_dij\_exp1}, ' // & '\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})')) call var_list%append_real (var_str ("fks_xi_min"), & 0.0000001_default, intrinsic = .true., & description=var_str ('Real parameter for the FKS ' // & 'phase space that sets the numerical lower value of the $\xi$ ' // & 'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // & '\ttt{fks\_dij\_exp2}, \ttt{\$fks\_mapping\_type}, \ttt{fks\_y\_max})')) call var_list%append_real (var_str ("fks_y_max"), & 1._default, intrinsic = .true., & description=var_str ('Real parameter for the FKS ' // & 'phase space that sets the numerical upper value of the $y$ ' // & 'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // & '\ttt{\$fks\_mapping\_type}, \ttt{fks\_dij\_exp2}, \ttt{fks\_y\_max})')) call var_list%append_log (var_str ("?vis_fks_regions"), & .false., intrinsic = .true., & description=var_str ('Logical variable that, if set to ' // & '\ttt{true}, generates \LaTeX\ code and executes it into a PDF ' // & ' to produce a table of all singular FKS regions and their ' // & ' flavor structures. The default is \ttt{false}.')) call var_list%append_real (var_str ("fks_xi_cut"), & 1.0_default, intrinsic = .true., & description = var_str ('Real paramter for the FKS ' // & 'phase space that applies a cut to $\xi$ variable with $0 < \xi_{\text{cut}}' // & '\leq \xi_{\text{max}}$. The dependence on the parameter vanishes between ' // & 'real subtraction and integrated subtraction term.')) call var_list%append_real (var_str ("fks_delta_o"), & 2._default, intrinsic = .true., & description = var_str ('Real paramter for the FKS ' // & 'phase space that applies a cut to the $y$ variable with $0 < \delta_o \leq 2$. ' // & 'The dependence on the parameter vanishes between real subtraction and integrated ' // & 'subtraction term.')) call var_list%append_real (var_str ("fks_delta_i"), & 2._default, intrinsic = .true., & description = var_str ('Real paramter for the FKS ' // & 'phase space that applies a cut to the $y$ variable with $0 < \delta_{\mathrm{I}} \leq 2$ '// & 'for initial state singularities only. ' // & 'The dependence on the parameter vanishes between real subtraction and integrated ' // & 'subtraction term.')) call var_list%append_string (var_str ("$fks_mapping_type"), & var_str ("default"), intrinsic = .true., & description=var_str ('Sets the FKS mapping type. Possible values ' // & 'are \ttt{"default"} and \ttt{"resonances"}. The latter option ' // & 'activates the resonance-aware subtraction mode and induces the ' // & 'generation of a soft mismatch component. (cf. also ' // & '\ttt{fks\_dij\_exp1}, \ttt{fks\_dij\_exp2}, \ttt{fks\_xi\_min}, ' // & '\ttt{fks\_y\_max})')) call var_list%append_string (var_str ("$resonances_exclude_particles"), & var_str ("default"), intrinsic = .true., & description=var_str ('Accepts a string of particle names. These ' // & 'particles will be ignored when the resonance histories are generated. ' // & 'If \ttt{\$fks\_mapping\_type} is not \ttt{"resonances"}, this ' // & 'option does nothing.')) call var_list%append_int (var_str ("alpha_power"), & 2, intrinsic = .true., & description=var_str ('Fixes the electroweak coupling ' // & 'powers used by BLHA matrix element generators. Setting these ' // & 'values is necessary for the correct generation of OLP-files. ' // & 'Having inconsistent values yields to error messages by the corresponding ' // & 'OLP-providers.')) call var_list%append_int (var_str ("alphas_power"), & 0, intrinsic = .true., & description=var_str ('Fixes the strong coupling ' // & 'powers used by BLHA matrix element generators. Setting these ' // & 'values is necessary for the correct generation of OLP-files. ' // & 'Having inconsistent values yields to error messages by the corresponding ' // & 'OLP-providers.')) call var_list%append_log (var_str ("?combined_nlo_integration"), & .false., intrinsic = .true., & description=var_str ('When this option is set to \ttt{true}, ' // & 'the NLO integration will not be performed in the separate components, ' // & 'but instead the sum of all components will be integrated directly. ' // & 'When fixed-order NLO events are requested, this integration ' // & 'mode is possible, but not necessary. However, it is necessary ' // & 'for POWHEG events.')) call var_list%append_log (var_str ("?fixed_order_nlo_events"), & .false., intrinsic = .true., & description=var_str ('Induces the generation of fixed-order ' // & 'NLO events. Deprecated name: \ttt{?nlo\_fixed\_order}.')) call var_list%append_log (var_str ("?check_event_weights_against_xsection"), & .false., intrinsic = .true., & description=var_str ('Activates an internal recording of event ' // & 'weights when unweighted events are generated. At the end of ' // & 'the simulation, the mean value of the weights and its standard ' // & 'deviation are displayed. This allows to cross-check event generation ' // & 'and integration, because the value displayed must be equal to ' // & 'the integration result.')) call var_list%append_log (var_str ("?keep_failed_events"), & .false., intrinsic = .true., & description=var_str ('In the context of weighted event generation, ' // & 'if set to \ttt{true}, events with failed kinematics will be ' // & 'written to the event output with an associated weight of zero. ' // & 'This way, the total cross section can be reconstructed from the event output.')) call var_list%append_int (var_str ("gks_multiplicity"), & 0, intrinsic = .true., & description=var_str ('Jet multiplicity for the GKS merging scheme.')) call var_list%append_string (var_str ("$gosam_filter_lo"), & var_str (""), intrinsic = .true., & description=var_str ('The filter string given to \gosam\ in order to ' // & 'filter out tree-level diagrams. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // & '\ttt{\$gosam\_symmetries})')) call var_list%append_string (var_str ("$gosam_filter_nlo"), & var_str (""), intrinsic = .true., & description=var_str ('The same as \ttt{\$gosam\_filter\_lo}, but for ' // & 'loop matrix elements. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // & '\ttt{\$gosam\_symmetries})')) call var_list%append_string (var_str ("$gosam_symmetries"), & var_str ("family,generation"), intrinsic = .true., & description=var_str ('String variable that is transferred to \gosam\ ' // & 'configuration file to determine whether certain helicity configurations ' // & 'are considered to be equal. Possible values are \ttt{flavour}, ' // & '\ttt{family} etc. For more info see the \gosam\ manual.')) call var_list%append_int (var_str ("form_threads"), & 2, intrinsic = .true., & description=var_str ('The number of threads used by \gosam when ' // & 'matrix elements are evaluated using \ttt{FORM}')) call var_list%append_int (var_str ("form_workspace"), & 1000, intrinsic = .true., & description=var_str ('The size of the workspace \gosam requires ' // & 'from \ttt{FORM}. Inside \ttt{FORM}, it corresponds to the heap ' // & 'size used by the algebra processor.')) call var_list%append_string (var_str ("$gosam_fc"), & var_str (""), intrinsic = .true., & description=var_str ('The Fortran compiler used by \gosam.')) call var_list%append_real (& var_str ("mult_call_real"), 1._default, & intrinsic = .true., & description=var_str ('(Real-valued) multiplier for the number ' // & 'of calls used in the integration of the real subtraction ' // & 'NLO component. This way, a higher accuracy can be achieved for ' // & 'the real component, while simultaneously avoiding redundant ' // & 'integration calls for the other components. (cf. also ' // & '\ttt{mult\_call\_dglap}, \ttt{mult\_call\_virt})')) call var_list%append_real (& var_str ("mult_call_virt"), 1._default, & intrinsic = .true., & description=var_str ('(Real-valued) multiplier for the number ' // & 'of calls used in the integration of the virtual NLO ' // & 'component. This way, a higher accuracy can be achieved for ' // & 'this component, while simultaneously avoiding redundant ' // & 'integration calls for the other components. (cf. also ' // & '\ttt{mult\_call\_dglap}, \ttt{mult\_call\_real})')) call var_list%append_real (& var_str ("mult_call_dglap"), 1._default, & intrinsic = .true., & description=var_str ('(Real-valued) multiplier for the number ' // & 'of calls used in the integration of the DGLAP remnant NLO ' // & 'component. This way, a higher accuracy can be achieved for ' // & 'this component, while simultaneously avoiding redundant ' // & 'integration calls for the other components. (cf. also ' // & '\ttt{mult\_call\_real}, \ttt{mult\_call\_virt})')) call var_list%append_string (var_str ("$dalitz_plot"), & var_str (''), intrinsic = .true., & description=var_str ('This string variable has two purposes: ' // & 'when different from the empty string, it switches on generation ' // & 'of the Dalitz plot file (ASCII tables) for the real emitters. ' // & 'The string variable itself provides the file name.')) call var_list%append_string (var_str ("$nlo_correction_type"), & var_str ("QCD"), intrinsic = .true., & description=var_str ('String variable which sets the NLO correction ' // & 'type via \ttt{nlo\_correction\_type = "{\em }"} to either ' // & '\ttt{"QCD"} or \ttt{"QED"}, or to both with \ttt{\em{}} ' // & 'set to \ttt{"Full"}.')) call var_list%append_string (var_str ("$exclude_gauge_splittings"), & var_str ("c:b:t:e2:e3"), intrinsic = .true., & description=var_str ('String variable that allows via ' // & '\ttt{\$exclude\_gauge\_splittings = "{\em ::\dots}"} ' // & 'to exclude fermion flavors from gluon/photon splitting into ' // & 'fermion pairs beyond LO. For example \ttt{\$exclude\_gauge\_splittings ' // & '= "c:s:b:t"} would lead to \ttt{gl => u U} and \ttt{gl => d ' // & 'D} as possible splittings in QCD. It is important to keep in ' // & 'mind that only the particles listed in the string are excluded! ' // & 'In QED this string would additionally allow for all splittings into ' // & 'lepton pairs \ttt{A => l L}. Therefore, once set the variable ' // & 'acts as a replacement of the default value, not as an addition! ' // & 'Note: \ttt{"\em "} can be both particle or antiparticle. It ' // & 'will always exclude the corresponding fermion pair. An empty ' // & 'string allows for all fermion flavors to take part in the splitting! ' // & 'Also, particles included in an \ttt{alias} are not excluded by ' // & '\ttt{\$exclude\_gauge\_splittings}!')) call var_list%append_log (var_str ("?nlo_use_born_scale"), & .false., intrinsic = .true., & description=var_str ('Flag that decides whether a scale expression ' // & 'defined for the Born component of an NLO process shall be applied ' // & 'to all other components as well or not. ' // & '(cf. also \ttt{?nlo\_cut\_all\_sqmes})')) call var_list%append_log (var_str ("?nlo_cut_all_sqmes"), & .false., intrinsic = .true., & description=var_str ('Flag that decides whether in the case that ' // & 'some NLO component does not pass a cut, all other components ' // & 'shall be discarded for that phase space point as well or not. ' // & '(cf. also \ttt{?nlo\_use\_born\_scale})')) call var_list%append_log (var_str ("?nlo_use_real_partition"), & .false., intrinsic = .true., & description=var_str (' If set to \ttt{true}, the real matrix ' // & 'element is split into a finite and a singular part using a ' // & 'partition function $f$, such that $\mathcal{R} ' // & '= [1-f(p_T^2)]\mathcal{R} + f(p_T^2)\mathcal{R} = ' // & '\mathcal{R}_{\text{fin}} ' // & '+ \mathcal{R}_{\text{sing}}$. The emission ' // & 'generation is then performed using $\mathcal{R}_{\text{sing}}$, ' // & 'whereas $\mathcal{R}_{\text{fin}}$ is treated separately. ' // & '(cf. also \ttt{real\_partition\_scale})')) call var_list%append_real (var_str ("real_partition_scale"), & 10._default, intrinsic = .true., & description=var_str ('This real variable sets the invariant mass ' // & 'of the FKS pair used as a separator between the singular and the ' // & 'finite part of the real subtraction terms in an NLO calculation, ' // & 'e.g. in $e^+e^- \to ' // & 't\bar tj$. (cf. also \ttt{?nlo\_use\_real\_partition})')) end subroutine var_list_set_nlo_defaults @ %def var_list_set_nlo_defaults @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Observables} In this module we define concrete variables and operators (observables) that we want to support in expressions. <<[[observables.f90]]>>= <> module observables <> <> use io_units use diagnostics use lorentz use subevents use variables <> <> contains <> end module observables @ %def observables @ \subsection{Process-specific variables} We allow the user to set a numeric process ID for each declared process. <>= public :: var_list_init_num_id <>= subroutine var_list_init_num_id (var_list, proc_id, num_id) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id integer, intent(in), optional :: num_id call var_list_set_procvar_int (var_list, proc_id, & var_str ("num_id"), num_id) end subroutine var_list_init_num_id @ %def var_list_init_num_id @ Integration results are stored in special variables. They are initialized by this subroutine. The values may or may not already known. Note: the values which are accessible are those that are unique for a process with multiple MCI records. The rest has been discarded. <>= public :: var_list_init_process_results <>= subroutine var_list_init_process_results (var_list, proc_id, & n_calls, integral, error, accuracy, chi2, efficiency) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id integer, intent(in), optional :: n_calls real(default), intent(in), optional :: integral, error, accuracy real(default), intent(in), optional :: chi2, efficiency call var_list_set_procvar_real (var_list, proc_id, & var_str ("integral"), integral) call var_list_set_procvar_real (var_list, proc_id, & var_str ("error"), error) end subroutine var_list_init_process_results @ %def var_list_init_process_results @ \subsection{Observables as Pseudo-Variables} Unary and binary observables are different. Most unary observables can be equally well evaluated for particle pairs. Binary observables cannot be evaluated for single particles. <>= public :: var_list_set_observables_unary public :: var_list_set_observables_binary <>= subroutine var_list_set_observables_unary (var_list, prt1) type(var_list_t), intent(inout) :: var_list type(prt_t), intent(in), target :: prt1 call var_list_append_obs1_iptr & (var_list, var_str ("PDG"), obs_pdg1, prt1) call var_list_append_obs1_iptr & (var_list, var_str ("Hel"), obs_helicity1, prt1) call var_list_append_obs1_iptr & (var_list, var_str ("Ncol"), obs_n_col1, prt1) call var_list_append_obs1_iptr & (var_list, var_str ("Nacl"), obs_n_acl1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("M"), obs_signed_mass1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("M2"), obs_mass_squared1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("E"), obs_energy1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Px"), obs_px1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Py"), obs_py1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Pz"), obs_pz1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("P"), obs_p1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Pl"), obs_pl1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Pt"), obs_pt1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Theta"), obs_theta1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Phi"), obs_phi1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Rap"), obs_rap1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Eta"), obs_eta1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Theta_star"), obs_theta_star1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Dist"), obs_dist1, prt1) call var_list_append_uobs_real & (var_list, var_str ("_User_obs_real"), prt1) call var_list_append_uobs_int & (var_list, var_str ("_User_obs_int"), prt1) end subroutine var_list_set_observables_unary subroutine var_list_set_observables_binary (var_list, prt1, prt2) type(var_list_t), intent(inout) :: var_list type(prt_t), intent(in), target :: prt1 type(prt_t), intent(in), optional, target :: prt2 call var_list_append_obs2_iptr & (var_list, var_str ("PDG"), obs_pdg2, prt1, prt2) call var_list_append_obs2_iptr & (var_list, var_str ("Hel"), obs_helicity2, prt1, prt2) call var_list_append_obs2_iptr & (var_list, var_str ("Ncol"), obs_n_col2, prt1, prt2) call var_list_append_obs2_iptr & (var_list, var_str ("Nacl"), obs_n_acl2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("M"), obs_signed_mass2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("M2"), obs_mass_squared2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("E"), obs_energy2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Px"), obs_px2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Py"), obs_py2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Pz"), obs_pz2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("P"), obs_p2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Pl"), obs_pl2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Pt"), obs_pt2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Theta"), obs_theta2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Phi"), obs_phi2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Rap"), obs_rap2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Eta"), obs_eta2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Theta_star"), obs_theta_star2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Dist"), obs_dist2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("kT"), obs_ktmeasure, prt1, prt2) call var_list_append_uobs_real & (var_list, var_str ("_User_obs_real"), prt1, prt2) call var_list_append_uobs_int & (var_list, var_str ("_User_obs_int"), prt1, prt2) end subroutine var_list_set_observables_binary @ %def var_list_set_observables_unary var_list_set_observables_binary @ \subsection{Checks} <>= public :: var_list_check_observable <>= subroutine var_list_check_observable (var_list, name, type) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(inout) :: type if (string_is_observable_id (name)) then call msg_fatal ("Variable name '" // char (name) & // "' is reserved for an observable") type = V_NONE return end if end subroutine var_list_check_observable @ %def var_list_check_observable @ Check if a variable name is defined as an observable: <>= function string_is_observable_id (string) result (flag) logical :: flag type(string_t), intent(in) :: string select case (char (string)) case ("PDG", "Hel", "Ncol", & "M", "M2", "E", "Px", "Py", "Pz", "P", "Pl", "Pt", & "Theta", "Phi", "Rap", "Eta", "Theta_star", "Dist", "kT") flag = .true. case default flag = .false. end select end function string_is_observable_id @ %def string_is_observable_id @ Check for result and process variables. <>= public :: var_list_check_result_var <>= subroutine var_list_check_result_var (var_list, name, type) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(inout) :: type if (string_is_integer_result_var (name)) type = V_INT if (.not. var_list%contains (name)) then if (string_is_result_var (name)) then call msg_fatal ("Result variable '" // char (name) // "' " & // "set without prior integration") type = V_NONE return else if (string_is_num_id (name)) then call msg_fatal ("Numeric process ID '" // char (name) // "' " & // "set without process declaration") type = V_NONE return end if end if end subroutine var_list_check_result_var @ %def var_list_check_result_var @ Check if a variable name is a result variable of integer type: <>= function string_is_integer_result_var (string) result (flag) logical :: flag type(string_t), intent(in) :: string type(string_t) :: buffer, name, separator buffer = string call split (buffer, name, "(", separator=separator) ! ")" if (separator == "(") then select case (char (name)) case ("num_id", "n_calls") flag = .true. case default flag = .false. end select else flag = .false. end if end function string_is_integer_result_var @ %def string_is_integer_result_var @ Check if a variable name is an integration-result variable: <>= function string_is_result_var (string) result (flag) logical :: flag type(string_t), intent(in) :: string type(string_t) :: buffer, name, separator buffer = string call split (buffer, name, "(", separator=separator) ! ")" if (separator == "(") then select case (char (name)) case ("integral", "error") flag = .true. case default flag = .false. end select else flag = .false. end if end function string_is_result_var @ %def string_is_result_var @ Check if a variable name is a numeric process ID: <>= function string_is_num_id (string) result (flag) logical :: flag type(string_t), intent(in) :: string type(string_t) :: buffer, name, separator buffer = string call split (buffer, name, "(", separator=separator) ! ")" if (separator == "(") then select case (char (name)) case ("num_id") flag = .true. case default flag = .false. end select else flag = .false. end if end function string_is_num_id @ %def string_is_num_id @ \subsection{Observables} These are analogous to the unary and binary numeric functions listed above. An observable takes the [[pval]] component(s) of its one or two argument nodes and produces an integer or real value. \subsubsection{Integer-valued unary observables} The PDG code <>= integer function obs_pdg1 (prt1) result (pdg) type(prt_t), intent(in) :: prt1 pdg = prt_get_pdg (prt1) end function obs_pdg1 @ %def obs_pdg @ The helicity. The return value is meaningful only if the particle is polarized, otherwise an invalid value is returned (-9). <>= integer function obs_helicity1 (prt1) result (h) type(prt_t), intent(in) :: prt1 if (prt_is_polarized (prt1)) then h = prt_get_helicity (prt1) else h = -9 end if end function obs_helicity1 @ %def obs_helicity1 @ The number of open color (anticolor) lines. The return value is meaningful only if the particle is colorized (i.e., the subevent has been given color information), otherwise the function returns zero. <>= integer function obs_n_col1 (prt1) result (n) type(prt_t), intent(in) :: prt1 if (prt_is_colorized (prt1)) then n = prt_get_n_col (prt1) else n = 0 end if end function obs_n_col1 integer function obs_n_acl1 (prt1) result (n) type(prt_t), intent(in) :: prt1 if (prt_is_colorized (prt1)) then n = prt_get_n_acl (prt1) else n = 0 end if end function obs_n_acl1 @ %def obs_n_col1 @ %def obs_n_acl1 @ \subsubsection{Real-valued unary observables} The invariant mass squared, obtained from the separately stored value. <>= real(default) function obs_mass_squared1 (prt1) result (p2) type(prt_t), intent(in) :: prt1 p2 = prt_get_msq (prt1) end function obs_mass_squared1 @ %def obs_mass_squared1 @ The signed invariant mass, which is the signed square root of the previous observable. <>= real(default) function obs_signed_mass1 (prt1) result (m) type(prt_t), intent(in) :: prt1 real(default) :: msq msq = prt_get_msq (prt1) m = sign (sqrt (abs (msq)), msq) end function obs_signed_mass1 @ %def obs_signed_mass1 @ The particle energy <>= real(default) function obs_energy1 (prt1) result (e) type(prt_t), intent(in) :: prt1 e = energy (prt_get_momentum (prt1)) end function obs_energy1 @ %def obs_energy1 @ Particle momentum (components) <>= real(default) function obs_px1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = vector4_get_component (prt_get_momentum (prt1), 1) end function obs_px1 real(default) function obs_py1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = vector4_get_component (prt_get_momentum (prt1), 2) end function obs_py1 real(default) function obs_pz1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = vector4_get_component (prt_get_momentum (prt1), 3) end function obs_pz1 real(default) function obs_p1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = space_part_norm (prt_get_momentum (prt1)) end function obs_p1 real(default) function obs_pl1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = longitudinal_part (prt_get_momentum (prt1)) end function obs_pl1 real(default) function obs_pt1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = transverse_part (prt_get_momentum (prt1)) end function obs_pt1 @ %def obs_px1 obs_py1 obs_pz1 @ %def obs_p1 obs_pl1 obs_pt1 @ Polar and azimuthal angle (lab frame). <>= real(default) function obs_theta1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = polar_angle (prt_get_momentum (prt1)) end function obs_theta1 real(default) function obs_phi1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = azimuthal_angle (prt_get_momentum (prt1)) end function obs_phi1 @ %def obs_theta1 obs_phi1 @ Rapidity and pseudorapidity <>= real(default) function obs_rap1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = rapidity (prt_get_momentum (prt1)) end function obs_rap1 real(default) function obs_eta1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = pseudorapidity (prt_get_momentum (prt1)) end function obs_eta1 @ %def obs_rap1 obs_eta1 @ Meaningless: Polar angle in the rest frame of the two arguments combined. <>= real(default) function obs_theta_star1 (prt1) result (dist) type(prt_t), intent(in) :: prt1 call msg_fatal (" 'Theta_star' is undefined as unary observable") dist = 0 end function obs_theta_star1 @ %def obs_theta_star1 @ [Obsolete] Meaningless: Polar angle in the rest frame of the 2nd argument. <>= real(default) function obs_theta_rf1 (prt1) result (dist) type(prt_t), intent(in) :: prt1 call msg_fatal (" 'Theta_RF' is undefined as unary observable") dist = 0 end function obs_theta_rf1 @ %def obs_theta_rf1 @ Meaningless: Distance on the $\eta$-$\phi$ cylinder. <>= real(default) function obs_dist1 (prt1) result (dist) type(prt_t), intent(in) :: prt1 call msg_fatal (" 'Dist' is undefined as unary observable") dist = 0 end function obs_dist1 @ %def obs_dist1 @ \subsubsection{Integer-valued binary observables} These observables are meaningless as binary functions. <>= integer function obs_pdg2 (prt1, prt2) result (pdg) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" PDG_Code is undefined as binary observable") pdg = 0 end function obs_pdg2 integer function obs_helicity2 (prt1, prt2) result (h) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" Helicity is undefined as binary observable") h = 0 end function obs_helicity2 integer function obs_n_col2 (prt1, prt2) result (n) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" Ncol is undefined as binary observable") n = 0 end function obs_n_col2 integer function obs_n_acl2 (prt1, prt2) result (n) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" Nacl is undefined as binary observable") n = 0 end function obs_n_acl2 @ %def obs_pdg2 @ %def obs_helicity2 @ %def obs_n_col2 @ %def obs_n_acl2 @ \subsubsection{Real-valued binary observables} The invariant mass squared, obtained from the separately stored value. <>= real(default) function obs_mass_squared2 (prt1, prt2) result (p2) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p2 = prt_get_msq (prt) end function obs_mass_squared2 @ %def obs_mass_squared2 @ The signed invariant mass, which is the signed square root of the previous observable. <>= real(default) function obs_signed_mass2 (prt1, prt2) result (m) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt real(default) :: msq call prt_init_combine (prt, prt1, prt2) msq = prt_get_msq (prt) m = sign (sqrt (abs (msq)), msq) end function obs_signed_mass2 @ %def obs_signed_mass2 @ The particle energy <>= real(default) function obs_energy2 (prt1, prt2) result (e) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) e = energy (prt_get_momentum (prt)) end function obs_energy2 @ %def obs_energy2 @ Particle momentum (components) <>= real(default) function obs_px2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = vector4_get_component (prt_get_momentum (prt), 1) end function obs_px2 real(default) function obs_py2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = vector4_get_component (prt_get_momentum (prt), 2) end function obs_py2 real(default) function obs_pz2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = vector4_get_component (prt_get_momentum (prt), 3) end function obs_pz2 real(default) function obs_p2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = space_part_norm (prt_get_momentum (prt)) end function obs_p2 real(default) function obs_pl2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = longitudinal_part (prt_get_momentum (prt)) end function obs_pl2 real(default) function obs_pt2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = transverse_part (prt_get_momentum (prt)) end function obs_pt2 @ %def obs_px2 obs_py2 obs_pz2 @ %def obs_p2 obs_pl2 obs_pt2 @ Enclosed angle and azimuthal distance (lab frame). <>= real(default) function obs_theta2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 p = enclosed_angle (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_theta2 real(default) function obs_phi2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = azimuthal_distance (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_phi2 @ %def obs_theta2 obs_phi2 @ Rapidity and pseudorapidity distance <>= real(default) function obs_rap2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 p = rapidity_distance & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_rap2 real(default) function obs_eta2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = pseudorapidity_distance & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_eta2 @ %def obs_rap2 obs_eta2 @ [This doesn't work! The principle of no common particle for momentum combination prohibits us from combining a decay particle with the momentum of its parent.] Polar angle in the rest frame of the 2nd argument. <>= real(default) function obs_theta_rf2 (prt1, prt2) result (theta) type(prt_t), intent(in) :: prt1, prt2 theta = enclosed_angle_rest_frame & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_theta_rf2 @ %def obs_theta_rf2 @ Polar angle of the first particle in the rest frame of the two particles combined. <>= real(default) function obs_theta_star2 (prt1, prt2) result (theta) type(prt_t), intent(in) :: prt1, prt2 theta = enclosed_angle_rest_frame & (prt_get_momentum (prt1), & prt_get_momentum (prt1) + prt_get_momentum (prt2)) end function obs_theta_star2 @ %def obs_theta_star2 @ Distance on the $\eta$-$\phi$ cylinder. <>= real(default) function obs_dist2 (prt1, prt2) result (dist) type(prt_t), intent(in) :: prt1, prt2 dist = eta_phi_distance & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_dist2 @ %def obs_dist2 @ Durham kT measure. <>= real(default) function obs_ktmeasure (prt1, prt2) result (kt) type(prt_t), intent(in) :: prt1, prt2 real (default) :: q2, e1, e2 ! Normalized scale to one for now! (#67) q2 = 1 e1 = energy (prt_get_momentum (prt1)) e2 = energy (prt_get_momentum (prt2)) kt = (2/q2) * min(e1**2,e2**2) * & (1 - enclosed_angle_ct(prt_get_momentum (prt1), & prt_get_momentum (prt2))) end function obs_ktmeasure @ %def obs_ktmeasure Index: trunk/src/mci/mci.nw =================================================================== --- trunk/src/mci/mci.nw (revision 8323) +++ trunk/src/mci/mci.nw (revision 8324) @@ -1,14067 +1,14116 @@ %% -*- 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]]>>= <> 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 <> <> <> <> contains <> 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. <>= public :: mci_t <>= 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 <> end type mci_t @ %def mci_t @ Finalizer: the random-number generator may need one. <>= procedure :: base_final => mci_final procedure (mci_final), deferred :: final <>= 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. <>= procedure :: base_write => mci_write procedure (mci_write), deferred :: write <>= 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. <>= procedure (mci_startup_message), deferred :: startup_message procedure :: base_startup_message => mci_startup_message <>= 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. <>= procedure(mci_write_log_entry), deferred :: write_log_entry <>= 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. <>= procedure(mci_compute_md5sum), deferred :: compute_md5sum <>= 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. <>= procedure :: record_index => mci_record_index <>= 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. <>= procedure :: set_dimensions => mci_set_dimensions procedure :: base_set_dimensions => mci_set_dimensions <>= 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. <>= procedure (mci_declare_flat_dimensions), deferred :: declare_flat_dimensions <>= 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.) <>= procedure (mci_declare_equivalences), deferred :: declare_equivalences <>= 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. <>= procedure :: declare_chains => mci_declare_chains <>= 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. <>= procedure :: collect_chain_weights => mci_collect_chain_weights <>= 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. <>= procedure :: has_chains => mci_has_chains <>= 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] <>= procedure :: write_chain_weights => mci_write_chain_weights <>= 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. <>= procedure :: set_md5sum => mci_set_md5sum <>= 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. <>= procedure :: add_pass => mci_add_pass <>= 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. <>= procedure (mci_allocate_instance), deferred :: allocate_instance <>= 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. <>= procedure :: import_rng => mci_import_rng <>= 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. <>= procedure :: set_timer => mci_set_timer <>= 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. <>= procedure :: start_timer => mci_start_timer procedure :: stop_timer => mci_stop_timer <>= 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. <>= procedure :: sampler_test => mci_sampler_test <>= 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. <>= procedure (mci_integrate), deferred :: integrate <>= 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. <>= procedure (mci_prepare_simulation), deferred :: prepare_simulation @ %def mci_final_simulation <>= 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. <>= procedure (mci_generate), deferred :: generate_weighted_event procedure (mci_generate), deferred :: generate_unweighted_event @ %def mci_generate_weighted_event @ %def mci_generate_unweighted_event <>= 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. <>= procedure (mci_rebuild), deferred :: rebuild_event <>= 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. <>= procedure :: pacify => mci_pacify <>= 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. <>= procedure :: get_integral => mci_get_integral procedure :: get_error => mci_get_error procedure :: get_efficiency => mci_get_efficiency procedure :: get_time => mci_get_time <>= 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. <>= procedure :: get_md5sum => mci_get_md5sum <>= 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. <>= public :: mci_instance_t <>= 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. integer :: n_dropped = 0 contains <> end type mci_instance_t @ %def mci_instance_t @ Output: deferred <>= procedure (mci_instance_write), deferred :: write <>= 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. <>= procedure (mci_instance_final), deferred :: final <>= 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. <>= procedure (mci_instance_base_init), deferred :: init procedure :: base_init => mci_instance_base_init <>= 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. <>= procedure :: set_channel_weights => mci_instance_set_channel_weights <>= 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. <>= procedure (mci_instance_compute_weight), deferred :: compute_weight <>= 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. <>= procedure (mci_instance_record_integrand), deferred :: record_integrand <>= 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. <>= procedure :: evaluate => mci_instance_evaluate <>= 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. <>= procedure (mci_instance_init_simulation), deferred :: init_simulation procedure (mci_instance_final_simulation), deferred :: final_simulation <>= 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. <>= procedure :: fetch => mci_instance_fetch <>= 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. <>= procedure :: get_value => mci_instance_get_value <>= 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. <>= 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). <>= procedure (mci_instance_get_event_excess), deferred :: get_event_excess <>= 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 @ Dropped events (i.e., events with zero weight that are not retained) are counted within the [[mci_instance]] object. <>= procedure :: get_n_event_dropped => mci_instance_get_n_event_dropped procedure :: reset_n_event_dropped => mci_instance_reset_n_event_dropped procedure :: record_event_dropped => mci_instance_record_event_dropped <>= function mci_instance_get_n_event_dropped (mci) result (n_dropped) class(mci_instance_t), intent(in) :: mci integer :: n_dropped n_dropped = mci%n_dropped end function mci_instance_get_n_event_dropped subroutine mci_instance_reset_n_event_dropped (mci) class(mci_instance_t), intent(inout) :: mci mci%n_dropped = 0 end subroutine mci_instance_reset_n_event_dropped subroutine mci_instance_record_event_dropped (mci) class(mci_instance_t), intent(inout) :: mci mci%n_dropped = mci%n_dropped + 1 end subroutine mci_instance_record_event_dropped @ %def mci_instance_get_n_event_dropped @ %def mci_instance_reset_n_event_dropped @ %def mci_instance_record_event_dropped @ \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. <>= public :: mci_state_t <>= type :: mci_state_t integer :: selected_channel = 0 real(default), dimension(:), allocatable :: x_in real(default) :: val contains <> end type mci_state_t @ %def mci_state_t @ Output: <>= procedure :: write => mci_state_write <>= 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. <>= procedure :: store => mci_instance_store <>= 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. <>= procedure :: recall => mci_instance_recall <>= 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. <>= public :: mci_sampler_t <>= type, abstract :: mci_sampler_t contains <> end type mci_sampler_t @ %def mci_sampler_t @ Output, deferred to the implementation. <>= procedure (mci_sampler_write), deferred :: write <>= 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]]. <>= procedure (mci_sampler_evaluate), deferred :: evaluate <>= 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]]. <>= procedure (mci_sampler_is_valid), deferred :: is_valid <>= 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. <>= procedure (mci_sampler_rebuild), deferred :: rebuild <>= 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]]. <>= procedure (mci_sampler_fetch), deferred :: fetch <>= 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. <>= public :: mci_results_t <>= type, abstract :: mci_results_t contains <> 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. <>= procedure (mci_results_write), deferred :: write procedure (mci_results_write_verbose), deferred :: write_verbose <>= 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. <>= generic :: record => record_simple, record_extended procedure (mci_results_record_simple), deferred :: record_simple procedure (mci_results_record_extended), deferred :: record_extended <>= 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]]>>= <> module mci_base_ut use unit_tests use mci_base_uti <> <> <> contains <> end module mci_base_ut @ %def mci_base_ut @ <<[[mci_base_uti.f90]]>>= <> module mci_base_uti <> use io_units use diagnostics use phs_base use rng_base use mci_base use rng_base_ut, only: rng_test_t <> <> <> <> contains <> end module mci_base_uti @ %def mci_base_ut @ API: driver for the unit tests below. <>= public :: mci_base_test <>= subroutine mci_base_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> 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. <>= public :: mci_test_t <>= 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 <>= 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 <>= 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. <>= 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. <>= 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. <>= 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. <>= 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. <>= 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. <>= 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). <>= 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. <>= 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. <>= 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. <>= 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]]. <>= 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.) <>= 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. <>= 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. <>= public :: mci_test_instance_t <>= 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 <>= 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. <>= 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. <>= 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. <>= 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. <>= 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. <>= 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. <>= 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. <>= 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 <>= 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 <>= 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]]. <>= 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. <>= 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. <>= 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. <>= 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. <>= 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. <>= 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 <> end type mci_test_results_t @ %def mci_test_results_t @ Output. <>= procedure :: write => mci_test_results_write procedure :: write_verbose => mci_test_results_write_verbose <>= 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. <>= procedure :: record_simple => mci_test_results_record_simple procedure :: record_extended => mci_test_results_record_extended <>= 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. <>= call test (mci_base_1, "mci_base_1", & "integrator configuration", & u, results) <>= public :: mci_base_1 <>= 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. <>= call test (mci_base_2, "mci_base_2", & "integration", & u, results) <>= public :: mci_base_2 <>= 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. <>= call test (mci_base_3, "mci_base_3", & "integration (two channels)", & u, results) <>= public :: mci_base_3 <>= 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. <>= call test (mci_base_4, "mci_base_4", & "event generation (two channels)", & u, results) <>= public :: mci_base_4 <>= 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. <>= call test (mci_base_5, "mci_base_5", & "store and recall", & u, results) <>= public :: mci_base_5 <>= 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. <>= call test (mci_base_6, "mci_base_6", & "chained channels", & u, results) <>= public :: mci_base_6 <>= 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. <>= call test (mci_base_7, "mci_base_7", & "recording results", & u, results) <>= public :: mci_base_7 <>= 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. <>= call test (mci_base_8, "mci_base_8", & "timer", & u, results) <>= public :: mci_base_8 <>= 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]]>>= <> module iterations <> <> use io_units use diagnostics <> <> <> contains <> 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. <>= 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. <>= public :: iterations_list_t <>= type :: iterations_list_t private integer :: n_pass = 0 type(iterations_spec_t), dimension(:), allocatable :: pass contains <> 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. <>= procedure :: init => iterations_list_init <>= 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 <>= procedure :: clear => iterations_list_clear <>= 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. <>= procedure :: write => iterations_list_write <>= 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. <>= procedure :: to_string => iterations_list_to_string <>= 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. <>= procedure :: get_n_pass => iterations_list_get_n_pass <>= 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. <>= procedure :: get_n_calls => iterations_list_get_n_calls <>= 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 @ <>= procedure :: set_n_calls => iterations_list_set_n_calls <>= 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. <>= procedure :: adapt_grids => iterations_list_adapt_grids procedure :: adapt_weights => iterations_list_adapt_weights <>= 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. <>= procedure :: get_n_it => iterations_list_get_n_it <>= 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} <>= public :: iteration_multipliers_t <>= 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]]>>= <> module iterations_ut use unit_tests use iterations_uti <> <> contains <> end module iterations_ut @ %def iterations_ut @ <<[[iterations_uti.f90]]>>= <> module iterations_uti <> use iterations <> <> contains <> end module iterations_uti @ %def iterations_ut @ API: driver for the unit tests below. <>= public :: iterations_test <>= subroutine iterations_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine iterations_test @ %def iterations_test @ \subsubsection{Empty list} <>= call test (iterations_1, "iterations_1", & "empty iterations list", & u, results) <>= public :: iterations_1 <>= 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} <>= call test (iterations_2, "iterations_2", & "create iterations list", & u, results) <>= public :: iterations_2 <>= 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 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 <> <> <> <> <> contains <> 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. <>= public :: integration_entry_t <>= 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 <> end type integration_entry_t @ %def integration_result_t @ The possible values of the type indicator: <>= 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. <>= interface integration_entry_t module procedure integration_entry_init end interface integration_entry_t <>= 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: <>= 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 <>= 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. <>= procedure :: write => integration_entry_write procedure :: write_verbose => integration_entry_write_verbose <>= 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. <>= procedure :: read => integration_entry_read <>= 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. <>= procedure :: write_chain_weights => integration_entry_write_chain_weights <>= 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. <>= public :: integration_results_t <>= 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 <> end type integration_results_t @ %def integration_results_t @ The array is extended in chunks of 10 entries. <>= 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. <>= procedure :: init => integration_results_init <>= 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. <>= procedure :: set_verbosity => integration_results_set_verbosity <>= 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. <>= procedure :: set_error_threshold => integration_results_set_error_threshold <>= 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. <>= procedure :: write => integration_results_write procedure :: write_verbose => integration_results_write_verbose <>= 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. <>= procedure :: write_chain_weights => & integration_results_write_chain_weights <>= 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. <>= procedure :: read => integration_results_read <>= 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. <>= procedure, private :: write_header procedure, private :: write_hline procedure, private :: write_dline <>= 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. <>= 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 <>= 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: <>= procedure :: expand => integration_results_expand <>= 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. <>= procedure :: new_pass => integration_results_new_pass <>= 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. <>= procedure :: append => integration_results_append <>= 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. <>= real(default), parameter, public :: INTEGRATION_ERROR_TOLERANCE = 1e-10 @ %def INTEGRATION_ERROR_TOLERANCE @ <>= procedure :: record_simple => integration_results_record_simple <>= 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. <>= procedure :: record_extended => integration_results_record_extended <>= 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. <>= 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. <>= procedure :: exist => integration_results_exist <>= 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. <>= procedure :: get_entry => results_get_entry <>= 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. <>= 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 <>= 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. <>= 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. <>= 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. <>= 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. <>= procedure :: pacify => integration_results_pacify <>= 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 @ <>= procedure :: record_correction => integration_results_record_correction <>= 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. <>= real, parameter, public :: GML_MIN_RANGE_RATIO = 0.02 <>= public :: integration_results_write_driver <>= 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. <>= public :: integration_results_compile_driver <>= 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]]>>= <> module integration_results_ut use unit_tests use integration_results_uti <> <> contains <> end module integration_results_ut @ %def integration_results_ut @ <<[[integration_results_uti.f90]]>>= <> module integration_results_uti <> use integration_results <> <> contains <> end module integration_results_uti @ %def integration_results_ut @ API: driver for the unit tests below. <>= public :: integration_results_test <>= subroutine integration_results_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine integration_results_test @ %def integration_results_test @ \subsubsection{Integration entry} <>= call test (integration_results_1, "integration_results_1", & "record single line and write to log", & u, results) <>= public :: integration_results_1 <>= 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 @ <>= call test (integration_results_2, "integration_results_2", & "record single result and write to log", & u, results) <>= public :: integration_results_2 <>= 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 @ <>= call test (integration_results_3, "integration_results_3", & "initialize display and add/display each entry", & u, results) <>= public :: integration_results_3 <>= 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 @ <>= call test (integration_results_4, "integration_results_4", & "record extended results and display", & u, results) <>= public :: integration_results_4 <>= 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 @ <>= call test (integration_results_5, "integration_results_5", & "record extended results and display", & u, results) <>= public :: integration_results_5 <>= 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]]>>= <> module mci_none <> use io_units, only: given_output_unit use diagnostics, only: msg_message, msg_fatal use phs_base, only: phs_channel_t use mci_base <> <> <> contains <> 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. <>= public :: mci_none_t <>= type, extends (mci_t) :: mci_none_t contains <> end type mci_none_t @ %def mci_t @ Finalizer: no-op. <>= procedure :: final => mci_none_final <>= subroutine mci_none_final (object) class(mci_none_t), intent(inout) :: object end subroutine mci_none_final @ %def mci_none_final @ Output. <>= procedure :: write => mci_none_write <>= 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. <>= procedure :: startup_message => mci_none_startup_message <>= 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. <>= procedure :: write_log_entry => mci_none_write_log_entry <>= 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. <>= procedure :: compute_md5sum => mci_none_compute_md5sum <>= 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. <>= procedure :: set_dimensions => mci_none_set_dimensions <>= 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. <>= procedure :: declare_flat_dimensions => mci_none_ignore_flat_dimensions <>= 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. <>= procedure :: declare_equivalences => mci_none_ignore_equivalences <>= 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. <>= procedure :: allocate_instance => mci_none_allocate_instance <>= 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. <>= procedure :: integrate => mci_none_integrate <>= 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. <>= procedure :: prepare_simulation => mci_none_ignore_prepare_simulation <>= 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. <>= procedure :: generate_weighted_event => mci_none_generate_no_event procedure :: generate_unweighted_event => mci_none_generate_no_event <>= 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. <>= procedure :: rebuild_event => mci_none_rebuild_event <>= 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. <>= public :: mci_none_instance_t <>= type, extends (mci_instance_t) :: mci_none_instance_t contains <> end type mci_none_instance_t @ %def mci_none_instance_t @ Output. <>= procedure :: write => mci_none_instance_write <>= 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. <>= procedure :: final => mci_none_instance_final <>= 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. <>= procedure :: init => mci_none_instance_init <>= 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. <>= procedure :: get_max => mci_none_instance_get_max <>= 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. <>= procedure :: set_max => mci_none_instance_set_max <>= 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. <>= procedure :: compute_weight => mci_none_instance_compute_weight <>= 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. <>= procedure :: record_integrand => mci_none_instance_record_integrand <>= 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. <>= procedure :: init_simulation => mci_none_instance_init_simulation procedure :: final_simulation => mci_none_instance_final_simulation <>= 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. <>= procedure :: get_event_excess => mci_none_instance_get_event_excess <>= 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]]>>= <> module mci_none_ut use unit_tests use mci_none_uti <> <> contains <> end module mci_none_ut @ %def mci_none_ut @ <<[[mci_none_uti.f90]]>>= <> module mci_none_uti use mci_base use mci_none <> <> <> contains <> end module mci_none_uti @ %def mci_none_ut @ API: driver for the unit tests below. <>= public :: mci_none_test <>= subroutine mci_none_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine mci_none_test @ %def mci_none_test @ \subsubsection{Trivial sanity check} Construct an integrator and display it. <>= call test (mci_none_1, "mci_none_1", & "dummy integrator", & u, results) <>= public :: mci_none_1 <>= 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]]>>= <> module mci_midpoint <> use io_units use diagnostics use phs_base use mci_base <> <> <> contains <> 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. <>= public :: mci_midpoint_t <>= 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 <> end type mci_midpoint_t @ %def mci_t @ Finalizer: base version is sufficient <>= procedure :: final => mci_midpoint_final <>= 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. <>= procedure :: write => mci_midpoint_write <>= 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. <>= procedure :: startup_message => mci_midpoint_startup_message <>= 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. <>= procedure :: write_log_entry => mci_midpoint_write_log_entry <>= 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. <>= procedure :: compute_md5sum => mci_midpoint_compute_md5sum <>= 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. <>= procedure :: set_dimensions => mci_midpoint_set_dimensions <>= 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. <>= procedure :: declare_flat_dimensions => mci_midpoint_declare_flat_dimensions <>= 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. <>= procedure :: declare_equivalences => mci_midpoint_ignore_equivalences <>= 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. <>= procedure :: allocate_instance => mci_midpoint_allocate_instance <>= 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. <>= procedure :: integrate => mci_midpoint_integrate <>= 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. <>= procedure :: prepare_simulation => mci_midpoint_ignore_prepare_simulation <>= 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. <>= procedure :: generate_weighted_event => mci_midpoint_generate_weighted_event <>= 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. <>= procedure :: generate_unweighted_event => & mci_midpoint_generate_unweighted_event <>= 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. <>= procedure :: rebuild_event => mci_midpoint_rebuild_event <>= 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. <>= public :: mci_midpoint_instance_t <>= 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 <> end type mci_midpoint_instance_t @ %def mci_midpoint_instance_t @ Output. <>= procedure :: write => mci_midpoint_instance_write <>= 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. <>= procedure :: final => mci_midpoint_instance_final <>= 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. <>= procedure :: init => mci_midpoint_instance_init <>= 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. <>= procedure :: get_max => mci_midpoint_instance_get_max <>= 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. <>= procedure :: set_max => mci_midpoint_instance_set_max <>= 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. <>= procedure :: compute_weight => mci_midpoint_instance_compute_weight <>= 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. <>= procedure :: record_integrand => mci_midpoint_instance_record_integrand <>= 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. <>= procedure :: init_simulation => mci_midpoint_instance_init_simulation procedure :: final_simulation => mci_midpoint_instance_final_simulation <>= 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. <>= procedure :: get_event_excess => mci_midpoint_instance_get_event_excess <>= 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]]>>= <> module mci_midpoint_ut use unit_tests use mci_midpoint_uti <> <> contains <> end module mci_midpoint_ut @ %def mci_midpoint_ut @ <<[[mci_midpoint_uti.f90]]>>= <> module mci_midpoint_uti <> use io_units use rng_base use mci_base use mci_midpoint use rng_base_ut, only: rng_test_t <> <> <> contains <> end module mci_midpoint_uti @ %def mci_midpoint_ut @ API: driver for the unit tests below. <>= public :: mci_midpoint_test <>= subroutine mci_midpoint_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> 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. <>= type, extends (mci_sampler_t) :: test_sampler_1_t real(default), dimension(:), allocatable :: x real(default) :: val contains <> end type test_sampler_1_t @ %def test_sampler_1_t @ Output: There is nothing stored inside, so just print an informative line. <>= procedure :: write => test_sampler_1_write <>= 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. <>= procedure :: evaluate => test_sampler_1_evaluate <>= 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. <>= procedure :: is_valid => test_sampler_1_is_valid <>= 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. <>= procedure :: rebuild => test_sampler_1_rebuild <>= 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. <>= procedure :: fetch => test_sampler_1_fetch <>= 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$. <>= type, extends (mci_sampler_t) :: test_sampler_2_t real(default) :: val real(default), dimension(2) :: x contains <> end type test_sampler_2_t @ %def test_sampler_2_t @ Output: There is nothing stored inside, so just print an informative line. <>= procedure :: write => test_sampler_2_write <>= 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. <>= procedure :: evaluate => test_sampler_2_evaluate <>= 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. <>= procedure :: is_valid => test_sampler_2_is_valid <>= 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. <>= procedure :: rebuild => test_sampler_2_rebuild <>= 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 <>= procedure :: fetch => test_sampler_2_fetch <>= 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). <>= type, extends (mci_sampler_t) :: test_sampler_4_t real(default) :: val real(default), dimension(:), allocatable :: x contains <> end type test_sampler_4_t @ %def test_sampler_4_t @ Output: There is nothing stored inside, so just print an informative line. <>= procedure :: write => test_sampler_4_write <>= 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. <>= procedure :: evaluate => test_sampler_4_evaluate <>= 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. <>= procedure :: is_valid => test_sampler_4_is_valid <>= 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. <>= procedure :: rebuild => test_sampler_4_rebuild <>= 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 <>= procedure :: fetch => test_sampler_4_fetch <>= 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. <>= call test (mci_midpoint_1, "mci_midpoint_1", & "one-dimensional integral", & u, results) <>= public :: mci_midpoint_1 <>= 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. <>= call test (mci_midpoint_2, "mci_midpoint_2", & "two-dimensional integral", & u, results) <>= public :: mci_midpoint_2 <>= 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. <>= call test (mci_midpoint_3, "mci_midpoint_3", & "two-dimensional integral with flat dimension", & u, results) <>= public :: mci_midpoint_3 <>= 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. <>= call test (mci_midpoint_4, "mci_midpoint_4", & "integrand with sign flip", & u, results) <>= public :: mci_midpoint_4 <>= 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. <>= call test (mci_midpoint_5, "mci_midpoint_5", & "weighted events", & u, results) <>= public :: mci_midpoint_5 <>= 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. <>= call test (mci_midpoint_6, "mci_midpoint_6", & "unweighted events", & u, results) <>= public :: mci_midpoint_6 <>= 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. <>= call test (mci_midpoint_7, "mci_midpoint_7", & "excess weight", & u, results) <>= public :: mci_midpoint_7 <>= 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]]>>= <> module mci_vamp <> <> 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 <> <> <> <> contains <> 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. <>= public :: grid_parameters_t <>= 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 <> end type grid_parameters_t @ %def grid_parameters_t @ I/O: <>= procedure :: write => grid_parameters_write <>= 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. <>= public :: history_parameters_t <>= type :: history_parameters_t logical :: global = .true. logical :: global_verbose = .false. logical :: channel = .false. logical :: channel_verbose = .false. contains <> end type history_parameters_t @ %def history_parameters_t @ I/O: <>= procedure :: write => history_parameters_write <>= 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. <>= 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 <> end type pass_t @ %def pass_t @ Finalizer. The VAMP histories contain a pointer array. <>= procedure :: final => pass_final <>= 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. <>= procedure :: write => pass_write <>= 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. <>= procedure :: read => pass_read <>= 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.) <>= procedure :: write_history => pass_write_history <>= 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. <>= procedure :: configure => pass_configure <>= 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. <>= procedure :: configure_history => pass_configure_history <>= 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. <>= interface operator (.matches.) module procedure pass_matches end interface operator (.matches.) <>= 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. <>= procedure :: update => pass_update <>= 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. <>= interface operator (.matches.) module procedure real_matches end interface operator (.matches.) <>= 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. <>= procedure :: get_integration_index => pass_get_integration_index <>= 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. <>= 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 <>= 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} <>= public :: mci_vamp_t <>= 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 <> end type mci_vamp_t @ %def mci_vamp_t @ Reset: delete integration-pass entries. <>= procedure :: reset => mci_vamp_reset <>= 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. <>= procedure :: final => mci_vamp_final <>= 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. <>= procedure :: write => mci_vamp_write <>= 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. <>= procedure :: write_history_parameters => mci_vamp_write_history_parameters <>= 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. <>= procedure :: write_history => mci_vamp_write_history <>= 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. <>= procedure :: compute_md5sum => mci_vamp_compute_md5sum <>= 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. <>= procedure :: get_md5sum => mci_vamp_get_md5sum <>= 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. <>= procedure :: startup_message => mci_vamp_startup_message <>= 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. <>= procedure :: write_log_entry => mci_vamp_write_log_entry <>= 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. <>= procedure :: record_index => mci_vamp_record_index <>= 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. <>= procedure :: set_grid_parameters => mci_vamp_set_grid_parameters <>= 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. <>= procedure :: set_history_parameters => mci_vamp_set_history_parameters <>= 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. <>= procedure :: set_rebuild_flag => mci_vamp_set_rebuild_flag <>= 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. <>= procedure :: set_grid_filename => mci_vamp_set_grid_filename <>= 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. <>= procedure :: prepend_grid_path => mci_vamp_prepend_grid_path <>= 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. <>= procedure :: declare_flat_dimensions => mci_vamp_declare_flat_dimensions <>= 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. <>= procedure :: declare_equivalences => mci_vamp_declare_equivalences <>= 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. <>= procedure :: allocate_instance => mci_vamp_allocate_instance <>= 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. <>= procedure :: add_pass => mci_vamp_add_pass <>= 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. <>= procedure :: update_from_ref => mci_vamp_update_from_ref <>= 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. <>= procedure :: update => mci_vamp_update <>= 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. <>= 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 <>= 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. <>= 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. <>= procedure :: integrate => mci_vamp_integrate <>= 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 Insert pos. and neg. Efficiency from VAMP. 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 Insert pos. and neg. Efficiency from VAMP. 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. <>= procedure :: check_goals => mci_vamp_check_goals <>= 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. <>= procedure :: error_reached => mci_vamp_error_reached procedure :: rel_error_reached => mci_vamp_rel_error_reached procedure :: accuracy_reached => mci_vamp_accuracy_reached <>= 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). <>= procedure :: prepare_simulation => mci_vamp_prepare_simulation <>= 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. <>= procedure :: generate_weighted_event => mci_vamp_generate_weighted_event <>= 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. <>= procedure :: generate_unweighted_event => & mci_vamp_generate_unweighted_event <>= 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. <>= procedure :: rebuild_event => mci_vamp_rebuild_event <>= 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. <>= procedure :: pacify => mci_vamp_pacify <>= 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. <>= 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. <>= public :: mci_vamp_instance_t <>= 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 <> end type mci_vamp_instance_t @ %def mci_vamp_instance_t @ Output. <>= procedure :: write => mci_vamp_instance_write <>= 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. <>= procedure :: write_grids => mci_vamp_instance_write_grids <>= 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. <>= procedure :: final => mci_vamp_instance_final <>= 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. <>= procedure :: init => mci_vamp_instance_init <>= 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. <>= procedure :: new_pass => mci_vamp_instance_new_pass <>= 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. <>= procedure :: create_grids => mci_vamp_instance_create_grids <>= 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. <>= procedure :: discard_integrals => mci_vamp_instance_discard_integrals <>= 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. <>= procedure :: allow_adaptation => mci_vamp_instance_allow_adaptation <>= 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. <>= procedure :: adapt_grids => mci_vamp_instance_adapt_grids <>= 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. <>= procedure :: adapt_weights => mci_vamp_instance_adapt_weights <>= 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. <>= procedure :: sample_grids => mci_vamp_instance_sample_grids <>= 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. <>= procedure :: get_efficiency_array => mci_vamp_instance_get_efficiency_array procedure :: get_efficiency => mci_vamp_instance_get_efficiency <>= 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). <>= procedure :: init_simulation => mci_vamp_instance_init_simulation <>= 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. <>= procedure :: final_simulation => mci_vamp_instance_final_simulation <>= 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. <>= 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: <>= 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.) <>= procedure :: compute_weight => mci_vamp_instance_compute_weight <>= 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. <>= procedure :: record_integrand => mci_vamp_instance_record_integrand <>= 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. <>= procedure :: get_event_weight => mci_vamp_instance_get_event_weight procedure :: get_event_excess => mci_vamp_instance_get_event_excess <>= 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. <>= 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]]>>= <> module mci_vamp_ut use unit_tests use mci_vamp_uti <> <> contains <> end module mci_vamp_ut @ %def mci_vamp_ut @ <<[[mci_vamp_uti.f90]]>>= <> module mci_vamp_uti <> <> 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 <> <> <> contains <> end module mci_vamp_uti @ %def mci_vamp_ut @ API: driver for the unit tests below. <>= public :: mci_vamp_test <>= subroutine mci_vamp_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> 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$. <>= type, extends (mci_sampler_t) :: test_sampler_1_t real(default), dimension(:), allocatable :: x real(default) :: val integer :: mode = 1 contains <> end type test_sampler_1_t @ %def test_sampler_1_t @ Output: There is nothing stored inside, so just print an informative line. <>= procedure :: write => test_sampler_1_write <>= 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. <>= procedure :: evaluate => test_sampler_1_evaluate <>= 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. <>= procedure :: is_valid => test_sampler_1_is_valid <>= 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. <>= procedure :: rebuild => test_sampler_1_rebuild <>= 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. <>= procedure :: fetch => test_sampler_1_fetch <>= 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} <>= type, extends (mci_sampler_t) :: test_sampler_2_t real(default), dimension(:,:), allocatable :: x real(default), dimension(:), allocatable :: f real(default) :: val contains <> end type test_sampler_2_t @ %def test_sampler_2_t @ Output: There is nothing stored inside, so just print an informative line. <>= procedure :: write => test_sampler_2_write <>= 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. <>= procedure :: compute => test_sampler_2_compute <>= 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. <>= procedure :: evaluate => test_sampler_2_evaluate <>= 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. <>= procedure :: is_valid => test_sampler_2_is_valid <>= 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. <>= procedure :: rebuild => test_sampler_2_rebuild <>= 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. <>= procedure :: fetch => test_sampler_2_fetch <>= 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$. <>= 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 <> end type test_sampler_3_t @ %def test_sampler_3_t @ Output: display $a$ and $b$ <>= procedure :: write => test_sampler_3_write <>= 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. <>= procedure :: compute => test_sampler_3_compute <>= 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. <>= procedure :: evaluate => test_sampler_3_evaluate <>= 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. <>= procedure :: is_valid => test_sampler_3_is_valid <>= 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. <>= procedure :: rebuild => test_sampler_3_rebuild <>= 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. <>= procedure :: fetch => test_sampler_3_fetch <>= 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. <>= call test (mci_vamp_1, "mci_vamp_1", & "one-dimensional integral", & u, results) <>= public :: mci_vamp_1 <>= 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. <>= call test (mci_vamp_2, "mci_vamp_2", & "multiple iterations", & u, results) <>= public :: mci_vamp_2 <>= 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. <>= call test (mci_vamp_3, "mci_vamp_3", & "grid adaptation", & u, results) <>= public :: mci_vamp_3 <>= 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. <>= call test (mci_vamp_4, "mci_vamp_4", & "two-dimensional integration", & u, results) <>= public :: mci_vamp_4 <>= 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. <>= call test (mci_vamp_5, "mci_vamp_5", & "two-dimensional integration", & u, results) <>= public :: mci_vamp_5 <>= 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. <>= call test (mci_vamp_6, "mci_vamp_6", & "weight adaptation", & u, results) <>= public :: mci_vamp_6 <>= 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. <>= call test (mci_vamp_7, "mci_vamp_7", & "use channel equivalences", & u, results) <>= public :: mci_vamp_7 <>= 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. <>= call test (mci_vamp_8, "mci_vamp_8", & "integration passes", & u, results) <>= public :: mci_vamp_8 <>= 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. <>= call test (mci_vamp_9, "mci_vamp_9", & "weighted event", & u, results) <>= public :: mci_vamp_9 <>= 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. <>= call test (mci_vamp_10, "mci_vamp_10", & "grids I/O", & u, results) <>= public :: mci_vamp_10 <>= 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. <>= call test (mci_vamp_11, "mci_vamp_11", & "weighted events with grid I/O", & u, results) <>= public :: mci_vamp_11 <>= 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. <>= call test (mci_vamp_12, "mci_vamp_12", & "unweighted events with grid I/O", & u, results) <>= public :: mci_vamp_12 <>= 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. <>= call test (mci_vamp_13, "mci_vamp_13", & "updating integration results", & u, results) <>= public :: mci_vamp_13 <>= 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. <>= call test (mci_vamp_14, "mci_vamp_14", & "accuracy goal", & u, results) <>= public :: mci_vamp_14 <>= 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. <>= call test (mci_vamp_15, "mci_vamp_15", & "VAMP history", & u, results) <>= public :: mci_vamp_15 <>= 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. <>= call test (mci_vamp_16, "mci_vamp_16", & "1-D integral with sign change", & u, results) <>= public :: mci_vamp_16 <>= 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]]>>= <> module mci_vamp2 <> <> 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 <> <> <> <> <> contains <> end module mci_vamp2 @ %def mci_vamp2 <>= @ <>= use mpi_f08 !NODEP! @ %def mpi_f08 @ \subsection{Type: mci\_vamp2\_func\_t} \label{sec:mci-vamp2-func} <>= 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 <> end type mci_vamp2_func_t @ %def mci_vamp2_func_t @ Set instance and sampler aka workspace. Also, reset number of [[n_calls]]. <>= procedure, public :: set_workspace => mci_vamp2_func_set_workspace <>= 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. <>= procedure, public :: get_probabilities => mci_vamp2_func_get_probabilities <>= 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. <>= procedure, public :: get_weight => mci_vamp2_func_get_weight <>= 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. <>= procedure, public :: set_integrand => mci_vamp2_func_set_integrand <>= 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. <>= procedure, public :: evaluate_maps => mci_vamp2_func_evaluate_maps <>= 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. <>= procedure, public :: evaluate_func => mci_vamp2_func_evaluate_func <>= 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 evaluate_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]]. <>= public :: mci_vamp2_config_t <>= 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]]. <>= type :: list_pass_t type(pass_t), pointer :: first => null () type(pass_t), pointer :: current => null () contains <> end type list_pass_t @ %def list_pass_t @ Finalizer. Deallocate each element of the list beginning by the first. <>= procedure :: final => list_pass_final <>= 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. <>= procedure :: add => list_pass_add <>= 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. <>= procedure :: update_from_ref => list_pass_update_from_ref <>= 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. <>= procedure :: write => list_pass_write <>= 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. <>= 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 <> 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. <>= procedure :: write => pass_write <>= 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), & 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. <>= procedure :: read => pass_read <>= 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. <>= 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. <>= procedure :: configure => pass_configure <>= 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. <>= interface operator (.matches.) module procedure pass_matches end interface operator (.matches.) <>= 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. <>= procedure :: update => pass_update <>= 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. <>= interface operator (.matches.) module procedure real_matches end interface operator (.matches.) <>= 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. <>= procedure :: get_integration_index => pass_get_integration_index <>= 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. <>= 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 <>= 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]]. <>= public :: mci_vamp2_t <>= 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 :: grid_filename_set = .false. logical :: negative_weights = .false. logical :: verbose = .false. logical :: pass_complete = .false. logical :: it_complete = .false. - type(string_t) :: integrator_filename + type(string_t) :: grid_filename + logical :: binary_grid_format = .false. character(32) :: md5sum_adapted = "" contains <> end type mci_vamp2_t @ %def mci_vamp2_t @ Finalizer: call to base and list finalizer. <>= procedure, public :: final => mci_vamp2_final <>= 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. <>= procedure, public :: write => mci_vamp2_write <>= 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. <>= procedure, public :: compute_md5sum => mci_vamp2_compute_md5sum <>= 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. <>= procedure, public :: get_md5sum => mci_vamp2_get_md5sum <>= 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. <>= procedure, public :: startup_message => mci_vamp2_startup_message <>= 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. <>= procedure, public :: write_log_entry => mci_vamp2_write_log_entry <>= 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. <>= procedure, public :: record_index => mci_vamp2_record_index <>= 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.) + if (mci%grid_filename_set) then 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 + mci%grid_filename = mci%grid_filename // ".m" // trim (buffer) 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]] <>= procedure, public :: set_config => mci_vamp2_set_config <>= 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. <>= procedure, public :: set_rebuild_flag => mci_vamp2_set_rebuild_flag <>= 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. <>= - procedure, public :: set_integrator_filename => mci_vamp2_set_integrator_filename + procedure, public :: set_grid_filename => mci_vamp2_set_grid_filename + procedure, public :: get_grid_filename => mci_vamp2_get_grid_filename <>= - subroutine mci_vamp2_set_integrator_filename (mci, name, run_id) + subroutine mci_vamp2_set_grid_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" + mci%grid_filename = name if (present (run_id)) then - mci%integrator_filename = name // "." // run_id // ".vg2" + mci%grid_filename = name // "." // run_id + end if + mci%grid_filename_set = .true. + end subroutine mci_vamp2_set_grid_filename + + type(string_t) function mci_vamp2_get_grid_filename (mci, binary_grid_format) & + result (filename) + class(mci_vamp2_t), intent(in) :: mci + logical, intent(in), optional :: binary_grid_format + filename = mci%grid_filename // ".vg2" + if (present (binary_grid_format)) then + if (binary_grid_format) then + filename = mci%grid_filename // ".vgx2" + end if end if - mci%integrator_filename_set = .true. - end subroutine mci_vamp2_set_integrator_filename + end function mci_vamp2_get_grid_filename + +@ %def mci_vamp2_set_grid_filename, mci_vamp2_get_grid_filename -@ %def mci_vamp2_set_integrator_filename @ To simplify the interface, we prepend a grid path in a separate subroutine. <>= - procedure :: prepend_integrator_path => mci_vamp2_prepend_integrator_path + procedure :: prepend_grid_path => mci_vamp2_prepend_grid_path <>= - subroutine mci_vamp2_prepend_integrator_path (mci, prefix) + subroutine mci_vamp2_prepend_grid_path (mci, prefix) class(mci_vamp2_t), intent(inout) :: mci type(string_t), intent(in) :: prefix - if (.not. mci%integrator_filename_set) then + if (.not. mci%grid_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 + mci%grid_filename = prefix // "/" // mci%grid_filename + end subroutine mci_vamp2_prepend_grid_path -@ %def mci_vamp2_prepend_integrator_path +@ %def mci_vamp2_prepend_grid_path @ Not implemented. <>= procedure, public :: declare_flat_dimensions => mci_vamp2_declare_flat_dimensions <>= 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 @ <>= procedure, public :: declare_equivalences => mci_vamp2_declare_equivalences <>= 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. <>= procedure, public :: allocate_instance => mci_vamp2_allocate_instance <>= 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. <>= procedure, public :: add_pass => mci_vamp2_add_pass <>= 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. <>= procedure, public :: update_from_ref => mci_vamp2_update_from_ref <>= 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. <>= procedure, public :: update => mci_vamp2_update <>= 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. + +The writing of the MCI object is split into two parts, a header with the relevant process configuration regarding the integration and the results of the different passes and their iterations. +The other part is the actual grid. +The header will always be written in ASCII format, including a md5 hash, in order to testify against unwilling changes to the setup. +The grid part can be either added to the ASCII file, or to an additional binary file. <>= 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 + procedure, private :: advance_to_data => mci_vamp2_advance_to_data <>= subroutine mci_vamp2_write_grids (mci) class(mci_vamp2_t), intent(in) :: mci integer :: u - if (.not. mci%integrator_filename_set) then + if (.not. mci%grid_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), & + open (newunit = u, file = char (mci%get_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)") "VAMP2 grids:" - call mci%integrator%write_grids (u) + if (mci%binary_grid_format) then + write (u, "(1X,2A)") "VAMP2 grids: binary file: ", & + char (mci%get_grid_filename (binary_grid_format = .true.)) + close (u) + open (newunit = u, & + file = char (mci%get_grid_filename (binary_grid_format = .true.)), & + action = "write", & + access = "stream", & + form = "unformatted", & + status = "replace") + call mci%integrator%write_binary_grids (u) + else + write (u, "(1X,A)") "VAMP2 grids:" + call mci%integrator%write_grids (u) + end if 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 + logical :: exist, binary_grid_format, exist_binary integer :: u success = .false. - if (.not. mci%integrator_filename_set) then + if (.not. mci%grid_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), "'" + !! First, check for existence of the (usual) grid file. + inquire (file = char (mci%get_grid_filename ()), exist = exist) + if (.not. exist) return !! success = .false. + open (newunit = u, file = char (mci%get_grid_filename ()), & + action = "read", status = "old") + !! Second, check for existence of a (possible) binary grid file. + call mci%advance_to_data (u, binary_grid_format) + rewind (u) !! Rewind header file, after line search. + if (binary_grid_format) then + inquire (file = char (mci%get_grid_filename (binary_grid_format = .true.)), & + exist = exist) + if (.not. exist) then + write (msg_buffer, "(3A)") & + "VAMP2: header: binary grid file not found, discarding grid file '", & + char (mci%get_grid_filename ()), "'." call msg_message () + return !! success = .false. end if end if + !! The grid file (ending *.vg) exists and, if binary file is listed, it exists, too. + call mci%update (u, success) + close (u) + if (.not. success) then + write (msg_buffer, "(A,A,A)") & + "VAMP2: header: parameter mismatch, discarding pass from file '", & + char (mci%get_grid_filename ()), "'." + call msg_message () + 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 + logical :: binary_grid_format 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) + open (newunit = u, & + file = char (mci%get_grid_filename ()), & + action = "read", & + status = "old") + call mci%advance_to_data (u, binary_grid_format) + if (binary_grid_format) then + close (u) + write (msg_buffer, "(3A)") & + "VAMP2: Reading from binary grid file '", & + char (mci%get_grid_filename (binary_grid_format = .true.)), "'" + call msg_message () + open (newunit = u, & + file = char (mci%get_grid_filename (binary_grid_format = .true.)), & + action = "read", & + access = "stream", & + form = "unformatted", & + status = "old") + call mci%integrator%read_binary_grids (u) + else + call mci%integrator%read_grids (u) + end if mci%integrator_defined = .true. + close (u) 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 + subroutine mci_vamp2_advance_to_data (mci, u, binary_grid_format) + class(mci_vamp2_t), intent(in) :: mci + integer, intent(in) :: u + logical, intent(out) :: binary_grid_format 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 () + type(string_t) :: search_string_binary, search_string_ascii + search_string_binary = "VAMP2 grids: binary file: " // & + mci%get_grid_filename (binary_grid_format = .true.) + search_string_ascii = "VAMP2 grids:" + SEARCH: do + read (u, "(A)") buffer + if (trim (adjustl (buffer)) == char (search_string_binary)) then + binary_grid_format = .true. + exit SEARCH + else if (trim (adjustl (buffer)) == char (search_string_ascii)) then + binary_grid_format = .false. + exit SEARCH end if - close (u) - mci%integrator_defined = success - end if - end subroutine mci_vamp2_read_grids + end do SEARCH + end subroutine mci_vamp2_advance_to_data + @ %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. <>= procedure, public :: init_integrator => mci_vamp2_init_integrator <>= 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. <>= procedure, public :: reset_result => mci_vamp2_reset_result <>= 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} <>= procedure, public :: set_calls => mci_vamp2_set_calls <>= 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. <>= procedure, private :: init_integration => mci_vamp2_init_integration <>= 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 + if (mci%grid_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 () + 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) // "’") + // "Using grids and results from file ’" & + // char (mci%get_grid_filename ()) // "’.") else if (.not. mci%integrator_defined) then + call msg_message ("VAMP2: " & + // "Initialize new grids and write to file '" & + // char (mci%get_grid_filename ()) // "'.") 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. <>= procedure, public :: integrate => mci_vamp2_integrate <>= 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 <> <> 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 () <> 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 + .and. mci%grid_filename_set) then <> 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 <> end subroutine mci_vamp2_integrate @ %def mci_vamp2_integrate <>= real(default) :: integral, error, efficiency integer :: calls, calls_valid @ <>= @ <>= @ <>= @ <>= integer :: rank, n_size type(MPI_Request), dimension(6) :: request @ MPI procedure-specific 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. <>= 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. <>= if (rank == 0) @ Check whether we are already finished with this pass. <>= 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. <>= 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. <>= procedure, public :: prepare_simulation => mci_vamp2_prepare_simulation <>= subroutine mci_vamp2_prepare_simulation (mci) class(mci_vamp2_t), intent(inout) :: mci logical :: success - if (.not. mci%integrator_filename_set) then + if (.not. mci%grid_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") + // char (mci%get_grid_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. <>= procedure, public :: generate_weighted_event => mci_vamp2_generate_weighted_event <>= 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). <>= procedure, public :: generate_unweighted_event => mci_vamp2_generate_unweighted_event <>= 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 @ <>= procedure, public :: rebuild_event => mci_vamp2_rebuild_event <>= 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]]. <>= public :: mci_vamp2_instance_t <>= 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 <> end type mci_vamp2_instance_t @ %def mci_vamp2_instance_t @ Output. <>= procedure, public :: write => mci_vamp2_instance_write <>= 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. <>= procedure, public :: final => mci_vamp2_instance_final <>= 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. <>= procedure, public :: init => mci_vamp2_instance_init <>= 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]]. <>= procedure, public :: set_workspace => mci_vamp2_instance_set_workspace <>= 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. <>= procedure, public :: compute_weight => mci_vamp2_instance_compute_weight <>= 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. <>= procedure, public :: record_integrand => mci_vamp2_instance_record_integrand <>= 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! <>= procedure, public :: init_simulation => mci_vamp2_instance_init_simulation <>= 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 @ <>= procedure, public :: final_simulation => mci_vamp2_instance_final_simulation <>= 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 @ <>= procedure, public :: get_event_weight => mci_vamp2_instance_get_event_weight <>= 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 @ <>= procedure, public :: get_event_excess => mci_vamp2_instance_get_event_excess <>= 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]]>>= <> module mci_vamp2_ut use unit_tests use mci_vamp2_uti <> <> contains <> end module mci_vamp2_ut @ %def mci_vamp2_ut @ <<[[mci_vamp2_uti.f90]]>>= <> module mci_vamp2_uti <> <> use io_units use constants, only: PI, TWOPI use rng_base use rng_tao use rng_stream use mci_base use mci_vamp2 <> <> <> contains <> end module mci_vamp2_uti @ %def mci_vamp2_uti @ API: driver for the unit tests below. <>= public :: mci_vamp2_test <>= subroutine mci_vamp2_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> 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$. <>= type, extends (mci_sampler_t) :: test_sampler_1_t real(default), dimension(:), allocatable :: x real(default) :: val integer :: mode = 1 contains <> end type test_sampler_1_t @ %def test_sampler_1_t @ Output: There is nothing stored inside, so just print an informative line. <>= procedure, public :: write => test_sampler_1_write <>= 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. <>= procedure, public :: evaluate => test_sampler_1_evaluate <>= 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. <>= procedure, public :: is_valid => test_sampler_1_is_valid <>= 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. <>= procedure, public :: rebuild => test_sampler_1_rebuild <>= 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. <>= procedure, public :: fetch => test_sampler_1_fetch <>= 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} <>= type, extends (mci_sampler_t) :: test_sampler_2_t real(default), dimension(:,:), allocatable :: x real(default), dimension(:), allocatable :: f real(default) :: val contains <> end type test_sampler_2_t @ %def test_sampler_2_t @ Output: There is nothing stored inside, so just print an informative line. <>= procedure, public :: write => test_sampler_2_write <>= 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. <>= procedure, public :: compute => test_sampler_2_compute <>= 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. <>= procedure, public :: evaluate => test_sampler_2_evaluate <>= 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. <>= procedure, public :: is_valid => test_sampler_2_is_valid <>= 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. <>= procedure, public :: rebuild => test_sampler_2_rebuild <>= 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. <>= procedure, public :: fetch => test_sampler_2_fetch <>= 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. <>= call test (mci_vamp2_1, "mci_vamp2_1", "one-dimensional integral", u, results) <>= public :: mci_vamp2_1 <>= 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) + call mci%set_grid_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. <>= call test (mci_vamp2_2, "mci_vamp2_2", & "multiple iterations", & u, results) <>= public :: mci_vamp2_2 <>= 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) + call mci%set_grid_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. <>= call test (mci_vamp2_3, "mci_vamp2_3", & "grid adaptation", & u, results) <>= public :: mci_vamp2_3 <>= 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_grid_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]]>>= <> module dispatch_mci <> use diagnostics use os_interface use variables use mci_base use mci_none use mci_midpoint use mci_vamp use mci_vamp2 <> <> <> contains <> end module dispatch_mci @ %def dispatch_mci @ Allocate an integrator according to the variable [[$integration_method]]. <>= public :: dispatch_mci_s <>= subroutine dispatch_mci_s (mci, var_list, process_id, is_nlo) class(mci_t), allocatable, intent(out) :: mci type(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: process_id logical, intent(in), optional :: is_nlo 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 + logical :: dispatch_nlo, binary_grid_format 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) + call mci%set_grid_filename (process_id, run_id) else - call mci%set_integrator_filename (process_id) + 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_integrator_path (grid_path) + call mci%prepend_grid_path (grid_path) end if call mci%set_rebuild_flag (rebuild_grids, check_grid_file) mci%negative_weights = negative_weights mci%verbose = verbose + mci%binary_grid_format = binary_grid_format end select case default call msg_fatal ("Integrator '" & // char (integration_method) // "' not implemented") end select contains <> end subroutine dispatch_mci_s @ %def dispatch_mci_s @ <>= 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")) select case (char (var_list%get_sval (var_str ("$phs_method")))) case default 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 case ("rambo") grid_par%use_vamp_equivalences = .false. end select 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")) select case (char (var_list%get_sval (var_str ("$phs_method")))) case default 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 case ("rambo") mci_vamp2_config%equivalences = .false. end select 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 + select case (char (var_list%get_sval (var_str ("$vamp_grid_format")))) + case ("binary","Binary","BINARY") + binary_grid_format = .true. + case ("ascii","Ascii","ASCII") + binary_grid_format = .false. + case default + binary_grid_format = .false. + end select 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. <>= character(*), parameter :: ALLOWED_IN_DIRNAME = & "abcdefghijklmnopqrstuvwxyz& &ABCDEFGHIJKLMNOPQRSTUVWXYZ& &1234567890& &.,_-+=" @ %def ALLOWED_IN_DIRNAME <>= public :: setup_grid_path <>= 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]]>>= <> module dispatch_mci_ut use unit_tests use dispatch_mci_uti <> <> contains <> end module dispatch_mci_ut @ %def dispatch_mci_ut @ <<[[dispatch_mci_uti.f90]]>>= <> module dispatch_mci_uti <> <> use variables use mci_base use mci_none use mci_midpoint use mci_vamp use dispatch_mci <> <> contains <> end module dispatch_mci_uti @ %def dispatch_mci_ut @ API: driver for the unit tests below. <>= public ::dispatch_mci_test <>= subroutine dispatch_mci_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine dispatch_mci_test @ %def dispatch_mci_test @ \subsubsection{Select type: integrator core} <>= call test (dispatch_mci_1, "dispatch_mci_1", & "integration method", & u, results) <>= public :: dispatch_mci_1 <>= 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/share/tests/functional_tests/vamp2_1.sin =================================================================== --- trunk/share/tests/functional_tests/vamp2_1.sin (revision 0) +++ trunk/share/tests/functional_tests/vamp2_1.sin (revision 8324) @@ -0,0 +1,33 @@ +# SINDARIN input for WHIZARD self-test +# Process e- e+ -> mu- mu+ + +model = "QED" +ee = 0.30286 +me = 0 +mmu = 0 + +?logging = true +?openmp_logging = false +?vis_history = false +?integration_timer = false + +seed = 1234 + +$method = "omega" +$phs_method = "wood" +$integration_method = "vamp2" + +process vamp2_1_p1 = "e-", "e+" => "mu-", "mu+" + +sqrts = 1000 + +$vamp_grid_format = "ascii" +integrate (vamp2_1_p1) { + iterations = 5:1000:"gw", 3:1500 +} + +$vamp_grid_format = "binary" +?rebuild_grids = false +integrate (vamp2_1_p1) { + iterations = 5:1000:"gw", 5:1000 +} Index: trunk/share/tests/functional_tests/vamp2_2.sin =================================================================== --- trunk/share/tests/functional_tests/vamp2_2.sin (revision 0) +++ trunk/share/tests/functional_tests/vamp2_2.sin (revision 8324) @@ -0,0 +1,37 @@ +# SINDARIN input for WHIZARD self-test +# Process e- e+ -> mu- mu+ + +model = "QED" +ee = 0.30286 +me = 0 +mmu = 0 + +?logging = true +?openmp_logging = false +?vis_history = false +?integration_timer = false + +seed = 1234 + +$method = "omega" +$phs_method = "wood" +$integration_method = "vamp2" + +process vamp2_2_p1 = "e-", "e+" => "mu-", "mu+" + +sqrts = 1000 + +$vamp_grid_format = "binary" +! $vamp_grid_format = "Binary" +! $vamp_grid_format = "BINARY" +integrate (vamp2_2_p1) { + iterations = 5:1000:"gw", 3:1500 +} + +$vamp_grid_format = "ascii" +! $vamp_grid_format = "Ascii" +! $vamp_grid_format = "ASCII" +?rebuild_grids = false +integrate (vamp2_2_p1) { + iterations = 5:1000:"gw", 5:1000 +} Index: trunk/share/tests/functional_tests/ref-output/show_4.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8323) +++ trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8324) @@ -1,1158 +1,1161 @@ ?openmp_logging = false [user variable] foo = PDG(11, 13, 15) [user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00) ##################################################### QED.ee => 3.028600000000E-01 QED.me => 5.110000000000E-04 QED.mmu => 1.057000000000E-01 QED.mtau => 1.777000000000E+00 [undefined] sqrts = [unknown real] luminosity = 0.000000000000E+00 isr_alpha = 0.000000000000E+00 isr_q_max = 0.000000000000E+00 isr_mass = 0.000000000000E+00 epa_alpha = 0.000000000000E+00 epa_x_min = 0.000000000000E+00 epa_q_min = 0.000000000000E+00 epa_q_max = 0.000000000000E+00 epa_mass = 0.000000000000E+00 ewa_x_min = 0.000000000000E+00 ewa_pt_max = 0.000000000000E+00 ewa_mass = 0.000000000000E+00 [undefined] circe1_sqrts = [unknown real] circe1_mapping_slope = 2.000000000000E+00 circe1_eps = 1.000000000000E-05 gaussian_spread1 = 0.000000000000E+00 gaussian_spread2 = 0.000000000000E+00 lambda_qcd = 2.000000000000E-01 helicity_selection_threshold = 1.000000000000E+10 safety_factor = 1.000000000000E+00 resonance_on_shell_limit = 4.000000000000E+00 resonance_on_shell_turnoff = 0.000000000000E+00 resonance_background_factor = 1.000000000000E+00 tolerance = 0.000000000000E+00 real_epsilon* = real_tiny* = accuracy_goal = 0.000000000000E+00 error_goal = 0.000000000000E+00 relative_error_goal = 0.000000000000E+00 error_threshold = 0.000000000000E+00 channel_weights_power = 2.500000000000E-01 phs_threshold_s = 5.000000000000E+01 phs_threshold_t = 1.000000000000E+02 phs_e_scale = 1.000000000000E+01 phs_m_scale = 1.000000000000E+01 phs_q_scale = 1.000000000000E+01 [undefined] x_min = [unknown real] [undefined] x_max = [unknown real] [undefined] y_min = [unknown real] [undefined] y_max = [unknown real] jet_r = 0.000000000000E+00 jet_p = 0.000000000000E+00 jet_ycut = 0.000000000000E+00 photon_iso_eps = 1.000000000000E+00 photon_iso_n = 1.000000000000E+00 photon_iso_r0 = 4.000000000000E-01 ps_mass_cutoff = 1.000000000000E+00 ps_fsr_lambda = 2.900000000000E-01 ps_isr_lambda = 2.900000000000E-01 ps_fixed_alphas = 0.000000000000E+00 ps_isr_primordial_kt_width = 0.000000000000E+00 ps_isr_primordial_kt_cutoff = 5.000000000000E+00 ps_isr_z_cutoff = 9.990000000000E-01 ps_isr_minenergy = 1.000000000000E+00 ps_isr_tscalefactor = 1.000000000000E+00 hadron_enhanced_fraction = 1.000000000000E-02 hadron_enhanced_width = 2.000000000000E+00 ps_tauola_mh = 1.250000000000E+02 ps_tauola_mix_angle = 9.000000000000E+01 mlm_Qcut_ME = 0.000000000000E+00 mlm_Qcut_PS = 0.000000000000E+00 mlm_ptmin = 0.000000000000E+00 mlm_etamax = 0.000000000000E+00 mlm_Rmin = 0.000000000000E+00 mlm_Emin = 0.000000000000E+00 mlm_ETclusfactor = 2.000000000000E-01 mlm_ETclusminE = 5.000000000000E+00 mlm_etaclusfactor = 1.000000000000E+00 mlm_Rclusfactor = 1.000000000000E+00 mlm_Eclusfactor = 1.000000000000E+00 powheg_pt_min = 1.000000000000E+00 powheg_lambda = 2.000000000000E-01 blha_top_yukawa = -1.000000000000E+00 fks_dij_exp1 = 1.000000000000E+00 fks_dij_exp2 = 1.000000000000E+00 fks_xi_min = 1.000000000000E-07 fks_y_max = 1.000000000000E+00 fks_xi_cut = 1.000000000000E+00 fks_delta_o = 2.000000000000E+00 fks_delta_i = 2.000000000000E+00 mult_call_real = 1.000000000000E+00 mult_call_virt = 1.000000000000E+00 mult_call_dglap = 1.000000000000E+00 real_partition_scale = 1.000000000000E+01 ##################################################### QED.charged* = PDG(11, 13, 15, -11, -13, -15) ##################################################### [user variable] foo = PDG(11, 13, 15) ##################################################### [user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00) ##################################################### $sf_trace_file = "" $lhapdf_dir = "" $lhapdf_file = "" $lhapdf_photon_file = "" $pdf_builtin_set = "CTEQ6L" $isr_handler_mode = "trivial" $epa_handler_mode = "trivial" $circe1_acc = "SBAND" [undefined] $circe2_file = [unknown string] $circe2_design = "*" [undefined] $beam_events_file = [unknown string] [undefined] $job_id = [unknown string] [undefined] $compile_workspace = [unknown string] $model_name = "QED" $method = "omega" $restrictions = "" $omega_flags = "" $library_name = "show_4_lib" $rng_method = "tao" $event_file_version = "" $polarization_mode = "helicity" $out_file = "" $integration_method = "vamp" $run_id = "" [undefined] $integrate_workspace = [unknown string] +$vamp_grid_format = "ascii" $phs_method = "default" $phs_file = "" $obs_label = "" $obs_unit = "" $title = "" $description = "" $x_label = "" $y_label = "" $gmlcode_bg = "" $gmlcode_fg = "" [undefined] $fill_options = [unknown string] [undefined] $draw_options = [unknown string] [undefined] $err_options = [unknown string] [undefined] $symbol = [unknown string] $sample = "" $sample_normalization = "auto" $rescan_input_format = "raw" $extension_raw = "evx" $extension_default = "evt" $debug_extension = "debug" $dump_extension = "pset.dat" $extension_hepevt = "hepevt" $extension_ascii_short = "short.evt" $extension_ascii_long = "long.evt" $extension_athena = "athena.evt" $extension_mokka = "mokka.evt" $lhef_version = "2.0" $lhef_extension = "lhe" $extension_lha = "lha" $extension_hepmc = "hepmc" $extension_lcio = "slcio" $extension_stdhep = "hep" $extension_stdhep_up = "up.hep" $extension_stdhep_ev4 = "ev4.hep" $extension_hepevt_verb = "hepevt.verb" $extension_lha_verb = "lha.verb" $shower_method = "WHIZARD" $ps_PYTHIA_PYGIVE = "" $ps_PYTHIA8_config = "" $ps_PYTHIA8_config_file = "" $hadronization_method = "PYTHIA6" $born_me_method = "" $loop_me_method = "" $correlation_me_method = "" $real_tree_me_method = "" $dglap_me_method = "" $select_alpha_regions = "" $virtual_selection = "Full" $blha_ew_scheme = "alpha_qed" $openloops_extra_cmd = "" $fks_mapping_type = "default" $resonances_exclude_particles = "default" $gosam_filter_lo = "" $gosam_filter_nlo = "" $gosam_symmetries = "family,generation" $gosam_fc = "" $dalitz_plot = "" $nlo_correction_type = "QCD" $exclude_gauge_splittings = "c:b:t:e2:e3" $fc => Fortran-compiler $fcflags => Fortran-flags ##################################################### ?sf_trace = false ?sf_allow_s_mapping = true ?hoppet_b_matching = false ?isr_recoil = false ?isr_keep_energy = false ?isr_handler = false ?epa_recoil = false ?epa_keep_energy = false ?epa_handler = false ?ewa_recoil = false ?ewa_keep_energy = false ?circe1_photon1 = false ?circe1_photon2 = false ?circe1_generate = true ?circe1_map = true ?circe1_with_radiation = false ?circe2_polarized = true ?beam_events_warn_eof = true ?energy_scan_normalize = false ?logging => true ?report_progress = true [user variable] ?me_verbose = false ?omega_write_phs_output = false ?read_color_factors = true ?slha_read_input = true ?slha_read_spectrum = true ?slha_read_decays = false ?alphas_is_fixed = true ?alphas_from_lhapdf = false ?alphas_from_pdf_builtin = false ?alphas_from_mz = false ?alphas_from_lambda_qcd = false ?fatal_beam_decay = true ?helicity_selection_active = true ?vis_diags = false ?vis_diags_color = false ?check_event_file = true ?unweighted = true ?negative_weights = false ?resonance_history = false ?keep_beams = false ?keep_remnants = true ?recover_beams = true ?update_event = false ?update_sqme = false ?update_weight = false ?use_alphas_from_file = false ?use_scale_from_file = false ?allow_decays = true ?auto_decays = false ?auto_decays_radiative = false ?decay_rest_frame = false ?isotropic_decay = false ?diagonal_decay = false ?polarized_events = false ?colorize_subevt = false ?pacify = false ?out_advance = true ?stratified = true ?use_vamp_equivalences = true ?vamp_verbose = false ?vamp_history_global = true ?vamp_history_global_verbose = false ?vamp_history_channels = false ?vamp_history_channels_verbose = false ?integration_timer = true ?check_grid_file = true ?vis_channels = false ?check_phs_file = true ?phs_only = false ?phs_keep_nonresonant = true ?phs_step_mapping = true ?phs_step_mapping_exp = true ?phs_s_mapping = true ?vis_history = false ?normalize_bins = false ?y_log = false ?x_log = false [undefined] ?draw_histogram = [unknown logical] [undefined] ?draw_base = [unknown logical] [undefined] ?draw_piecewise = [unknown logical] [undefined] ?fill_curve = [unknown logical] [undefined] ?draw_curve = [unknown logical] [undefined] ?draw_errors = [unknown logical] [undefined] ?draw_symbols = [unknown logical] ?analysis_file_only = false ?keep_flavors_when_clustering = false ?sample_pacify = false ?sample_select = true ?read_raw = true ?write_raw = true ?debug_process = true ?debug_transforms = true ?debug_decay = true ?debug_verbose = true ?dump_compressed = false ?dump_weights = false ?dump_summary = false ?dump_screen = false ?hepevt_ensure_order = false ?lhef_write_sqme_prc = true ?lhef_write_sqme_ref = false ?lhef_write_sqme_alt = true ?hepmc_output_cross_section = false ?hepmc3_hepmc2mode = false ?allow_shower = true ?ps_fsr_active = false ?ps_isr_active = false ?ps_taudec_active = false ?muli_active = false ?shower_verbose = false ?ps_isr_alphas_running = true ?ps_fsr_alphas_running = true ?ps_isr_pt_ordered = false ?ps_isr_angular_ordered = true ?ps_isr_only_onshell_emitted_partons = false ?allow_hadronization = true ?hadronization_active = false ?ps_tauola_photos = false ?ps_tauola_transverse = false ?ps_tauola_dec_rad_cor = true ?ps_tauola_pol_vector = false ?mlm_matching = false ?powheg_matching = false ?powheg_use_singular_jacobian = false ?powheg_rebuild_grids = false ?powheg_test_sudakov = false ?powheg_disable_sudakov = false ?ckkw_matching = false ?omega_openmp => false ?openmp_is_active* = false ?openmp_logging = false ?mpi_logging = false ?test_soft_limit = false ?test_coll_limit = false ?test_anti_coll_limit = false ?virtual_collinear_resonance_aware = true ?openloops_use_cms = true ?openloops_switch_off_muon_yukawa = false ?openloops_use_collier = true ?disable_subtraction = false ?vis_fks_regions = false ?combined_nlo_integration = false ?fixed_order_nlo_events = false ?check_event_weights_against_xsection = false ?keep_failed_events = false ?nlo_use_born_scale = false ?nlo_cut_all_sqmes = false ?nlo_use_real_partition = false ?rebuild_library = true ?recompile_library = false ?rebuild_phase_space = true ?rebuild_grids = true ?powheg_rebuild_grids = true ?rebuild_events = true ##################################################### [undefined] sqrts = [unknown real] luminosity = 0.000000000000E+00 ?sf_trace = false $sf_trace_file = "" ?sf_allow_s_mapping = true $lhapdf_dir = "" $lhapdf_file = "" $lhapdf_photon_file = "" lhapdf_member = 0 lhapdf_photon_scheme = 0 $pdf_builtin_set = "CTEQ6L" ?hoppet_b_matching = false isr_alpha = 0.000000000000E+00 isr_q_max = 0.000000000000E+00 isr_mass = 0.000000000000E+00 isr_order = 3 ?isr_recoil = false ?isr_keep_energy = false ?isr_handler = false $isr_handler_mode = "trivial" epa_alpha = 0.000000000000E+00 epa_x_min = 0.000000000000E+00 epa_q_min = 0.000000000000E+00 epa_q_max = 0.000000000000E+00 epa_mass = 0.000000000000E+00 ?epa_recoil = false ?epa_keep_energy = false ?epa_handler = false $epa_handler_mode = "trivial" ewa_x_min = 0.000000000000E+00 ewa_pt_max = 0.000000000000E+00 ewa_mass = 0.000000000000E+00 ?ewa_recoil = false ?ewa_keep_energy = false ?circe1_photon1 = false ?circe1_photon2 = false [undefined] circe1_sqrts = [unknown real] ?circe1_generate = true ?circe1_map = true circe1_mapping_slope = 2.000000000000E+00 circe1_eps = 1.000000000000E-05 circe1_ver = 0 circe1_rev = 0 $circe1_acc = "SBAND" circe1_chat = 0 ?circe1_with_radiation = false ?circe2_polarized = true [undefined] $circe2_file = [unknown string] $circe2_design = "*" gaussian_spread1 = 0.000000000000E+00 gaussian_spread2 = 0.000000000000E+00 [undefined] $beam_events_file = [unknown string] ?beam_events_warn_eof = true ?energy_scan_normalize = false ?logging => true [undefined] $job_id = [unknown string] [undefined] $compile_workspace = [unknown string] seed = 0 $model_name = "QED" [undefined] process_num_id = [unknown integer] $method = "omega" ?report_progress = true $restrictions = "" ?omega_write_phs_output = false $omega_flags = "" ?read_color_factors = true ?slha_read_input = true ?slha_read_spectrum = true ?slha_read_decays = false $library_name = "show_4_lib" ?alphas_is_fixed = true ?alphas_from_lhapdf = false ?alphas_from_pdf_builtin = false alphas_order = 0 alphas_nf = 5 ?alphas_from_mz = false ?alphas_from_lambda_qcd = false lambda_qcd = 2.000000000000E-01 ?fatal_beam_decay = true ?helicity_selection_active = true helicity_selection_threshold = 1.000000000000E+10 helicity_selection_cutoff = 1000 $rng_method = "tao" ?vis_diags = false ?vis_diags_color = false ?check_event_file = true $event_file_version = "" n_events = 0 event_index_offset = 0 ?unweighted = true safety_factor = 1.000000000000E+00 ?negative_weights = false ?resonance_history = false resonance_on_shell_limit = 4.000000000000E+00 resonance_on_shell_turnoff = 0.000000000000E+00 resonance_background_factor = 1.000000000000E+00 ?keep_beams = false ?keep_remnants = true ?recover_beams = true ?update_event = false ?update_sqme = false ?update_weight = false ?use_alphas_from_file = false ?use_scale_from_file = false ?allow_decays = true ?auto_decays = false auto_decays_multiplicity = 2 ?auto_decays_radiative = false ?decay_rest_frame = false ?isotropic_decay = false ?diagonal_decay = false [undefined] decay_helicity = [unknown integer] ?polarized_events = false $polarization_mode = "helicity" ?colorize_subevt = false tolerance = 0.000000000000E+00 checkpoint = 0 event_callback_interval = 0 ?pacify = false $out_file = "" ?out_advance = true real_range* = real_precision* = real_epsilon* = real_tiny* = $integration_method = "vamp" threshold_calls = 10 min_calls_per_channel = 10 min_calls_per_bin = 10 min_bins = 3 max_bins = 20 ?stratified = true ?use_vamp_equivalences = true ?vamp_verbose = false ?vamp_history_global = true ?vamp_history_global_verbose = false ?vamp_history_channels = false ?vamp_history_channels_verbose = false $run_id = "" n_calls_test = 0 ?integration_timer = true ?check_grid_file = true accuracy_goal = 0.000000000000E+00 error_goal = 0.000000000000E+00 relative_error_goal = 0.000000000000E+00 integration_results_verbosity = 1 error_threshold = 0.000000000000E+00 channel_weights_power = 2.500000000000E-01 [undefined] $integrate_workspace = [unknown string] +$vamp_grid_format = "ascii" $phs_method = "default" ?vis_channels = false ?check_phs_file = true $phs_file = "" ?phs_only = false phs_threshold_s = 5.000000000000E+01 phs_threshold_t = 1.000000000000E+02 phs_off_shell = 2 phs_t_channel = 6 phs_e_scale = 1.000000000000E+01 phs_m_scale = 1.000000000000E+01 phs_q_scale = 1.000000000000E+01 ?phs_keep_nonresonant = true ?phs_step_mapping = true ?phs_step_mapping_exp = true ?phs_s_mapping = true ?vis_history = false n_bins = 20 ?normalize_bins = false $obs_label = "" $obs_unit = "" $title = "" $description = "" $x_label = "" $y_label = "" graph_width_mm = 130 graph_height_mm = 90 ?y_log = false ?x_log = false [undefined] x_min = [unknown real] [undefined] x_max = [unknown real] [undefined] y_min = [unknown real] [undefined] y_max = [unknown real] $gmlcode_bg = "" $gmlcode_fg = "" [undefined] ?draw_histogram = [unknown logical] [undefined] ?draw_base = [unknown logical] [undefined] ?draw_piecewise = [unknown logical] [undefined] ?fill_curve = [unknown logical] [undefined] ?draw_curve = [unknown logical] [undefined] ?draw_errors = [unknown logical] [undefined] ?draw_symbols = [unknown logical] [undefined] $fill_options = [unknown string] [undefined] $draw_options = [unknown string] [undefined] $err_options = [unknown string] [undefined] $symbol = [unknown string] ?analysis_file_only = false kt_algorithm* = 0 cambridge_algorithm* = 1 antikt_algorithm* = 2 genkt_algorithm* = 3 cambridge_for_passive_algorithm* = 11 genkt_for_passive_algorithm* = 13 ee_kt_algorithm* = 50 ee_genkt_algorithm* = 53 plugin_algorithm* = 99 undefined_jet_algorithm* = 999 jet_algorithm = 999 jet_r = 0.000000000000E+00 jet_p = 0.000000000000E+00 jet_ycut = 0.000000000000E+00 ?keep_flavors_when_clustering = false photon_iso_eps = 1.000000000000E+00 photon_iso_n = 1.000000000000E+00 photon_iso_r0 = 4.000000000000E-01 $sample = "" $sample_normalization = "auto" ?sample_pacify = false ?sample_select = true sample_max_tries = 10000 sample_split_n_evt = 0 sample_split_n_kbytes = 0 sample_split_index = 0 $rescan_input_format = "raw" ?read_raw = true ?write_raw = true $extension_raw = "evx" $extension_default = "evt" $debug_extension = "debug" ?debug_process = true ?debug_transforms = true ?debug_decay = true ?debug_verbose = true $dump_extension = "pset.dat" ?dump_compressed = false ?dump_weights = false ?dump_summary = false ?dump_screen = false ?hepevt_ensure_order = false $extension_hepevt = "hepevt" $extension_ascii_short = "short.evt" $extension_ascii_long = "long.evt" $extension_athena = "athena.evt" $extension_mokka = "mokka.evt" $lhef_version = "2.0" $lhef_extension = "lhe" ?lhef_write_sqme_prc = true ?lhef_write_sqme_ref = false ?lhef_write_sqme_alt = true $extension_lha = "lha" $extension_hepmc = "hepmc" ?hepmc_output_cross_section = false ?hepmc3_hepmc2mode = false $extension_lcio = "slcio" $extension_stdhep = "hep" $extension_stdhep_up = "up.hep" $extension_stdhep_ev4 = "ev4.hep" $extension_hepevt_verb = "hepevt.verb" $extension_lha_verb = "lha.verb" ?allow_shower = true ?ps_fsr_active = false ?ps_isr_active = false ?ps_taudec_active = false ?muli_active = false $shower_method = "WHIZARD" ?shower_verbose = false $ps_PYTHIA_PYGIVE = "" $ps_PYTHIA8_config = "" $ps_PYTHIA8_config_file = "" ps_mass_cutoff = 1.000000000000E+00 ps_fsr_lambda = 2.900000000000E-01 ps_isr_lambda = 2.900000000000E-01 ps_max_n_flavors = 5 ?ps_isr_alphas_running = true ?ps_fsr_alphas_running = true ps_fixed_alphas = 0.000000000000E+00 ?ps_isr_pt_ordered = false ?ps_isr_angular_ordered = true ps_isr_primordial_kt_width = 0.000000000000E+00 ps_isr_primordial_kt_cutoff = 5.000000000000E+00 ps_isr_z_cutoff = 9.990000000000E-01 ps_isr_minenergy = 1.000000000000E+00 ps_isr_tscalefactor = 1.000000000000E+00 ?ps_isr_only_onshell_emitted_partons = false ?allow_hadronization = true ?hadronization_active = false $hadronization_method = "PYTHIA6" hadron_enhanced_fraction = 1.000000000000E-02 hadron_enhanced_width = 2.000000000000E+00 ?ps_tauola_photos = false ?ps_tauola_transverse = false ?ps_tauola_dec_rad_cor = true ps_tauola_dec_mode1 = 0 ps_tauola_dec_mode2 = 0 ps_tauola_mh = 1.250000000000E+02 ps_tauola_mix_angle = 9.000000000000E+01 ?ps_tauola_pol_vector = false ?mlm_matching = false mlm_Qcut_ME = 0.000000000000E+00 mlm_Qcut_PS = 0.000000000000E+00 mlm_ptmin = 0.000000000000E+00 mlm_etamax = 0.000000000000E+00 mlm_Rmin = 0.000000000000E+00 mlm_Emin = 0.000000000000E+00 mlm_nmaxMEjets = 0 mlm_ETclusfactor = 2.000000000000E-01 mlm_ETclusminE = 5.000000000000E+00 mlm_etaclusfactor = 1.000000000000E+00 mlm_Rclusfactor = 1.000000000000E+00 mlm_Eclusfactor = 1.000000000000E+00 ?powheg_matching = false ?powheg_use_singular_jacobian = false powheg_grid_size_xi = 5 powheg_grid_size_y = 5 powheg_grid_sampling_points = 500000 powheg_pt_min = 1.000000000000E+00 powheg_lambda = 2.000000000000E-01 ?powheg_rebuild_grids = false ?powheg_test_sudakov = false ?powheg_disable_sudakov = false ?ckkw_matching = false ?omega_openmp => false ?openmp_is_active* = false openmp_num_threads_default* = 1 openmp_num_threads = 1 ?openmp_logging = false ?mpi_logging = false $born_me_method = "" $loop_me_method = "" $correlation_me_method = "" $real_tree_me_method = "" $dglap_me_method = "" ?test_soft_limit = false ?test_coll_limit = false ?test_anti_coll_limit = false $select_alpha_regions = "" $virtual_selection = "Full" ?virtual_collinear_resonance_aware = true blha_top_yukawa = -1.000000000000E+00 $blha_ew_scheme = "alpha_qed" openloops_verbosity = 1 ?openloops_use_cms = true openloops_phs_tolerance = 7 openloops_stability_log = 0 ?openloops_switch_off_muon_yukawa = false $openloops_extra_cmd = "" ?openloops_use_collier = true ?disable_subtraction = false fks_dij_exp1 = 1.000000000000E+00 fks_dij_exp2 = 1.000000000000E+00 fks_xi_min = 1.000000000000E-07 fks_y_max = 1.000000000000E+00 ?vis_fks_regions = false fks_xi_cut = 1.000000000000E+00 fks_delta_o = 2.000000000000E+00 fks_delta_i = 2.000000000000E+00 $fks_mapping_type = "default" $resonances_exclude_particles = "default" alpha_power = 2 alphas_power = 0 ?combined_nlo_integration = false ?fixed_order_nlo_events = false ?check_event_weights_against_xsection = false ?keep_failed_events = false gks_multiplicity = 0 $gosam_filter_lo = "" $gosam_filter_nlo = "" $gosam_symmetries = "family,generation" form_threads = 2 form_workspace = 1000 $gosam_fc = "" mult_call_real = 1.000000000000E+00 mult_call_virt = 1.000000000000E+00 mult_call_dglap = 1.000000000000E+00 $dalitz_plot = "" $nlo_correction_type = "QCD" $exclude_gauge_splittings = "c:b:t:e2:e3" ?nlo_use_born_scale = false ?nlo_cut_all_sqmes = false ?nlo_use_real_partition = false real_partition_scale = 1.000000000000E+01 $fc => Fortran-compiler $fcflags => Fortran-flags ?rebuild_library = true ?recompile_library = false ?rebuild_phase_space = true ?rebuild_grids = true ?powheg_rebuild_grids = true ?rebuild_events = true ##################################################### QED.ee => 3.028600000000E-01 QED.me => 5.110000000000E-04 QED.mmu => 1.057000000000E-01 QED.mtau => 1.777000000000E+00 QED.particle* = PDG(0) QED.E_LEPTON* = PDG(11) QED.e-* = PDG(11) QED.e1* = PDG(11) QED.e+* = PDG(-11) QED.E1* = PDG(-11) QED.MU_LEPTON* = PDG(13) QED.m-* = PDG(13) QED.e2* = PDG(13) QED.mu-* = PDG(13) QED.m+* = PDG(-13) QED.E2* = PDG(-13) QED.mu+* = PDG(-13) QED.TAU_LEPTON* = PDG(15) QED.t-* = PDG(15) QED.e3* = PDG(15) QED.ta-* = PDG(15) QED.tau-* = PDG(15) QED.t+* = PDG(-15) QED.E3* = PDG(-15) QED.ta+* = PDG(-15) QED.tau+* = PDG(-15) QED.PHOTON* = PDG(22) QED.A* = PDG(22) QED.gamma* = PDG(22) QED.photon* = PDG(22) QED.charged* = PDG(11, 13, 15, -11, -13, -15) QED.neutral* = PDG(22) QED.colored* = PDG() [undefined] sqrts = [unknown real] luminosity = 0.000000000000E+00 ?sf_trace = false $sf_trace_file = "" ?sf_allow_s_mapping = true $lhapdf_dir = "" $lhapdf_file = "" $lhapdf_photon_file = "" lhapdf_member = 0 lhapdf_photon_scheme = 0 $pdf_builtin_set = "CTEQ6L" ?hoppet_b_matching = false isr_alpha = 0.000000000000E+00 isr_q_max = 0.000000000000E+00 isr_mass = 0.000000000000E+00 isr_order = 3 ?isr_recoil = false ?isr_keep_energy = false ?isr_handler = false $isr_handler_mode = "trivial" epa_alpha = 0.000000000000E+00 epa_x_min = 0.000000000000E+00 epa_q_min = 0.000000000000E+00 epa_q_max = 0.000000000000E+00 epa_mass = 0.000000000000E+00 ?epa_recoil = false ?epa_keep_energy = false ?epa_handler = false $epa_handler_mode = "trivial" ewa_x_min = 0.000000000000E+00 ewa_pt_max = 0.000000000000E+00 ewa_mass = 0.000000000000E+00 ?ewa_recoil = false ?ewa_keep_energy = false ?circe1_photon1 = false ?circe1_photon2 = false [undefined] circe1_sqrts = [unknown real] ?circe1_generate = true ?circe1_map = true circe1_mapping_slope = 2.000000000000E+00 circe1_eps = 1.000000000000E-05 circe1_ver = 0 circe1_rev = 0 $circe1_acc = "SBAND" circe1_chat = 0 ?circe1_with_radiation = false ?circe2_polarized = true [undefined] $circe2_file = [unknown string] $circe2_design = "*" gaussian_spread1 = 0.000000000000E+00 gaussian_spread2 = 0.000000000000E+00 [undefined] $beam_events_file = [unknown string] ?beam_events_warn_eof = true ?energy_scan_normalize = false ?logging => true [undefined] $job_id = [unknown string] [undefined] $compile_workspace = [unknown string] seed = 0 $model_name = "QED" [undefined] process_num_id = [unknown integer] $method = "omega" ?report_progress = true [user variable] ?me_verbose = false $restrictions = "" ?omega_write_phs_output = false $omega_flags = "" ?read_color_factors = true ?slha_read_input = true ?slha_read_spectrum = true ?slha_read_decays = false $library_name = "show_4_lib" ?alphas_is_fixed = true ?alphas_from_lhapdf = false ?alphas_from_pdf_builtin = false alphas_order = 0 alphas_nf = 5 ?alphas_from_mz = false ?alphas_from_lambda_qcd = false lambda_qcd = 2.000000000000E-01 ?fatal_beam_decay = true ?helicity_selection_active = true helicity_selection_threshold = 1.000000000000E+10 helicity_selection_cutoff = 1000 $rng_method = "tao" ?vis_diags = false ?vis_diags_color = false ?check_event_file = true $event_file_version = "" n_events = 0 event_index_offset = 0 ?unweighted = true safety_factor = 1.000000000000E+00 ?negative_weights = false ?resonance_history = false resonance_on_shell_limit = 4.000000000000E+00 resonance_on_shell_turnoff = 0.000000000000E+00 resonance_background_factor = 1.000000000000E+00 ?keep_beams = false ?keep_remnants = true ?recover_beams = true ?update_event = false ?update_sqme = false ?update_weight = false ?use_alphas_from_file = false ?use_scale_from_file = false ?allow_decays = true ?auto_decays = false auto_decays_multiplicity = 2 ?auto_decays_radiative = false ?decay_rest_frame = false ?isotropic_decay = false ?diagonal_decay = false [undefined] decay_helicity = [unknown integer] ?polarized_events = false $polarization_mode = "helicity" ?colorize_subevt = false tolerance = 0.000000000000E+00 checkpoint = 0 event_callback_interval = 0 ?pacify = false $out_file = "" ?out_advance = true real_range* = real_precision* = real_epsilon* = real_tiny* = $integration_method = "vamp" threshold_calls = 10 min_calls_per_channel = 10 min_calls_per_bin = 10 min_bins = 3 max_bins = 20 ?stratified = true ?use_vamp_equivalences = true ?vamp_verbose = false ?vamp_history_global = true ?vamp_history_global_verbose = false ?vamp_history_channels = false ?vamp_history_channels_verbose = false $run_id = "" n_calls_test = 0 ?integration_timer = true ?check_grid_file = true accuracy_goal = 0.000000000000E+00 error_goal = 0.000000000000E+00 relative_error_goal = 0.000000000000E+00 integration_results_verbosity = 1 error_threshold = 0.000000000000E+00 channel_weights_power = 2.500000000000E-01 [undefined] $integrate_workspace = [unknown string] +$vamp_grid_format = "ascii" $phs_method = "default" ?vis_channels = false ?check_phs_file = true $phs_file = "" ?phs_only = false phs_threshold_s = 5.000000000000E+01 phs_threshold_t = 1.000000000000E+02 phs_off_shell = 2 phs_t_channel = 6 phs_e_scale = 1.000000000000E+01 phs_m_scale = 1.000000000000E+01 phs_q_scale = 1.000000000000E+01 ?phs_keep_nonresonant = true ?phs_step_mapping = true ?phs_step_mapping_exp = true ?phs_s_mapping = true ?vis_history = false n_bins = 20 ?normalize_bins = false $obs_label = "" $obs_unit = "" $title = "" $description = "" $x_label = "" $y_label = "" graph_width_mm = 130 graph_height_mm = 90 ?y_log = false ?x_log = false [undefined] x_min = [unknown real] [undefined] x_max = [unknown real] [undefined] y_min = [unknown real] [undefined] y_max = [unknown real] $gmlcode_bg = "" $gmlcode_fg = "" [undefined] ?draw_histogram = [unknown logical] [undefined] ?draw_base = [unknown logical] [undefined] ?draw_piecewise = [unknown logical] [undefined] ?fill_curve = [unknown logical] [undefined] ?draw_curve = [unknown logical] [undefined] ?draw_errors = [unknown logical] [undefined] ?draw_symbols = [unknown logical] [undefined] $fill_options = [unknown string] [undefined] $draw_options = [unknown string] [undefined] $err_options = [unknown string] [undefined] $symbol = [unknown string] ?analysis_file_only = false kt_algorithm* = 0 cambridge_algorithm* = 1 antikt_algorithm* = 2 genkt_algorithm* = 3 cambridge_for_passive_algorithm* = 11 genkt_for_passive_algorithm* = 13 ee_kt_algorithm* = 50 ee_genkt_algorithm* = 53 plugin_algorithm* = 99 undefined_jet_algorithm* = 999 jet_algorithm = 999 jet_r = 0.000000000000E+00 jet_p = 0.000000000000E+00 jet_ycut = 0.000000000000E+00 ?keep_flavors_when_clustering = false photon_iso_eps = 1.000000000000E+00 photon_iso_n = 1.000000000000E+00 photon_iso_r0 = 4.000000000000E-01 $sample = "" $sample_normalization = "auto" ?sample_pacify = false ?sample_select = true sample_max_tries = 10000 sample_split_n_evt = 0 sample_split_n_kbytes = 0 sample_split_index = 0 $rescan_input_format = "raw" ?read_raw = true ?write_raw = true $extension_raw = "evx" $extension_default = "evt" $debug_extension = "debug" ?debug_process = true ?debug_transforms = true ?debug_decay = true ?debug_verbose = true $dump_extension = "pset.dat" ?dump_compressed = false ?dump_weights = false ?dump_summary = false ?dump_screen = false ?hepevt_ensure_order = false $extension_hepevt = "hepevt" $extension_ascii_short = "short.evt" $extension_ascii_long = "long.evt" $extension_athena = "athena.evt" $extension_mokka = "mokka.evt" $lhef_version = "2.0" $lhef_extension = "lhe" ?lhef_write_sqme_prc = true ?lhef_write_sqme_ref = false ?lhef_write_sqme_alt = true $extension_lha = "lha" $extension_hepmc = "hepmc" ?hepmc_output_cross_section = false ?hepmc3_hepmc2mode = false $extension_lcio = "slcio" $extension_stdhep = "hep" $extension_stdhep_up = "up.hep" $extension_stdhep_ev4 = "ev4.hep" $extension_hepevt_verb = "hepevt.verb" $extension_lha_verb = "lha.verb" ?allow_shower = true ?ps_fsr_active = false ?ps_isr_active = false ?ps_taudec_active = false ?muli_active = false $shower_method = "WHIZARD" ?shower_verbose = false $ps_PYTHIA_PYGIVE = "" $ps_PYTHIA8_config = "" $ps_PYTHIA8_config_file = "" ps_mass_cutoff = 1.000000000000E+00 ps_fsr_lambda = 2.900000000000E-01 ps_isr_lambda = 2.900000000000E-01 ps_max_n_flavors = 5 ?ps_isr_alphas_running = true ?ps_fsr_alphas_running = true ps_fixed_alphas = 0.000000000000E+00 ?ps_isr_pt_ordered = false ?ps_isr_angular_ordered = true ps_isr_primordial_kt_width = 0.000000000000E+00 ps_isr_primordial_kt_cutoff = 5.000000000000E+00 ps_isr_z_cutoff = 9.990000000000E-01 ps_isr_minenergy = 1.000000000000E+00 ps_isr_tscalefactor = 1.000000000000E+00 ?ps_isr_only_onshell_emitted_partons = false ?allow_hadronization = true ?hadronization_active = false $hadronization_method = "PYTHIA6" hadron_enhanced_fraction = 1.000000000000E-02 hadron_enhanced_width = 2.000000000000E+00 ?ps_tauola_photos = false ?ps_tauola_transverse = false ?ps_tauola_dec_rad_cor = true ps_tauola_dec_mode1 = 0 ps_tauola_dec_mode2 = 0 ps_tauola_mh = 1.250000000000E+02 ps_tauola_mix_angle = 9.000000000000E+01 ?ps_tauola_pol_vector = false ?mlm_matching = false mlm_Qcut_ME = 0.000000000000E+00 mlm_Qcut_PS = 0.000000000000E+00 mlm_ptmin = 0.000000000000E+00 mlm_etamax = 0.000000000000E+00 mlm_Rmin = 0.000000000000E+00 mlm_Emin = 0.000000000000E+00 mlm_nmaxMEjets = 0 mlm_ETclusfactor = 2.000000000000E-01 mlm_ETclusminE = 5.000000000000E+00 mlm_etaclusfactor = 1.000000000000E+00 mlm_Rclusfactor = 1.000000000000E+00 mlm_Eclusfactor = 1.000000000000E+00 ?powheg_matching = false ?powheg_use_singular_jacobian = false powheg_grid_size_xi = 5 powheg_grid_size_y = 5 powheg_grid_sampling_points = 500000 powheg_pt_min = 1.000000000000E+00 powheg_lambda = 2.000000000000E-01 ?powheg_rebuild_grids = false ?powheg_test_sudakov = false ?powheg_disable_sudakov = false ?ckkw_matching = false ?omega_openmp => false ?openmp_is_active* = false openmp_num_threads_default* = 1 openmp_num_threads = 1 ?openmp_logging = false ?mpi_logging = false $born_me_method = "" $loop_me_method = "" $correlation_me_method = "" $real_tree_me_method = "" $dglap_me_method = "" ?test_soft_limit = false ?test_coll_limit = false ?test_anti_coll_limit = false $select_alpha_regions = "" $virtual_selection = "Full" ?virtual_collinear_resonance_aware = true blha_top_yukawa = -1.000000000000E+00 $blha_ew_scheme = "alpha_qed" openloops_verbosity = 1 ?openloops_use_cms = true openloops_phs_tolerance = 7 openloops_stability_log = 0 ?openloops_switch_off_muon_yukawa = false $openloops_extra_cmd = "" ?openloops_use_collier = true ?disable_subtraction = false fks_dij_exp1 = 1.000000000000E+00 fks_dij_exp2 = 1.000000000000E+00 fks_xi_min = 1.000000000000E-07 fks_y_max = 1.000000000000E+00 ?vis_fks_regions = false fks_xi_cut = 1.000000000000E+00 fks_delta_o = 2.000000000000E+00 fks_delta_i = 2.000000000000E+00 $fks_mapping_type = "default" $resonances_exclude_particles = "default" alpha_power = 2 alphas_power = 0 ?combined_nlo_integration = false ?fixed_order_nlo_events = false ?check_event_weights_against_xsection = false ?keep_failed_events = false gks_multiplicity = 0 $gosam_filter_lo = "" $gosam_filter_nlo = "" $gosam_symmetries = "family,generation" form_threads = 2 form_workspace = 1000 $gosam_fc = "" mult_call_real = 1.000000000000E+00 mult_call_virt = 1.000000000000E+00 mult_call_dglap = 1.000000000000E+00 $dalitz_plot = "" $nlo_correction_type = "QCD" $exclude_gauge_splittings = "c:b:t:e2:e3" ?nlo_use_born_scale = false ?nlo_cut_all_sqmes = false ?nlo_use_real_partition = false real_partition_scale = 1.000000000000E+01 $fc => Fortran-compiler $fcflags => Fortran-flags ?rebuild_library = true ?recompile_library = false ?rebuild_phase_space = true ?rebuild_grids = true ?powheg_rebuild_grids = true ?rebuild_events = true [user variable] foo = PDG(11, 13, 15) [user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00) | WHIZARD run finished. |=============================================================================| Index: trunk/share/tests/functional_tests/ref-output/vamp2_1.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/vamp2_1.ref (revision 0) +++ trunk/share/tests/functional_tests/ref-output/vamp2_1.ref (revision 8324) @@ -0,0 +1,124 @@ +?openmp_logging = false +?vis_history = false +?integration_timer = false +seed = 1234 +$method = "omega" +$phs_method = "wood" +$integration_method = "vamp2" +| Process library 'vamp2_1_lib': recorded process 'vamp2_1_p1' +sqrts = 1.000000000000E+03 +$vamp_grid_format = "ascii" +| Integrate: current process library needs compilation +| Process library 'vamp2_1_lib': compiling ... +| Process library 'vamp2_1_lib': writing makefile +| Process library 'vamp2_1_lib': removing old files +| Process library 'vamp2_1_lib': writing driver +| Process library 'vamp2_1_lib': creating source code +| Process library 'vamp2_1_lib': compiling sources +| Process library 'vamp2_1_lib': linking +| Process library 'vamp2_1_lib': loading +| Process library 'vamp2_1_lib': ... success. +| Integrate: compilation done +| RNG: Initializing TAO random-number generator +| RNG: Setting seed for random-number generator to 1234 +| Initializing integration for process vamp2_1_p1: +| Beam structure: [any particles] +| Beam data (collision): +| e- (mass = 0.0000000E+00 GeV) +| e+ (mass = 0.0000000E+00 GeV) +| sqrts = 1.000000000000E+03 GeV +| Phase space: generating configuration ... +| Phase space: ... success. +| Phase space: writing configuration file 'vamp2_1_p1.i1.phs' +| ------------------------------------------------------------------------ +| Process [scattering]: 'vamp2_1_p1' +| Library name = 'vamp2_1_lib' +| Process index = 1 +| Process components: +| 1: 'vamp2_1_p1_i1': e-, e+ => m-, m+ [omega] +| ------------------------------------------------------------------------ +| Phase space: 1 channels, 2 dimensions +| Phase space: found 1 channel, collected in 1 grove. +| Phase space: Using 1 equivalence between channels. +| Phase space: wood +Warning: No cuts have been defined. +| Starting integration for process 'vamp2_1_p1' +| Integrate: iterations = 5:1000:"gw", 3:1500 +| Integrator: 1 chains, 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: Initialize new grids and write to file 'vamp2_1_p1.m1.vg2'. +| VAMP2: set chain: use chained weights. + 1 800 8.6935211E+01 7.92E-02 0.09 0.03* 66.72 + 2 800 8.6857951E+01 6.34E-02 0.07 0.02* 49.37 + 3 800 8.6942034E+01 6.69E-02 0.08 0.02 59.07 + 4 800 8.6955287E+01 6.33E-02 0.07 0.02* 54.99 + 5 800 8.6956986E+01 6.53E-02 0.08 0.02 73.40 +|-----------------------------------------------------------------------------| + 5 4000 8.6928397E+01 2.99E-02 0.03 0.02 73.40 0.41 5 +|-----------------------------------------------------------------------------| + 6 1200 8.6908341E+01 5.24E-02 0.06 0.02* 52.15 + 7 1200 8.6837971E+01 4.99E-02 0.06 0.02* 52.05 + 8 1200 8.6945238E+01 4.92E-02 0.06 0.02* 52.14 +|-----------------------------------------------------------------------------| + 8 3600 8.6897281E+01 2.91E-02 0.03 0.02 52.14 1.21 3 +|=============================================================================| +$vamp_grid_format = "binary" +?rebuild_grids = false +| RNG: Initializing TAO random-number generator +| RNG: Setting seed for random-number generator to 1235 +| Initializing integration for process vamp2_1_p1: +| Beam structure: [any particles] +| Beam data (collision): +| e- (mass = 0.0000000E+00 GeV) +| e+ (mass = 0.0000000E+00 GeV) +| sqrts = 1.000000000000E+03 GeV +| Phase space: generating configuration ... +| Phase space: ... success. +| Phase space: writing configuration file 'vamp2_1_p1.i1.phs' +| ------------------------------------------------------------------------ +| Process [scattering]: 'vamp2_1_p1' +| Library name = 'vamp2_1_lib' +| Process index = 1 +| Process components: +| 1: 'vamp2_1_p1_i1': e-, e+ => m-, m+ [omega] +| ------------------------------------------------------------------------ +| Phase space: 1 channels, 2 dimensions +| Phase space: found 1 channel, collected in 1 grove. +| Phase space: Using 1 equivalence between channels. +| Phase space: wood +Warning: No cuts have been defined. +| Starting integration for process 'vamp2_1_p1' +| Integrate: iterations = 5:1000:"gw", 5:1000 +| Integrator: 1 chains, 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 ’vamp2_1_p1.m1.vg2’. + 1 800 8.6935211E+01 7.92E-02 0.09 0.03* 66.72 + 2 800 8.6857951E+01 6.34E-02 0.07 0.02* 49.37 + 3 800 8.6942034E+01 6.69E-02 0.08 0.02 59.07 + 4 800 8.6955287E+01 6.33E-02 0.07 0.02* 54.99 + 5 800 8.6956986E+01 6.53E-02 0.08 0.02 73.40 +|-----------------------------------------------------------------------------| + 5 4000 8.6928397E+01 2.99E-02 0.03 0.02 73.40 0.41 5 +|-----------------------------------------------------------------------------| +| VAMP2: header: parameter mismatch, discarding pass from file 'vamp2_1_p1.m1.vg2'. + 6 800 8.6925619E+01 6.00E-02 0.07 0.02* 52.10 + 7 800 8.6877404E+01 6.28E-02 0.07 0.02 52.14 + 8 800 8.6895243E+01 5.94E-02 0.07 0.02* 52.41 + 9 800 8.6935341E+01 6.25E-02 0.07 0.02 52.11 + 10 800 8.6909881E+01 6.34E-02 0.07 0.02 52.08 +|-----------------------------------------------------------------------------| + 10 4000 8.6908743E+01 2.75E-02 0.03 0.02 52.08 0.14 5 +|=============================================================================| +| There were no errors and 2 warning(s). +| WHIZARD run finished. +|=============================================================================| Index: trunk/share/tests/functional_tests/ref-output/pythia8_1.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/pythia8_1.ref (revision 8323) +++ trunk/share/tests/functional_tests/ref-output/pythia8_1.ref (revision 8324) @@ -1,868 +1,868 @@ ?openmp_logging = false ?vis_history = false ?integration_timer = false ?pacify = true SM.me => 0.00000E+00 $method = "omega" | Process library 'pythia8_1_lib': recorded process 'pythia8_1_p1' | Process library 'pythia8_1_lib': compiling ... | Process library 'pythia8_1_lib': writing makefile | Process library 'pythia8_1_lib': removing old files | Process library 'pythia8_1_lib': writing driver | Process library 'pythia8_1_lib': creating source code | Process library 'pythia8_1_lib': compiling sources | Process library 'pythia8_1_lib': linking | Process library 'pythia8_1_lib': loading | Process library 'pythia8_1_lib': ... success. seed = 1234 $phs_method = "wood" $integration_method = "vamp2" $rng_method = "rng_stream" sqrts = 1.00000E+03 openmp_num_threads = 1 | RNG: Initializing RNG Stream random-number generator | RNG: Setting seed for random-number generator to 1234 | Initializing integration for process pythia8_1_p1: | Beam structure: [any particles] | Beam data (collision): | e- (mass = 0.0000000E+00 GeV) | e+ (mass = 0.0000000E+00 GeV) | sqrts = 1.000000000000E+03 GeV | Phase space: generating configuration ... | Phase space: ... success. | Phase space: writing configuration file 'pythia8_1_p1.i1.phs' | ------------------------------------------------------------------------ | Process [scattering]: 'pythia8_1_p1' | Library name = 'pythia8_1_lib' | Process index = 1 | Process components: | 1: 'pythia8_1_p1_i1': e-, e+ => u, ubar [omega] | ------------------------------------------------------------------------ | 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 | Applying user-defined cuts. | Starting integration for process 'pythia8_1_p1' | Integrate: iterations = 3:1000:"g", 3:1000 | Integrator: 2 chains, 2 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] set chain: use chained weights. +| VAMP2: set chain: use chained weights. 1 900 1.680E+02 1.39E+00 0.83 0.25 36.5 2 900 1.694E+02 7.09E-01 0.42 0.13 35.1 3 900 1.682E+02 6.88E-01 0.41 0.12 59.3 |-----------------------------------------------------------------------------| 3 2700 1.687E+02 4.65E-01 0.28 0.14 59.3 0.86 3 |-----------------------------------------------------------------------------| 4 900 1.681E+02 6.79E-01 0.40 0.12 34.0 5 900 1.692E+02 7.30E-01 0.43 0.13 34.3 6 900 1.689E+02 6.74E-01 0.40 0.12 34.1 |-----------------------------------------------------------------------------| 6 2700 1.687E+02 4.00E-01 0.24 0.12 34.1 0.62 3 |=============================================================================| n_events = 1 ?debug_decay = false ?debug_process = false ?debug_verbose = false ?sample_pacify = true ?allow_shower = true ?ps_fsr_active = true $shower_method = "PYTHIA8" $sample = "pythia8_1a" | Starting simulation for process 'pythia8_1_p1' | Simulate: activating parton shower | Shower: Using PYTHIA8 shower | RNG: Initializing RNG Stream random-number generator | RNG: Setting seed for random-number generator to 1235 | Simulation: requested number of events = 1 | corr. to luminosity [fb-1] = 5.9271E-03 | Events: writing to ASCII file 'pythia8_1a.debug' | Events: writing to raw file 'pythia8_1a.evx' | Events: generating 1 unweighted, unpolarized events ... | Events: event normalization mode '1' | ... event sample complete. | Events: actual unweighting efficiency = 50.00 % | Events: closing ASCII file 'pythia8_1a.debug' | Events: closing raw file 'pythia8_1a.evx' ?hadronization_active = true $hadronization_method = "PYTHIA8" $sample = "pythia8_1b" | Starting simulation for process 'pythia8_1_p1' | Simulate: activating parton shower | Shower: Using PYTHIA8 shower | Simulate: activating hadronization | Hadronization: Using PYTHIA8 interface for hadronization and decays. | RNG: Initializing RNG Stream random-number generator | RNG: Setting seed for random-number generator to 1236 | Simulation: requested number of events = 1 | corr. to luminosity [fb-1] = 5.9271E-03 | Events: writing to ASCII file 'pythia8_1b.debug' | Events: writing to raw file 'pythia8_1b.evx' | Events: generating 1 unweighted, unpolarized events ... | Events: event normalization mode '1' | ... event sample complete. | Events: actual unweighting efficiency = 100.00 % | Events: closing ASCII file 'pythia8_1b.debug' | Events: closing raw file 'pythia8_1b.evx' | WHIZARD run finished. |=============================================================================| Contents of pythia8_1a.debug: ======================================================================== Event #1 ------------------------------------------------------------------------ Unweighted = T Normalization = '1' Helicity handling = drop Keep correlations = F ------------------------------------------------------------------------ Squared matrix el. (ref) = 5.20858E-02 Squared matrix el. (prc) = 5.20858E-02 Event weight (ref) = 1.00000E+00 Event weight (prc) = 1.00000E+00 ------------------------------------------------------------------------ Selected MCI group = 1 Selected term = 1 Selected channel = 2 ------------------------------------------------------------------------ Passed selection = T Reweighting factor = 1.00000E+00 Analysis flag = T ======================================================================== Event transform: trivial (hard process) ------------------------------------------------------------------------ Associated process: 'pythia8_1_p1' RNG Stream generator Current position = [ 1406751874.0, 353173304.0, 69075414.0, 4120795872.0, 2940738971.0, 1076868956.0, ] Beginning substream = [ 1645229399.0, 1877497944.0, 574158534.0, 2268932622.0, 3511034181.0, 2508020503.0, ] Initial stream = [ 1645229399.0, 1877497944.0, 574158534.0, 2268932622.0, 3511034181.0, 2508020503.0, ] Number of tries = 1 ------------------------------------------------------------------------ Particle set: ------------------------------------------------------------------------ Particle 1 [i] f(11) E = 5.000000E+02 P = 0.000000E+00 0.000000E+00 5.000000E+02 T = 0.000000000E+00 Children: 3 4 Particle 2 [i] f(-11) E = 5.000000E+02 P = 0.000000E+00 0.000000E+00 -5.000000E+02 T = 0.000000000E+00 Children: 3 4 Particle 3 [o] f(2)c(1 ) E = 5.000000E+02 P = -2.541053E+02 -8.350176E+01 4.224428E+02 T = 0.000000000E+00 Parents: 1 2 Particle 4 [o] f(-2)c(-1 ) E = 5.000000E+02 P = 2.541053E+02 8.350176E+01 -4.224428E+02 T = 0.000000000E+00 Parents: 1 2 ======================================================================== ======================================================================== Event transform: shower ------------------------------------------------------------------------ Associated process: 'pythia8_1_p1' RNG Stream generator Current position = [ 244426135.0, 2098806856.0, 1330552735.0, 1957943094.0, 3060143382.0, 2035378285.0, ] Beginning substream = [ 1172788459.0, 244426135.0, 2098806856.0, 19170156.0, 1957943094.0, 3060143382.0, ] Initial stream = [ 1172788459.0, 244426135.0, 2098806856.0, 19170156.0, 1957943094.0, 3060143382.0, ] Number of tries = 1 Particle set: ------------------------------------------------------------------------ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000 3 [v] u 1 0 1-2 7 500.000 -254.105 -83.502 422.443 0.000 4 [v] ubar 0 1 1-2 5-6 500.000 254.105 83.502 -422.443 0.000 5 [v] ubar 0 502 4 17-18 454.822 239.242 59.577 -382.200 0.000 6 [v] gl 502 501 4 8-9 47.226 13.822 23.583 -38.512 0.000 7 [v] u 501 0 3 10 497.951 -253.064 -83.160 420.712 0.000 8 [v] gl 502 503 6 19 45.145 18.993 18.597 -36.490 0.000 9 [v] gl 503 501 6 11-12 14.961 -11.717 2.835 8.860 0.000 10 [v] u 501 0 7 13 485.072 -246.518 -81.009 409.830 0.000 11 [v] gl 503 505 9 22 4.473 -1.121 -2.695 3.390 0.000 12 [v] gl 505 501 9 14-15 32.841 -21.956 1.797 24.356 0.000 13 [v] u 501 0 10 16 462.718 -235.158 -77.276 390.944 0.000 14 [v] gl 505 506 12 23-24 50.460 -32.491 -0.950 38.596 0.000 15 [v] gl 506 501 12 26-27 6.590 -1.768 -1.296 6.215 0.000 16 [v] u 501 0 13 28 438.509 -222.855 -73.233 370.490 0.000 17 [o] ubar 0 507 5 [none] 396.090 208.344 54.528 -332.425 0.000 18 [v] gl 507 502 5 38-39 59.936 31.404 5.545 -50.748 0.000 19 [v] gl 502 503 8 20-21 43.942 18.487 18.101 -35.518 0.000 20 [v] gl 502 508 19 40 27.986 13.708 11.776 -21.369 0.000 21 [v] gl 508 503 19 34 16.089 4.746 6.244 -14.048 0.000 22 [v] gl 503 505 11 25 4.340 -1.088 -2.614 3.289 0.000 23 [v] gl 509 506 14 43 40.891 -26.969 -0.104 30.736 0.000 24 [o] gl 505 509 14 [none] 9.980 -5.625 -1.093 8.171 0.000 25 [v] gl 503 505 22 32-33 3.929 -0.985 -2.367 2.978 0.000 26 [v] gl 506 510 15 41-42 3.716 -1.149 0.198 3.528 0.000 27 [v] gl 510 501 15 29-30 22.461 -10.574 -4.766 19.235 0.000 28 [v] u 501 0 16 31 418.922 -212.901 -69.961 353.941 0.000 29 [v] gl 510 511 27 55 71.045 -35.242 -13.648 60.159 0.000 30 [v] gl 511 501 27 52 24.497 -12.472 -3.322 20.821 0.000 31 [v] u 501 0 28 50-51 345.841 -175.760 -57.757 292.197 0.000 32 [v] gl 512 505 25 62-63 3.108 -1.297 -1.205 2.555 0.000 33 [v] gl 503 512 25 37 1.129 0.403 -1.043 0.154 0.000 34 [v] gl 508 503 21 35-36 15.782 4.655 6.125 -13.780 0.000 35 [v] gl 508 513 34 44-45 4.718 2.170 1.434 -3.936 0.000 36 [v] gl 513 503 34 46 11.148 2.515 4.614 -9.832 0.000 37 [v] gl 503 512 33 59-60 1.044 0.373 -0.965 0.143 0.000 38 [o] gl 507 514 18 [none] 60.264 31.237 5.887 -51.200 0.000 39 [v] gl 514 502 18 47-48 1.208 0.920 0.304 -0.721 0.000 40 [v] gl 502 508 20 49 26.449 12.956 11.130 -20.195 0.000 41 [v] gl 515 510 26 53-54 1.334 -0.164 0.376 1.269 0.000 42 [o] gl 506 515 26 [none] 8.701 -5.152 -0.194 7.009 0.000 43 [o] gl 509 506 23 [none] 34.572 -22.802 -0.088 25.986 0.000 44 [o] gl 508 516 35 [none] 9.410 3.195 3.166 -8.265 0.000 45 [o] gl 516 513 35 [none] 0.550 0.157 0.437 -0.294 0.000 46 [v] gl 513 503 36 61 5.906 1.332 2.444 -5.209 0.000 47 [o] gl 514 517 39 [none] 0.420 0.013 0.295 -0.298 0.000 48 [o] gl 517 502 39 [none] 11.673 6.238 4.589 -8.734 0.000 49 [o] gl 502 508 40 [none] 15.565 7.624 6.550 -11.884 0.000 50 [o] u 518 0 31 [none] 267.737 -135.926 -45.155 226.203 0.000 51 [o] gl 501 518 31 [none] 83.645 -42.655 -13.353 70.702 0.000 52 [v] gl 511 501 30 58 18.957 -9.652 -2.571 16.112 0.000 53 [o] gl 515 519 41 [none] 1.758 -0.847 0.519 1.450 0.000 54 [o] gl 519 510 41 [none] 3.764 -1.395 -0.947 3.365 0.000 55 [v] gl 510 511 29 56-57 66.858 -33.164 -12.844 56.613 0.000 56 [o] gl 510 520 55 [none] 46.017 -22.577 -9.095 39.053 0.000 57 [o] gl 520 511 55 [none] 26.850 -13.647 -4.564 22.669 0.000 58 [o] gl 511 501 52 [none] 12.947 -6.592 -1.756 11.004 0.000 59 [v] gl 521 512 37 64 1.130 0.731 -0.769 -0.390 0.000 60 [o] gl 503 521 37 [none] 0.320 -0.267 -0.028 0.174 0.000 61 [o] gl 513 503 46 [none] 5.501 1.241 2.276 -4.851 0.000 62 [o] gl 522 505 32 [none] 3.158 -1.168 -1.282 2.639 0.000 63 [o] gl 512 522 32 [none] 0.187 0.024 -0.084 -0.166 0.000 64 [o] gl 521 512 59 [none] 0.894 0.578 -0.608 -0.308 0.000 ------------------------------------------------------------------------ Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000 Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000 Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000 ------------------------------------------------------------------------ Shower settings: ------------------------------------------------------------------------ Master switches: ps_isr_active = F ps_fsr_active = T ps_tau_dec = F muli_active = F hadronization_active = F General settings: method = PYTHIA8 shower_verbose = F ps_mass_cutoff = 1.000000000000E+00 ps_max_n_flavors = 5 [ISR off] FSR settings: ps_fsr_lambda = 2.900000000000E-01 ps_fsr_alphas_running = T Matching Settings: mlm_matching = F ckkw_matching = F PYTHIA6 specific settings: ps_PYTHIA_PYGIVE = '' PYTHIA8 specific settings: ps_PYTHIA8_config = '' ps_PYTHIA8_config_file = '' ======================================================================== Local variables: ------------------------------------------------------------------------ sqrts* = 1.00000E+03 sqrts_hat* => 1.00000E+03 n_in* => 2 n_out* => 22 n_tot* => 24 $process_id* => "pythia8_1_p1" process_num_id* => [unknown integer] sqme* => 5.20858E-02 sqme_ref* => 5.20858E-02 event_index* => 1 event_weight* => 1.00000E+00 event_weight_ref* => 1.00000E+00 event_excess* => 0.00000E+00 ------------------------------------------------------------------------ subevent: 1 prt(i:11|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02| 0.0000000E+00| 1) 2 prt(i:-11|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02| 0.0000000E+00| 2) 3 prt(o:-2| 3.9608953E+02; 2.0834375E+02, 5.4527689E+01,-3.3242523E+02| 0.0000000E+00| 3) 4 prt(o:21| 9.9802194E+00;-5.6251031E+00,-1.0932282E+00, 8.1711595E+00| 0.0000000E+00| 4) 5 prt(o:21| 6.0264469E+01; 3.1236986E+01, 5.8874612E+00,-5.1199559E+01| 0.0000000E+00| 5) 6 prt(o:21| 8.7008971E+00;-5.1521177E+00,-1.9407531E-01, 7.0088250E+00| 0.0000000E+00| 6) 7 prt(o:21| 3.4571713E+01;-2.2801680E+01,-8.8023314E-02, 2.5986130E+01| 0.0000000E+00| 7) 8 prt(o:21| 9.4100437E+00; 3.1952341E+00, 3.1659857E+00,-8.2653455E+00| 0.0000000E+00| 8) 9 prt(o:21| 5.4951880E-01; 1.5738276E-01, 4.3698235E-01,-2.9368011E-01| 0.0000000E+00| 9) 10 prt(o:21| 4.1957092E-01; 1.3414355E-02, 2.9469594E-01,-2.9835234E-01| 0.0000000E+00| 10) 11 prt(o:21| 1.1672822E+01; 6.2381216E+00, 4.5893626E+00,-8.7337487E+00| 0.0000000E+00| 11) 12 prt(o:21| 1.5564928E+01; 7.6241808E+00, 6.5496518E+00,-1.1884482E+01| 0.0000000E+00| 12) 13 prt(o:2| 2.6773664E+02;-1.3592642E+02,-4.5154996E+01, 2.2620331E+02| 0.0000000E+00| 13) 14 prt(o:21| 8.3645039E+01;-4.2654604E+01,-1.3353109E+01, 7.0701993E+01| 0.0000000E+00| 14) 15 prt(o:21| 1.7575753E+00;-8.4663406E-01, 5.1930560E-01, 1.4500356E+00| 0.0000000E+00| 15) 16 prt(o:21| 3.7636004E+00;-1.3945397E+00,-9.4745811E-01, 3.3648581E+00| 0.0000000E+00| 16) 17 prt(o:21| 4.6017110E+01;-2.2577357E+01,-9.0950804E+00, 3.9052746E+01| 0.0000000E+00| 17) 18 prt(o:21| 2.6850294E+01;-1.3647001E+01,-4.5635748E+00, 2.2668733E+01| 0.0000000E+00| 18) 19 prt(o:21| 1.2946985E+01;-6.5918191E+00,-1.7558648E+00, 1.1004058E+01| 0.0000000E+00| 19) 20 prt(o:21| 3.1986933E-01;-2.6670673E-01,-2.8027834E-02, 1.7435122E-01| 0.0000000E+00| 20) 21 prt(o:21| 5.5005933E+00; 1.2407116E+00, 2.2763683E+00,-4.8513203E+00| 0.0000000E+00| 21) 22 prt(o:21| 3.1579615E+00;-1.1676241E+00,-1.2824302E+00, 2.6390809E+00| 0.0000000E+00| 22) 23 prt(o:21| 1.8700318E-01; 2.3996538E-02,-8.3517885E-02,-1.6558719E-01| 0.0000000E+00| 23) 24 prt(o:21| 8.9361763E-01; 5.7783410E-01,-6.0811735E-01,-3.0798296E-01| 0.0000000E+00| 24) ======================================================================== Contents of pythia8_1b.debug: ======================================================================== Event #1 ------------------------------------------------------------------------ Unweighted = T Normalization = '1' Helicity handling = drop Keep correlations = F ------------------------------------------------------------------------ Squared matrix el. (ref) = 5.04278E-02 Squared matrix el. (prc) = 5.04278E-02 Event weight (ref) = 1.00000E+00 Event weight (prc) = 1.00000E+00 ------------------------------------------------------------------------ Selected MCI group = 1 Selected term = 1 Selected channel = 1 ------------------------------------------------------------------------ Passed selection = T Reweighting factor = 1.00000E+00 Analysis flag = T ======================================================================== Event transform: trivial (hard process) ------------------------------------------------------------------------ Associated process: 'pythia8_1_p1' RNG Stream generator Current position = [ 1181672156.0, 918370603.0, 2351276331.0, 709317015.0, 3565763956.0, 3526655229.0, ] Beginning substream = [ 1257951883.0, 2124301545.0, 1723027666.0, 2080453032.0, 1195684852.0, 1749773276.0, ] Initial stream = [ 1257951883.0, 2124301545.0, 1723027666.0, 2080453032.0, 1195684852.0, 1749773276.0, ] Number of tries = 1 ------------------------------------------------------------------------ Particle set: ------------------------------------------------------------------------ Particle 1 [i] f(11) E = 5.000000E+02 P = 0.000000E+00 0.000000E+00 5.000000E+02 T = 0.000000000E+00 Children: 3 4 Particle 2 [i] f(-11) E = 5.000000E+02 P = 0.000000E+00 0.000000E+00 -5.000000E+02 T = 0.000000000E+00 Children: 3 4 Particle 3 [o] f(2)c(1 ) E = 5.000000E+02 P = -2.459287E+02 -1.531956E+02 4.074926E+02 T = 0.000000000E+00 Parents: 1 2 Particle 4 [o] f(-2)c(-1 ) E = 5.000000E+02 P = 2.459287E+02 1.531956E+02 -4.074926E+02 T = 0.000000000E+00 Parents: 1 2 ======================================================================== ======================================================================== Event transform: shower ------------------------------------------------------------------------ Associated process: 'pythia8_1_p1' RNG Stream generator Current position = [ 1459724150.0, 1113883731.0, 3072361390.0, 3768449865.0, 3588250432.0, 1148658053.0, ] Beginning substream = [ 139826393.0, 1459724150.0, 1113883731.0, 1552647665.0, 3768449865.0, 3588250432.0, ] Initial stream = [ 139826393.0, 1459724150.0, 1113883731.0, 1552647665.0, 3768449865.0, 3588250432.0, ] Number of tries = 1 Particle set: ------------------------------------------------------------------------ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000 3 [v] u 1 0 1-2 5-6 500.000 -245.929 -153.196 407.493 0.000 4 [v] ubar 0 1 1-2 7 500.000 245.929 153.196 -407.493 0.000 5 [v] u 502 0 3 11-12 344.576 -207.722 -77.184 263.868 0.000 6 [v] gl 501 502 3 8-9 161.319 -35.307 -74.206 138.820 0.000 7 [v] ubar 0 501 4 10 494.105 243.029 151.389 -402.688 0.000 8 [v] gl 503 502 6 13 158.228 -38.308 -70.448 136.403 0.000 9 [v] gl 501 503 6 16 5.140 4.009 -3.130 0.747 0.000 10 [v] ubar 0 501 7 14-15 492.056 242.021 150.762 -401.018 0.000 11 [v] u 504 0 5 26-27 237.408 -140.735 -50.037 184.533 0.000 12 [v] gl 502 504 5 20-21 108.763 -67.373 -27.857 80.710 0.000 13 [v] gl 503 502 8 17-18 156.634 -37.922 -69.738 135.028 0.000 14 [o] ubar 0 505 10 [none] 394.148 197.637 121.285 -318.720 0.000 15 [v] gl 505 501 10 35-36 98.047 44.493 29.392 -82.278 0.000 16 [v] gl 501 503 9 19 5.001 3.900 -3.045 0.727 0.000 17 [v] gl 506 502 13 22 37.981 -12.920 -15.262 32.291 0.000 18 [v] gl 503 506 13 32-33 119.037 -24.702 -54.710 102.793 0.000 19 [v] gl 501 503 16 34 4.616 3.600 -2.811 0.671 0.000 20 [v] gl 507 504 12 28 100.848 -61.585 -23.607 76.292 0.000 21 [v] gl 502 507 12 23-24 16.709 -8.780 -7.784 11.896 0.000 22 [v] gl 506 502 17 25 29.187 -9.929 -11.728 24.814 0.000 23 [v] gl 508 507 21 31 21.279 -9.233 -10.806 15.836 0.000 24 [v] gl 502 508 21 40 8.840 -4.109 -2.367 7.461 0.000 25 [o] gl 506 502 22 [none] 15.776 -5.367 -6.339 13.413 0.000 26 [v] u 509 0 11 59-60 190.135 -112.849 -41.917 147.171 0.000 27 [v] gl 504 509 11 61 77.331 -46.241 -15.156 60.101 0.000 28 [v] gl 507 504 20 29-30 70.790 -43.229 -16.571 53.553 0.000 29 [o] dbar 0 504 28 [none] 31.756 -20.332 -7.124 23.328 0.109 30 [v] d 507 0 28 49 40.002 -23.317 -9.939 30.945 0.109 31 [v] gl 508 507 23 38-39 20.311 -8.813 -10.314 15.116 0.000 32 [v] gl 510 506 18 67 110.925 -22.396 -51.834 95.478 0.000 33 [v] gl 503 510 18 46 8.203 -2.234 -2.932 7.328 0.000 34 [v] gl 501 503 19 37 4.525 3.529 -2.755 0.658 0.000 35 [v] gl 505 511 15 50-51 96.802 43.606 28.682 -81.526 0.000 36 [v] gl 511 501 15 43 1.384 0.996 0.624 -0.732 0.000 37 [v] gl 501 503 34 41-42 4.386 3.420 -2.670 0.637 0.000 38 [v] gl 512 507 31 47-48 16.278 -7.838 -7.566 12.096 0.000 39 [v] gl 508 512 31 55 6.340 -2.048 -3.366 4.967 0.000 40 [v] gl 502 508 24 53-54 6.532 -3.036 -1.749 5.513 0.000 41 [v] gl 513 503 37 44-45 1.729 1.689 -0.109 0.353 0.000 42 [v] gl 501 513 37 70 3.131 2.072 -2.347 0.034 0.000 43 [v] gl 511 501 36 52 0.910 0.655 0.410 -0.481 0.000 44 [v] gl 513 514 41 68-69 1.738 1.665 0.126 0.479 0.000 45 [o] gl 514 503 41 [none] 1.353 -0.347 -0.722 1.090 0.000 46 [v] gl 503 510 33 65-66 6.842 -1.863 -2.446 6.112 0.000 47 [o] d 512 0 38 [none] 10.129 -4.444 -4.425 7.948 0.109 48 [o] dbar 0 507 38 [none] 8.599 -4.823 -3.748 6.043 0.109 49 [o] d 507 0 30 [none] 37.553 -21.889 -9.332 29.050 0.109 50 [v] gl 505 515 35 73 93.008 42.259 27.433 -78.180 0.000 51 [v] gl 515 511 35 71-72 3.973 1.476 1.331 -3.441 0.000 52 [o] gl 511 501 43 [none] 0.731 0.526 0.329 -0.387 0.000 53 [v] gl 502 516 40 58 1.451 -0.104 -0.635 1.300 0.000 54 [v] gl 516 508 40 56-57 8.721 -4.108 -3.046 7.064 0.000 55 [o] gl 508 512 39 [none] 2.701 -0.872 -1.434 2.116 0.000 56 [o] gl 518 508 54 [none] 6.979 -3.177 -2.007 5.881 0.000 57 [o] gl 516 518 54 [none] 2.715 -1.000 -1.465 2.055 0.000 58 [o] gl 502 516 53 [none] 0.478 -0.034 -0.209 0.428 0.000 59 [o] u 519 0 26 [none] 116.385 -69.550 -25.558 89.750 0.000 60 [v] gl 509 519 26 64 85.007 -50.030 -18.565 66.170 0.000 61 [v] gl 504 509 27 62-63 66.074 -39.510 -12.950 51.352 0.000 62 [o] gl 504 520 61 [none] 20.320 -11.903 -3.780 16.029 0.000 63 [o] gl 520 509 61 [none] 79.097 -47.231 -16.452 61.277 0.000 64 [o] gl 509 519 60 [none] 51.664 -30.406 -11.283 40.216 0.000 65 [o] u 503 0 46 [none] 2.618 -0.825 -0.999 2.252 0.109 66 [o] ubar 0 510 46 [none] 16.051 -3.427 -6.974 14.041 0.109 67 [o] gl 510 506 32 [none] 99.097 -20.008 -46.307 85.297 0.000 68 [o] gl 523 514 44 [none] 1.384 1.292 0.247 0.429 0.000 69 [o] gl 513 523 44 [none] 1.343 1.028 -0.862 0.061 0.000 70 [o] gl 501 513 42 [none] 2.142 1.418 -1.605 0.023 0.000 71 [o] gl 524 511 51 [none] 7.731 3.180 2.673 -6.520 0.000 72 [o] gl 515 524 51 [none] 30.806 14.000 8.852 -25.974 0.000 73 [o] gl 505 515 50 [none] 58.444 26.555 17.238 -49.126 0.000 ------------------------------------------------------------------------ Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000 Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000 Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000 ------------------------------------------------------------------------ Shower settings: ------------------------------------------------------------------------ Master switches: ps_isr_active = F ps_fsr_active = T ps_tau_dec = F muli_active = F hadronization_active = T General settings: method = PYTHIA8 shower_verbose = F ps_mass_cutoff = 1.000000000000E+00 ps_max_n_flavors = 5 [ISR off] FSR settings: ps_fsr_lambda = 2.900000000000E-01 ps_fsr_alphas_running = T Matching Settings: mlm_matching = F ckkw_matching = F PYTHIA6 specific settings: ps_PYTHIA_PYGIVE = '' PYTHIA8 specific settings: ps_PYTHIA8_config = '' ps_PYTHIA8_config_file = '' ======================================================================== ======================================================================== Event transform: hadronization ------------------------------------------------------------------------ Associated process: 'pythia8_1_p1' RNG Stream generator Current position = [ 521427311.0, 2587893192.0, 1737772007.0, 1186036700.0, 83139990.0, 4025248731.0, ] Beginning substream = [ 1712487803.0, 521427311.0, 2587893192.0, 2004959789.0, 1186036700.0, 83139990.0, ] Initial stream = [ 1712487803.0, 521427311.0, 2587893192.0, 2004959789.0, 1186036700.0, 83139990.0, ] Number of tries = 1 Particle set: ------------------------------------------------------------------------ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000 3 [v] ubar 0 505 1-2 73 394.148 197.637 121.285 -318.720 0.000 4 [v] gl 506 502 1-2 53 15.776 -5.367 -6.339 13.413 0.000 5 [v] dbar 0 504 1-2 41 31.756 -20.332 -7.124 23.328 0.109 6 [v] gl 514 503 1-2 28 1.353 -0.347 -0.722 1.090 0.000 7 [v] d 512 0 1-2 49 10.129 -4.444 -4.425 7.948 0.109 8 [v] dbar 0 507 1-2 33 8.599 -4.823 -3.748 6.043 0.109 9 [v] d 507 0 1-2 32 37.553 -21.889 -9.332 29.050 0.109 10 [v] gl 511 501 1-2 70 0.731 0.526 0.329 -0.387 0.000 11 [v] gl 508 512 1-2 50 2.701 -0.872 -1.434 2.116 0.000 12 [v] gl 518 508 1-2 51 6.979 -3.177 -2.007 5.881 0.000 13 [v] gl 516 518 1-2 31 2.715 -1.000 -1.465 2.055 0.000 14 [v] gl 502 516 1-2 31 0.478 -0.034 -0.209 0.428 0.000 15 [v] u 519 0 1-2 37 116.385 -69.550 -25.558 89.750 0.000 16 [v] gl 504 520 1-2 40 20.320 -11.903 -3.780 16.029 0.000 17 [v] gl 520 509 1-2 39 79.097 -47.231 -16.452 61.277 0.000 18 [v] gl 509 519 1-2 38 51.664 -30.406 -11.283 40.216 0.000 19 [v] u 503 0 1-2 28 2.618 -0.825 -0.999 2.252 0.109 20 [v] ubar 0 510 1-2 55 16.051 -3.427 -6.974 14.041 0.109 21 [v] gl 510 506 1-2 54 99.097 -20.008 -46.307 85.297 0.000 22 [v] gl 523 514 1-2 68 1.384 1.292 0.247 0.429 0.000 23 [v] gl 513 523 1-2 29 1.343 1.028 -0.862 0.061 0.000 24 [v] gl 501 513 1-2 29 2.142 1.418 -1.605 0.023 0.000 25 [v] gl 524 511 1-2 71 7.731 3.180 2.673 -6.520 0.000 26 [v] gl 515 524 1-2 30 30.806 14.000 8.852 -25.974 0.000 27 [v] gl 505 515 1-2 30 58.444 26.555 17.238 -49.126 0.000 28 [v] u 1014 0 6,19 67 3.971 -1.172 -1.721 3.341 0.270 29 [v] gl 1001 1023 23-24 69 3.485 2.446 -2.468 0.084 0.068 30 [v] gl 1005 1024 26-27 72 89.250 40.554 26.090 -75.101 0.116 31 [v] gl 1002 1018 13-14 52 3.193 -1.035 -1.674 2.484 0.153 32 [v] d 507 0 9 34-36 37.553 -21.889 -9.332 29.050 0.109 33 [v] dbar 0 507 8 34-36 8.599 -4.823 -3.748 6.043 0.109 34 [r] omega 0 0 32-33 121-123 28.478 -16.323 -7.136 22.194 1.027 35 [r] k0 0 0 32-33 95 13.354 -7.601 -4.246 10.114 0.248 36 [r] k0 0 0 32-33 96 4.319 -2.787 -1.698 2.785 0.248 37 [v] u 519 0 15 42-48 116.385 -69.550 -25.558 89.750 0.000 38 [v] gl 509 519 18 42-48 51.664 -30.406 -11.283 40.216 0.000 39 [v] gl 520 509 17 42-48 79.097 -47.231 -16.452 61.277 0.000 40 [v] gl 504 520 16 42-48 20.320 -11.903 -3.780 16.029 0.000 41 [v] dbar 0 504 5 42-48 31.756 -20.332 -7.124 23.328 0.109 42 [o] pip 0 0 37-41 [none] 10.114 -6.098 -2.307 7.730 0.019 43 [o] pim 0 0 37-41 [none] 84.040 -49.726 -18.274 65.239 0.019 44 [r] pi0 0 0 37-41 124-125 54.428 -32.908 -11.005 41.932 0.018 45 [r] omega 0 0 37-41 126-128 62.091 -37.451 -13.997 47.499 0.603 46 [r] pi0 0 0 37-41 129-130 47.461 -27.835 -9.653 37.210 0.018 47 [r] rhop 0 0 37-41 97-98 15.196 -9.373 -3.312 11.475 0.440 48 [r] omega 0 0 37-41 131-133 25.892 -16.031 -5.649 19.516 0.656 49 [v] d 512 0 7 56-66 10.129 -4.444 -4.425 7.948 0.109 50 [v] gl 508 512 11 56-66 2.701 -0.872 -1.434 2.116 0.000 51 [v] gl 518 508 12 56-66 6.979 -3.177 -2.007 5.881 0.000 52 [v] gl 1002 1018 31 56-66 3.193 -1.035 -1.674 2.484 0.153 53 [v] gl 506 502 4 56-66 15.776 -5.367 -6.339 13.413 0.000 54 [v] gl 510 506 21 56-66 99.097 -20.008 -46.307 85.297 0.000 55 [v] ubar 0 510 20 56-66 16.051 -3.427 -6.974 14.041 0.109 56 [r] pi0 0 0 49-55 134-135 1.139 -0.588 -0.440 0.860 0.018 57 [o] pim 0 0 49-55 [none] 4.390 -1.654 -2.057 3.505 0.019 58 [o] pip 0 0 49-55 [none] 2.736 -1.577 -0.951 2.019 0.019 59 [o] pim 0 0 49-55 [none] 14.824 -6.078 -5.688 12.266 0.019 60 [o] pip 0 0 49-55 [none] 6.539 -1.950 -2.561 5.690 0.019 61 [r] kstar0 0 0 49-55 99-100 7.767 -1.939 -3.916 6.350 0.901 62 [r] kstarm 0 0 49-55 101-102 42.549 -9.087 -19.341 36.785 0.650 63 [r] rhop 0 0 49-55 103-104 12.677 -2.806 -6.099 10.728 0.537 64 [o] pim 0 0 49-55 [none] 5.452 -1.177 -2.388 4.755 0.019 65 [o] pip 0 0 49-55 [none] 8.687 -1.865 -3.655 7.656 0.019 66 [o] pim 0 0 49-55 [none] 47.166 -9.607 -22.062 40.566 0.019 67 [v] u 1014 0 28 74-94 3.971 -1.172 -1.721 3.341 0.270 68 [v] gl 523 514 22 74-94 1.384 1.292 0.247 0.429 0.000 69 [v] gl 1001 1023 29 74-94 3.485 2.446 -2.468 0.084 0.068 70 [v] gl 511 501 10 74-94 0.731 0.526 0.329 -0.387 0.000 71 [v] gl 524 511 25 74-94 7.731 3.180 2.673 -6.520 0.000 72 [v] gl 1005 1024 30 74-94 89.250 40.554 26.090 -75.101 0.116 73 [v] ubar 0 505 3 74-94 394.148 197.637 121.285 -318.720 0.000 74 [o] pip 0 0 67-73 [none] 0.875 0.338 -0.184 0.774 0.019 75 [r] etaprim 0 0 67-73 136-137 3.199 -0.573 -1.325 2.689 0.917 76 [r] k0 0 0 67-73 105 0.686 0.305 -0.302 -0.198 0.248 77 [o] km 0 0 67-73 [none] 0.994 0.607 -0.244 0.562 0.244 78 [o] pip 0 0 67-73 [none] 0.728 0.163 -0.664 -0.209 0.019 79 [o] pim 0 0 67-73 [none] 0.470 0.434 -0.103 0.047 0.019 80 [o] pip 0 0 67-73 [none] 0.188 -0.041 0.090 0.077 0.019 81 [r] Delta0 0 0 67-73 106-107 1.676 1.002 -0.403 -0.446 1.442 82 [r] rhom 0 0 67-73 108-109 1.439 0.734 0.359 -0.898 0.596 83 [r] Deltaba 0 0 67-73 110-111 4.093 2.242 0.802 -3.069 1.666 84 [r] k0 0 0 67-73 112 1.491 0.402 0.442 -1.272 0.248 85 [r] k0 0 0 67-73 113 36.983 17.160 10.544 -31.013 0.248 86 [o] pim 0 0 67-73 [none] 3.332 1.412 1.278 -2.730 0.019 87 [r] rho0 0 0 67-73 114-115 6.985 3.317 2.167 -5.705 0.546 88 [o] pip 0 0 67-73 [none] 46.895 21.610 13.650 -39.317 0.019 89 [r] rho0 0 0 67-73 116-117 38.716 19.439 12.146 -31.192 0.557 90 [o] pim 0 0 67-73 [none] 13.276 6.215 4.271 -10.926 0.019 91 [r] eta 0 0 67-73 138-140 42.684 21.185 13.092 -34.661 0.300 92 [r] rho0 0 0 67-73 118-119 127.042 63.779 38.927 -102.742 0.756 93 [o] pip 0 0 67-73 [none] 118.442 59.490 36.421 -95.724 0.019 94 [o] pim 0 0 67-73 [none] 50.506 25.244 15.470 -40.918 0.019 95 [r] kS0 0 0 35 141-142 13.354 -7.601 -4.246 10.114 0.248 96 [o] kL0 0 0 36 [none] 4.319 -2.787 -1.698 2.785 0.248 97 [o] pip 0 0 47 [none] 8.168 -5.029 -1.494 6.259 0.019 98 [r] pi0 0 0 47 143-144 7.028 -4.344 -1.818 5.215 0.018 99 [o] kp 0 0 61 [none] 3.124 -0.574 -1.467 2.651 0.244 100 [o] pim 0 0 61 [none] 4.643 -1.365 -2.449 3.699 0.019 101 [r] k0 0 0 62 120 32.352 -6.705 -14.742 28.002 0.248 102 [o] pim 0 0 62 [none] 10.196 -2.382 -4.598 8.782 0.019 103 [o] pip 0 0 63 [none] 7.027 -1.620 -3.087 6.100 0.019 104 [r] pi0 0 0 63 145-146 5.650 -1.186 -3.012 4.628 0.018 105 [r] kS0 0 0 76 147-148 0.686 0.305 -0.302 -0.198 0.248 106 [o] n 0 0 81 [none] 1.183 0.668 -0.185 -0.191 0.883 107 [r] pi0 0 0 81 149-150 0.493 0.334 -0.219 -0.255 0.018 108 [o] pim 0 0 82 [none] 1.282 0.744 0.342 -0.976 0.019 109 [r] pi0 0 0 82 151-152 0.157 -0.010 0.018 0.078 0.018 110 [o] nbar 0 0 83 [none] 3.280 1.982 0.778 -2.312 0.883 111 [o] pip 0 0 83 [none] 0.813 0.261 0.024 -0.757 0.019 112 [o] kL0 0 0 84 [none] 1.491 0.402 0.442 -1.272 0.248 113 [r] kS0 0 0 85 153-154 36.983 17.160 10.544 -31.013 0.248 114 [o] pip 0 0 87 [none] 3.251 1.304 1.246 -2.701 0.019 115 [o] pim 0 0 87 [none] 3.734 2.013 0.920 -3.004 0.019 116 [o] pip 0 0 89 [none] 13.153 6.325 4.223 -10.731 0.019 117 [o] pim 0 0 89 [none] 25.562 13.114 7.923 -20.461 0.019 118 [o] pip 0 0 92 [none] 42.115 21.117 12.551 -34.208 0.019 119 [o] pim 0 0 92 [none] 84.927 42.662 26.376 -68.534 0.019 120 [o] kL0 0 0 101 [none] 32.352 -6.705 -14.742 28.002 0.248 121 [o] pip 0 0 34 [none] 3.767 -2.312 -0.721 2.882 0.019 122 [o] pim 0 0 34 [none] 15.519 -8.669 -4.031 12.223 0.019 123 [r] pi0 0 0 34 155-156 9.192 -5.342 -2.384 7.089 0.018 124 [o] A 0 0 44 [none] 34.597 -20.966 -6.962 26.625 0.000 125 [o] A 0 0 44 [none] 19.831 -11.943 -4.044 15.307 0.000 126 [o] pip 0 0 45 [none] 3.861 -2.288 -0.938 2.961 0.019 127 [o] pim 0 0 45 [none] 34.953 -21.060 -7.717 26.807 0.019 128 [r] pi0 0 0 45 157-158 23.277 -14.102 -5.342 17.731 0.018 129 [o] A 0 0 46 [none] 44.462 -26.068 -9.014 34.872 0.000 130 [o] A 0 0 46 [none] 2.999 -1.767 -0.639 2.337 0.000 131 [o] pip 0 0 48 [none] 12.538 -7.753 -2.536 9.521 0.019 132 [o] pim 0 0 48 [none] 10.215 -6.450 -2.339 7.567 0.019 133 [r] pi0 0 0 48 159-160 3.139 -1.828 -0.775 2.428 0.018 134 [o] A 0 0 56 [none] 0.731 -0.434 -0.265 0.525 0.000 135 [o] A 0 0 56 [none] 0.409 -0.155 -0.175 0.335 0.000 136 [r] rho0 0 0 75 161-162 2.601 -0.505 -1.279 2.097 0.478 137 [o] A 0 0 75 [none] 0.597 -0.069 -0.046 0.592 0.000 138 [r] pi0 0 0 91 163-164 13.515 6.685 4.240 -10.953 0.018 139 [r] pi0 0 0 91 165-166 18.068 9.081 5.441 -14.642 0.018 140 [r] pi0 0 0 91 167-168 11.101 5.420 3.411 -9.066 0.018 141 [r] pi0 0 0 95 169-170 12.120 -6.897 -3.903 9.169 0.018 142 [r] pi0 0 0 95 171-172 1.235 -0.704 -0.343 0.945 0.018 143 [o] A 0 0 98 [none] 0.642 -0.426 -0.166 0.451 0.000 144 [o] A 0 0 98 [none] 6.386 -3.918 -1.652 4.765 0.000 145 [o] A 0 0 104 [none] 4.772 -0.991 -2.506 3.938 0.000 146 [o] A 0 0 104 [none] 0.878 -0.195 -0.506 0.691 0.000 147 [r] pi0 0 0 105 173-174 0.317 0.183 -0.195 0.105 0.018 148 [r] pi0 0 0 105 175-176 0.369 0.122 -0.107 -0.303 0.018 149 [o] A 0 0 107 [none] 0.424 0.325 -0.160 -0.220 0.000 150 [o] A 0 0 107 [none] 0.068 0.009 -0.058 -0.035 0.000 151 [o] A 0 0 109 [none] 0.119 -0.014 0.025 0.115 0.000 152 [o] A 0 0 109 [none] 0.038 0.004 -0.007 -0.037 0.000 153 [r] pi0 0 0 113 177-178 27.645 12.950 7.954 -23.092 0.018 154 [r] pi0 0 0 113 179-180 9.338 4.210 2.590 -7.921 0.018 155 [o] A 0 0 123 [none] 7.718 -4.523 -2.009 5.922 0.000 156 [o] A 0 0 123 [none] 1.474 -0.818 -0.375 1.168 0.000 157 [o] A 0 0 128 [none] 22.187 -13.420 -5.103 16.915 0.000 158 [o] A 0 0 128 [none] 1.090 -0.682 -0.239 0.815 0.000 159 [o] A 0 0 133 [none] 1.252 -0.727 -0.372 0.949 0.000 160 [o] A 0 0 133 [none] 1.887 -1.101 -0.403 1.479 0.000 161 [o] pip 0 0 136 [none] 0.242 0.085 -0.115 0.136 0.019 162 [o] pim 0 0 136 [none] 2.360 -0.590 -1.164 1.961 0.019 163 [o] A 0 0 138 [none] 5.461 2.734 1.758 -4.389 0.000 164 [o] A 0 0 138 [none] 8.054 3.951 2.482 -6.564 0.000 165 [o] A 0 0 139 [none] 10.687 5.423 3.182 -8.641 0.000 166 [o] A 0 0 139 [none] 7.382 3.657 2.259 -6.001 0.000 167 [o] A 0 0 140 [none] 4.948 2.389 1.581 -4.034 0.000 168 [o] A 0 0 140 [none] 6.153 3.031 1.830 -5.032 0.000 169 [o] A 0 0 141 [none] 2.675 -1.560 -0.881 1.987 0.000 170 [o] A 0 0 141 [none] 9.445 -5.337 -3.022 7.182 0.000 171 [o] A 0 0 142 [none] 0.240 -0.106 -0.110 0.186 0.000 172 [o] A 0 0 142 [none] 0.994 -0.599 -0.233 0.759 0.000 173 [o] A 0 0 147 [none] 0.235 0.189 -0.125 0.062 0.000 174 [o] A 0 0 147 [none] 0.082 -0.006 -0.070 0.043 0.000 175 [o] A 0 0 148 [none] 0.191 0.076 0.008 -0.175 0.000 176 [o] A 0 0 148 [none] 0.178 0.046 -0.115 -0.127 0.000 177 [o] A 0 0 153 [none] 18.676 8.708 5.339 -15.635 0.000 178 [o] A 0 0 153 [none] 8.970 4.242 2.615 -7.458 0.000 179 [o] A 0 0 154 [none] 2.290 0.980 0.643 -1.967 0.000 180 [o] A 0 0 154 [none] 7.048 3.230 1.947 -5.954 0.000 ------------------------------------------------------------------------ Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000 Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000 Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000 ------------------------------------------------------------------------ Shower settings: ------------------------------------------------------------------------ Master switches: ps_isr_active = F ps_fsr_active = T ps_tau_dec = F muli_active = F hadronization_active = T General settings: method = PYTHIA8 shower_verbose = F ps_mass_cutoff = 1.000000000000E+00 ps_max_n_flavors = 5 [ISR off] FSR settings: ps_fsr_lambda = 2.900000000000E-01 ps_fsr_alphas_running = T Matching Settings: mlm_matching = F ckkw_matching = F PYTHIA6 specific settings: ps_PYTHIA_PYGIVE = '' PYTHIA8 specific settings: ps_PYTHIA8_config = '' ps_PYTHIA8_config_file = '' ------------------------------------------------------------------------ Hadronization settings: ------------------------------------------------------------------------ Master switches: active = T General settings: hadron_method = PYTHIA8 pT generation parameters enhanced_fraction = 1.000000000000E-02 enhanced_width = 2.000000000000E+00 ======================================================================== Local variables: ------------------------------------------------------------------------ sqrts* = 1.00000E+03 sqrts_hat* => 1.00000E+03 n_in* => 2 n_out* => 84 n_tot* => 86 $process_id* => "pythia8_1_p1" process_num_id* => [unknown integer] sqme* => 5.04278E-02 sqme_ref* => 5.04278E-02 event_index* => 1 event_weight* => 1.00000E+00 event_weight_ref* => 1.00000E+00 event_excess* => 0.00000E+00 ------------------------------------------------------------------------ subevent: 1 prt(i:11|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02| 0.0000000E+00| 1) 2 prt(i:-11|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02| 0.0000000E+00| 2) 3 prt(o:211| 1.0113590E+01;-6.0979292E+00,-2.3068828E+00, 7.7303800E+00| 1.9479785E-02| 3) 4 prt(o:-211| 8.4039902E+01;-4.9725991E+01,-1.8273756E+01, 6.5238649E+01| 1.9479785E-02| 4) 5 prt(o:-211| 4.3899719E+00;-1.6539083E+00,-2.0572400E+00, 3.5049572E+00| 1.9479785E-02| 5) 6 prt(o:211| 2.7363905E+00;-1.5772713E+00,-9.5147913E-01, 2.0187263E+00| 1.9479785E-02| 6) 7 prt(o:-211| 1.4824310E+01;-6.0780011E+00,-5.6881380E+00, 1.2265548E+01| 1.9479785E-02| 7) 8 prt(o:211| 6.5388047E+00;-1.9503909E+00,-2.5613464E+00, 5.6896368E+00| 1.9479785E-02| 8) 9 prt(o:-211| 5.4515287E+00;-1.1773822E+00,-2.3883897E+00, 4.7548976E+00| 1.9479785E-02| 9) 10 prt(o:211| 8.6870902E+00;-1.8646192E+00,-3.6554241E+00, 7.6555291E+00| 1.9479785E-02| 10) 11 prt(o:-211| 4.7166238E+01;-9.6071061E+00,-2.2061559E+01, 4.0566311E+01| 1.9479785E-02| 11) 12 prt(o:211| 8.7542410E-01; 3.3813017E-01,-1.8410890E-01, 7.7373088E-01| 1.9479785E-02| 12) 13 prt(o:-321| 9.9362455E-01; 6.0668187E-01,-2.4436729E-01, 5.6195333E-01| 2.4371994E-01| 13) 14 prt(o:211| 7.2799291E-01; 1.6254703E-01,-6.6369766E-01,-2.0875289E-01| 1.9479785E-02| 14) 15 prt(o:-211| 4.6976377E-01; 4.3411628E-01,-1.0282743E-01, 4.6559518E-02| 1.9479785E-02| 15) 16 prt(o:211| 1.8772946E-01;-4.0912859E-02, 9.0482963E-02, 7.6821471E-02| 1.9479785E-02| 16) 17 prt(o:-211| 3.3321947E+00; 1.4123984E+00, 1.2784484E+00,-2.7303374E+00| 1.9479785E-02| 17) 18 prt(o:211| 4.6895496E+01; 2.1609917E+01, 1.3650255E+01,-3.9317300E+01| 1.9479785E-02| 18) 19 prt(o:-211| 1.3276496E+01; 6.2150233E+00, 4.2711561E+00,-1.0925959E+01| 1.9479785E-02| 19) 20 prt(o:211| 1.1844215E+02; 5.9489636E+01, 3.6421176E+01,-9.5723580E+01| 1.9479785E-02| 20) 21 prt(o:-211| 5.0506255E+01; 2.5243810E+01, 1.5470435E+01,-4.0917943E+01| 1.9479785E-02| 21) 22 prt(o:130| 4.3191353E+00;-2.7871461E+00,-1.6980484E+00, 2.7849170E+00| 2.4761571E-01| 22) 23 prt(o:211| 8.1681659E+00;-5.0288077E+00,-1.4935747E+00, 6.2593755E+00| 1.9479785E-02| 23) 24 prt(o:321| 3.1235191E+00;-5.7448239E-01,-1.4674577E+00, 2.6512619E+00| 2.4371994E-01| 24) 25 prt(o:-211| 4.6433642E+00;-1.3646400E+00,-2.4485153E+00, 3.6991731E+00| 1.9479785E-02| 25) 26 prt(o:-211| 1.0196417E+01;-2.3820963E+00,-4.5981725E+00, 8.7823608E+00| 1.9479785E-02| 26) 27 prt(o:211| 7.0270768E+00;-1.6198427E+00,-3.0869827E+00, 6.0997521E+00| 1.9479785E-02| 27) 28 prt(o:2112| 1.1830511E+00; 6.6793443E-01,-1.8478258E-01,-1.9114703E-01| 8.8279178E-01| 28) 29 prt(o:-211| 1.2816533E+00; 7.4382158E-01, 3.4165614E-01,-9.7629707E-01| 1.9479785E-02| 29) 30 prt(o:-2112| 3.2798944E+00; 1.9816153E+00, 7.7750790E-01,-2.3116222E+00| 8.8279178E-01| 30) 31 prt(o:211| 8.1345963E-01; 2.6057901E-01, 2.4338299E-02,-7.5745826E-01| 1.9479785E-02| 31) 32 prt(o:130| 1.4910003E+00; 4.0230525E-01, 4.4220872E-01,-1.2720330E+00| 2.4761571E-01| 32) 33 prt(o:211| 3.2508235E+00; 1.3038623E+00, 1.2462409E+00,-2.7009628E+00| 1.9479785E-02| 33) 34 prt(o:-211| 3.7337820E+00; 2.0131964E+00, 9.2034417E-01,-3.0036070E+00| 1.9479785E-02| 34) 35 prt(o:211| 1.3153348E+01; 6.3246260E+00, 4.2231403E+00,-1.0731043E+01| 1.9479785E-02| 35) 36 prt(o:-211| 2.5562326E+01; 1.3114208E+01, 7.9229234E+00,-2.0461130E+01| 1.9479785E-02| 36) 37 prt(o:211| 4.2114878E+01; 2.1116966E+01, 1.2550599E+01,-3.4208182E+01| 1.9479785E-02| 37) 38 prt(o:-211| 8.4927346E+01; 4.2662189E+01, 2.6376010E+01,-6.8533775E+01| 1.9479785E-02| 38) 39 prt(o:130| 3.2352477E+01;-6.7049323E+00,-1.4742434E+01, 2.8002494E+01| 2.4761571E-01| 39) 40 prt(o:211| 3.7672329E+00;-2.3120513E+00,-7.2146021E-01, 2.8820962E+00| 1.9479785E-02| 40) 41 prt(o:-211| 1.5518609E+01;-8.6690195E+00,-4.0314266E+00, 1.2223070E+01| 1.9479785E-02| 41) 42 prt(o:22| 3.4596799E+01;-2.0965690E+01,-6.9618312E+00, 2.6625387E+01| 0.0000000E+00| 42) 43 prt(o:22| 1.9831211E+01;-1.1942722E+01,-4.0435328E+00, 1.5306801E+01| 0.0000000E+00| 43) 44 prt(o:211| 3.8606340E+00;-2.2883098E+00,-9.3758570E-01, 2.9613488E+00| 1.9479785E-02| 44) 45 prt(o:-211| 3.4953319E+01;-2.1060447E+01,-7.7168172E+00, 2.6807151E+01| 1.9479785E-02| 45) 46 prt(o:22| 4.4462182E+01;-2.6068419E+01,-9.0140475E+00, 3.4872198E+01| 0.0000000E+00| 46) 47 prt(o:22| 2.9987380E+00;-1.7667372E+00,-6.3864935E-01, 2.3373481E+00| 0.0000000E+00| 47) 48 prt(o:211| 1.2538122E+01;-7.7533727E+00,-2.5356655E+00, 9.5205374E+00| 1.9479785E-02| 48) 49 prt(o:-211| 1.0215289E+01;-6.4496085E+00,-2.3390549E+00, 7.5672994E+00| 1.9479785E-02| 49) 50 prt(o:22| 7.3072686E-01;-4.3360547E-01,-2.6498317E-01, 5.2510185E-01| 0.0000000E+00| 50) 51 prt(o:22| 4.0867001E-01;-1.5459155E-01,-1.7524614E-01, 3.3526322E-01| 0.0000000E+00| 51) 52 prt(o:22| 5.9728587E-01;-6.8595735E-02,-4.5978371E-02, 5.9154968E-01| 0.0000000E+00| 52) 53 prt(o:22| 6.4194690E-01;-4.2596364E-01,-1.6611101E-01, 4.5061949E-01| 0.0000000E+00| 53) 54 prt(o:22| 6.3863341E+00;-3.9184141E+00,-1.6521880E+00, 4.7646164E+00| 0.0000000E+00| 54) 55 prt(o:22| 4.7715117E+00;-9.9139040E-01,-2.5058248E+00, 3.9376784E+00| 0.0000000E+00| 55) 56 prt(o:22| 8.7832420E-01;-1.9507881E-01,-5.0631084E-01, 6.9068588E-01| 0.0000000E+00| 56) 57 prt(o:22| 4.2444068E-01; 3.2540992E-01,-1.6033508E-01,-2.2034277E-01| 0.0000000E+00| 57) 58 prt(o:22| 6.8348643E-02; 8.9729238E-03,-5.8181619E-02,-3.4726400E-02| 0.0000000E+00| 58) 59 prt(o:22| 1.1898178E-01;-1.4155885E-02, 2.5167306E-02, 1.1542479E-01| 0.0000000E+00| 59) 60 prt(o:22| 3.8285723E-02; 4.2381727E-03,-7.4733211E-03,-3.7309301E-02| 0.0000000E+00| 60) 61 prt(o:22| 7.7177196E+00;-4.5234388E+00,-2.0085654E+00, 5.9217701E+00| 0.0000000E+00| 61) 62 prt(o:22| 1.4743379E+00;-8.1844573E-01,-3.7499908E-01, 1.1675592E+00| 0.0000000E+00| 62) 63 prt(o:22| 2.2187128E+01;-1.3420243E+01,-5.1030500E+00, 1.6915218E+01| 0.0000000E+00| 63) 64 prt(o:22| 1.0897363E+00;-6.8215241E-01,-2.3925294E-01, 8.1544544E-01| 0.0000000E+00| 64) 65 prt(o:22| 1.2517601E+00;-7.2711018E-01,-3.7205485E-01, 9.4857227E-01| 0.0000000E+00| 65) 66 prt(o:22| 1.8871889E+00;-1.1006150E+00,-4.0268162E-01, 1.4791808E+00| 0.0000000E+00| 66) 67 prt(o:211| 2.4165378E-01; 8.4762311E-02,-1.1492570E-01, 1.3610363E-01| 1.9479785E-02| 67) 68 prt(o:-211| 2.3597218E+00;-5.8954215E-01,-1.1638755E+00, 1.9612855E+00| 1.9479785E-02| 68) 69 prt(o:22| 5.4613564E+00; 2.7335823E+00, 1.7578398E+00,-4.3890706E+00| 0.0000000E+00| 69) 70 prt(o:22| 8.0536453E+00; 3.9510421E+00, 2.4824818E+00,-6.5641263E+00| 0.0000000E+00| 70) 71 prt(o:22| 1.0686918E+01; 5.4233409E+00, 3.1822214E+00,-8.6412414E+00| 0.0000000E+00| 71) 72 prt(o:22| 7.3815469E+00; 3.6573540E+00, 2.2588351E+00,-6.0007216E+00| 0.0000000E+00| 72) 73 prt(o:22| 4.9479844E+00; 2.3888328E+00, 1.5814628E+00,-4.0342289E+00| 0.0000000E+00| 73) 74 prt(o:22| 6.1525310E+00; 3.0309293E+00, 1.8295406E+00,-5.0318870E+00| 0.0000000E+00| 74) 75 prt(o:22| 2.6749393E+00;-1.5596613E+00,-8.8067864E-01, 1.9867465E+00| 0.0000000E+00| 75) 76 prt(o:22| 9.4445911E+00;-5.3373987E+00,-3.0219016E+00, 7.1819626E+00| 0.0000000E+00| 76) 77 prt(o:22| 2.4046111E-01;-1.0578065E-01,-1.1001694E-01, 1.8581784E-01| 0.0000000E+00| 77) 78 prt(o:22| 9.9446756E-01;-5.9859802E-01,-2.3295083E-01, 7.5919697E-01| 0.0000000E+00| 78) 79 prt(o:22| 2.3462851E-01; 1.8882524E-01,-1.2473090E-01, 6.1949718E-02| 0.0000000E+00| 79) 80 prt(o:22| 8.2321157E-02;-6.2573286E-03,-6.9993308E-02, 4.2878382E-02| 0.0000000E+00| 80) 81 prt(o:22| 1.9122342E-01; 7.6083575E-02, 8.2167141E-03,-1.7524318E-01| 0.0000000E+00| 81) 82 prt(o:22| 1.7775249E-01; 4.5929077E-02,-1.1509604E-01,-1.2743379E-01| 0.0000000E+00| 82) 83 prt(o:22| 1.8675538E+01; 8.7078539E+00, 5.3394203E+00,-1.5634564E+01| 0.0000000E+00| 83) 84 prt(o:22| 8.9695084E+00; 4.2422662E+00, 2.6146684E+00,-7.4577991E+00| 0.0000000E+00| 84) 85 prt(o:22| 2.2898065E+00; 9.8030452E-01, 6.4268399E-01,-1.9670216E+00| 0.0000000E+00| 85) 86 prt(o:22| 7.0478755E+00; 3.2295846E+00, 1.9472010E+00,-5.9540524E+00| 0.0000000E+00| 86) ======================================================================== Index: trunk/share/tests/functional_tests/ref-output/vars.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/vars.ref (revision 8323) +++ trunk/share/tests/functional_tests/ref-output/vars.ref (revision 8324) @@ -1,376 +1,377 @@ ?openmp_logging = false [user variable] foo = -7.800000000000E-02 [user variable] bar = 1 [user variable] a = 2.010000000000E-05 [user variable] i = 3 [user variable] foo = 2.922000000000E+00 [user variable] i = 9 [user variable] foo = 2.922000000000E+00 [user variable] bar = 1 [user variable] i = 9 [user variable] k = 1 [user variable] k2 = 1.000000000000E+00 [user variable] i = -1 [user variable] k = 2 [user variable] k2 = 4.000000000000E+00 [user variable] i = -2 [user variable] k = 3 [user variable] k2 = 9.000000000000E+00 [user variable] i = -3 [user variable] k = 4 [user variable] k2 = 1.600000000000E+01 [user variable] i = -4 [user variable] k = 8 [user variable] k2 = 6.400000000000E+01 [user variable] i = -8 [user variable] i = 9 [user variable] MW = 7.980000000000E+01 [user variable] MW = 7.980000000000E+01 SM.mtau => 8.000000000000E-01 SM.mW => 8.011900000000E+01 SM.mW => 8.011900000000E+01 SM.sw* => 4.775372811515E-01 SM.mW => 7.500000000000E+01 SM.sw* => 5.688014954824E-01 SM.mW => 8.000000000000E+01 SM.sw* => 4.799305327664E-01 SM.mW => 8.050000000000E+01 SM.sw* => 4.697684723671E-01 SM.mW => 8.100000000000E+01 SM.sw* => 4.593162187090E-01 SM.mW => 8.150000000000E+01 SM.sw* => 4.485534858838E-01 SM.mW => 8.200000000000E+01 SM.sw* => 4.374573583998E-01 SM.mW => 8.300000000000E+01 SM.sw* => 4.141569403361E-01 SM.mW => 8.469722796445E+01 SM.sw* => 3.705366373038E-01 SM.mW => 8.642916174533E+01 SM.sw* => 3.188332912310E-01 SM.mW => 8.819651102555E+01 SM.sw* => 2.540459583362E-01 SM.mW => 9.000000000000E+01 SM.sw* => 1.609055729882E-01 mW is 80.119 and sw is: 0.4775 seed = 32 seed = 32 seed = 30 seed = 30 seed = 28 seed = 28 seed = 26 seed = 26 seed = 24 seed = 24 seed = 22 seed = 22 seed = 20 seed = 20 seed = 18 seed = 18 seed = 16 seed = 16 seed = 14 seed = 14 seed = 12 seed = 12 seed = 10 seed = 10 seed = 8 seed = 8 seed = 6 seed = 6 seed = 4 seed = 4 seed = 2 seed = 2 [user variable] $str = "foo" [user variable] $str = "bar" [user variable] ?ok = false [user variable] ?ok = false [user variable] ?ok = true ?sf_trace = false ?sf_allow_s_mapping = true ?hoppet_b_matching = false ?isr_recoil = false ?isr_keep_energy = false ?isr_handler = false ?epa_recoil = false ?epa_keep_energy = false ?epa_handler = false ?ewa_recoil = false ?ewa_keep_energy = false ?circe1_photon1 = false ?circe1_photon2 = false ?circe1_generate = true ?circe1_map = true ?circe1_with_radiation = false ?circe2_polarized = true ?beam_events_warn_eof = true ?energy_scan_normalize = false ?logging => true ?report_progress = true [user variable] ?me_verbose = false ?omega_write_phs_output = false ?read_color_factors = true ?slha_read_input = true ?slha_read_spectrum = true ?slha_read_decays = false ?alphas_is_fixed = true ?alphas_from_lhapdf = false ?alphas_from_pdf_builtin = false ?alphas_from_mz = false ?alphas_from_lambda_qcd = false ?fatal_beam_decay = true ?helicity_selection_active = true ?vis_diags = false ?vis_diags_color = false ?check_event_file = true ?unweighted = true ?negative_weights = false ?resonance_history = false ?keep_beams = false ?keep_remnants = true ?recover_beams = true ?update_event = false ?update_sqme = false ?update_weight = false ?use_alphas_from_file = false ?use_scale_from_file = false ?allow_decays = true ?auto_decays = false ?auto_decays_radiative = false ?decay_rest_frame = false ?isotropic_decay = false ?diagonal_decay = false ?polarized_events = false ?colorize_subevt = false ?pacify = false ?out_advance = true ?stratified = true ?use_vamp_equivalences = true ?vamp_verbose = false ?vamp_history_global = true ?vamp_history_global_verbose = false ?vamp_history_channels = false ?vamp_history_channels_verbose = false ?integration_timer = true ?check_grid_file = true ?vis_channels = false ?check_phs_file = true ?phs_only = false ?phs_keep_nonresonant = true ?phs_step_mapping = true ?phs_step_mapping_exp = true ?phs_s_mapping = true ?vis_history = false ?normalize_bins = false ?y_log = false ?x_log = false [undefined] ?draw_histogram = [unknown logical] [undefined] ?draw_base = [unknown logical] [undefined] ?draw_piecewise = [unknown logical] [undefined] ?fill_curve = [unknown logical] [undefined] ?draw_curve = [unknown logical] [undefined] ?draw_errors = [unknown logical] [undefined] ?draw_symbols = [unknown logical] ?analysis_file_only = false ?keep_flavors_when_clustering = false ?sample_pacify = false ?sample_select = true ?read_raw = true ?write_raw = true ?debug_process = true ?debug_transforms = true ?debug_decay = true ?debug_verbose = true ?dump_compressed = false ?dump_weights = false ?dump_summary = false ?dump_screen = false ?hepevt_ensure_order = false ?lhef_write_sqme_prc = true ?lhef_write_sqme_ref = false ?lhef_write_sqme_alt = true ?hepmc_output_cross_section = false ?hepmc3_hepmc2mode = false ?allow_shower = true ?ps_fsr_active = false ?ps_isr_active = false ?ps_taudec_active = false ?muli_active = false ?shower_verbose = false ?ps_isr_alphas_running = true ?ps_fsr_alphas_running = true ?ps_isr_pt_ordered = false ?ps_isr_angular_ordered = true ?ps_isr_only_onshell_emitted_partons = false ?allow_hadronization = true ?hadronization_active = false ?ps_tauola_photos = false ?ps_tauola_transverse = false ?ps_tauola_dec_rad_cor = true ?ps_tauola_pol_vector = false ?mlm_matching = false ?powheg_matching = false ?powheg_use_singular_jacobian = false ?powheg_rebuild_grids = false ?powheg_test_sudakov = false ?powheg_disable_sudakov = false ?ckkw_matching = false ?omega_openmp => false ?openmp_is_active* = false ?openmp_logging = false ?mpi_logging = false ?test_soft_limit = false ?test_coll_limit = false ?test_anti_coll_limit = false ?virtual_collinear_resonance_aware = true ?openloops_use_cms = true ?openloops_switch_off_muon_yukawa = false ?openloops_use_collier = true ?disable_subtraction = false ?vis_fks_regions = false ?combined_nlo_integration = false ?fixed_order_nlo_events = false ?check_event_weights_against_xsection = false ?keep_failed_events = false ?nlo_use_born_scale = false ?nlo_cut_all_sqmes = false ?nlo_use_real_partition = false ?rebuild_library = true ?recompile_library = false ?rebuild_phase_space = true ?rebuild_grids = true ?powheg_rebuild_grids = true ?rebuild_events = true [user variable] ?ok = true [user variable] $str = "foo" [user variable] $str = "foobar" $sf_trace_file = "" $lhapdf_dir = "" $lhapdf_file = "" $lhapdf_photon_file = "" $pdf_builtin_set = "CTEQ6L" $isr_handler_mode = "trivial" $epa_handler_mode = "trivial" $circe1_acc = "SBAND" [undefined] $circe2_file = [unknown string] $circe2_design = "*" [undefined] $beam_events_file = [unknown string] [undefined] $job_id = [unknown string] [undefined] $compile_workspace = [unknown string] $model_name = "SM" $method = "omega" $restrictions = "" $omega_flags = "" $library_name = "vars_lib" $rng_method = "tao" $event_file_version = "" $polarization_mode = "helicity" $out_file = "" $integration_method = "vamp" $run_id = "" [undefined] $integrate_workspace = [unknown string] +$vamp_grid_format = "ascii" $phs_method = "default" $phs_file = "" $obs_label = "" $obs_unit = "" $title = "" $description = "" $x_label = "" $y_label = "" $gmlcode_bg = "" $gmlcode_fg = "" [undefined] $fill_options = [unknown string] [undefined] $draw_options = [unknown string] [undefined] $err_options = [unknown string] [undefined] $symbol = [unknown string] $sample = "" $sample_normalization = "auto" $rescan_input_format = "raw" $extension_raw = "evx" $extension_default = "evt" $debug_extension = "debug" $dump_extension = "pset.dat" $extension_hepevt = "hepevt" $extension_ascii_short = "short.evt" $extension_ascii_long = "long.evt" $extension_athena = "athena.evt" $extension_mokka = "mokka.evt" $lhef_version = "2.0" $lhef_extension = "lhe" $extension_lha = "lha" $extension_hepmc = "hepmc" $extension_lcio = "slcio" $extension_stdhep = "hep" $extension_stdhep_up = "up.hep" $extension_stdhep_ev4 = "ev4.hep" $extension_hepevt_verb = "hepevt.verb" $extension_lha_verb = "lha.verb" $shower_method = "WHIZARD" $ps_PYTHIA_PYGIVE = "" $ps_PYTHIA8_config = "" $ps_PYTHIA8_config_file = "" $hadronization_method = "PYTHIA6" $born_me_method = "" $loop_me_method = "" $correlation_me_method = "" $real_tree_me_method = "" $dglap_me_method = "" $select_alpha_regions = "" $virtual_selection = "Full" $blha_ew_scheme = "alpha_qed" $openloops_extra_cmd = "" $fks_mapping_type = "default" $resonances_exclude_particles = "default" $gosam_filter_lo = "" $gosam_filter_nlo = "" $gosam_symmetries = "family,generation" $gosam_fc = "" $dalitz_plot = "" $nlo_correction_type = "QCD" $exclude_gauge_splittings = "c:b:t:e2:e3" $fc => Fortran-compiler $fcflags => Fortran-flags [user variable] $str = "foobar" [user variable] q = PDG(2) [user variable] q = PDG(2, 1, -2, -1) Q is only local and hence not not defined ****************************************************************************** *** ERROR: show: object 'Q' not found ****************************************************************************** | (WHIZARD run continues) SM.u* = PDG(2) [user variable] q = PDG(2, 1, -2, -1) [user variable] i = 1 one = 1 [user variable] i = 2 two [user variable] i = 3 three [user variable] i = 4 four [user variable] i = -1 [user variable] $str = "i<=0" [user variable] i = 1 [user variable] $str = "i>0" [user variable] i = 2 [user variable] $str = "i>1" Testing the complex calculus [user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00) [user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00) [user variable] ia = 2 [user variable] ia = 2 [user variable] ra = 2.000000000000E+00 [user variable] ra = 2.000000000000E+00 [user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00) [user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00) ?pacify = true [user variable] cc = ( 1.00000E+00, 0.00000E+00) ?pacify = true [user variable] cc = ( 1.00000E+00, 0.00000E+00) | There were 1 error(s) and no warnings. | WHIZARD run finished. |=============================================================================| Index: trunk/share/tests/functional_tests/ref-output/event_eff_2.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/event_eff_2.ref (revision 8323) +++ trunk/share/tests/functional_tests/ref-output/event_eff_2.ref (revision 8324) @@ -1,255 +1,259 @@ ?openmp_logging = false ?vis_history = false ?integration_timer = false seed = 0 $method = "omega" | Process library 'event_eff_2_lib': recorded process 'event_eff_2_p1' | Process library 'event_eff_2_lib': compiling ... | Process library 'event_eff_2_lib': writing makefile | Process library 'event_eff_2_lib': removing old files | Process library 'event_eff_2_lib': writing driver | Process library 'event_eff_2_lib': creating source code | Process library 'event_eff_2_lib': compiling sources | Process library 'event_eff_2_lib': linking | Process library 'event_eff_2_lib': loading | Process library 'event_eff_2_lib': ... success. $phs_method = "wood" $integration_method = "vamp2" sqrts = 1.000000000000E+03 openmp_num_threads = 1 n_events = 1000 | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 0 | Initializing integration for process event_eff_2_p1: | Beam structure: [any particles] | Beam data (collision): | e- (mass = 0.0000000E+00 GeV) | e+ (mass = 0.0000000E+00 GeV) | sqrts = 1.000000000000E+03 GeV | Phase space: generating configuration ... | Phase space: ... success. | Phase space: writing configuration file 'event_eff_2_p1.i1.phs' | ------------------------------------------------------------------------ | Process [scattering]: 'event_eff_2_p1' | Library name = 'event_eff_2_lib' | Process index = 1 | Process components: | 1: 'event_eff_2_p1_i1': e-, e+ => m-, m+ [omega] | ------------------------------------------------------------------------ | Phase space: 1 channels, 2 dimensions | Phase space: found 1 channel, collected in 1 grove. | Phase space: Using 1 equivalence between channels. | Phase space: wood Warning: No cuts have been defined. | Starting integration for process 'event_eff_2_p1' | Integrate: iterations = 3:1000:"g", 3:1000 | Integrator: 1 chains, 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] set chain: use chained weights. +| VAMP2: Initialize new grids and write to file 'event_eff_2_p1.m1.vg2'. +| VAMP2: set chain: use chained weights. 1 800 8.6990044E+01 7.71E-02 0.09 0.03* 66.87 2 800 8.6806923E+01 6.12E-02 0.07 0.02* 49.30 3 800 8.6830909E+01 6.08E-02 0.07 0.02* 66.03 |-----------------------------------------------------------------------------| 3 2400 8.6859799E+01 3.76E-02 0.04 0.02 66.03 1.91 3 |-----------------------------------------------------------------------------| 4 800 8.6934110E+01 6.29E-02 0.07 0.02 68.86 5 800 8.7037881E+01 6.11E-02 0.07 0.02* 68.91 6 800 8.6971940E+01 6.32E-02 0.07 0.02 68.94 |-----------------------------------------------------------------------------| 6 2400 8.6982429E+01 3.60E-02 0.04 0.02 68.94 0.72 3 |=============================================================================| | Starting simulation for process 'event_eff_2_p1' | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 1 | Simulation: requested number of events = 1000 | corr. to luminosity [fb-1] = 1.1497E+01 | Events: writing to raw file 'event_eff_2_p1.evx' | Events: generating 1000 unweighted, unpolarized events ... | Events: event normalization mode '1' | ... event sample complete. | Events: actual unweighting efficiency = 69.64 % | Events: closing raw file 'event_eff_2_p1.evx' | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 2 | Initializing integration for process event_eff_2_p1: | Beam structure: [any particles] | Beam data (collision): | e- (mass = 0.0000000E+00 GeV) | e+ (mass = 0.0000000E+00 GeV) | sqrts = 1.000000000000E+03 GeV | Phase space: generating configuration ... | Phase space: ... success. | Phase space: writing configuration file 'event_eff_2_p1.i1.phs' | ------------------------------------------------------------------------ | Process [scattering]: 'event_eff_2_p1' | Library name = 'event_eff_2_lib' | Process index = 1 | Process components: | 1: 'event_eff_2_p1_i1': e-, e+ => m-, m+ [omega] | ------------------------------------------------------------------------ | Phase space: 1 channels, 2 dimensions | Phase space: found 1 channel, collected in 1 grove. | Phase space: Using 1 equivalence between channels. | Phase space: wood Warning: No cuts have been defined. | Using user-defined reweighting factor. | Starting integration for process 'event_eff_2_p1' | Integrate: iterations = 3:1000:"g", 3:1000 | Integrator: 1 chains, 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] set chain: use chained weights. +| VAMP2: Initialize new grids and write to file 'event_eff_2_p1.m1.vg2'. +| VAMP2: set chain: use chained weights. 1 800 8.6787815E+01 1.63E-01 0.19 0.05* 33.31 2 800 8.7189309E+01 1.36E-01 0.16 0.04* 70.58 3 800 8.6997292E+01 1.34E-01 0.15 0.04* 42.41 |-----------------------------------------------------------------------------| 3 2400 8.7014301E+01 8.22E-02 0.09 0.05 42.41 1.81 3 |-----------------------------------------------------------------------------| 4 800 8.6954300E+01 1.24E-01 0.14 0.04* 67.35 5 800 8.6963253E+01 1.21E-01 0.14 0.04* 67.60 6 800 8.6831489E+01 1.26E-01 0.15 0.04 67.49 |-----------------------------------------------------------------------------| 6 2400 8.6918249E+01 7.14E-02 0.08 0.04 67.49 0.35 3 |=============================================================================| | Starting simulation for process 'event_eff_2_p1' | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 3 | Simulation: requested number of events = 1000 | corr. to luminosity [fb-1] = 1.1505E+01 | Events: writing to raw file 'event_eff_2_p1.evx' | Events: generating 1000 unweighted, unpolarized events ... | Events: event normalization mode '1' | ... event sample complete. | Events: actual unweighting efficiency = 69.40 % Warning: Encountered events with excess weight: 3 events ( 0.300 %) | Maximum excess weight = 2.209E-03 | Average excess weight = 5.218E-06 | Events: closing raw file 'event_eff_2_p1.evx' ?negative_weights = true | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 4 | Initializing integration for process event_eff_2_p1: | Beam structure: [any particles] | Beam data (collision): | e- (mass = 0.0000000E+00 GeV) | e+ (mass = 0.0000000E+00 GeV) | sqrts = 1.000000000000E+03 GeV | Phase space: generating configuration ... | Phase space: ... success. | Phase space: writing configuration file 'event_eff_2_p1.i1.phs' | ------------------------------------------------------------------------ | Process [scattering]: 'event_eff_2_p1' | Library name = 'event_eff_2_lib' | Process index = 1 | Process components: | 1: 'event_eff_2_p1_i1': e-, e+ => m-, m+ [omega] | ------------------------------------------------------------------------ | Phase space: 1 channels, 2 dimensions | Phase space: found 1 channel, collected in 1 grove. | Phase space: Using 1 equivalence between channels. | Phase space: wood Warning: No cuts have been defined. | Using user-defined reweighting factor. | Starting integration for process 'event_eff_2_p1' | Integrate: iterations = 3:1000:"g", 3:1000 | Integrator: 1 chains, 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] set chain: use chained weights. +| VAMP2: Initialize new grids and write to file 'event_eff_2_p1.m1.vg2'. +| VAMP2: set chain: use chained weights. 1 800 -8.6707576E+01 1.62E-01 0.19 0.05* 33.99 2 800 -8.6712716E+01 1.29E-01 0.15 0.04* 72.70 3 800 -8.6793578E+01 1.22E-01 0.14 0.04* 52.78 |-----------------------------------------------------------------------------| 3 2400 -8.6744179E+01 7.78E-02 0.09 0.04 52.78 0.14 3 |-----------------------------------------------------------------------------| 4 800 -8.6852754E+01 1.17E-01 0.13 0.04* 61.08 5 800 -8.7096507E+01 1.20E-01 0.14 0.04 61.18 6 800 -8.6946719E+01 1.24E-01 0.14 0.04 61.19 |-----------------------------------------------------------------------------| 6 2400 -8.6963742E+01 6.95E-02 0.08 0.04 61.19 1.07 3 |=============================================================================| | Starting simulation for process 'event_eff_2_p1' | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 5 | Simulation: requested number of events = 1000 | corr. to luminosity [fb-1] = -1.1499E+01 | Events: writing to raw file 'event_eff_2_p1.evx' | Events: generating 1000 unweighted, unpolarized events ... | Events: event normalization mode '1' | ... event sample complete. | Events: actual unweighting efficiency = 60.10 % | Events: closing raw file 'event_eff_2_p1.evx' ?negative_weights = true | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 6 | Initializing integration for process event_eff_2_p1: | Beam structure: [any particles] | Beam data (collision): | e- (mass = 0.0000000E+00 GeV) | e+ (mass = 0.0000000E+00 GeV) | sqrts = 1.000000000000E+03 GeV | Phase space: generating configuration ... | Phase space: ... success. | Phase space: writing configuration file 'event_eff_2_p1.i1.phs' | ------------------------------------------------------------------------ | Process [scattering]: 'event_eff_2_p1' | Library name = 'event_eff_2_lib' | Process index = 1 | Process components: | 1: 'event_eff_2_p1_i1': e-, e+ => m-, m+ [omega] | ------------------------------------------------------------------------ | Phase space: 1 channels, 2 dimensions | Phase space: found 1 channel, collected in 1 grove. | Phase space: Using 1 equivalence between channels. | Phase space: wood Warning: No cuts have been defined. | Using user-defined reweighting factor. | Starting integration for process 'event_eff_2_p1' | Integrate: iterations = 3:1000:"g", 3:1000 | Integrator: 1 chains, 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] set chain: use chained weights. +| VAMP2: Initialize new grids and write to file 'event_eff_2_p1.m1.vg2'. +| VAMP2: set chain: use chained weights. 1 800 -4.3608894E+01 1.58E-01 0.36 0.10* 29.56 2 800 -4.3545396E+01 1.44E-01 0.33 0.09* 62.37 3 800 -4.3426646E+01 1.39E-01 0.32 0.09* 36.98 |-----------------------------------------------------------------------------| 3 2400 -4.3519369E+01 8.45E-02 0.19 0.10 36.98 0.40 3 |-----------------------------------------------------------------------------| 4 800 -4.3231798E+01 1.35E-01 0.31 0.09* 59.81 5 800 -4.3492986E+01 1.35E-01 0.31 0.09* 60.20 6 800 -4.3353281E+01 1.24E-01 0.29 0.08* 60.38 |-----------------------------------------------------------------------------| 6 2400 -4.3359035E+01 7.58E-02 0.17 0.09 60.38 0.93 3 |=============================================================================| | Starting simulation for process 'event_eff_2_p1' | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 7 | Simulation: requested number of events = 1000 | corr. to luminosity [fb-1] = -2.3063E+01 | Events: writing to raw file 'event_eff_2_p1.evx' | Events: generating 1000 unweighted, unpolarized events ... | Events: event normalization mode '1' | ... event sample complete. | Events: actual unweighting efficiency = 63.37 % | Events: closing raw file 'event_eff_2_p1.evx' | There were no errors and 5 warning(s). | WHIZARD run finished. |=============================================================================| Index: trunk/share/tests/functional_tests/ref-output/testproc_11.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/testproc_11.ref (revision 8323) +++ trunk/share/tests/functional_tests/ref-output/testproc_11.ref (revision 8324) @@ -1,94 +1,95 @@ ?openmp_logging = false ?vis_history = false ?integration_timer = false error_threshold = 1.000000000000E-05 $method = "unit_test" | Process library 'testproc_11_lib': recorded process 'testproc_11_p1' | Process library 'testproc_11_lib': recorded process 'testproc_11_p2' | Process library 'testproc_11_lib': compiling ... | Process library 'testproc_11_lib': ... success. $phs_method = "wood" sqrts = 1.000000000000E+03 seed = 0 $integration_method = "vamp" | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 0 | Initializing integration for process testproc_11_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 | Phase space: generating configuration ... | Phase space: ... success. | Phase space: writing configuration file 'testproc_11_p1.i1.phs' | ------------------------------------------------------------------------ | Process [scattering]: 'testproc_11_p1' | Library name = 'testproc_11_lib' | Process index = 1 | Process components: | 1: 'testproc_11_p1_i1': s, s => s, s [unit_test] | ------------------------------------------------------------------------ | Phase space: 5 channels, 2 dimensions | Phase space: found 5 channels, collected in 2 groves. | Phase space: Using 18 equivalences between channels. | Phase space: wood Warning: No cuts have been defined. | Starting integration for process 'testproc_11_p1' | Integrate: iterations = 1:1000 | Integrator: 2 chains, 5 channels, 2 dimensions | Integrator: Using VAMP channel equivalences | Integrator: 1000 initial calls, 20 bins, stratified = T | Integrator: VAMP |=============================================================================| | It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] | |=============================================================================| 1 1000 7.7464622E+03 0.00E+00 0.00 0.00* 100.00 |-----------------------------------------------------------------------------| 1 1000 7.7464622E+03 0.00E+00 0.00 0.00 100.00 |=============================================================================| $integration_method = "vamp2" | RNG: Initializing TAO random-number generator | RNG: Setting seed for random-number generator to 1 | Initializing integration for process testproc_11_p2: | Beam structure: [any particles] | Beam data (collision): | s (mass = 1.2500000E+02 GeV) | s (mass = 1.2500000E+02 GeV) | sqrts = 1.000000000000E+03 GeV | Phase space: generating configuration ... | Phase space: ... success. | Phase space: writing configuration file 'testproc_11_p2.i1.phs' | ------------------------------------------------------------------------ | Process [scattering]: 'testproc_11_p2' | Library name = 'testproc_11_lib' | Process index = 2 | Process components: | 1: 'testproc_11_p2_i1': s, s => s, s [unit_test] | ------------------------------------------------------------------------ | Phase space: 5 channels, 2 dimensions | Phase space: found 5 channels, collected in 2 groves. | Phase space: Using 18 equivalences between channels. | Phase space: wood Warning: No cuts have been defined. | Starting integration for process 'testproc_11_p2' | Integrate: iterations = 1:1000 | Integrator: 2 chains, 5 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] set chain: use chained weights. +| VAMP2: Initialize new grids and write to file 'testproc_11_p2.m1.vg2'. +| VAMP2: set chain: use chained weights. 1 1000 7.7464622E+03 0.00E+00 0.00 0.00* 100.00 |-----------------------------------------------------------------------------| 1 1000 7.7464622E+03 0.00E+00 0.00 0.00 100.00 |=============================================================================| tolerance = 1.000000000000E-04 | expect: success | Summary of value checks: | Failures: 0 / Total: 1 | There were no errors and 2 warning(s). | WHIZARD run finished. |=============================================================================| Index: trunk/share/tests/functional_tests/ref-output/vamp2_2.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/vamp2_2.ref (revision 0) +++ trunk/share/tests/functional_tests/ref-output/vamp2_2.ref (revision 8324) @@ -0,0 +1,125 @@ +?openmp_logging = false +?vis_history = false +?integration_timer = false +seed = 1234 +$method = "omega" +$phs_method = "wood" +$integration_method = "vamp2" +| Process library 'vamp2_2_lib': recorded process 'vamp2_2_p1' +sqrts = 1.000000000000E+03 +$vamp_grid_format = "binary" +| Integrate: current process library needs compilation +| Process library 'vamp2_2_lib': compiling ... +| Process library 'vamp2_2_lib': writing makefile +| Process library 'vamp2_2_lib': removing old files +| Process library 'vamp2_2_lib': writing driver +| Process library 'vamp2_2_lib': creating source code +| Process library 'vamp2_2_lib': compiling sources +| Process library 'vamp2_2_lib': linking +| Process library 'vamp2_2_lib': loading +| Process library 'vamp2_2_lib': ... success. +| Integrate: compilation done +| RNG: Initializing TAO random-number generator +| RNG: Setting seed for random-number generator to 1234 +| Initializing integration for process vamp2_2_p1: +| Beam structure: [any particles] +| Beam data (collision): +| e- (mass = 0.0000000E+00 GeV) +| e+ (mass = 0.0000000E+00 GeV) +| sqrts = 1.000000000000E+03 GeV +| Phase space: generating configuration ... +| Phase space: ... success. +| Phase space: writing configuration file 'vamp2_2_p1.i1.phs' +| ------------------------------------------------------------------------ +| Process [scattering]: 'vamp2_2_p1' +| Library name = 'vamp2_2_lib' +| Process index = 1 +| Process components: +| 1: 'vamp2_2_p1_i1': e-, e+ => m-, m+ [omega] +| ------------------------------------------------------------------------ +| Phase space: 1 channels, 2 dimensions +| Phase space: found 1 channel, collected in 1 grove. +| Phase space: Using 1 equivalence between channels. +| Phase space: wood +Warning: No cuts have been defined. +| Starting integration for process 'vamp2_2_p1' +| Integrate: iterations = 5:1000:"gw", 3:1500 +| Integrator: 1 chains, 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: Initialize new grids and write to file 'vamp2_2_p1.m1.vg2'. +| VAMP2: set chain: use chained weights. + 1 800 8.6935211E+01 7.92E-02 0.09 0.03* 66.72 + 2 800 8.6857951E+01 6.34E-02 0.07 0.02* 49.37 + 3 800 8.6942034E+01 6.69E-02 0.08 0.02 59.07 + 4 800 8.6955287E+01 6.33E-02 0.07 0.02* 54.99 + 5 800 8.6956986E+01 6.53E-02 0.08 0.02 73.40 +|-----------------------------------------------------------------------------| + 5 4000 8.6928397E+01 2.99E-02 0.03 0.02 73.40 0.41 5 +|-----------------------------------------------------------------------------| + 6 1200 8.6908341E+01 5.24E-02 0.06 0.02* 52.15 + 7 1200 8.6837971E+01 4.99E-02 0.06 0.02* 52.05 + 8 1200 8.6945238E+01 4.92E-02 0.06 0.02* 52.14 +|-----------------------------------------------------------------------------| + 8 3600 8.6897281E+01 2.91E-02 0.03 0.02 52.14 1.21 3 +|=============================================================================| +$vamp_grid_format = "ascii" +?rebuild_grids = false +| RNG: Initializing TAO random-number generator +| RNG: Setting seed for random-number generator to 1235 +| Initializing integration for process vamp2_2_p1: +| Beam structure: [any particles] +| Beam data (collision): +| e- (mass = 0.0000000E+00 GeV) +| e+ (mass = 0.0000000E+00 GeV) +| sqrts = 1.000000000000E+03 GeV +| Phase space: generating configuration ... +| Phase space: ... success. +| Phase space: writing configuration file 'vamp2_2_p1.i1.phs' +| ------------------------------------------------------------------------ +| Process [scattering]: 'vamp2_2_p1' +| Library name = 'vamp2_2_lib' +| Process index = 1 +| Process components: +| 1: 'vamp2_2_p1_i1': e-, e+ => m-, m+ [omega] +| ------------------------------------------------------------------------ +| Phase space: 1 channels, 2 dimensions +| Phase space: found 1 channel, collected in 1 grove. +| Phase space: Using 1 equivalence between channels. +| Phase space: wood +Warning: No cuts have been defined. +| Starting integration for process 'vamp2_2_p1' +| Integrate: iterations = 5:1000:"gw", 5:1000 +| Integrator: 1 chains, 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: Reading from binary grid file 'vamp2_2_p1.m1.vgx2' +| VAMP2: Using grids and results from file ’vamp2_2_p1.m1.vg2’. + 1 800 8.6935211E+01 7.92E-02 0.09 0.03* 66.72 + 2 800 8.6857951E+01 6.34E-02 0.07 0.02* 49.37 + 3 800 8.6942034E+01 6.69E-02 0.08 0.02 59.07 + 4 800 8.6955287E+01 6.33E-02 0.07 0.02* 54.99 + 5 800 8.6956986E+01 6.53E-02 0.08 0.02 73.40 +|-----------------------------------------------------------------------------| + 5 4000 8.6928397E+01 2.99E-02 0.03 0.02 73.40 0.41 5 +|-----------------------------------------------------------------------------| +| VAMP2: header: parameter mismatch, discarding pass from file 'vamp2_2_p1.m1.vg2'. + 6 800 8.6925619E+01 6.00E-02 0.07 0.02* 52.10 + 7 800 8.6877404E+01 6.28E-02 0.07 0.02 52.14 + 8 800 8.6895243E+01 5.94E-02 0.07 0.02* 52.41 + 9 800 8.6935341E+01 6.25E-02 0.07 0.02 52.11 + 10 800 8.6909881E+01 6.34E-02 0.07 0.02 52.08 +|-----------------------------------------------------------------------------| + 10 4000 8.6908743E+01 2.75E-02 0.03 0.02 52.08 0.14 5 +|=============================================================================| +| There were no errors and 2 warning(s). +| WHIZARD run finished. +|=============================================================================| Index: trunk/share/tests/functional_tests/ref-output/testproc_12.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/testproc_12.ref (revision 8323) +++ trunk/share/tests/functional_tests/ref-output/testproc_12.ref (revision 8324) @@ -1,143 +1,146 @@ ?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: 1000 initial calls, 20 max. bins, stratified = T | Integrator: VAMP2 |=============================================================================| | It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] | |=============================================================================| +| VAMP2: Initialize new grids and write to 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 |=============================================================================| ?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: 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’ +| 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: 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' +| VAMP2: header: parameter mismatch, discarding pass from file 'testproc_12_p1.m1.vg2'. +| VAMP2: Initialize new grids and write to 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: 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' +| VAMP2: header: parameter mismatch, discarding pass from file 'testproc_12_p1.m1.vg2'. +| VAMP2: Initialize new grids and write to 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/functional_tests/ref-output/process_log.ref =================================================================== --- trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8323) +++ trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8324) @@ -1,548 +1,549 @@ ############################################################################### Process [scattering]: 'process_log_1_p1' Run ID = '' Library name = 'process_log_lib' Process index = 1 Process components: 1: 'process_log_1_p1_i1': e-, e+ => m-, m+ [omega] ------------------------------------------------------------------------ ############################################################################### Integral = 8.3556567814E+03 Error = 3.2359019246E+00 Accuracy = 1.8972317270E-02 Chi2 = 5.2032955661E-01 Efficiency = 7.8315602603E-01 T(10k evt) =