Index: trunk/src/process_integration/process_integration.nw
===================================================================
--- trunk/src/process_integration/process_integration.nw (revision 8465)
+++ trunk/src/process_integration/process_integration.nw (revision 8466)
@@ -1,19445 +1,19458 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: integration and process objects and such
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Integration and Process Objects}
\includemodulegraph{process_integration}
This is the central part of the \whizard\ package. It provides the
functionality for evaluating structure functions, kinematics and matrix
elements, integration and event generation. It combines the various
parts that deal with those tasks individually and organizes the data
transfer between them.
\begin{description}
\item[subevt\_expr]
This enables process observables as (abstract) expressions, to be
evaluated for each process call.
\item[parton\_states]
A [[parton_state_t]] object represents an elementary partonic
interaction. There are two versions: one for the isolated
elementary process, one for the elementary process convoluted with
the structure-function chain. The parton state is an effective
state. It needs not coincide with the seed-kinematics state which is
used in evaluating phase space.
\item[process]
Here, all pieces are combined for the purpose of evaluating the
elementary processes. The whole algorithm is coded in terms of
abstract data types as defined in the appropriate modules: [[prc_core]]
for matrix-element evaluation, [[prc_core_def]] for the associated
configuration and driver, [[sf_base]] for beams and structure-functions,
[[phs_base]] for phase space, and [[mci_base]] for integration and event
generation.
\item[process\_config]
\item[process\_counter]
Very simple object for statistics
\item[process\_mci]
\item[pcm]
\item[kinematics]
\item[instances]
While the above modules set up all static information, the instances
have the changing event data. There are term and process instances but
no component instances.
\item[process\_stacks]
Process stacks collect process objects.
\end{description}
We combine here hard interactions, phase space, and (for scatterings)
structure functions and interfaces them to the integration module.
The process object implements the combination of a fixed beam and
structure-function setup with a number of elementary processes. The
latter are called process components. The process object
represents an entity which is supposedly observable. It should
be meaningful to talk about the cross section of a process.
The individual components of a process are, technically, processes
themselves, but they may have unphysical cross sections which have to
be added for a physical result. Process components may be exclusive
tree-level elementary processes, dipole subtraction term, loop
corrections, etc.
The beam and structure function setup is common to all process
components. Thus, there is only one instance of this part.
The process may be a scattering process or a decay process. In the
latter case, there are no structure functions, and the beam setup
consists of a single particle. Otherwise, the two classes are treated
on the same footing.
Once a sampling point has been chosen, a process determines a set of
partons with a correlated density matrix of quantum numbers. In
general, each sampling point will generate, for each process component,
one or more distinct parton configurations. This is the [[computed]]
state. The computed state is the subject of the multi-channel
integration algorithm.
For NLO computations, it is necessary to project the computed states
onto another set of parton configurations (e.g., by recombining
certain pairs). This is the [[observed]] state. When computing
partonic observables, the information is taken from the observed
state.
For the purpose of event generation, we will later select one parton
configuration from the observed state and collapse the correlated
quantum state. This configuration is then dressed by applying parton
shower, decays and hadronization. The decay chain, in particular,
combines a scattering process with possible subsequent decay processes
on the parton level, which are full-fledged process objects themselves.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process observables}
We define an abstract [[subevt_expr_t]] object as an extension of the
[[subevt_t]] type. The object contains a local variable list, variable
instances (as targets for pointers in the variable list), and evaluation
trees. The evaluation trees reference both the variables and the [[subevt]].
There are two instances of the abstract type: one for process instances, one
for physical events. Both have a common logical expression [[selection]]
which determines whether the object passes user-defined cuts.
The intention is that we fill the [[subevt_t]] base object and compute the
variables once we have evaluated a kinematical phase space point (or a
complete event). We then evaluate the expressions and can use the results in
further calculations.
The [[process_expr_t]] extension contains furthermore scale and weight
expressions. The [[event_expr_t]] extension contains a reweighting-factor
expression and a logical expression for event analysis. In practice, we will
link the variable list of the [[event_obs]] object to the variable list of the
currently active [[process_obs]] object, such that the process variables are
available to both objects. Event variables are meaningful only for physical
events.
Note that there are unit tests, but they are deferred to the
[[expr_tests]] module.
<<[[subevt_expr.f90]]>>=
<<File header>>
module subevt_expr
<<Use kinds>>
<<Use strings>>
use constants, only: zero, one
use io_units
use format_utils, only: write_separator
use diagnostics
use lorentz
use subevents
use variables
use flavors
use quantum_numbers
use interactions
use particles
use expr_base
<<Standard module head>>
<<Subevt expr: public>>
<<Subevt expr: types>>
<<Subevt expr: interfaces>>
contains
<<Subevt expr: procedures>>
end module subevt_expr
@ %def subevt_expr
@
\subsection{Abstract base type}
<<Subevt expr: types>>=
type, extends (subevt_t), abstract :: subevt_expr_t
logical :: subevt_filled = .false.
type(var_list_t) :: var_list
real(default) :: sqrts_hat = 0
integer :: n_in = 0
integer :: n_out = 0
integer :: n_tot = 0
logical :: has_selection = .false.
class(expr_t), allocatable :: selection
logical :: colorize_subevt = .false.
contains
<<Subevt expr: subevt expr: TBP>>
end type subevt_expr_t
@ %def subevt_expr_t
@ Output: Base and extended version. We already have a [[write]] routine for
the [[subevt_t]] parent type.
<<Subevt expr: subevt expr: TBP>>=
procedure :: base_write => subevt_expr_write
<<Subevt expr: procedures>>=
subroutine subevt_expr_write (object, unit, pacified)
class(subevt_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Local variables:"
call write_separator (u)
call var_list_write (object%var_list, u, follow_link=.false., &
pacified = pacified)
call write_separator (u)
if (object%subevt_filled) then
call object%subevt_t%write (u, pacified = pacified)
if (object%has_selection) then
call write_separator (u)
write (u, "(1x,A)") "Selection expression:"
call write_separator (u)
call object%selection%write (u)
end if
else
write (u, "(1x,A)") "subevt: [undefined]"
end if
end subroutine subevt_expr_write
@ %def subevt_expr_write
@ Finalizer.
<<Subevt expr: subevt expr: TBP>>=
procedure (subevt_expr_final), deferred :: final
procedure :: base_final => subevt_expr_final
<<Subevt expr: procedures>>=
subroutine subevt_expr_final (object)
class(subevt_expr_t), intent(inout) :: object
call object%var_list%final ()
if (object%has_selection) then
call object%selection%final ()
end if
end subroutine subevt_expr_final
@ %def subevt_expr_final
@
\subsection{Initialization}
Initialization: define local variables and establish pointers.
The common variables are [[sqrts]] (the nominal beam energy, fixed),
[[sqrts_hat]] (the actual energy), [[n_in]], [[n_out]], and [[n_tot]] for
the [[subevt]]. With the exception of [[sqrts]], all are implemented as
pointers to subobjects.
<<Subevt expr: subevt expr: TBP>>=
procedure (subevt_expr_setup_vars), deferred :: setup_vars
procedure :: base_setup_vars => subevt_expr_setup_vars
<<Subevt expr: procedures>>=
subroutine subevt_expr_setup_vars (expr, sqrts)
class(subevt_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%var_list%final ()
call var_list_append_real (expr%var_list, &
var_str ("sqrts"), sqrts, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("sqrts_hat"), expr%sqrts_hat, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("n_in"), expr%n_in, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("n_out"), expr%n_out, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("n_tot"), expr%n_tot, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
end subroutine subevt_expr_setup_vars
@ %def subevt_expr_setup_vars
@ Append the subevent expr (its base-type core) itself to the variable
list, if it is not yet present.
<<Subevt expr: subevt expr: TBP>>=
procedure :: setup_var_self => subevt_expr_setup_var_self
<<Subevt expr: procedures>>=
subroutine subevt_expr_setup_var_self (expr)
class(subevt_expr_t), intent(inout), target :: expr
if (.not. expr%var_list%contains (var_str ("@evt"))) then
call var_list_append_subevt_ptr &
(expr%var_list, &
var_str ("@evt"), expr%subevt_t, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic=.true.)
end if
end subroutine subevt_expr_setup_var_self
@ %def subevt_expr_setup_var_self
@ Link a variable list to the local one. This could be done event by event,
but before evaluating expressions.
<<Subevt expr: subevt expr: TBP>>=
procedure :: link_var_list => subevt_expr_link_var_list
<<Subevt expr: procedures>>=
subroutine subevt_expr_link_var_list (expr, var_list)
class(subevt_expr_t), intent(inout) :: expr
type(var_list_t), intent(in), target :: var_list
call expr%var_list%link (var_list)
end subroutine subevt_expr_link_var_list
@ %def subevt_expr_link_var_list
@ Compile the selection expression. If there is no expression, the build
method won't allocate the expression object.
<<Subevt expr: subevt expr: TBP>>=
procedure :: setup_selection => subevt_expr_setup_selection
<<Subevt expr: procedures>>=
subroutine subevt_expr_setup_selection (expr, ef_cuts)
class(subevt_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_cuts
call ef_cuts%build (expr%selection)
if (allocated (expr%selection)) then
call expr%setup_var_self ()
call expr%selection%setup_lexpr (expr%var_list)
expr%has_selection = .true.
end if
end subroutine subevt_expr_setup_selection
@ %def subevt_expr_setup_selection
@ (De)activate color storage and evaluation for the expression. The subevent
particles will have color information.
<<Subevt expr: subevt expr: TBP>>=
procedure :: colorize => subevt_expr_colorize
<<Subevt expr: procedures>>=
subroutine subevt_expr_colorize (expr, colorize_subevt)
class(subevt_expr_t), intent(inout), target :: expr
logical, intent(in) :: colorize_subevt
expr%colorize_subevt = colorize_subevt
end subroutine subevt_expr_colorize
@ %def subevt_expr_colorize
@
\subsection{Evaluation}
Reset to initial state, i.e., mark the [[subevt]] as invalid.
<<Subevt expr: subevt expr: TBP>>=
procedure :: reset_contents => subevt_expr_reset_contents
procedure :: base_reset_contents => subevt_expr_reset_contents
<<Subevt expr: procedures>>=
subroutine subevt_expr_reset_contents (expr)
class(subevt_expr_t), intent(inout) :: expr
expr%subevt_filled = .false.
end subroutine subevt_expr_reset_contents
@ %def subevt_expr_reset_contents
@ Evaluate the selection expression and return the result. There is also a
deferred version: this should evaluate the remaining expressions if the event
has passed.
<<Subevt expr: subevt expr: TBP>>=
procedure :: base_evaluate => subevt_expr_evaluate
<<Subevt expr: procedures>>=
subroutine subevt_expr_evaluate (expr, passed)
class(subevt_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
if (expr%has_selection) then
call expr%selection%evaluate ()
if (expr%selection%is_known ()) then
passed = expr%selection%get_log ()
else
call msg_error ("Evaluate selection expression: result undefined")
passed = .false.
end if
else
passed = .true.
end if
end subroutine subevt_expr_evaluate
@ %def subevt_expr_evaluate
@
\subsection{Implementation for partonic events}
This implementation contains the expressions that we can evaluate for the
partonic process during integration.
<<Subevt expr: public>>=
public :: parton_expr_t
<<Subevt expr: types>>=
type, extends (subevt_expr_t) :: parton_expr_t
integer, dimension(:), allocatable :: i_beam
integer, dimension(:), allocatable :: i_in
integer, dimension(:), allocatable :: i_out
logical :: has_scale = .false.
logical :: has_fac_scale = .false.
logical :: has_ren_scale = .false.
logical :: has_weight = .false.
class(expr_t), allocatable :: scale
class(expr_t), allocatable :: fac_scale
class(expr_t), allocatable :: ren_scale
class(expr_t), allocatable :: weight
contains
<<Subevt expr: parton expr: TBP>>
end type parton_expr_t
@ %def parton_expr_t
@ Finalizer.
<<Subevt expr: parton expr: TBP>>=
procedure :: final => parton_expr_final
<<Subevt expr: procedures>>=
subroutine parton_expr_final (object)
class(parton_expr_t), intent(inout) :: object
call object%base_final ()
if (object%has_scale) then
call object%scale%final ()
end if
if (object%has_fac_scale) then
call object%fac_scale%final ()
end if
if (object%has_ren_scale) then
call object%ren_scale%final ()
end if
if (object%has_weight) then
call object%weight%final ()
end if
end subroutine parton_expr_final
@ %def parton_expr_final
@ Output: continue writing the active expressions, after the common selection
expression.
Note: the [[prefix]] argument is declared in the [[write]] method of the
[[subevt_t]] base type. Here, it is unused.
<<Subevt expr: parton expr: TBP>>=
procedure :: write => parton_expr_write
<<Subevt expr: procedures>>=
subroutine parton_expr_write (object, unit, prefix, pacified)
class(parton_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
call object%base_write (u, pacified = pacified)
if (object%subevt_filled) then
if (object%has_scale) then
call write_separator (u)
write (u, "(1x,A)") "Scale expression:"
call write_separator (u)
call object%scale%write (u)
end if
if (object%has_fac_scale) then
call write_separator (u)
write (u, "(1x,A)") "Factorization scale expression:"
call write_separator (u)
call object%fac_scale%write (u)
end if
if (object%has_ren_scale) then
call write_separator (u)
write (u, "(1x,A)") "Renormalization scale expression:"
call write_separator (u)
call object%ren_scale%write (u)
end if
if (object%has_weight) then
call write_separator (u)
write (u, "(1x,A)") "Weight expression:"
call write_separator (u)
call object%weight%write (u)
end if
end if
end subroutine parton_expr_write
@ %def parton_expr_write
@ Define variables.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_vars => parton_expr_setup_vars
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_vars (expr, sqrts)
class(parton_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%base_setup_vars (sqrts)
end subroutine parton_expr_setup_vars
@ %def parton_expr_setup_vars
@ Compile the scale expressions. If a pointer is disassociated, there is
no expression.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_scale => parton_expr_setup_scale
procedure :: setup_fac_scale => parton_expr_setup_fac_scale
procedure :: setup_ren_scale => parton_expr_setup_ren_scale
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_scale (expr, ef_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_scale
call ef_scale%build (expr%scale)
if (allocated (expr%scale)) then
call expr%setup_var_self ()
call expr%scale%setup_expr (expr%var_list)
expr%has_scale = .true.
end if
end subroutine parton_expr_setup_scale
subroutine parton_expr_setup_fac_scale (expr, ef_fac_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_fac_scale
call ef_fac_scale%build (expr%fac_scale)
if (allocated (expr%fac_scale)) then
call expr%setup_var_self ()
call expr%fac_scale%setup_expr (expr%var_list)
expr%has_fac_scale = .true.
end if
end subroutine parton_expr_setup_fac_scale
subroutine parton_expr_setup_ren_scale (expr, ef_ren_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_ren_scale
call ef_ren_scale%build (expr%ren_scale)
if (allocated (expr%ren_scale)) then
call expr%setup_var_self ()
call expr%ren_scale%setup_expr (expr%var_list)
expr%has_ren_scale = .true.
end if
end subroutine parton_expr_setup_ren_scale
@ %def parton_expr_setup_scale
@ %def parton_expr_setup_fac_scale
@ %def parton_expr_setup_ren_scale
@ Compile the weight expression.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_weight => parton_expr_setup_weight
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_weight (expr, ef_weight)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_weight
call ef_weight%build (expr%weight)
if (allocated (expr%weight)) then
call expr%setup_var_self ()
call expr%weight%setup_expr (expr%var_list)
expr%has_weight = .true.
end if
end subroutine parton_expr_setup_weight
@ %def parton_expr_setup_weight
@ Filling the partonic state consists of two parts. The first routine
prepares the subevt without assigning momenta. It takes the particles from an
[[interaction_t]]. It needs the indices and flavors for the beam,
incoming, and outgoing particles.
We can assume that the particle content of the subevt does not change.
Therefore, we set the event variables [[n_in]], [[n_out]], [[n_tot]] already
in this initialization step.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_subevt => parton_expr_setup_subevt
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_subevt (expr, int, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: i_beam, i_in, i_out
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
allocate (expr%i_beam (size (i_beam)))
allocate (expr%i_in (size (i_in)))
allocate (expr%i_out (size (i_out)))
expr%i_beam = i_beam
expr%i_in = i_in
expr%i_out = i_out
call interaction_to_subevt (int, &
expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
call subevt_set_pdg_beam (expr%subevt_t, f_beam%get_pdg ())
call subevt_set_pdg_incoming (expr%subevt_t, f_in%get_pdg ())
call subevt_set_pdg_outgoing (expr%subevt_t, f_out%get_pdg ())
call subevt_set_p2_beam (expr%subevt_t, f_beam%get_mass () ** 2)
call subevt_set_p2_incoming (expr%subevt_t, f_in%get_mass () ** 2)
call subevt_set_p2_outgoing (expr%subevt_t, f_out%get_mass () ** 2)
expr%n_in = size (i_in)
expr%n_out = size (i_out)
expr%n_tot = expr%n_in + expr%n_out
end subroutine parton_expr_setup_subevt
@ %def parton_expr_setup_subevt
@ Transfer PDG codes, masses (initalization) and momenta to a
predefined subevent. We use the flavor assignment of the first
branch in the interaction state matrix. Only incoming and outgoing
particles are transferred. Switch momentum sign for incoming
particles.
<<Subevt expr: interfaces>>=
interface interaction_momenta_to_subevt
module procedure interaction_momenta_to_subevt_id
module procedure interaction_momenta_to_subevt_tr
end interface
<<Subevt expr: procedures>>=
subroutine interaction_to_subevt (int, j_beam, j_in, j_out, subevt)
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(out) :: subevt
type(flavor_t), dimension(:), allocatable :: flv
integer :: n_beam, n_in, n_out, i, j
allocate (flv (int%get_n_tot ()))
flv = quantum_numbers_get_flavor (int%get_quantum_numbers (1))
n_beam = size (j_beam)
n_in = size (j_in)
n_out = size (j_out)
call subevt_init (subevt, n_beam + n_in + n_out)
do i = 1, n_beam
j = j_beam(i)
call subevt_set_beam (subevt, i, &
flv(j)%get_pdg (), &
vector4_null, &
flv(j)%get_mass () ** 2)
end do
do i = 1, n_in
j = j_in(i)
call subevt_set_incoming (subevt, n_beam + i, &
flv(j)%get_pdg (), &
vector4_null, &
flv(j)%get_mass () ** 2)
end do
do i = 1, n_out
j = j_out(i)
call subevt_set_outgoing (subevt, n_beam + n_in + i, &
flv(j)%get_pdg (), &
vector4_null, &
flv(j)%get_mass () ** 2)
end do
end subroutine interaction_to_subevt
subroutine interaction_momenta_to_subevt_id (int, j_beam, j_in, j_out, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
call subevt_set_p_beam (subevt, - int%get_momenta (j_beam))
call subevt_set_p_incoming (subevt, - int%get_momenta (j_in))
call subevt_set_p_outgoing (subevt, int%get_momenta (j_out))
end subroutine interaction_momenta_to_subevt_id
subroutine interaction_momenta_to_subevt_tr &
(int, j_beam, j_in, j_out, lt, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
type(lorentz_transformation_t), intent(in) :: lt
call subevt_set_p_beam &
(subevt, - lt * int%get_momenta (j_beam))
call subevt_set_p_incoming &
(subevt, - lt * int%get_momenta (j_in))
call subevt_set_p_outgoing &
(subevt, lt * int%get_momenta (j_out))
end subroutine interaction_momenta_to_subevt_tr
@ %def interaction_momenta_to_subevt
@ The second part takes the momenta from the interaction object and thus
completes the subevt. The partonic energy can then be computed.
<<Subevt expr: parton expr: TBP>>=
procedure :: fill_subevt => parton_expr_fill_subevt
<<Subevt expr: procedures>>=
subroutine parton_expr_fill_subevt (expr, int)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
call interaction_momenta_to_subevt (int, &
expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
expr%subevt_filled = .true.
end subroutine parton_expr_fill_subevt
@ %def parton_expr_fill_subevt
@ Evaluate, if the event passes the selection. For absent expressions we take
default values.
<<Subevt expr: parton expr: TBP>>=
procedure :: evaluate => parton_expr_evaluate
<<Subevt expr: procedures>>=
subroutine parton_expr_evaluate &
(expr, passed, scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
class(parton_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: scale
real(default), intent(out) :: fac_scale
real(default), intent(out) :: ren_scale
real(default), intent(out) :: weight
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
logical :: force_scale, force_eval
force_scale = .false.; force_eval = .false.
if (present (scale_forced)) force_scale = allocated (scale_forced)
if (present (force_evaluation)) force_eval = force_evaluation
call expr%base_evaluate (passed)
if (passed .or. force_eval) then
if (force_scale) then
scale = scale_forced
else if (expr%has_scale) then
call expr%scale%evaluate ()
if (expr%scale%is_known ()) then
scale = expr%scale%get_real ()
else
call msg_error ("Evaluate scale expression: result undefined")
scale = zero
end if
else
scale = expr%sqrts_hat
end if
if (force_scale) then
fac_scale = scale_forced
else if (expr%has_fac_scale) then
call expr%fac_scale%evaluate ()
if (expr%fac_scale%is_known ()) then
fac_scale = expr%fac_scale%get_real ()
else
call msg_error ("Evaluate factorization scale expression: &
&result undefined")
fac_scale = zero
end if
else
fac_scale = scale
end if
if (force_scale) then
ren_scale = scale_forced
else if (expr%has_ren_scale) then
call expr%ren_scale%evaluate ()
if (expr%ren_scale%is_known ()) then
ren_scale = expr%ren_scale%get_real ()
else
call msg_error ("Evaluate renormalization scale expression: &
&result undefined")
ren_scale = zero
end if
else
ren_scale = scale
end if
if (expr%has_weight) then
call expr%weight%evaluate ()
if (expr%weight%is_known ()) then
weight = expr%weight%get_real ()
else
call msg_error ("Evaluate weight expression: result undefined")
weight = zero
end if
else
weight = one
end if
else
weight = zero
end if
end subroutine parton_expr_evaluate
@ %def parton_expr_evaluate
@ Return the beam/incoming parton indices.
<<Subevt expr: parton expr: TBP>>=
procedure :: get_beam_index => parton_expr_get_beam_index
procedure :: get_in_index => parton_expr_get_in_index
<<Subevt expr: procedures>>=
subroutine parton_expr_get_beam_index (expr, i_beam)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_beam
i_beam = expr%i_beam
end subroutine parton_expr_get_beam_index
subroutine parton_expr_get_in_index (expr, i_in)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_in
i_in = expr%i_in
end subroutine parton_expr_get_in_index
@ %def parton_expr_get_beam_index
@ %def parton_expr_get_in_index
@
\subsection{Implementation for full events}
This implementation contains the expressions that we can evaluate for the
full event. It also contains data that pertain to the event, suitable
for communication with external event formats. These data
simultaneously serve as pointer targets for the variable lists hidden
in the expressions (eval trees).
Squared matrix element and weight values: when reading events from
file, the [[ref]] value is the number in the file, while the [[prc]]
value is the number that we calculate from the momenta in the file,
possibly with different parameters. When generating events the first
time, or if we do not recalculate, the numbers should coincide.
Furthermore, the array of [[alt]] values is copied from an array of
alternative event records. These values should represent calculated
values.
<<Subevt expr: public>>=
public :: event_expr_t
<<Subevt expr: types>>=
type, extends (subevt_expr_t) :: event_expr_t
logical :: has_reweight = .false.
logical :: has_analysis = .false.
class(expr_t), allocatable :: reweight
class(expr_t), allocatable :: analysis
logical :: has_id = .false.
type(string_t) :: id
logical :: has_num_id = .false.
integer :: num_id = 0
logical :: has_index = .false.
integer :: index = 0
logical :: has_sqme_ref = .false.
real(default) :: sqme_ref = 0
logical :: has_sqme_prc = .false.
real(default) :: sqme_prc = 0
logical :: has_weight_ref = .false.
real(default) :: weight_ref = 0
logical :: has_weight_prc = .false.
real(default) :: weight_prc = 0
logical :: has_excess_prc = .false.
real(default) :: excess_prc = 0
integer :: n_alt = 0
logical :: has_sqme_alt = .false.
real(default), dimension(:), allocatable :: sqme_alt
logical :: has_weight_alt = .false.
real(default), dimension(:), allocatable :: weight_alt
contains
<<Subevt expr: event expr: TBP>>
end type event_expr_t
@ %def event_expr_t
@ Finalizer for the expressions.
<<Subevt expr: event expr: TBP>>=
procedure :: final => event_expr_final
<<Subevt expr: procedures>>=
subroutine event_expr_final (object)
class(event_expr_t), intent(inout) :: object
call object%base_final ()
if (object%has_reweight) then
call object%reweight%final ()
end if
if (object%has_analysis) then
call object%analysis%final ()
end if
end subroutine event_expr_final
@ %def event_expr_final
@ Output: continue writing the active expressions, after the common selection
expression.
Note: the [[prefix]] argument is declared in the [[write]] method of the
[[subevt_t]] base type. Here, it is unused.
<<Subevt expr: event expr: TBP>>=
procedure :: write => event_expr_write
<<Subevt expr: procedures>>=
subroutine event_expr_write (object, unit, prefix, pacified)
class(event_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
call object%base_write (u, pacified = pacified)
if (object%subevt_filled) then
if (object%has_reweight) then
call write_separator (u)
write (u, "(1x,A)") "Reweighting expression:"
call write_separator (u)
call object%reweight%write (u)
end if
if (object%has_analysis) then
call write_separator (u)
write (u, "(1x,A)") "Analysis expression:"
call write_separator (u)
call object%analysis%write (u)
end if
end if
end subroutine event_expr_write
@ %def event_expr_write
@ Initializer. This is required only for the [[sqme_alt]] and
[[weight_alt]] arrays.
<<Subevt expr: event expr: TBP>>=
procedure :: init => event_expr_init
<<Subevt expr: procedures>>=
subroutine event_expr_init (expr, n_alt)
class(event_expr_t), intent(out) :: expr
integer, intent(in), optional :: n_alt
if (present (n_alt)) then
expr%n_alt = n_alt
allocate (expr%sqme_alt (n_alt), source = 0._default)
allocate (expr%weight_alt (n_alt), source = 0._default)
end if
end subroutine event_expr_init
@ %def event_expr_init
@ Define variables. We have the variables of the base type plus
specific variables for full events. There is the event index.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_vars => event_expr_setup_vars
<<Subevt expr: procedures>>=
subroutine event_expr_setup_vars (expr, sqrts)
class(event_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%base_setup_vars (sqrts)
call var_list_append_string_ptr (expr%var_list, &
var_str ("$process_id"), expr%id, &
is_known = expr%has_id, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("process_num_id"), expr%num_id, &
is_known = expr%has_num_id, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("sqme"), expr%sqme_prc, &
is_known = expr%has_sqme_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("sqme_ref"), expr%sqme_ref, &
is_known = expr%has_sqme_ref, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("event_index"), expr%index, &
is_known = expr%has_index, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("event_weight"), expr%weight_prc, &
is_known = expr%has_weight_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("event_weight_ref"), expr%weight_ref, &
is_known = expr%has_weight_ref, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("event_excess"), expr%excess_prc, &
is_known = expr%has_excess_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
end subroutine event_expr_setup_vars
@ %def event_expr_setup_vars
@ Compile the analysis expression. If the pointer is disassociated, there is
no expression.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_analysis => event_expr_setup_analysis
<<Subevt expr: procedures>>=
subroutine event_expr_setup_analysis (expr, ef_analysis)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_analysis
call ef_analysis%build (expr%analysis)
if (allocated (expr%analysis)) then
call expr%setup_var_self ()
call expr%analysis%setup_lexpr (expr%var_list)
expr%has_analysis = .true.
end if
end subroutine event_expr_setup_analysis
@ %def event_expr_setup_analysis
@ Compile the reweight expression.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_reweight => event_expr_setup_reweight
<<Subevt expr: procedures>>=
subroutine event_expr_setup_reweight (expr, ef_reweight)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_reweight
call ef_reweight%build (expr%reweight)
if (allocated (expr%reweight)) then
call expr%setup_var_self ()
call expr%reweight%setup_expr (expr%var_list)
expr%has_reweight = .true.
end if
end subroutine event_expr_setup_reweight
@ %def event_expr_setup_reweight
@ Store the string or numeric process ID. This should be done during
initialization.
<<Subevt expr: event expr: TBP>>=
procedure :: set_process_id => event_expr_set_process_id
procedure :: set_process_num_id => event_expr_set_process_num_id
<<Subevt expr: procedures>>=
subroutine event_expr_set_process_id (expr, id)
class(event_expr_t), intent(inout) :: expr
type(string_t), intent(in) :: id
expr%id = id
expr%has_id = .true.
end subroutine event_expr_set_process_id
subroutine event_expr_set_process_num_id (expr, num_id)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: num_id
expr%num_id = num_id
expr%has_num_id = .true.
end subroutine event_expr_set_process_num_id
@ %def event_expr_set_process_id
@ %def event_expr_set_process_num_id
@ Reset / set the data that pertain to a particular event. The event
index is reset unless explicitly told to keep it.
<<Subevt expr: event expr: TBP>>=
procedure :: reset_contents => event_expr_reset_contents
procedure :: set => event_expr_set
<<Subevt expr: procedures>>=
subroutine event_expr_reset_contents (expr)
class(event_expr_t), intent(inout) :: expr
call expr%base_reset_contents ()
expr%has_sqme_ref = .false.
expr%has_sqme_prc = .false.
expr%has_sqme_alt = .false.
expr%has_weight_ref = .false.
expr%has_weight_prc = .false.
expr%has_weight_alt = .false.
expr%has_excess_prc = .false.
end subroutine event_expr_reset_contents
subroutine event_expr_set (expr, &
weight_ref, weight_prc, weight_alt, &
excess_prc, &
sqme_ref, sqme_prc, sqme_alt)
class(event_expr_t), intent(inout) :: expr
real(default), intent(in), optional :: weight_ref, weight_prc
real(default), intent(in), optional :: excess_prc
real(default), intent(in), optional :: sqme_ref, sqme_prc
real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
if (present (sqme_ref)) then
expr%has_sqme_ref = .true.
expr%sqme_ref = sqme_ref
end if
if (present (sqme_prc)) then
expr%has_sqme_prc = .true.
expr%sqme_prc = sqme_prc
end if
if (present (sqme_alt)) then
expr%has_sqme_alt = .true.
expr%sqme_alt = sqme_alt
end if
if (present (weight_ref)) then
expr%has_weight_ref = .true.
expr%weight_ref = weight_ref
end if
if (present (weight_prc)) then
expr%has_weight_prc = .true.
expr%weight_prc = weight_prc
end if
if (present (weight_alt)) then
expr%has_weight_alt = .true.
expr%weight_alt = weight_alt
end if
if (present (excess_prc)) then
expr%has_excess_prc = .true.
expr%excess_prc = excess_prc
end if
end subroutine event_expr_set
@ %def event_expr_reset_contents event_expr_set
@ Access the subevent index.
<<Subevt expr: event expr: TBP>>=
procedure :: has_event_index => event_expr_has_event_index
procedure :: get_event_index => event_expr_get_event_index
<<Subevt expr: procedures>>=
function event_expr_has_event_index (expr) result (flag)
class(event_expr_t), intent(in) :: expr
logical :: flag
flag = expr%has_index
end function event_expr_has_event_index
function event_expr_get_event_index (expr) result (index)
class(event_expr_t), intent(in) :: expr
integer :: index
if (expr%has_index) then
index = expr%index
else
index = 0
end if
end function event_expr_get_event_index
@ %def event_expr_has_event_index
@ %def event_expr_get_event_index
@ Set/increment the subevent index. Initialize it if necessary.
<<Subevt expr: event expr: TBP>>=
procedure :: set_event_index => event_expr_set_event_index
procedure :: reset_event_index => event_expr_reset_event_index
procedure :: increment_event_index => event_expr_increment_event_index
<<Subevt expr: procedures>>=
subroutine event_expr_set_event_index (expr, index)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: index
expr%index = index
expr%has_index = .true.
end subroutine event_expr_set_event_index
subroutine event_expr_reset_event_index (expr)
class(event_expr_t), intent(inout) :: expr
expr%has_index = .false.
end subroutine event_expr_reset_event_index
subroutine event_expr_increment_event_index (expr, offset)
class(event_expr_t), intent(inout) :: expr
integer, intent(in), optional :: offset
if (expr%has_index) then
expr%index = expr%index + 1
else if (present (offset)) then
call expr%set_event_index (offset + 1)
else
call expr%set_event_index (1)
end if
end subroutine event_expr_increment_event_index
@ %def event_expr_set_event_index
@ %def event_expr_increment_event_index
@ Fill the event expression: take the particle data and kinematics
from a [[particle_set]] object.
We allow the particle content to change for each event. Therefore, we set the
event variables each time.
Also increment the event index; initialize it if necessary.
<<Subevt expr: event expr: TBP>>=
procedure :: fill_subevt => event_expr_fill_subevt
<<Subevt expr: procedures>>=
subroutine event_expr_fill_subevt (expr, particle_set)
class(event_expr_t), intent(inout) :: expr
type(particle_set_t), intent(in) :: particle_set
call particle_set%to_subevt (expr%subevt_t, expr%colorize_subevt)
expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
expr%n_in = subevt_get_n_in (expr%subevt_t)
expr%n_out = subevt_get_n_out (expr%subevt_t)
expr%n_tot = expr%n_in + expr%n_out
expr%subevt_filled = .true.
end subroutine event_expr_fill_subevt
@ %def event_expr_fill_subevt
@ Evaluate, if the event passes the selection. For absent expressions we take
default values.
<<Subevt expr: event expr: TBP>>=
procedure :: evaluate => event_expr_evaluate
<<Subevt expr: procedures>>=
subroutine event_expr_evaluate (expr, passed, reweight, analysis_flag)
class(event_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: reweight
logical, intent(out) :: analysis_flag
call expr%base_evaluate (passed)
if (passed) then
if (expr%has_reweight) then
call expr%reweight%evaluate ()
if (expr%reweight%is_known ()) then
reweight = expr%reweight%get_real ()
else
call msg_error ("Evaluate reweight expression: &
&result undefined")
reweight = 0
end if
else
reweight = 1
end if
if (expr%has_analysis) then
call expr%analysis%evaluate ()
if (expr%analysis%is_known ()) then
analysis_flag = expr%analysis%get_log ()
else
call msg_error ("Evaluate analysis expression: &
&result undefined")
analysis_flag = .false.
end if
else
analysis_flag = .true.
end if
end if
end subroutine event_expr_evaluate
@ %def event_expr_evaluate
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Parton states}
A [[parton_state_t]] object contains the effective kinematics and
dynamics of an elementary partonic interaction, with or without the
beam/structure function state included. The type is abstract and has
two distinct extensions. The [[isolated_state_t]] extension describes
the isolated elementary interaction where the [[int_eff]] subobject
contains the complex transition amplitude, exclusive in all quantum
numbers. The particle content and kinematics describe the effective
partonic state. The [[connected_state_t]] extension contains the
partonic [[subevt]] and the expressions for cuts and scales which use
it.
In the isolated state, the effective partonic interaction may either
be identical to the hard interaction, in which case it is just a
pointer to the latter. Or it may involve a rearrangement of partons,
in which case we allocate it explicitly and flag this by
[[int_is_allocated]].
The [[trace]] evaluator contains the absolute square of the effective
transition amplitude matrix, summed over final states. It is also summed over
initial states, depending on the the beam setup allows. The result is used for
integration.
The [[matrix]] evaluator is the counterpart of [[trace]] which is kept
exclusive in all observable quantum numbers. The [[flows]] evaluator is
furthermore exclusive in colors, but neglecting all color interference. The
[[matrix]] and [[flows]] evaluators are filled only for sampling points that
become part of physical events.
Note: It would be natural to make the evaluators allocatable. The extra
[[has_XXX]] flags indicate whether evaluators are active, instead.
This module contains no unit tests. The tests are covered by the
[[processes]] module below.
<<[[parton_states.f90]]>>=
<<File header>>
module parton_states
<<Use kinds>>
<<Use debug>>
use io_units
use format_utils, only: write_separator
use diagnostics
use lorentz
use subevents
use variables
use expr_base
use model_data
use flavors
use helicities
use colors
use quantum_numbers
use state_matrices
use polarizations
use interactions
use evaluators
use beams
use sf_base
use process_constants
use prc_core
use subevt_expr
<<Standard module head>>
<<Parton states: public>>
<<Parton states: types>>
contains
<<Parton states: procedures>>
end module parton_states
@ %def parton_states
@
\subsection{Abstract base type}
The common part are the evaluators, one for the trace (summed over all
quantum numbers), one for the transition matrix (summed only over
unobservable quantum numbers), and one for the flow distribution
(transition matrix without interferences, exclusive in color flow).
<<Parton states: types>>=
type, abstract :: parton_state_t
logical :: has_trace = .false.
logical :: has_matrix = .false.
logical :: has_flows = .false.
type(evaluator_t) :: trace
type(evaluator_t) :: matrix
type(evaluator_t) :: flows
contains
<<Parton states: parton state: TBP>>
end type parton_state_t
@ %def parton_state_t
@ The [[isolated_state_t]] extension contains the [[sf_chain_eff]] object
and the (hard) effective interaction [[int_eff]], separately, both are
implemented as a pointer. The evaluators (trace, matrix, flows) apply
to the hard interaction only.
If the effective interaction differs from the hard interaction, the
pointer is allocated explicitly. Analogously for [[sf_chain_eff]].
<<Parton states: public>>=
public :: isolated_state_t
<<Parton states: types>>=
type, extends (parton_state_t) :: isolated_state_t
logical :: sf_chain_is_allocated = .false.
type(sf_chain_instance_t), pointer :: sf_chain_eff => null ()
logical :: int_is_allocated = .false.
type(interaction_t), pointer :: int_eff => null ()
contains
<<Parton states: isolated state: TBP>>
end type isolated_state_t
@ %def isolated_state_t
@ The [[connected_state_t]] extension contains all data that enable
the evaluation of observables for the effective connected state. The
evaluators connect the (effective) structure-function chain and hard
interaction that were kept separate in the [[isolated_state_t]].
The [[flows_sf]] evaluator is an extended copy of the
structure-function
The [[expr]] subobject consists of the [[subevt]], a simple event record,
expressions for cuts etc.\ which refer to this record, and a [[var_list]]
which contains event-specific variables, linked to the process variable
list. Variables used within the expressions are looked up in [[var_list]].
<<Parton states: public>>=
public :: connected_state_t
<<Parton states: types>>=
type, extends (parton_state_t) :: connected_state_t
type(state_flv_content_t) :: state_flv
logical :: has_flows_sf = .false.
type(evaluator_t) :: flows_sf
logical :: has_expr = .false.
type(parton_expr_t) :: expr
contains
<<Parton states: connected state: TBP>>
end type connected_state_t
@ %def connected_state_t
@ Output: each evaluator is written only when it is active. The
[[sf_chain]] is only written if it is explicitly allocated.
<<Parton states: parton state: TBP>>=
procedure :: write => parton_state_write
<<Parton states: procedures>>=
subroutine parton_state_write (state, unit, testflag)
class(parton_state_t), intent(in) :: state
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
select type (state)
class is (isolated_state_t)
if (state%sf_chain_is_allocated) then
call write_separator (u)
call state%sf_chain_eff%write (u)
end if
if (state%int_is_allocated) then
call write_separator (u)
write (u, "(1x,A)") &
"Effective interaction:"
call write_separator (u)
call state%int_eff%basic_write (u, testflag = testflag)
end if
class is (connected_state_t)
if (state%has_flows_sf) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (extension of the beam evaluator &
&with color contractions):"
call write_separator (u)
call state%flows_sf%write (u, testflag = testflag)
end if
end select
if (state%has_trace) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (trace of the squared transition matrix):"
call write_separator (u)
call state%trace%write (u, testflag = testflag)
end if
if (state%has_matrix) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (squared transition matrix):"
call write_separator (u)
call state%matrix%write (u, testflag = testflag)
end if
if (state%has_flows) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (squared color-flow matrix):"
call write_separator (u)
call state%flows%write (u, testflag = testflag)
end if
select type (state)
class is (connected_state_t)
if (state%has_expr) then
call write_separator (u)
call state%expr%write (u)
end if
end select
end subroutine parton_state_write
@ %def parton_state_write
@ Finalize interaction and evaluators, but only if allocated.
<<Parton states: parton state: TBP>>=
procedure :: final => parton_state_final
<<Parton states: procedures>>=
subroutine parton_state_final (state)
class(parton_state_t), intent(inout) :: state
if (state%has_flows) then
call state%flows%final ()
state%has_flows = .false.
end if
if (state%has_matrix) then
call state%matrix%final ()
state%has_matrix = .false.
end if
if (state%has_trace) then
call state%trace%final ()
state%has_trace = .false.
end if
select type (state)
class is (connected_state_t)
if (state%has_flows_sf) then
call state%flows_sf%final ()
state%has_flows_sf = .false.
end if
call state%expr%final ()
class is (isolated_state_t)
if (state%int_is_allocated) then
call state%int_eff%final ()
deallocate (state%int_eff)
state%int_is_allocated = .false.
end if
if (state%sf_chain_is_allocated) then
call state%sf_chain_eff%final ()
end if
end select
end subroutine parton_state_final
@ %def parton_state_final
@
\subsection{Common Initialization}
Initialize the isolated parton state. In this version, the
effective structure-function chain [[sf_chain_eff]] and the effective
interaction [[int_eff]] both are trivial pointers to the seed
structure-function chain and to the hard interaction, respectively.
<<Parton states: isolated state: TBP>>=
procedure :: init => isolated_state_init
<<Parton states: procedures>>=
subroutine isolated_state_init (state, sf_chain, int)
class(isolated_state_t), intent(out) :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(interaction_t), intent(in), target :: int
state%sf_chain_eff => sf_chain
state%int_eff => int
end subroutine isolated_state_init
@ %def isolated_state_init
@
\subsection{Evaluator initialization: isolated state}
Create an evaluator for the trace of the squared transition matrix.
The trace goes over all outgoing quantum numbers. Whether we trace
over incoming quantum numbers other than color, depends on the given
[[qn_mask_in]].
There are two options: explicitly computing the color factor table
([[use_cf]] false; [[nc]] defined), or taking the color factor
table from the hard matrix element data.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_trace => isolated_state_setup_square_trace
<<Parton states: procedures>>=
subroutine isolated_state_setup_square_trace (state, core, &
qn_mask_in, col, keep_fs_flavor)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
!!! Actually need allocatable attribute here fore once because col might
!!! enter the subroutine non-allocated.
integer, intent(in), dimension(:), allocatable :: col
logical, intent(in) :: keep_fs_flavor
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
qn_mask( : data%n_in) = &
quantum_numbers_mask (.false., .true., .false.) &
.or. qn_mask_in
qn_mask(data%n_in + 1 : ) = &
quantum_numbers_mask (.not. keep_fs_flavor, .true., .true.)
if (core%use_color_factors) then
call state%trace%init_square (state%int_eff, qn_mask, &
col_flow_index = data%cf_index, &
col_factor = data%color_factors, &
col_index_hi = col, &
nc = core%nc)
else
call state%trace%init_square (state%int_eff, qn_mask, nc = core%nc)
end if
end associate
state%has_trace = .true.
end subroutine isolated_state_setup_square_trace
@ %def isolated_state_setup_square_trace
@ Set up an identity-evaluator for the trace. This implies that [[me]]
is considered to be a squared amplitude, as for example for BLHA matrix
elements.
<<Parton states: isolated state: TBP>>=
procedure :: setup_identity_trace => isolated_state_setup_identity_trace
<<Parton states: procedures>>=
subroutine isolated_state_setup_identity_trace (state, core, qn_mask_in, &
keep_fs_flavors, keep_colors)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
logical, intent(in), optional :: keep_fs_flavors, keep_colors
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
logical :: fs_flv_flag, col_flag
fs_flv_flag = .true.; col_flag = .true.
if (present(keep_fs_flavors)) fs_flv_flag = .not. keep_fs_flavors
if (present(keep_colors)) col_flag = .not. keep_colors
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
qn_mask( : data%n_in) = &
quantum_numbers_mask (.false., col_flag, .false.) .or. qn_mask_in
qn_mask(data%n_in + 1 : ) = &
quantum_numbers_mask (fs_flv_flag, col_flag, .true.)
end associate
call state%int_eff%set_mask (qn_mask)
call state%trace%init_identity (state%int_eff)
state%has_trace = .true.
end subroutine isolated_state_setup_identity_trace
@ %def isolated_state_setup_identity_trace
@ Set up the evaluator for the transition matrix, exclusive in
helicities where this is requested.
For all unstable final-state particles we keep polarization according to the
applicable decay options. If the process is a decay itself, this applies also
to the initial state.
For all polarized final-state particles, we keep polarization including
off-diagonal entries. We drop helicity completely for unpolarized final-state
particles.
For the initial state, if the particle has not been handled yet, we
apply the provided [[qn_mask_in]] which communicates the beam properties.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_matrix => isolated_state_setup_square_matrix
<<Parton states: procedures>>=
subroutine isolated_state_setup_square_matrix &
(state, core, model, qn_mask_in, col)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
integer, dimension(:), intent(in) :: col
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
logical :: helmask, helmask_hd
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
allocate (flv (data%n_flv))
do i = 1, data%n_in + data%n_out
call flv%init (data%flv_state(i,:), model)
if ((data%n_in == 1 .or. i > data%n_in) &
.and. any (.not. flv%is_stable ())) then
helmask = all (flv%decays_isotropically ())
helmask_hd = all (flv%decays_diagonal ())
qn_mask(i) = quantum_numbers_mask (.false., .true., helmask, &
mask_hd = helmask_hd)
else if (i > data%n_in) then
helmask = all (.not. flv%is_polarized ())
qn_mask(i) = quantum_numbers_mask (.false., .true., helmask)
else
qn_mask(i) = quantum_numbers_mask (.false., .true., .false.) &
.or. qn_mask_in(i)
end if
end do
if (core%use_color_factors) then
call state%matrix%init_square (state%int_eff, qn_mask, &
col_flow_index = data%cf_index, &
col_factor = data%color_factors, &
col_index_hi = col, &
nc = core%nc)
else
call state%matrix%init_square (state%int_eff, &
qn_mask, &
nc = core%nc)
end if
end associate
state%has_matrix = .true.
end subroutine isolated_state_setup_square_matrix
@ %def isolated_state_setup_square_matrix
@ This procedure initializes the evaluator that computes the
contributions to color flows, neglecting color interference.
The incoming-particle mask can be used to sum over incoming flavor.
Helicity handling: see above.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_flows => isolated_state_setup_square_flows
<<Parton states: procedures>>=
subroutine isolated_state_setup_square_flows (state, core, model, qn_mask_in)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
logical :: helmask, helmask_hd
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
allocate (flv (data%n_flv))
do i = 1, data%n_in + data%n_out
call flv%init (data%flv_state(i,:), model)
if ((data%n_in == 1 .or. i > data%n_in) &
.and. any (.not. flv%is_stable ())) then
helmask = all (flv%decays_isotropically ())
helmask_hd = all (flv%decays_diagonal ())
qn_mask(i) = quantum_numbers_mask (.false., .false., helmask, &
mask_hd = helmask_hd)
else if (i > data%n_in) then
helmask = all (.not. flv%is_polarized ())
qn_mask(i) = quantum_numbers_mask (.false., .false., helmask)
else
qn_mask(i) = quantum_numbers_mask (.false., .false., .false.) &
.or. qn_mask_in(i)
end if
end do
call state%flows%init_square (state%int_eff, qn_mask, &
expand_color_flows = .true.)
end associate
state%has_flows = .true.
end subroutine isolated_state_setup_square_flows
@ %def isolated_state_setup_square_flows
@
\subsection{Evaluator initialization: connected state}
Set up a trace evaluator as a product of two evaluators (incoming state,
effective interaction). In the result, all quantum numbers are summed over.
If the optional [[int]] interaction is provided, use this for the
first factor in the convolution. Otherwise, use the final interaction
of the stored [[sf_chain]].
The [[resonant]] flag applies if we want to construct
a decay chain. The resonance property can propagate to the final
event output.
If an extended structure function is required [[requires_extended_sf]],
we have to not consider [[sub]] as a quantum number.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_trace => connected_state_setup_connected_trace
<<Parton states: procedures>>=
subroutine connected_state_setup_connected_trace &
(state, isolated, int, resonant, undo_helicities, &
keep_fs_flavors, requires_extended_sf)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
logical, intent(in), optional :: undo_helicities
logical, intent(in), optional :: keep_fs_flavors
logical, intent(in), optional :: requires_extended_sf
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int, beam_int
logical :: reduce, fs_flv_flag
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
"connected_state_setup_connected_trace")
reduce = .false.; fs_flv_flag = .true.
if (present (undo_helicities)) reduce = undo_helicities
if (present (keep_fs_flavors)) fs_flv_flag = .not. keep_fs_flavors
mask = quantum_numbers_mask (fs_flv_flag, .true., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
end if
if (debug2_active (D_PROCESS_INTEGRATION)) then
call src_int%basic_write ()
end if
call state%trace%init_product (src_int, isolated%trace, &
qn_mask_conn = mask, &
qn_mask_rest = mask, &
connections_are_resonant = resonant, &
ignore_sub_for_qn = requires_extended_sf)
if (reduce) then
beam_int => isolated%sf_chain_eff%get_beam_int_ptr ()
call undo_qn_hel (beam_int, mask, beam_int%get_n_tot ())
call undo_qn_hel (src_int, mask, src_int%get_n_tot ())
call beam_int%set_matrix_element (cmplx (1, 0, default))
call src_int%set_matrix_element (cmplx (1, 0, default))
end if
state%has_trace = .true.
contains
subroutine undo_qn_hel (int_in, mask, n_tot)
type(interaction_t), intent(inout) :: int_in
type(quantum_numbers_mask_t), intent(in) :: mask
integer, intent(in) :: n_tot
type(quantum_numbers_mask_t), dimension(n_tot) :: mask_in
mask_in = mask
call int_in%set_mask (mask_in)
end subroutine undo_qn_hel
end subroutine connected_state_setup_connected_trace
@ %def connected_state_setup_connected_trace
@ Set up a matrix evaluator as a product of two evaluators (incoming
state, effective interation). In the intermediate state, color and
helicity is summed over. In the final state, we keep the quantum
numbers which are present in the original evaluators.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_matrix => connected_state_setup_connected_matrix
<<Parton states: procedures>>=
subroutine connected_state_setup_connected_matrix &
(state, isolated, int, resonant, qn_filter_conn)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int
mask = quantum_numbers_mask (.false., .true., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
end if
call state%matrix%init_product &
(src_int, isolated%matrix, mask, &
qn_filter_conn = qn_filter_conn, &
connections_are_resonant = resonant)
state%has_matrix = .true.
end subroutine connected_state_setup_connected_matrix
@ %def connected_state_setup_connected_matrix
@ Set up a matrix evaluator as a product of two evaluators (incoming
state, effective interation). In the intermediate state, only
helicity is summed over. In the final state, we keep the quantum
numbers which are present in the original evaluators.
If the optional [[int]] interaction is provided, use this for the
first factor in the convolution. Otherwise, use the final interaction
of the stored [[sf_chain]], after creating an intermediate interaction
that includes a correlated color state. We assume that for a
caller-provided [[int]], this is not necessary.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_flows => connected_state_setup_connected_flows
<<Parton states: procedures>>=
subroutine connected_state_setup_connected_flows &
(state, isolated, int, resonant, qn_filter_conn)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int
mask = quantum_numbers_mask (.false., .false., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
call state%flows_sf%init_color_contractions (src_int)
state%has_flows_sf = .true.
src_int => state%flows_sf%interaction_t
end if
call state%flows%init_product (src_int, isolated%flows, mask, &
qn_filter_conn = qn_filter_conn, &
connections_are_resonant = resonant)
state%has_flows = .true.
end subroutine connected_state_setup_connected_flows
@ %def connected_state_setup_connected_flows
@ Determine and store the flavor content for the connected state.
This queries the [[matrix]] evaluator component, which should hold the
requested flavor information.
<<Parton states: connected state: TBP>>=
procedure :: setup_state_flv => connected_state_setup_state_flv
<<Parton states: procedures>>=
subroutine connected_state_setup_state_flv (state, n_out_hard)
class(connected_state_t), intent(inout), target :: state
integer, intent(in) :: n_out_hard
call interaction_get_flv_content &
(state%matrix%interaction_t, state%state_flv, n_out_hard)
end subroutine connected_state_setup_state_flv
@ %def connected_state_setup_state_flv
@ Return the current flavor state object.
<<Parton states: connected state: TBP>>=
procedure :: get_state_flv => connected_state_get_state_flv
<<Parton states: procedures>>=
function connected_state_get_state_flv (state) result (state_flv)
class(connected_state_t), intent(in) :: state
type(state_flv_content_t) :: state_flv
state_flv = state%state_flv
end function connected_state_get_state_flv
@ %def connected_state_get_state_flv
@
\subsection{Cuts and expressions}
Set up the [[subevt]] that corresponds to the connected interaction.
The index arrays refer to the interaction.
We assign the particles as follows: the beam particles are the first
two (decay process: one) entries in the trace evaluator. The incoming
partons are identified by their link to the outgoing partons of the
structure-function chain. The outgoing partons are those of the trace
evaluator, which include radiated partons during the
structure-function chain.
<<Parton states: connected state: TBP>>=
procedure :: setup_subevt => connected_state_setup_subevt
<<Parton states: procedures>>=
subroutine connected_state_setup_subevt (state, sf_chain, f_beam, f_in, f_out)
class(connected_state_t), intent(inout), target :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
integer :: n_beam, n_in, n_out, n_vir, n_tot, i, j
integer, dimension(:), allocatable :: i_beam, i_in, i_out
integer :: sf_out_i
type(interaction_t), pointer :: sf_int
sf_int => sf_chain%get_out_int_ptr ()
n_beam = size (f_beam)
n_in = size (f_in)
n_out = size (f_out)
n_vir = state%trace%get_n_vir ()
n_tot = state%trace%get_n_tot ()
allocate (i_beam (n_beam), i_in (n_in), i_out (n_out))
i_beam = [(i, i = 1, n_beam)]
do j = 1, n_in
sf_out_i = sf_chain%get_out_i (j)
i_in(j) = interaction_find_link &
(state%trace%interaction_t, sf_int, sf_out_i)
end do
i_out = [(i, i = n_vir + 1, n_tot)]
call state%expr%setup_subevt (state%trace%interaction_t, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
state%has_expr = .true.
end subroutine connected_state_setup_subevt
@ %def connected_state_setup_subevt
@ Initialize the variable list specific for this state/term. We insert event
variables ([[sqrts_hat]]) and link the process variable list. The variable
list acquires pointers to subobjects of [[state]], which must therefore have a
[[target]] attribute.
<<Parton states: connected state: TBP>>=
procedure :: setup_var_list => connected_state_setup_var_list
<<Parton states: procedures>>=
subroutine connected_state_setup_var_list (state, process_var_list, beam_data)
class(connected_state_t), intent(inout), target :: state
type(var_list_t), intent(in), target :: process_var_list
type(beam_data_t), intent(in) :: beam_data
call state%expr%setup_vars (beam_data%get_sqrts ())
call state%expr%link_var_list (process_var_list)
end subroutine connected_state_setup_var_list
@ %def connected_state_setup_var_list
@ Allocate the cut expression etc.
<<Parton states: connected state: TBP>>=
procedure :: setup_cuts => connected_state_setup_cuts
procedure :: setup_scale => connected_state_setup_scale
procedure :: setup_fac_scale => connected_state_setup_fac_scale
procedure :: setup_ren_scale => connected_state_setup_ren_scale
procedure :: setup_weight => connected_state_setup_weight
<<Parton states: procedures>>=
subroutine connected_state_setup_cuts (state, ef_cuts)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_cuts
call state%expr%setup_selection (ef_cuts)
end subroutine connected_state_setup_cuts
subroutine connected_state_setup_scale (state, ef_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_scale
call state%expr%setup_scale (ef_scale)
end subroutine connected_state_setup_scale
subroutine connected_state_setup_fac_scale (state, ef_fac_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_fac_scale
call state%expr%setup_fac_scale (ef_fac_scale)
end subroutine connected_state_setup_fac_scale
subroutine connected_state_setup_ren_scale (state, ef_ren_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_ren_scale
call state%expr%setup_ren_scale (ef_ren_scale)
end subroutine connected_state_setup_ren_scale
subroutine connected_state_setup_weight (state, ef_weight)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_weight
call state%expr%setup_weight (ef_weight)
end subroutine connected_state_setup_weight
@ %def connected_state_setup_expressions
@ Reset the expression object: invalidate the subevt.
<<Parton states: connected state: TBP>>=
procedure :: reset_expressions => connected_state_reset_expressions
<<Parton states: procedures>>=
subroutine connected_state_reset_expressions (state)
class(connected_state_t), intent(inout) :: state
if (state%has_expr) call state%expr%reset_contents ()
end subroutine connected_state_reset_expressions
@ %def connected_state_reset_expressions
@
\subsection{Evaluation}
Transfer momenta to the trace evaluator and fill the [[subevt]] with
this effective kinematics, if applicable.
Note: we may want to apply a boost for the [[subevt]].
<<Parton states: parton state: TBP>>=
procedure :: receive_kinematics => parton_state_receive_kinematics
<<Parton states: procedures>>=
subroutine parton_state_receive_kinematics (state)
class(parton_state_t), intent(inout), target :: state
if (state%has_trace) then
call state%trace%receive_momenta ()
select type (state)
class is (connected_state_t)
if (state%has_expr) then
call state%expr%fill_subevt (state%trace%interaction_t)
end if
end select
end if
end subroutine parton_state_receive_kinematics
@ %def parton_state_receive_kinematics
@ Recover kinematics: We assume that the trace evaluator is filled
with momenta. Send those momenta back to the sources, then fill the
variables and subevent as above.
The incoming momenta of the connected state are not connected to the
isolated state but to the beam interaction. Therefore, the incoming
momenta within the isolated state do not become defined, yet.
Instead, we reconstruct the beam (and ISR) momentum configuration.
<<Parton states: parton state: TBP>>=
procedure :: send_kinematics => parton_state_send_kinematics
<<Parton states: procedures>>=
subroutine parton_state_send_kinematics (state)
class(parton_state_t), intent(inout), target :: state
if (state%has_trace) then
call interaction_send_momenta (state%trace%interaction_t)
select type (state)
class is (connected_state_t)
call state%expr%fill_subevt (state%trace%interaction_t)
end select
end if
end subroutine parton_state_send_kinematics
@ %def parton_state_send_kinematics
@ Evaluate the expressions. The routine evaluates first the cut expression.
If the event passes, it evaluates the other expressions. Where no expressions
are defined, default values are inserted.
<<Parton states: connected state: TBP>>=
procedure :: evaluate_expressions => connected_state_evaluate_expressions
<<Parton states: procedures>>=
subroutine connected_state_evaluate_expressions (state, passed, &
scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
class(connected_state_t), intent(inout) :: state
logical, intent(out) :: passed
real(default), intent(out) :: scale, fac_scale, ren_scale, weight
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
if (state%has_expr) then
call state%expr%evaluate (passed, scale, fac_scale, ren_scale, weight, &
scale_forced, force_evaluation)
end if
end subroutine connected_state_evaluate_expressions
@ %def connected_state_evaluate_expressions
@ Evaluate the structure-function chain, if it is allocated
explicitly. The argument is the factorization scale.
If the chain is merely a pointer, the chain should already be
evaluated at this point.
<<Parton states: isolated state: TBP>>=
procedure :: evaluate_sf_chain => isolated_state_evaluate_sf_chain
<<Parton states: procedures>>=
subroutine isolated_state_evaluate_sf_chain (state, fac_scale)
class(isolated_state_t), intent(inout) :: state
real(default), intent(in) :: fac_scale
if (state%sf_chain_is_allocated) call state%sf_chain_eff%evaluate (fac_scale)
end subroutine isolated_state_evaluate_sf_chain
@ %def isolated_state_evaluate_sf_chain
@ Evaluate the trace.
<<Parton states: parton state: TBP>>=
procedure :: evaluate_trace => parton_state_evaluate_trace
<<Parton states: procedures>>=
subroutine parton_state_evaluate_trace (state)
class(parton_state_t), intent(inout) :: state
if (state%has_trace) call state%trace%evaluate ()
end subroutine parton_state_evaluate_trace
@ %def parton_state_evaluate_trace
<<Parton states: parton state: TBP>>=
procedure :: evaluate_matrix => parton_state_evaluate_matrix
<<Parton states: procedures>>=
subroutine parton_state_evaluate_matrix (state)
class(parton_state_t), intent(inout) :: state
if (state%has_matrix) call state%matrix%evaluate ()
end subroutine parton_state_evaluate_matrix
@ %def parton_state_evaluate_matrix
@ Evaluate the extra evaluators that we need for physical events.
<<Parton states: parton state: TBP>>=
procedure :: evaluate_event_data => parton_state_evaluate_event_data
<<Parton states: procedures>>=
subroutine parton_state_evaluate_event_data (state, only_momenta)
class(parton_state_t), intent(inout) :: state
logical, intent(in), optional :: only_momenta
logical :: only_mom
only_mom = .false.; if (present (only_momenta)) only_mom = only_momenta
select type (state)
type is (connected_state_t)
if (state%has_flows_sf) then
call state%flows_sf%receive_momenta ()
if (.not. only_mom) call state%flows_sf%evaluate ()
end if
end select
if (state%has_matrix) then
call state%matrix%receive_momenta ()
if (.not. only_mom) call state%matrix%evaluate ()
end if
if (state%has_flows) then
call state%flows%receive_momenta ()
if (.not. only_mom) call state%flows%evaluate ()
end if
end subroutine parton_state_evaluate_event_data
@ %def parton_state_evaluate_event_data
@ Normalize the helicity density matrix by its trace, i.e., factor out
the trace and put it into an overall normalization factor. The trace
and flow evaluators are unchanged.
<<Parton states: parton state: TBP>>=
procedure :: normalize_matrix_by_trace => &
parton_state_normalize_matrix_by_trace
<<Parton states: procedures>>=
subroutine parton_state_normalize_matrix_by_trace (state)
class(parton_state_t), intent(inout) :: state
if (state%has_matrix) call state%matrix%normalize_by_trace ()
end subroutine parton_state_normalize_matrix_by_trace
@ %def parton_state_normalize_matrix_by_trace
@
\subsection{Accessing the state}
Three functions return a pointer to the event-relevant interactions.
<<Parton states: parton state: TBP>>=
procedure :: get_trace_int_ptr => parton_state_get_trace_int_ptr
procedure :: get_matrix_int_ptr => parton_state_get_matrix_int_ptr
procedure :: get_flows_int_ptr => parton_state_get_flows_int_ptr
<<Parton states: procedures>>=
function parton_state_get_trace_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_trace) then
ptr => state%trace%interaction_t
else
ptr => null ()
end if
end function parton_state_get_trace_int_ptr
function parton_state_get_matrix_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_matrix) then
ptr => state%matrix%interaction_t
else
ptr => null ()
end if
end function parton_state_get_matrix_int_ptr
function parton_state_get_flows_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_flows) then
ptr => state%flows%interaction_t
else
ptr => null ()
end if
end function parton_state_get_flows_int_ptr
@ %def parton_state_get_trace_int_ptr
@ %def parton_state_get_matrix_int_ptr
@ %def parton_state_get_flows_int_ptr
@ Return the indices of the beam particles and the outgoing particles within
the trace (and thus, matrix and flows) evaluator, respectively.
<<Parton states: connected state: TBP>>=
procedure :: get_beam_index => connected_state_get_beam_index
procedure :: get_in_index => connected_state_get_in_index
<<Parton states: procedures>>=
subroutine connected_state_get_beam_index (state, i_beam)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_beam
call state%expr%get_beam_index (i_beam)
end subroutine connected_state_get_beam_index
subroutine connected_state_get_in_index (state, i_in)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_in
call state%expr%get_in_index (i_in)
end subroutine connected_state_get_in_index
@ %def connected_state_get_beam_index
@ %def connected_state_get_in_index
@
<<Parton states: public>>=
public :: refill_evaluator
<<Parton states: procedures>>=
subroutine refill_evaluator (sqme, qn, flv_index, evaluator)
complex(default), intent(in), dimension(:) :: sqme
type(quantum_numbers_t), intent(in), dimension(:,:) :: qn
integer, intent(in), dimension(:), optional :: flv_index
type(evaluator_t), intent(inout) :: evaluator
integer :: i, i_flv
do i = 1, size (sqme)
if (present (flv_index)) then
i_flv = flv_index(i)
else
i_flv = i
end if
call evaluator%add_to_matrix_element (qn(:,i_flv), sqme(i), &
match_only_flavor = .true.)
end do
end subroutine refill_evaluator
@ %def refill_evaluator
@ Return the number of outgoing (hard) particles for the state.
<<Parton states: parton state: TBP>>=
procedure :: get_n_out => parton_state_get_n_out
<<Parton states: procedures>>=
function parton_state_get_n_out (state) result (n)
class(parton_state_t), intent(in), target :: state
integer :: n
n = state%trace%get_n_out ()
end function parton_state_get_n_out
@ %def parton_state_get_n_out
@
\subsection{Unit tests}
<<[[parton_states_ut.f90]]>>=
<<File header>>
module parton_states_ut
use unit_tests
use parton_states_uti
<<Standard module head>>
<<Parton states: public test>>
contains
<<Parton states: test driver>>
end module parton_states_ut
@ %def parton_states_ut
<<[[parton_states_uti.f90]]>>=
<<File header>>
module parton_states_uti
<<Use kinds>>
<<Use strings>>
use constants, only: zero
use numeric_utils
use flavors
use colors
use helicities
use quantum_numbers
use sf_base, only: sf_chain_instance_t
use state_matrices, only: state_matrix_t
use prc_template_me, only: prc_template_me_t
use interactions, only: interaction_t
use models, only: model_t, create_test_model
use parton_states
<<Standard module head>>
<<Parton states: test declarations>>
contains
<<Parton states: tests>>
end module parton_states_uti
@ %def parton_states_uti
@
<<Parton states: public test>>=
public :: parton_states_test
<<Parton states: test driver>>=
subroutine parton_states_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Parton states: execute tests>>
end subroutine parton_states_test
@ %def parton_states_test
@
\subsubsection{Test a simple isolated state}
<<Parton states: execute tests>>=
call test (parton_states_1, "parton_states_1", &
"Create a 2 -> 2 isolated state and compute trace", &
u, results)
<<Parton states: test declarations>>=
public :: parton_states_1
<<Parton states: tests>>=
subroutine parton_states_1 (u)
integer, intent(in) :: u
type(state_matrix_t), allocatable :: state
type(flavor_t), dimension(2) :: flv_in
type(flavor_t), dimension(2) :: flv_out1, flv_out2
type(flavor_t), dimension(4) :: flv_tot
type(helicity_t), dimension(4) :: hel
type(color_t), dimension(4) :: col
integer :: h1, h2, h3, h4
integer :: f
integer :: i
type(quantum_numbers_t), dimension(4) :: qn
type(prc_template_me_t) :: core
type(sf_chain_instance_t), target :: sf_chain
type(interaction_t), target :: int
type(isolated_state_t) :: isolated_state
integer :: n_states = 0
integer, dimension(:), allocatable :: col_flow_index
type(quantum_numbers_mask_t), dimension(2) :: qn_mask
integer, dimension(8) :: i_allowed_states
complex(default), dimension(8) :: me
complex(default) :: me_check_tot, me_check_1, me_check_2, me2
logical :: tmp1, tmp2
type(model_t), pointer :: test_model => null ()
write (u, "(A)") "* Test output: parton_states_1"
write (u, "(A)") "* Purpose: Test the standard parton states"
write (u, "(A)")
call flv_in%init ([11, -11])
call flv_out1%init ([1, -1])
call flv_out2%init ([2, -2])
write (u, "(A)") "* Using incoming flavors: "
call flavor_write_array (flv_in, u)
write (u, "(A)") "* Two outgoing flavor structures: "
call flavor_write_array (flv_out1, u)
call flavor_write_array (flv_out2, u)
write (u, "(A)") "* Initialize state matrix"
allocate (state)
call state%init ()
write (u, "(A)") "* Fill state matrix"
call col(3)%init ([1])
call col(4)%init ([-1])
do f = 1, 2
do h1 = -1, 1, 2
do h2 = -1, 1, 2
do h3 = -1, 1, 2
do h4 = -1, 1, 2
n_states = n_states + 1
call hel%init ([h1, h2, h3, h4], [h1, h2, h3, h4])
if (f == 1) then
flv_tot = [flv_in, flv_out1]
else
flv_tot = [flv_in, flv_out2]
end if
call qn%init (flv_tot, col, hel)
call state%add_state (qn)
end do
end do
end do
end do
end do
!!! Two flavors, one color flow, 2 x 2 x 2 x 2 helicity configurations
!!! -> 32 states.
write (u, "(A)")
write (u, "(A,I2)") "* Generated number of states: ", n_states
call state%freeze ()
!!! Indices of the helicity configurations which are non-zero
i_allowed_states = [6, 7, 10, 11, 22, 23, 26, 27]
me = [cmplx (-1.89448E-5_default, 9.94456E-7_default, default), &
cmplx (-8.37887E-2_default, 4.30842E-3_default, default), &
cmplx (-1.99997E-1_default, -1.01985E-2_default, default), &
cmplx ( 1.79717E-5_default, 9.27038E-7_default, default), &
cmplx (-1.74859E-5_default, 8.78819E-7_default, default), &
cmplx ( 1.67577E-1_default, -8.61683E-3_default, default), &
cmplx ( 2.41331E-1_default, 1.23306E-2_default, default), &
cmplx (-3.59435E-5_default, -1.85407E-6_default, default)]
me_check_tot = cmplx (zero, zero, default)
me_check_1 = cmplx (zero, zero, default)
me_check_2 = cmplx (zero, zero, default)
do i = 1, 8
me2 = me(i) * conjg (me(i))
me_check_tot = me_check_tot + me2
if (i < 5) then
me_check_1 = me_check_1 + me2
else
me_check_2 = me_check_2 + me2
end if
call state%set_matrix_element (i_allowed_states(i), me(i))
end do
!!! Don't forget the color factor
me_check_tot = 3._default * me_check_tot
me_check_1 = 3._default * me_check_1
me_check_2 = 3._default * me_check_2
write (u, "(A)")
write (u, "(A)") "* Setup interaction"
call int%basic_init (2, 0, 2, set_relations = .true.)
call int%set_state_matrix (state)
core%data%n_in = 2; core%data%n_out = 2
core%data%n_flv = 2
allocate (core%data%flv_state (4, 2))
core%data%flv_state (1, :) = [11, 11]
core%data%flv_state (2, :) = [-11, -11]
core%data%flv_state (3, :) = [1, 2]
core%data%flv_state (4, :) = [-1, -2]
core%use_color_factors = .false.
core%nc = 3
write (u, "(A)") "* Init isolated state"
call isolated_state%init (sf_chain, int)
!!! There is only one color flow.
allocate (col_flow_index (n_states)); col_flow_index = 1
call qn_mask%init (.false., .false., .true., mask_cg = .false.)
write (u, "(A)") "* Give a trace to the isolated state"
call isolated_state%setup_square_trace (core, qn_mask, col_flow_index, .false.)
call isolated_state%evaluate_trace ()
write (u, "(A)")
write (u, "(A)", advance = "no") "* Squared matrix element correct: "
write (u, "(L1)") nearly_equal (me_check_tot, &
isolated_state%trace%get_matrix_element (1), rel_smallness = 0.00001_default)
write (u, "(A)") "* Give a matrix to the isolated state"
call create_test_model (var_str ("SM"), test_model)
call isolated_state%setup_square_matrix (core, test_model, qn_mask, col_flow_index)
call isolated_state%evaluate_matrix ()
write (u, "(A)") "* Sub-matrixelements correct: "
tmp1 = nearly_equal (me_check_1, &
isolated_state%matrix%get_matrix_element (1), rel_smallness = 0.00001_default)
tmp2 = nearly_equal (me_check_2, &
isolated_state%matrix%get_matrix_element (2), rel_smallness = 0.00001_default)
write (u, "(A,L1,A,L1)") "* 1: ", tmp1, ", 2: ", tmp2
write (u, "(A)") "* Test output end: parton_states_1"
end subroutine parton_states_1
@ %def parton_states_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process component management}
This module contains tools for managing and combining process
components and matrix-element code and values, acting at a level below
the actual process definition.
\subsection{Abstract base type}
The types introduced here are abstract base types.
<<[[pcm_base.f90]]>>=
<<File header>>
module pcm_base
<<Use kinds>>
use io_units
use diagnostics
use format_utils, only: write_integer_array
use format_utils, only: write_separator
use physics_defs, only: BORN, NLO_REAL
<<Use strings>>
use os_interface, only: os_data_t
use process_libraries, only: process_component_def_t
use process_libraries, only: process_library_t
use prc_core_def
use prc_core
use variables, only: var_list_t
use mappings, only: mapping_defaults_t
use phs_base, only: phs_config_t
use phs_forests, only: phs_parameters_t
use mci_base, only: mci_t
use model_data, only: model_data_t
use models, only: model_t
use blha_config, only: blha_master_t
use blha_olp_interfaces, only: blha_template_t
use process_config
use process_mci, only: process_mci_entry_t
<<Standard module head>>
<<PCM base: public>>
<<PCM base: parameters>>
<<PCM base: types>>
<<PCM base: interfaces>>
contains
<<PCM base: procedures>>
end module pcm_base
@ %def pcm_base
@
\subsection{Core management}
This object holds information about the cores used by the components
and allocates the corresponding manager instance.
[[i_component]] is the index of the process component which this core belongs
to. The pointer to the core definition is a convenient help in configuring
the core itself.
We allow for a [[blha_config]] configuration object that covers BLHA cores.
The BLHA standard is suitable generic to warrant support outside of specific
type extension (i.e., applies to LO and NLO if requested). The BLHA
configuration is allocated only if the core requires it.
<<PCM base: public>>=
public :: core_entry_t
<<PCM base: types>>=
type :: core_entry_t
integer :: i_component = 0
logical :: active = .false.
class(prc_core_def_t), pointer :: core_def => null ()
type(blha_template_t), allocatable :: blha_config
class(prc_core_t), allocatable :: core
contains
<<PCM base: core entry: TBP>>
end type core_entry_t
@ %def core_entry_t
@
<<PCM base: core entry: TBP>>=
procedure :: get_core_ptr => core_entry_get_core_ptr
<<PCM base: procedures>>=
function core_entry_get_core_ptr (core_entry) result (core)
class(core_entry_t), intent(in), target :: core_entry
class(prc_core_t), pointer :: core
if (allocated (core_entry%core)) then
core => core_entry%core
else
core => null ()
end if
end function core_entry_get_core_ptr
@ %def core_entry_get_core_ptr
@ Configure the core object after allocation with correct type. The
[[core_def]] object pointer and the index [[i_component]] of the associated
process component are already there.
<<PCM base: core entry: TBP>>=
procedure :: configure => core_entry_configure
<<PCM base: procedures>>=
subroutine core_entry_configure (core_entry, lib, id)
class(core_entry_t), intent(inout) :: core_entry
type(process_library_t), intent(in), target :: lib
type(string_t), intent(in) :: id
call core_entry%core%init &
(core_entry%core_def, lib, id, core_entry%i_component)
end subroutine core_entry_configure
@ %def core_entry_configure
@
\subsection{Process component manager}
This object may hold process and method-specific data, and it should
allocate the corresponding manager instance.
The number of components determines the [[component_selected]] array.
[[i_phs_config]] is a lookup table that returns the PHS configuration index
for a given component index.
[[i_core]] is a lookup table that returns the core-entry index for a given
component index.
<<PCM base: public>>=
public :: pcm_t
<<PCM base: types>>=
type, abstract :: pcm_t
logical :: initialized = .false.
logical :: has_pdfs = .false.
integer :: n_components = 0
integer :: n_cores = 0
integer :: n_mci = 0
logical, dimension(:), allocatable :: component_selected
logical, dimension(:), allocatable :: component_active
integer, dimension(:), allocatable :: i_phs_config
integer, dimension(:), allocatable :: i_core
integer, dimension(:), allocatable :: i_mci
type(blha_template_t) :: blha_defaults
logical :: uses_blha = .false.
type(os_data_t) :: os_data
contains
<<PCM base: pcm: TBP>>
end type pcm_t
@ %def pcm_t
@ The factory method. We use the [[inout]] intent, so calling this
again is an error.
<<PCM base: pcm: TBP>>=
procedure(pcm_allocate_instance), deferred :: allocate_instance
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_allocate_instance (pcm, instance)
import
class(pcm_t), intent(in) :: pcm
class(pcm_instance_t), intent(inout), allocatable :: instance
end subroutine pcm_allocate_instance
end interface
@ %def pcm_allocate_instance
@
<<PCM base: pcm: TBP>>=
procedure(pcm_is_nlo), deferred :: is_nlo
<<PCM base: interfaces>>=
abstract interface
function pcm_is_nlo (pcm) result (is_nlo)
import
logical :: is_nlo
class(pcm_t), intent(in) :: pcm
end function pcm_is_nlo
end interface
@ %def pcm_is_nlo
@
<<PCM base: pcm: TBP>>=
procedure(pcm_final), deferred :: final
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_final (pcm)
import
class(pcm_t), intent(inout) :: pcm
end subroutine pcm_final
end interface
@ %def pcm_final
@
\subsection{Initialization methods}
The PCM has the duty to coordinate and configure the process-object
components.
Initialize the PCM configuration itself, using environment data.
<<PCM base: pcm: TBP>>=
procedure(pcm_init), deferred :: init
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_init (pcm, env, meta)
import
class(pcm_t), intent(out) :: pcm
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
end subroutine pcm_init
end interface
@ %def pcm_init
@
Initialize the BLHA configuration block, the component-independent default
settings. This is to be called by [[pcm_init]]. We use the provided variable
list.
This block is filled regardless of whether BLHA is actually used, because why
not? We use a default value for the scheme (not set in unit tests).
<<PCM base: pcm: TBP>>=
procedure :: set_blha_defaults => pcm_set_blha_defaults
<<PCM base: procedures>>=
subroutine pcm_set_blha_defaults (pcm, polarized_beams, var_list)
class(pcm_t), intent(inout) :: pcm
type(var_list_t), intent(in) :: var_list
logical, intent(in) :: polarized_beams
logical :: muon_yukawa_off
real(default) :: top_yukawa
type(string_t) :: ew_scheme
muon_yukawa_off = &
var_list%get_lval (var_str ("?openloops_switch_off_muon_yukawa"))
top_yukawa = &
var_list%get_rval (var_str ("blha_top_yukawa"))
ew_scheme = &
var_list%get_sval (var_str ("$blha_ew_scheme"))
if (ew_scheme == "") ew_scheme = "Gmu"
call pcm%blha_defaults%init &
(polarized_beams, muon_yukawa_off, top_yukawa, ew_scheme)
end subroutine pcm_set_blha_defaults
@ %def pcm_set_blha_defaults
@ Read the method settings from the variable list and store them in the BLHA
master. The details depend on the [[pcm]] concrete type.
<<PCM base: pcm: TBP>>=
procedure(pcm_set_blha_methods), deferred :: set_blha_methods
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_set_blha_methods (pcm, blha_master, var_list)
import
class(pcm_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
end subroutine pcm_set_blha_methods
end interface
@ %def pcm_set_blha_methods
@ Produce the LO and NLO flavor-state tables (as far as available), as
appropriate for BLHA configuration. We may inspect either the PCM itself or
the array of process cores.
<<PCM base: pcm: TBP>>=
procedure(pcm_get_blha_flv_states), deferred :: get_blha_flv_states
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_get_blha_flv_states (pcm, core_entry, flv_born, flv_real)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
end subroutine pcm_get_blha_flv_states
end interface
@ %def pcm_get_blha_flv_states
@
Allocate the right number of process components. The number is also stored in
the process meta. Initially, all components are active but none are
selected.
<<PCM base: pcm: TBP>>=
procedure :: allocate_components => pcm_allocate_components
<<PCM base: procedures>>=
subroutine pcm_allocate_components (pcm, comp, meta)
class(pcm_t), intent(inout) :: pcm
type(process_component_t), dimension(:), allocatable, intent(out) :: comp
type(process_metadata_t), intent(in) :: meta
pcm%n_components = meta%n_components
allocate (comp (pcm%n_components))
allocate (pcm%component_selected (pcm%n_components), source = .false.)
allocate (pcm%component_active (pcm%n_components), source = .true.)
end subroutine pcm_allocate_components
@ %def pcm_allocate_components
@ Each process component belongs to a category/type, which we identify by a
universal integer constant. The categories can be taken from the process
definition. For easy lookup, we store the categories in an array.
<<PCM base: pcm: TBP>>=
procedure(pcm_categorize_components), deferred :: categorize_components
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_categorize_components (pcm, config)
import
class(pcm_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
end subroutine pcm_categorize_components
end interface
@ %def pcm_categorize_components
@
Allocate the right number and type(s) of process-core
objects, i.e., the interface object between the process and matrix-element
code.
Within the [[pcm]] block, also associate cores with components and store
relevant configuration data, including the [[i_core]] lookup table.
<<PCM base: pcm: TBP>>=
procedure(pcm_allocate_cores), deferred :: allocate_cores
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_allocate_cores (pcm, config, core_entry)
import
class(pcm_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
end subroutine pcm_allocate_cores
end interface
@ %def pcm_allocate_cores
@ Generate and interface external code for a single core, if this is
required.
<<PCM base: pcm: TBP>>=
procedure(pcm_prepare_any_external_code), deferred :: &
prepare_any_external_code
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
end subroutine pcm_prepare_any_external_code
end interface
@ %def pcm_prepare_any_external_code
@ Prepare the BLHA configuration for a core object that requires it. This
does not affect the core object, which may not yet be allocated.
<<PCM base: pcm: TBP>>=
procedure(pcm_setup_blha), deferred :: setup_blha
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_setup_blha (pcm, core_entry)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
end subroutine pcm_setup_blha
end interface
@ %def pcm_setup_blha
@ Configure the BLHA interface for a core object that requires it. This is
separate from the previous method, assuming that the [[pcm]] has to allocate
the actual cores and acquire some data in-between.
<<PCM base: pcm: TBP>>=
procedure(pcm_prepare_blha_core), deferred :: prepare_blha_core
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_prepare_blha_core (pcm, core_entry, model)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
end subroutine pcm_prepare_blha_core
end interface
@ %def pcm_prepare_blha_core
@ Allocate and configure the MCI (multi-channel integrator) records and their
relation to process components, appropriate for the algorithm implemented by
[[pcm]].
Create a [[mci_t]] template: the procedure [[dispatch_mci]] is called as a
factory method for allocating the [[mci_t]] object with a specific concrete
type. The call may depend on the concrete [[pcm]] type.
<<PCM base: public>>=
public :: dispatch_mci_proc
<<PCM base: interfaces>>=
abstract interface
subroutine dispatch_mci_proc (mci, var_list, process_id, is_nlo)
import
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
end subroutine dispatch_mci_proc
end interface
@ %def dispatch_mci_proc
<<PCM base: pcm: TBP>>=
procedure(pcm_setup_mci), deferred :: setup_mci
procedure(pcm_call_dispatch_mci), deferred :: call_dispatch_mci
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_setup_mci (pcm, mci_entry)
import
class(pcm_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
end subroutine pcm_setup_mci
end interface
abstract interface
subroutine pcm_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
import
class(pcm_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), intent(out), allocatable :: mci_template
end subroutine pcm_call_dispatch_mci
end interface
@ %def pcm_setup_mci
@ %def pcm_call_dispatch_mci
@ Proceed with PCM configuration based on the core and component
configuration data. Base version is empty.
<<PCM base: pcm: TBP>>=
procedure(pcm_complete_setup), deferred :: complete_setup
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_complete_setup (pcm, core_entry, component, model)
import
class(pcm_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
end subroutine pcm_complete_setup
end interface
@ %def pcm_complete_setup
@
\subsubsection{Retrieve information}
Return the core index that belongs to a particular component.
<<PCM base: pcm: TBP>>=
procedure :: get_i_core => pcm_get_i_core
<<PCM base: procedures>>=
function pcm_get_i_core (pcm, i_component) result (i_core)
class(pcm_t), intent(in) :: pcm
integer, intent(in) :: i_component
integer :: i_core
if (allocated (pcm%i_core)) then
i_core = pcm%i_core(i_component)
else
i_core = 0
end if
end function pcm_get_i_core
@ %def pcm_get_i_core
@
\subsubsection{Phase-space configuration}
Allocate and initialize the right number and type(s) of phase-space
configuration entries. The [[i_phs_config]] lookup table must be set
accordingly.
<<PCM base: pcm: TBP>>=
procedure(pcm_init_phs_config), deferred :: init_phs_config
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
import
class(pcm_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
end subroutine pcm_init_phs_config
end interface
@ %def pcm_init_phs_config
@
Initialize a single component. We require all process-configuration blocks,
and specific templates for the phase-space and integrator configuration.
We also provide the current component index [[i]] and the [[active]] flag.
<<PCM base: pcm: TBP>>=
procedure(pcm_init_component), deferred :: init_component
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_init_component &
(pcm, component, i, active, phs_config, env, meta, config)
import
class(pcm_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
end subroutine pcm_init_component
end interface
@ %def pcm_init_component
@
Record components in the process [[meta]] data if they have turned
out to be inactive.
<<PCM base: pcm: TBP>>=
procedure :: record_inactive_components => pcm_record_inactive_components
<<PCM base: procedures>>=
subroutine pcm_record_inactive_components (pcm, component, meta)
class(pcm_t), intent(inout) :: pcm
type(process_component_t), dimension(:), intent(in) :: component
type(process_metadata_t), intent(inout) :: meta
integer :: i
pcm%component_active = component%active
do i = 1, pcm%n_components
if (.not. component(i)%active) call meta%deactivate_component (i)
end do
end subroutine pcm_record_inactive_components
@ %def pcm_record_inactive_components
@
\subsection{Manager instance}
This object deals with the actual (squared) matrix element values.
<<PCM base: public>>=
public :: pcm_instance_t
<<PCM base: types>>=
type, abstract :: pcm_instance_t
class(pcm_t), pointer :: config => null ()
logical :: bad_point = .false.
contains
<<PCM base: pcm instance: TBP>>
end type pcm_instance_t
@ %def pcm_instance_t
@
<<PCM base: pcm instance: TBP>>=
procedure(pcm_instance_final), deferred :: final
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_instance_final (pcm_instance)
import
class(pcm_instance_t), intent(inout) :: pcm_instance
end subroutine pcm_instance_final
end interface
@ %def pcm_instance_final
@
<<PCM base: pcm instance: TBP>>=
procedure :: link_config => pcm_instance_link_config
<<PCM base: procedures>>=
subroutine pcm_instance_link_config (pcm_instance, config)
class(pcm_instance_t), intent(inout) :: pcm_instance
class(pcm_t), intent(in), target :: config
pcm_instance%config => config
end subroutine pcm_instance_link_config
@ %def pcm_instance_link_config
@
<<PCM base: pcm instance: TBP>>=
procedure :: is_valid => pcm_instance_is_valid
<<PCM base: procedures>>=
function pcm_instance_is_valid (pcm_instance) result (valid)
logical :: valid
class(pcm_instance_t), intent(in) :: pcm_instance
valid = .not. pcm_instance%bad_point
end function pcm_instance_is_valid
@ %def pcm_instance_is_valid
@
<<PCM base: pcm instance: TBP>>=
procedure :: set_bad_point => pcm_instance_set_bad_point
<<PCM base: procedures>>=
pure subroutine pcm_instance_set_bad_point (pcm_instance, bad_point)
class(pcm_instance_t), intent(inout) :: pcm_instance
logical, intent(in) :: bad_point
pcm_instance%bad_point = pcm_instance%bad_point .or. bad_point
end subroutine pcm_instance_set_bad_point
@ %def pcm_instance_set_bad_point
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{The process object}
<<[[process.f90]]>>=
<<File header>>
module process
<<Use kinds>>
<<Use strings>>
<<Use debug>>
use io_units
use format_utils, only: write_separator
use constants
use diagnostics
use numeric_utils
use lorentz
use cputime
use md5
use rng_base
use dispatch_rng, only: dispatch_rng_factory
use dispatch_rng, only: update_rng_seed_in_var_list
use os_interface
use sm_qcd
use integration_results
use mci_base
use flavors
use model_data
use models
use physics_defs
use process_libraries
use process_constants
use particles
use variables
use beam_structures
use beams
use interactions
use pdg_arrays
use expr_base
use sf_base
use sf_mappings
use resonances, only: resonance_history_t, resonance_history_set_t
use prc_test_core, only: test_t
use prc_core_def, only: prc_core_def_t
use prc_core, only: prc_core_t, helicity_selection_t
use prc_external, only: prc_external_t
use prc_recola, only: prc_recola_t
use blha_olp_interfaces, only: prc_blha_t, blha_template_t
use prc_threshold, only: prc_threshold_t
use phs_fks, only: phs_fks_config_t
use phs_base
use mappings, only: mapping_defaults_t
use phs_forests, only: phs_parameters_t
use phs_wood, only: phs_wood_config_t
use dispatch_phase_space, only: dispatch_phs
use blha_config, only: blha_master_t
use nlo_data, only: FKS_DEFAULT, FKS_RESONANCES
use parton_states, only: connected_state_t
use pcm_base
use pcm
use process_counter
use process_config
use process_mci
<<Standard module head>>
<<Process: public>>
<<Process: public parameters>>
<<Process: types>>
<<Process: interfaces>>
contains
<<Process: procedures>>
end module process
@ %def process
@
\subsection{Process status}
Store counter and status information in a process object.
<<Process: types>>=
type :: process_status_t
private
end type process_status_t
@ %def process_status_t
@
\subsection{Process status}
Store integration results in a process object.
<<Process: types>>=
type :: process_results_t
private
end type process_results_t
@ %def process_results_t
@
\subsection{The process type}
A process object is the workspace for the process instance.
After initialization, its contents are filled by
integration passes which shape the integration grids and compute cross
sections. Processes are set up initially from user-level
configuration data. After calculating integrals and thus developing
integration grid data, the program may use a process
object or a copy of it for the purpose of generating events.
The process object consists of several subobjects with their specific
purposes. The corresponding types are defined below. (Technically,
the subobject type definitions have to come before the process type
definition, but with NOWEB magic we reverse this order here.)
The [[type]] determines whether we are considering a decay or a
scattering process.
The [[meta]] object describes the process and its environment. All
contents become fixed when the object is initialized.
The [[config]] object holds physical and technical configuration data
that have been obtained during process initialization, and which are
common to all process components.
The individual process components are configured in the [[component]]
objects. These objects contain more configuration parameters and
workspace, as needed for the specific process variant.
The [[term]] objects describe parton configurations which are
technically used as phase-space points. Each process component may
split into several terms with distinct kinematics and particle
content. Furthermore, each term may project on a different physical
state, e.g., by particle recombination. The [[term]] object provides
the framework for this projection, for applying cuts, weight, and thus
completing the process calculation.
The [[beam_config]] object describes the incoming particles, either the
decay mother or the scattering beams. It also contains the structure-function
information.
The [[mci_entry]] objects configure a MC input parameter set and integrator,
each. The number of parameters depends on the process component and on the
beam and structure-function setup.
The [[pcm]] component is the process-component manager. This
polymorphic object manages and hides the details of dealing with NLO
processes where several components have to be combined in a
non-trivial way. It also acts as an abstract factory for the
corresponding object in [[process_instance]], which does the actual
work for this matter.
<<Process: public>>=
public :: process_t
<<Process: types>>=
type :: process_t
private
type(process_metadata_t) :: &
meta
type(process_environment_t) :: &
env
type(process_config_data_t) :: &
config
class(pcm_t), allocatable :: &
pcm
type(process_component_t), dimension(:), allocatable :: &
component
type(process_phs_config_t), dimension(:), allocatable :: &
phs_entry
type(core_entry_t), dimension(:), allocatable :: &
core_entry
type(process_mci_entry_t), dimension(:), allocatable :: &
mci_entry
class(rng_factory_t), allocatable :: &
rng_factory
type(process_beam_config_t) :: &
beam_config
type(process_term_t), dimension(:), allocatable :: &
term
type(process_status_t) :: &
status
type(process_results_t) :: &
result
contains
<<Process: process: TBP>>
end type process_t
@ %def process_t
@
\subsection{Process pointer}
Wrapper type for storing pointers to process objects in arrays.
<<Process: public>>=
public :: process_ptr_t
<<Process: types>>=
type :: process_ptr_t
type(process_t), pointer :: p => null ()
end type process_ptr_t
@ %def process_ptr_t
@
\subsection{Output}
This procedure is an important debugging and inspection tool; it is
not used during normal operation. The process object is written
to a file (identified by unit, which may also be standard output).
Optional flags determine whether we show everything or just the
interesting parts.
The shorthand as a traditional TBP.
<<Process: process: TBP>>=
procedure :: write => process_write
<<Process: procedures>>=
subroutine process_write (process, screen, unit, &
show_os_data, show_var_list, show_rng, show_expressions, pacify)
class(process_t), intent(in) :: process
logical, intent(in) :: screen
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_os_data
logical, intent(in), optional :: show_var_list
logical, intent(in), optional :: show_rng
logical, intent(in), optional :: show_expressions
logical, intent(in), optional :: pacify
integer :: u, iostat
character(0) :: iomsg
integer, dimension(:), allocatable :: v_list
u = given_output_unit (unit)
allocate (v_list (0))
call set_flag (v_list, F_SHOW_OS_DATA, show_os_data)
call set_flag (v_list, F_SHOW_VAR_LIST, show_var_list)
call set_flag (v_list, F_SHOW_RNG, show_rng)
call set_flag (v_list, F_SHOW_EXPRESSIONS, show_expressions)
call set_flag (v_list, F_PACIFY, pacify)
if (screen) then
call process%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
else
call process%write_formatted (u, "DT", v_list, iostat, iomsg)
end if
end subroutine process_write
@ %def process_write
@ Standard DTIO procedure with binding.
For the particular application, the screen format is triggered by the
[[LISTDIRECTED]] option for the [[iotype]] format editor string. The
other options activate when the particular parameter value is found in
[[v_list]].
NOTE: The DTIO [[generic]] binding is supported by gfortran since 7.0.
TODO wk 2018: The default could be to show everything, and we should have separate
switches for all major parts. Currently, there are only a few.
<<Process: process: TBP>>=
! generic :: write (formatted) => write_formatted
procedure :: write_formatted => process_write_formatted
<<Process: procedures>>=
subroutine process_write_formatted (dtv, unit, iotype, v_list, iostat, iomsg)
class(process_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: u
logical :: screen
logical :: var_list
logical :: rng_factory
logical :: expressions
logical :: counters
logical :: os_data
logical :: model
logical :: pacify
integer :: i
u = unit
select case (iotype)
case ("LISTDIRECTED")
screen = .true.
case default
screen = .false.
end select
var_list = flagged (v_list, F_SHOW_VAR_LIST)
rng_factory = flagged (v_list, F_SHOW_RNG, .true.)
expressions = flagged (v_list, F_SHOW_EXPRESSIONS)
counters = .true.
os_data = flagged (v_list, F_SHOW_OS_DATA)
model = .false.
pacify = flagged (v_list, F_PACIFY)
associate (process => dtv)
if (screen) then
write (msg_buffer, "(A)") repeat ("-", 72)
call msg_message ()
else
call write_separator (u, 2)
end if
call process%meta%write (u, screen)
if (var_list) then
call process%env%write (u, show_var_list=var_list, &
show_model=.false., show_lib=.false., &
show_os_data=os_data)
else if (.not. screen) then
write (u, "(1x,A)") "Variable list: [not shown]"
end if
if (process%meta%type == PRC_UNKNOWN) then
call write_separator (u, 2)
return
else if (screen) then
return
end if
call write_separator (u)
call process%config%write (u, counters, model, expressions)
if (rng_factory) then
if (allocated (process%rng_factory)) then
call write_separator (u)
call process%rng_factory%write (u)
end if
end if
call write_separator (u, 2)
if (allocated (process%component)) then
write (u, "(1x,A)") "Process component configuration:"
do i = 1, size (process%component)
call write_separator (u)
call process%component(i)%write (u)
end do
else
write (u, "(1x,A)") "Process component configuration: [undefined]"
end if
call write_separator (u, 2)
if (allocated (process%term)) then
write (u, "(1x,A)") "Process term configuration:"
do i = 1, size (process%term)
call write_separator (u)
call process%term(i)%write (u)
end do
else
write (u, "(1x,A)") "Process term configuration: [undefined]"
end if
call write_separator (u, 2)
call process%beam_config%write (u)
call write_separator (u, 2)
if (allocated (process%mci_entry)) then
write (u, "(1x,A)") "Multi-channel integrator configurations:"
do i = 1, size (process%mci_entry)
call write_separator (u)
write (u, "(1x,A,I0,A)") "MCI #", i, ":"
call process%mci_entry(i)%write (u, pacify)
end do
end if
call write_separator (u, 2)
end associate
iostat = 0
iomsg = ""
end subroutine process_write_formatted
@ %def process_write_formatted
@
<<Process: process: TBP>>=
procedure :: write_meta => process_write_meta
<<Process: procedures>>=
subroutine process_write_meta (process, unit, testflag)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
select case (process%meta%type)
case (PRC_UNKNOWN)
write (u, "(1x,A)") "Process instance [undefined]"
return
case (PRC_DECAY)
write (u, "(1x,A)", advance="no") "Process instance [decay]:"
case (PRC_SCATTERING)
write (u, "(1x,A)", advance="no") "Process instance [scattering]:"
case default
call msg_bug ("process_instance_write: undefined process type")
end select
write (u, "(1x,A,A,A)") "'", char (process%meta%id), "'"
write (u, "(3x,A,A,A)") "Run ID = '", char (process%meta%run_id), "'"
if (allocated (process%meta%component_id)) then
write (u, "(3x,A)") "Process components:"
do i = 1, size (process%meta%component_id)
if (process%pcm%component_selected(i)) then
write (u, "(3x,'*')", advance="no")
else
write (u, "(4x)", advance="no")
end if
write (u, "(1x,I0,9A)") i, ": '", &
char (process%meta%component_id (i)), "': ", &
char (process%meta%component_description (i))
end do
end if
end subroutine process_write_meta
@ %def process_write_meta
@ Screen output. Write a short account of the process configuration
and the current results. The verbose version lists the components,
the short version just the results.
<<Process: process: TBP>>=
procedure :: show => process_show
<<Process: procedures>>=
subroutine process_show (object, unit, verbose)
class(process_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
logical :: verb
real(default) :: err_percent
u = given_output_unit (unit)
verb = .true.; if (present (verbose)) verb = verbose
if (verb) then
call object%meta%show (u, object%config%model%get_name ())
select case (object%meta%type)
case (PRC_DECAY)
write (u, "(2x,A)", advance="no") "Computed width ="
case (PRC_SCATTERING)
write (u, "(2x,A)", advance="no") "Computed cross section ="
case default; return
end select
else
if (object%meta%run_id /= "") then
write (u, "('Run',1x,A,':',1x)", advance="no") &
char (object%meta%run_id)
end if
write (u, "(A)", advance="no") char (object%meta%id)
select case (object%meta%num_id)
case (0)
write (u, "(':')")
case default
write (u, "(1x,'(',I0,')',':')") object%meta%num_id
end select
write (u, "(2x)", advance="no")
end if
if (object%has_integral_tot ()) then
write (u, "(ES14.7,1x,'+-',ES9.2)", advance="no") &
object%get_integral_tot (), object%get_error_tot ()
select case (object%meta%type)
case (PRC_DECAY)
write (u, "(1x,A)", advance="no") "GeV"
case (PRC_SCATTERING)
write (u, "(1x,A)", advance="no") "fb "
case default
write (u, "(1x,A)", advance="no") " "
end select
if (object%get_integral_tot () /= 0) then
err_percent = abs (100 &
* object%get_error_tot () / object%get_integral_tot ())
else
err_percent = 0
end if
if (err_percent == 0) then
write (u, "(1x,'(',F4.0,4x,'%)')") err_percent
else if (err_percent < 0.1) then
write (u, "(1x,'(',F7.3,1x,'%)')") err_percent
else if (err_percent < 1) then
write (u, "(1x,'(',F6.2,2x,'%)')") err_percent
else if (err_percent < 10) then
write (u, "(1x,'(',F5.1,3x,'%)')") err_percent
else
write (u, "(1x,'(',F4.0,4x,'%)')") err_percent
end if
else
write (u, "(A)") "[integral undefined]"
end if
end subroutine process_show
@ %def process_show
@ Finalizer. Explicitly iterate over all subobjects that may contain
allocated pointers.
TODO wk 2018 (workaround): The finalizer for the [[config_data]] component is not
called. The reason is that this deletes model data local to the process,
but these could be referenced by pointers (flavor objects) from some
persistent event record. Obviously, such side effects should be avoided, but
this requires refactoring the event-handling procedures.
<<Process: process: TBP>>=
procedure :: final => process_final
<<Process: procedures>>=
subroutine process_final (process)
class(process_t), intent(inout) :: process
integer :: i
! call process%meta%final ()
call process%env%final ()
! call process%config%final ()
if (allocated (process%component)) then
do i = 1, size (process%component)
call process%component(i)%final ()
end do
end if
if (allocated (process%term)) then
do i = 1, size (process%term)
call process%term(i)%final ()
end do
end if
call process%beam_config%final ()
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
call process%mci_entry(i)%final ()
end do
end if
if (allocated (process%pcm)) then
call process%pcm%final ()
deallocate (process%pcm)
end if
end subroutine process_final
@ %def process_final
@
\subsubsection{Process setup}
Initialize a process. We need a process library [[lib]] and the process
identifier [[proc_id]] (string). We will fetch the current run ID from the
variable list [[var_list]].
We collect all important data from the environment and store them in the
appropriate places. OS data, model, and variable list are copied
into [[env]] (true snapshot), also the process library (pointer only).
The [[meta]] subobject is initialized with process ID and attributes taken
from the process library.
We initialize the [[config]] subobject with all data that are relevant for
this run, using the settings from [[env]]. These data determine the MD5 sum
for this run, which allows us to identify the setup and possibly skips in a
later re-run.
We also allocate and initialize the embedded RNG factory. We take the seed
from the [[var_list]], and we should return the [[var_list]] to the caller
with a new seed.
Finally, we allocate the process component manager [[pcm]], which implements
the chosen algorithm for process integration. The first task of the manager
is to allocate the component array and to determine the component categories
(e.g., Born/Virtual etc.).
TODO wk 2018: The [[pcm]] dispatcher should be provided by the caller, if we
eventually want to eliminate dependencies on concrete [[pcm_t]] extensions.
<<Process: process: TBP>>=
procedure :: init => process_init
<<Process: procedures>>=
subroutine process_init &
(process, proc_id, lib, os_data, model, var_list, beam_structure)
class(process_t), intent(out) :: process
type(string_t), intent(in) :: proc_id
type(process_library_t), intent(in), target :: lib
type(os_data_t), intent(in) :: os_data
class(model_t), intent(in), target :: model
type(var_list_t), intent(inout), target, optional :: var_list
type(beam_structure_t), intent(in), optional :: beam_structure
integer :: next_rng_seed
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_init")
associate &
(meta => process%meta, env => process%env, config => process%config)
call env%init &
(model, lib, os_data, var_list, beam_structure)
call meta%init &
(proc_id, lib, env%get_var_list_ptr ())
call config%init &
(meta, env)
call dispatch_rng_factory &
(process%rng_factory, env%get_var_list_ptr (), next_rng_seed)
call update_rng_seed_in_var_list (var_list, next_rng_seed)
call dispatch_pcm &
(process%pcm, config%process_def%is_nlo ())
associate (pcm => process%pcm)
call pcm%init (env, meta)
call pcm%allocate_components (process%component, meta)
call pcm%categorize_components (config)
end associate
end associate
end subroutine process_init
@ %def process_init
@
\subsection{Process component manager}
The [[pcm]] (read: process-component manager) takes the responsibility of
steering the actual algorithm of configuration and integration. Depending on
the concrete type, different algorithms can be implemented.
The first version of this supports just two implementations: leading-order
(tree-level) integration and event generation, and NLO (QCD/FKS subtraction).
We thus can start with a single logical for steering the dispatcher.
TODO wk 2018: Eventually, we may eliminate all references to the extensions of
[[pcm_t]] from this module and therefore move this outside the module as well.
<<Process: procedures>>=
subroutine dispatch_pcm (pcm, is_nlo)
class(pcm_t), allocatable, intent(out) :: pcm
logical, intent(in) :: is_nlo
if (.not. is_nlo) then
allocate (pcm_default_t :: pcm)
else
allocate (pcm_nlo_t :: pcm)
end if
end subroutine dispatch_pcm
@ %def dispatch_pcm
@ This step is performed after phase-space and core objects are done: collect
all missing information and prepare the process component manager for the
appropriate integration algorithm.
<<Process: process: TBP>>=
procedure :: complete_pcm_setup => process_complete_pcm_setup
<<Process: procedures>>=
subroutine process_complete_pcm_setup (process)
class(process_t), intent(inout) :: process
call process%pcm%complete_setup &
(process%core_entry, process%component, process%env%get_model_ptr ())
end subroutine process_complete_pcm_setup
@ %def process_complete_pcm_setup
@
\subsection{Core management}
Allocate cores (interface objects to matrix-element code).
The [[dispatch_core]] procedure is taken as an argument, so we do not depend on
the implementation, and thus on the specific core types.
The [[helicity_selection]] object collects data that the matrix-element
code needs for configuring the appropriate behavior.
After the cores have been allocated, and assuming the phs initial
configuration has been done before, we proceed with computing the [[pcm]]
internal data.
<<Process: process: TBP>>=
procedure :: setup_cores => process_setup_cores
<<Process: procedures>>=
subroutine process_setup_cores (process, dispatch_core, &
helicity_selection, use_color_factors, has_beam_pol)
class(process_t), intent(inout) :: process
procedure(dispatch_core_proc) :: dispatch_core
type(helicity_selection_t), intent(in), optional :: helicity_selection
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
integer :: i
associate (pcm => process%pcm)
call pcm%allocate_cores (process%config, process%core_entry)
do i = 1, size (process%core_entry)
call dispatch_core (process%core_entry(i)%core, &
process%core_entry(i)%core_def, &
process%config%model, &
helicity_selection, &
process%config%qcd, &
use_color_factors, &
has_beam_pol)
call process%core_entry(i)%configure &
(process%env%get_lib_ptr (), process%meta%id)
if (process%core_entry(i)%core%uses_blha ()) then
call pcm%setup_blha (process%core_entry(i))
end if
end do
end associate
end subroutine process_setup_cores
@ %def process_setup_cores
<<Process: interfaces>>=
abstract interface
subroutine dispatch_core_proc (core, core_def, model, &
helicity_selection, qcd, use_color_factors, has_beam_pol)
import
class(prc_core_t), allocatable, intent(inout) :: core
class(prc_core_def_t), intent(in) :: core_def
class(model_data_t), intent(in), target, optional :: model
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(qcd_t), intent(in), optional :: qcd
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
end subroutine dispatch_core_proc
end interface
@ %def dispatch_core_proc
@ Use the [[pcm]] to initialize the BLHA interface for each core which
requires it.
<<Process: process: TBP>>=
procedure :: prepare_blha_cores => process_prepare_blha_cores
<<Process: procedures>>=
subroutine process_prepare_blha_cores (process)
class(process_t), intent(inout), target :: process
integer :: i
associate (pcm => process%pcm)
do i = 1, size (process%core_entry)
associate (core_entry => process%core_entry(i))
if (core_entry%core%uses_blha ()) then
pcm%uses_blha = .true.
call pcm%prepare_blha_core (core_entry, process%config%model)
end if
end associate
end do
end associate
end subroutine process_prepare_blha_cores
@ %def process_prepare_blha_cores
@ Create the BLHA interface data, using PCM for specific data, and write the
BLHA contract file(s).
We take various configuration data and copy them to the [[blha_master]]
record, which then creates and writes the contracts.
For assigning the QCD/EW coupling powers, we inspect the first process
component only. The other parameters are taken as-is from the process
environment variables.
<<Process: process: TBP>>=
procedure :: create_blha_interface => process_create_blha_interface
<<Process: procedures>>=
subroutine process_create_blha_interface (process)
class(process_t), intent(inout) :: process
integer :: alpha_power, alphas_power
integer :: openloops_phs_tolerance, openloops_stability_log
logical :: use_cms
type(string_t) :: ew_scheme, correction_type
type(string_t) :: openloops_extra_cmd
type(blha_master_t) :: blha_master
integer, dimension(:,:), allocatable :: flv_born, flv_real
if (process%pcm%uses_blha) then
call collect_configuration_parameters (process%get_var_list_ptr ())
call process%component(1)%config%get_coupling_powers &
(alpha_power, alphas_power)
associate (pcm => process%pcm)
call pcm%set_blha_methods (blha_master, process%get_var_list_ptr ())
call blha_master%set_ew_scheme (ew_scheme)
call blha_master%allocate_config_files ()
call blha_master%set_correction_type (correction_type)
call blha_master%setup_additional_features ( &
openloops_phs_tolerance, &
use_cms, &
openloops_stability_log, &
extra_cmd = openloops_extra_cmd, &
beam_structure = process%env%get_beam_structure ())
call pcm%get_blha_flv_states (process%core_entry, flv_born, flv_real)
call blha_master%generate (process%meta%id, &
process%config%model, process%config%n_in, &
alpha_power, alphas_power, &
flv_born, flv_real)
call blha_master%write_olp (process%meta%id)
end associate
end if
contains
subroutine collect_configuration_parameters (var_list)
type(var_list_t), intent(in) :: var_list
openloops_phs_tolerance = &
var_list%get_ival (var_str ("openloops_phs_tolerance"))
openloops_stability_log = &
var_list%get_ival (var_str ("openloops_stability_log"))
use_cms = &
var_list%get_lval (var_str ("?openloops_use_cms"))
ew_scheme = &
var_list%get_sval (var_str ("$blha_ew_scheme"))
correction_type = &
var_list%get_sval (var_str ("$nlo_correction_type"))
openloops_extra_cmd = &
var_list%get_sval (var_str ("$openloops_extra_cmd"))
end subroutine collect_configuration_parameters
end subroutine process_create_blha_interface
@ %def process_create_blha_interface
@ Initialize the process components, one by one. We require templates for the
[[mci]] (integrator) and [[phs_config]] (phase-space) configuration data.
The [[active]] flag is set if the component has an associated matrix
element, so we can compute it. The case of no core is a unit-test case.
The specifics depend on the algorithm and are delegated to the [[pcm]]
process-component manager.
The optional [[phs_config]] overrides a pre-generated config array (for unit
test).
<<Process: process: TBP>>=
procedure :: init_components => process_init_components
<<Process: procedures>>=
subroutine process_init_components (process, phs_config)
class(process_t), intent(inout), target :: process
class(phs_config_t), allocatable, intent(in), optional :: phs_config
integer :: i, i_core
class(prc_core_t), pointer :: core
logical :: active
associate (pcm => process%pcm)
do i = 1, pcm%n_components
i_core = pcm%get_i_core(i)
if (i_core > 0) then
core => process%get_core_ptr (i_core)
active = core%has_matrix_element ()
else
active = .true.
end if
if (present (phs_config)) then
call pcm%init_component (process%component(i), &
i, &
active, &
phs_config, &
process%env, process%meta, process%config)
else
call pcm%init_component (process%component(i), &
i, &
active, &
process%phs_entry(pcm%i_phs_config(i))%phs_config, &
process%env, process%meta, process%config)
end if
end do
end associate
end subroutine process_init_components
@ %def process_init_components
@ If process components have turned out to be inactive, this has to be
recorded in the [[meta]] block. Delegate to the [[pcm]].
<<Process: process: TBP>>=
procedure :: record_inactive_components => process_record_inactive_components
<<Process: procedures>>=
subroutine process_record_inactive_components (process)
class(process_t), intent(inout) :: process
associate (pcm => process%pcm)
call pcm%record_inactive_components (process%component, process%meta)
end associate
end subroutine process_record_inactive_components
@ %def process_record_inactive_components
@ Determine the process terms for each process component.
<<Process: process: TBP>>=
procedure :: setup_terms => process_setup_terms
<<Process: procedures>>=
subroutine process_setup_terms (process, with_beams)
class(process_t), intent(inout), target :: process
logical, intent(in), optional :: with_beams
class(model_data_t), pointer :: model
integer :: i, j, k, i_term
integer, dimension(:), allocatable :: n_entry
integer :: n_components, n_tot
integer :: i_sub
type(string_t) :: subtraction_method
class(prc_core_t), pointer :: core => null ()
logical :: setup_subtraction_component, singular_real
logical :: requires_spin_correlations
integer :: nlo_type_to_fetch, n_emitters
i_sub = 0
model => process%config%model
n_components = process%meta%n_components
allocate (n_entry (n_components), source = 0)
do i = 1, n_components
associate (component => process%component(i))
if (component%active) then
n_entry(i) = 1
if (component%get_nlo_type () == NLO_REAL) then
select type (pcm => process%pcm)
type is (pcm_nlo_t)
if (component%component_type /= COMP_REAL_FIN) &
n_entry(i) = n_entry(i) + pcm%region_data%get_n_phs ()
end select
end if
end if
end associate
end do
n_tot = sum (n_entry)
allocate (process%term (n_tot))
k = 0
if (process%is_nlo_calculation ()) then
i_sub = process%component(1)%config%get_associated_subtraction ()
subtraction_method = process%component(i_sub)%config%get_me_method ()
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "process_setup_terms: ", &
subtraction_method)
end if
do i = 1, n_components
associate (component => process%component(i))
if (.not. component%active) cycle
allocate (component%i_term (n_entry(i)))
do j = 1, n_entry(i)
singular_real = component%get_nlo_type () == NLO_REAL &
.and. component%component_type /= COMP_REAL_FIN
setup_subtraction_component = singular_real .and. j == n_entry(i)
i_term = k + j
component%i_term(j) = i_term
if (singular_real) then
process%term(i_term)%i_sub = k + n_entry(i)
else
process%term(i_term)%i_sub = 0
end if
if (setup_subtraction_component) then
select type (pcm => process%pcm)
class is (pcm_nlo_t)
process%term(i_term)%i_core = pcm%i_core(pcm%i_sub)
end select
else
process%term(i_term)%i_core = process%pcm%get_i_core(i)
end if
if (process%term(i_term)%i_core == 0) then
call msg_bug ("Process '" // char (process%get_id ()) &
// "': core not found!")
end if
core => process%get_core_term (i_term)
if (i_sub > 0) then
select type (pcm => process%pcm)
type is (pcm_nlo_t)
requires_spin_correlations = &
pcm%region_data%requires_spin_correlations ()
n_emitters = pcm%region_data%get_n_emitters_sc ()
class default
requires_spin_correlations = .false.
n_emitters = 0
end select
if (requires_spin_correlations) then
call process%term(i_term)%init ( &
i_term, i, j, core, model, &
nlo_type = component%config%get_nlo_type (), &
use_beam_pol = with_beams, &
subtraction_method = subtraction_method, &
has_pdfs = process%pcm%has_pdfs, &
n_emitters = n_emitters)
else
call process%term(i_term)%init ( &
i_term, i, j, core, model, &
nlo_type = component%config%get_nlo_type (), &
use_beam_pol = with_beams, &
subtraction_method = subtraction_method, &
has_pdfs = process%pcm%has_pdfs)
end if
else
call process%term(i_term)%init ( &
i_term, i, j, core, model, &
nlo_type = component%config%get_nlo_type (), &
use_beam_pol = with_beams, &
has_pdfs = process%pcm%has_pdfs)
end if
end do
end associate
k = k + n_entry(i)
end do
process%config%n_terms = n_tot
end subroutine process_setup_terms
@ %def process_setup_terms
@ Initialize the beam setup. This is the trivial version where the
incoming state of the matrix element coincides with the initial state
of the process. For a scattering process, we need the c.m. energy,
all other variables are set to their default values (no polarization,
lab frame and c.m.\ frame coincide, etc.)
We assume that all components consistently describe a scattering
process, i.e., two incoming particles.
Note: The current layout of the [[beam_data_t]] record requires that the
flavor for each beam is unique. For processes with multiple
flavors in the initial state, one has to set up beams explicitly.
This restriction could be removed by extending the code in the
[[beams]] module.
<<Process: process: TBP>>=
procedure :: setup_beams_sqrts => process_setup_beams_sqrts
<<Process: procedures>>=
subroutine process_setup_beams_sqrts (process, sqrts, beam_structure, i_core)
class(process_t), intent(inout) :: process
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
integer, intent(in), optional :: i_core
type(pdg_array_t), dimension(:,:), allocatable :: pdg_in
integer, dimension(2) :: pdg_scattering
type(flavor_t), dimension(2) :: flv_in
integer :: i, i0, ic
allocate (pdg_in (2, process%meta%n_components))
i0 = 0
do i = 1, process%meta%n_components
if (process%component(i)%active) then
if (present (i_core)) then
ic = i_core
else
ic = process%pcm%get_i_core (i)
end if
associate (core => process%core_entry(ic)%core)
pdg_in(:,i) = core%data%get_pdg_in ()
end associate
if (i0 == 0) i0 = i
end if
end do
do i = 1, process%meta%n_components
if (.not. process%component(i)%active) then
pdg_in(:,i) = pdg_in(:,i0)
end if
end do
if (all (pdg_array_get_length (pdg_in) == 1) .and. &
all (pdg_in(1,:) == pdg_in(1,i0)) .and. &
all (pdg_in(2,:) == pdg_in(2,i0))) then
pdg_scattering = pdg_array_get (pdg_in(:,i0), 1)
call flv_in%init (pdg_scattering, process%config%model)
call process%beam_config%init_scattering (flv_in, sqrts, beam_structure)
else
call msg_fatal ("Setting up process '" // char (process%meta%id) // "':", &
[var_str (" --------------------------------------------"), &
var_str ("Inconsistent initial state. This happens if either "), &
var_str ("several processes with non-matching initial states "), &
var_str ("have been added, or for a single process with an "), &
var_str ("initial state flavor sum. In that case, please set beams "), &
var_str ("explicitly [singling out a flavor / structure function.]")])
end if
end subroutine process_setup_beams_sqrts
@ %def process_setup_beams_sqrts
@ This is the version that applies to decay processes. The energy is the
particle mass, hence no extra argument.
<<Process: process: TBP>>=
procedure :: setup_beams_decay => process_setup_beams_decay
<<Process: procedures>>=
subroutine process_setup_beams_decay (process, rest_frame, beam_structure, i_core)
class(process_t), intent(inout), target :: process
logical, intent(in), optional :: rest_frame
type(beam_structure_t), intent(in), optional :: beam_structure
integer, intent(in), optional :: i_core
type(pdg_array_t), dimension(:,:), allocatable :: pdg_in
integer, dimension(1) :: pdg_decay
type(flavor_t), dimension(1) :: flv_in
integer :: i, i0, ic
allocate (pdg_in (1, process%meta%n_components))
i0 = 0
do i = 1, process%meta%n_components
if (process%component(i)%active) then
if (present (i_core)) then
ic = i_core
else
ic = process%pcm%get_i_core (i)
end if
associate (core => process%core_entry(ic)%core)
pdg_in(:,i) = core%data%get_pdg_in ()
end associate
if (i0 == 0) i0 = i
end if
end do
do i = 1, process%meta%n_components
if (.not. process%component(i)%active) then
pdg_in(:,i) = pdg_in(:,i0)
end if
end do
if (all (pdg_array_get_length (pdg_in) == 1) &
.and. all (pdg_in(1,:) == pdg_in(1,i0))) then
pdg_decay = pdg_array_get (pdg_in(:,i0), 1)
call flv_in%init (pdg_decay, process%config%model)
call process%beam_config%init_decay (flv_in, rest_frame, beam_structure)
else
call msg_fatal ("Setting up decay '" &
// char (process%meta%id) // "': decaying particle not unique")
end if
end subroutine process_setup_beams_decay
@ %def process_setup_beams_decay
@ We have to make sure that the masses of the various flavors
in a given position in the particle string coincide.
<<Process: process: TBP>>=
procedure :: check_masses => process_check_masses
<<Process: procedures>>=
subroutine process_check_masses (process)
class(process_t), intent(in) :: process
type(flavor_t), dimension(:), allocatable :: flv
real(default), dimension(:), allocatable :: mass
integer :: i, j
integer :: i_component
class(prc_core_t), pointer :: core
do i = 1, process%get_n_terms ()
i_component = process%term(i)%i_component
if (.not. process%component(i_component)%active) cycle
core => process%get_core_term (i)
associate (data => core%data)
allocate (flv (data%n_flv), mass (data%n_flv))
do j = 1, data%n_in + data%n_out
call flv%init (data%flv_state(j,:), process%config%model)
mass = flv%get_mass ()
if (any (.not. nearly_equal(mass, mass(1)))) then
call msg_fatal ("Process '" // char (process%meta%id) // "': " &
// "mass values in flavor combination do not coincide. ")
end if
end do
deallocate (flv, mass)
end associate
end do
end subroutine process_check_masses
@ %def process_check_masses
@ Set up index mapping for [[region_data]] for singular regions equivalent w.r.t.
their amplitudes. Has to be called after [[region_data]] AND the [[core]] are fully
set up. For processes with structure function, subprocesses which lead to the same
amplitude for the hard interaction can differ if structure functions are applied.
In this case we remap flavor structures to themselves if the eqvivalent hard interaction
flavor structure has no identical initial state.
<<Process: process: TBP>>=
procedure :: optimize_nlo_singular_regions => process_optimize_nlo_singular_regions
<<Process: procedures>>=
subroutine process_optimize_nlo_singular_regions (process)
class(process_t), intent(inout) :: process
class(prc_core_t), pointer :: core, core_sub
integer, dimension(:), allocatable :: eqv_flv_index_born
integer, dimension(:), allocatable :: eqv_flv_index_real
integer, dimension(:,:), allocatable :: flv_born, flv_real
integer :: i_flv, i_flv2, n_in, i
integer :: i_component, i_core, i_core_sub
logical :: fetched_born, fetched_real
logical :: optimize
fetched_born = .false.; fetched_real = .false.
select type (pcm => process%pcm)
type is (pcm_nlo_t)
optimize = pcm%settings%reuse_amplitudes_fks
if (optimize) then
do i_component = 1, pcm%n_components
i_core = pcm%get_i_core(i_component)
core => process%get_core_ptr (i_core)
if (.not. core%data_known) cycle
associate (data => core%data)
if (pcm%nlo_type_core(i_core) == NLO_REAL .and. &
.not. pcm%component_type(i_component) == COMP_SUB) then
if (allocated (core%data%eqv_flv_index)) then
eqv_flv_index_real = core%get_equivalent_flv_index ()
fetched_real = .true.
end if
i_core_sub = pcm%get_i_core (pcm%i_sub)
core_sub => process%get_core_ptr (i_core_sub)
if (allocated (core_sub%data%eqv_flv_index)) then
eqv_flv_index_born = core_sub%get_equivalent_flv_index ()
fetched_born = .true.
end if
if (fetched_born .and. fetched_real) exit
end if
end associate
end do
if (.not. fetched_born .or. .not. fetched_real) then
call msg_warning('Failed to fetch flavor equivalence indices. &
&Disabling singular region optimization')
optimize = .false.
eqv_flv_index_born = [(i, i = 1, pcm%region_data%n_flv_born)]
eqv_flv_index_real = [(i, i = 1, pcm%region_data%n_flv_real)]
end if
if (optimize .and. pcm%has_pdfs) then
flv_born = pcm%region_data%get_flv_states_born ()
flv_real = pcm%region_data%get_flv_states_real ()
n_in = pcm%region_data%n_in
do i_flv = 1, size (eqv_flv_index_born)
do i_flv2 = 1, i_flv
if (any (flv_born(1:n_in, eqv_flv_index_born(i_flv)) /= &
flv_born(1:n_in, i_flv))) then
eqv_flv_index_born(i_flv) = i_flv
exit
end if
end do
end do
do i_flv = 1, size (eqv_flv_index_real)
do i_flv2 = 1, i_flv
if (any (flv_real(1:n_in, eqv_flv_index_real(i_flv)) /= &
flv_real(1:n_in, i_flv))) then
eqv_flv_index_real(i_flv) = i_flv
exit
end if
end do
end do
end if
else
eqv_flv_index_born = [(i, i = 1, pcm%region_data%n_flv_born)]
eqv_flv_index_real = [(i, i = 1, pcm%region_data%n_flv_real)]
end if
pcm%region_data%eqv_flv_index_born = eqv_flv_index_born
pcm%region_data%eqv_flv_index_real = eqv_flv_index_real
call pcm%region_data%find_eqv_regions (optimize)
end select
end subroutine process_optimize_nlo_singular_regions
@ %def process_optimize_nlo_singular_regions
@ For some structure functions we need to get the list of initial
state flavors. This is a two-dimensional array. The first index is
the beam index, the second index is the component index. Each array
element is itself a PDG array object, which consists of the list of
incoming PDG values for this beam and component.
<<Process: process: TBP>>=
procedure :: get_pdg_in => process_get_pdg_in
<<Process: procedures>>=
subroutine process_get_pdg_in (process, pdg_in)
class(process_t), intent(in), target :: process
type(pdg_array_t), dimension(:,:), allocatable, intent(out) :: pdg_in
integer :: i, i_core
allocate (pdg_in (process%config%n_in, process%meta%n_components))
do i = 1, process%meta%n_components
if (process%component(i)%active) then
i_core = process%pcm%get_i_core (i)
associate (core => process%core_entry(i_core)%core)
pdg_in(:,i) = core%data%get_pdg_in ()
end associate
end if
end do
end subroutine process_get_pdg_in
@ %def process_get_pdg_in
@ The phase-space configuration object, in case we need it separately.
<<Process: process: TBP>>=
procedure :: get_phs_config => process_get_phs_config
<<Process: procedures>>=
function process_get_phs_config (process, i_component) result (phs_config)
class(phs_config_t), pointer :: phs_config
class(process_t), intent(in), target :: process
integer, intent(in) :: i_component
if (allocated (process%component)) then
phs_config => process%component(i_component)%phs_config
else
phs_config => null ()
end if
end function process_get_phs_config
@ %def process_get_phs_config
@ The resonance history set can be extracted from the phase-space
configuration. However, this is only possible if the default phase-space
method (wood) has been chosen. If [[include_trivial]] is set, we include the
resonance history with no resonances in the set.
<<Process: process: TBP>>=
procedure :: extract_resonance_history_set &
=> process_extract_resonance_history_set
<<Process: procedures>>=
subroutine process_extract_resonance_history_set &
(process, res_set, include_trivial, i_component)
class(process_t), intent(in), target :: process
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
integer, intent(in), optional :: i_component
integer :: i
i = 1; if (present (i_component)) i = i_component
select type (phs_config => process%get_phs_config (i))
class is (phs_wood_config_t)
call phs_config%extract_resonance_history_set (res_set, include_trivial)
class default
call msg_error ("process '" // char (process%get_id ()) &
// "': extract resonance histories: phase-space method must be &
&'wood'. No resonances can be determined.")
end select
end subroutine process_extract_resonance_history_set
@ %def process_extract_resonance_history_set
@ Initialize from a complete beam setup. If the beam setup does not
apply directly to the process, choose a fallback option as a straight
scattering or decay process.
<<Process: process: TBP>>=
procedure :: setup_beams_beam_structure => process_setup_beams_beam_structure
<<Process: procedures>>=
subroutine process_setup_beams_beam_structure &
(process, beam_structure, sqrts, decay_rest_frame)
class(process_t), intent(inout) :: process
type(beam_structure_t), intent(in) :: beam_structure
real(default), intent(in) :: sqrts
logical, intent(in), optional :: decay_rest_frame
integer :: n_in
logical :: applies
n_in = process%get_n_in ()
call beam_structure%check_against_n_in (process%get_n_in (), applies)
if (applies) then
call process%beam_config%init_beam_structure &
(beam_structure, sqrts, process%get_model_ptr (), decay_rest_frame)
else if (n_in == 2) then
call process%setup_beams_sqrts (sqrts, beam_structure)
else
call process%setup_beams_decay (decay_rest_frame, beam_structure)
end if
end subroutine process_setup_beams_beam_structure
@ %def process_setup_beams_beam_structure
@ Notify the user about beam setup.
<<Process: process: TBP>>=
procedure :: beams_startup_message => process_beams_startup_message
<<Process: procedures>>=
subroutine process_beams_startup_message (process, unit, beam_structure)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
call process%beam_config%startup_message (unit, beam_structure)
end subroutine process_beams_startup_message
@ %def process_beams_startup_message
@ Initialize phase-space configuration by reading out the environment
variables. We return the rebuild flags and store parameters in the blocks
[[phs_par]] and [[mapping_defs]].
The phase-space configuration object(s) are allocated by [[pcm]].
<<Process: process: TBP>>=
procedure :: init_phs_config => process_init_phs_config
<<Process: procedures>>=
subroutine process_init_phs_config (process)
class(process_t), intent(inout) :: process
type(var_list_t), pointer :: var_list
type(phs_parameters_t) :: phs_par
type(mapping_defaults_t) :: mapping_defs
var_list => process%env%get_var_list_ptr ()
phs_par%m_threshold_s = &
var_list%get_rval (var_str ("phs_threshold_s"))
phs_par%m_threshold_t = &
var_list%get_rval (var_str ("phs_threshold_t"))
phs_par%off_shell = &
var_list%get_ival (var_str ("phs_off_shell"))
phs_par%keep_nonresonant = &
var_list%get_lval (var_str ("?phs_keep_nonresonant"))
phs_par%t_channel = &
var_list%get_ival (var_str ("phs_t_channel"))
mapping_defs%energy_scale = &
var_list%get_rval (var_str ("phs_e_scale"))
mapping_defs%invariant_mass_scale = &
var_list%get_rval (var_str ("phs_m_scale"))
mapping_defs%momentum_transfer_scale = &
var_list%get_rval (var_str ("phs_q_scale"))
mapping_defs%step_mapping = &
var_list%get_lval (var_str ("?phs_step_mapping"))
mapping_defs%step_mapping_exp = &
var_list%get_lval (var_str ("?phs_step_mapping_exp"))
mapping_defs%enable_s_mapping = &
var_list%get_lval (var_str ("?phs_s_mapping"))
associate (pcm => process%pcm)
call pcm%init_phs_config (process%phs_entry, &
process%meta, process%env, phs_par, mapping_defs)
end associate
end subroutine process_init_phs_config
@ %def process_init_phs_config
@ We complete the kinematics configuration after the beam setup, but before we
configure the chain of structure functions. The reason is that we need the
total energy [[sqrts]] for the kinematics, but the structure-function setup
requires the number of channels, which depends on the kinematics
configuration. For instance, the kinematics module may return the need for
parameterizing an s-channel resonance.
<<Process: process: TBP>>=
procedure :: configure_phs => process_configure_phs
<<Process: procedures>>=
subroutine process_configure_phs (process, rebuild, ignore_mismatch, &
combined_integration, subdir)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
logical, intent(in), optional :: combined_integration
type(string_t), intent(in), optional :: subdir
real(default) :: sqrts
integer :: i, i_born, nlo_type
class(phs_config_t), pointer :: phs_config_born
sqrts = process%get_sqrts ()
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) then
select type (pcm => process%pcm)
type is (pcm_default_t)
call component%configure_phs (sqrts, process%beam_config, &
rebuild, ignore_mismatch, subdir)
class is (pcm_nlo_t)
nlo_type = component%config%get_nlo_type ()
select case (nlo_type)
case (BORN, NLO_VIRTUAL, NLO_SUBTRACTION)
call component%configure_phs (sqrts, process%beam_config, &
rebuild, ignore_mismatch, subdir)
call check_and_extend_phs (component)
case (NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
i_born = component%config%get_associated_born ()
if (component%component_type /= COMP_REAL_FIN) &
call check_and_extend_phs (component)
call process%component(i_born)%get_phs_config &
(phs_config_born)
select type (config => component%phs_config)
type is (phs_fks_config_t)
select type (phs_config_born)
type is (phs_wood_config_t)
config%md5sum_born_config = &
phs_config_born%md5sum_phs_config
call config%set_born_config (phs_config_born)
call config%set_mode (component%config%get_nlo_type ())
end select
end select
call component%configure_phs (sqrts, &
process%beam_config, rebuild, ignore_mismatch, subdir)
end select
class default
call msg_bug ("process_configure_phs: unsupported PCM type")
end select
end if
end associate
end do
contains
subroutine check_and_extend_phs (component)
type(process_component_t), intent(inout) :: component
if (combined_integration) then
select type (phs_config => component%phs_config)
class is (phs_wood_config_t)
phs_config%is_combined_integration = .true.
call phs_config%increase_n_par ()
end select
end if
end subroutine check_and_extend_phs
end subroutine process_configure_phs
@ %def process_configure_phs
@
<<Process: process: TBP>>=
procedure :: print_phs_startup_message => process_print_phs_startup_message
<<Process: procedures>>=
subroutine process_print_phs_startup_message (process)
class(process_t), intent(in) :: process
integer :: i_component
do i_component = 1, process%meta%n_components
associate (component => process%component(i_component))
if (component%active) then
call component%phs_config%startup_message ()
end if
end associate
end do
end subroutine process_print_phs_startup_message
@ %def process_print_phs_startup_message
@ Insert the structure-function configuration data. First allocate the
storage, then insert data one by one. The third procedure declares a
mapping (of the MC input parameters) for a specific channel and
structure-function combination.
We take the number of channels from the corresponding entry in the
[[config_data]] section.
Otherwise, these a simple wrapper routines. The extra level in the
call tree may allow for simple addressing of multiple concurrent beam
configurations, not implemented currently.
If we do not want structure functions, we simply do not call those procedures.
<<Process: process: TBP>>=
procedure :: init_sf_chain => process_init_sf_chain
generic :: set_sf_channel => set_sf_channel_single
procedure :: set_sf_channel_single => process_set_sf_channel
generic :: set_sf_channel => set_sf_channel_array
procedure :: set_sf_channel_array => process_set_sf_channel_array
<<Process: procedures>>=
subroutine process_init_sf_chain (process, sf_config, sf_trace_file)
class(process_t), intent(inout) :: process
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
type(string_t) :: file
if (present (sf_trace_file)) then
if (sf_trace_file /= "") then
file = sf_trace_file
else
file = process%get_id () // "_sftrace.dat"
end if
call process%beam_config%init_sf_chain (sf_config, file)
else
call process%beam_config%init_sf_chain (sf_config)
end if
end subroutine process_init_sf_chain
subroutine process_set_sf_channel (process, c, sf_channel)
class(process_t), intent(inout) :: process
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
call process%beam_config%set_sf_channel (c, sf_channel)
end subroutine process_set_sf_channel
subroutine process_set_sf_channel_array (process, sf_channel)
class(process_t), intent(inout) :: process
type(sf_channel_t), dimension(:), intent(in) :: sf_channel
integer :: c
call process%beam_config%allocate_sf_channels (size (sf_channel))
do c = 1, size (sf_channel)
call process%beam_config%set_sf_channel (c, sf_channel(c))
end do
end subroutine process_set_sf_channel_array
@ %def process_init_sf_chain
@ %def process_set_sf_channel
@ Notify about the structure-function setup.
<<Process: process: TBP>>=
procedure :: sf_startup_message => process_sf_startup_message
<<Process: procedures>>=
subroutine process_sf_startup_message (process, sf_string, unit)
class(process_t), intent(in) :: process
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
call process%beam_config%sf_startup_message (sf_string, unit)
end subroutine process_sf_startup_message
@ %def process_sf_startup_message
@ As soon as both the kinematics configuration and the
structure-function setup are complete, we match parameterizations
(channels) for both. The matching entries are (re)set in the
[[component]] phase-space configuration, while the structure-function
configuration is left intact.
<<Process: process: TBP>>=
procedure :: collect_channels => process_collect_channels
<<Process: procedures>>=
subroutine process_collect_channels (process, coll)
class(process_t), intent(inout) :: process
type(phs_channel_collection_t), intent(inout) :: coll
integer :: i
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) &
call component%collect_channels (coll)
end associate
end do
end subroutine process_collect_channels
@ %def process_collect_channels
@ Independently, we should be able to check if any component does not
contain phase-space parameters. Such a process can only be integrated
if there are structure functions.
<<Process: process: TBP>>=
procedure :: contains_trivial_component => process_contains_trivial_component
<<Process: procedures>>=
function process_contains_trivial_component (process) result (flag)
class(process_t), intent(in) :: process
logical :: flag
integer :: i
flag = .true.
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) then
if (component%get_n_phs_par () == 0) return
end if
end associate
end do
flag = .false.
end function process_contains_trivial_component
@ %def process_contains_trivial_component
@
<<Process: process: TBP>>=
procedure :: get_master_component => process_get_master_component
<<Process: procedures>>=
function process_get_master_component (process, i_mci) result (i_component)
integer :: i_component
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer :: i
i_component = 0
do i = 1, size (process%component)
if (process%component(i)%i_mci == i_mci) then
i_component = i
return
end if
end do
end function process_get_master_component
@ %def process_get_master_component
@ Determine the MC parameter set structure and the MCI configuration for each
process component. We need data from the structure-function and phase-space
setup, so those should be complete before this is called. We also
make a random-number generator instance for each MCI group.
<<Process: process: TBP>>=
procedure :: setup_mci => process_setup_mci
<<Process: procedures>>=
subroutine process_setup_mci (process, dispatch_mci)
class(process_t), intent(inout) :: process
procedure(dispatch_mci_proc) :: dispatch_mci
class(mci_t), allocatable :: mci_template
integer :: i, i_mci
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_setup_mci")
associate (pcm => process%pcm)
call pcm%call_dispatch_mci (dispatch_mci, &
process%get_var_list_ptr (), process%meta%id, mci_template)
call pcm%setup_mci (process%mci_entry)
process%config%n_mci = pcm%n_mci
process%component(:)%i_mci = pcm%i_mci(:)
do i = 1, pcm%n_components
i_mci = process%pcm%i_mci(i)
if (i_mci > 0) then
associate (component => process%component(i), &
mci_entry => process%mci_entry(i_mci))
call mci_entry%configure (mci_template, &
process%meta%type, &
i_mci, i, component, process%beam_config%n_sfpar, &
process%rng_factory)
call mci_entry%set_parameters (process%get_var_list_ptr ())
end associate
end if
end do
end associate
end subroutine process_setup_mci
@ %def process_setup_mci
@ Set cuts. This is a parse node, namely the right-hand side of the [[cut]]
assignment. When creating an instance, we compile this into an evaluation
tree. The parse node may be null.
<<Process: process: TBP>>=
procedure :: set_cuts => process_set_cuts
<<Process: procedures>>=
subroutine process_set_cuts (process, ef_cuts)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_cuts
allocate (process%config%ef_cuts, source = ef_cuts)
end subroutine process_set_cuts
@ %def process_set_cuts
@ Analogously for the other expressions.
<<Process: process: TBP>>=
procedure :: set_scale => process_set_scale
procedure :: set_fac_scale => process_set_fac_scale
procedure :: set_ren_scale => process_set_ren_scale
procedure :: set_weight => process_set_weight
<<Process: procedures>>=
subroutine process_set_scale (process, ef_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_scale
allocate (process%config%ef_scale, source = ef_scale)
end subroutine process_set_scale
subroutine process_set_fac_scale (process, ef_fac_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_fac_scale
allocate (process%config%ef_fac_scale, source = ef_fac_scale)
end subroutine process_set_fac_scale
subroutine process_set_ren_scale (process, ef_ren_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_ren_scale
allocate (process%config%ef_ren_scale, source = ef_ren_scale)
end subroutine process_set_ren_scale
subroutine process_set_weight (process, ef_weight)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_weight
allocate (process%config%ef_weight, source = ef_weight)
end subroutine process_set_weight
@ %def process_set_scale
@ %def process_set_fac_scale
@ %def process_set_ren_scale
@ %def process_set_weight
@
\subsubsection{MD5 sum}
The MD5 sum of the process object should reflect the state completely,
including integration results. It is used for checking the integrity
of event files. This global checksum includes checksums for the
various parts. In particular, the MCI object receives a checksum that
includes the configuration of all configuration parts relevant for an
individual integration. This checksum is used for checking the
integrity of integration grids.
We do not need MD5 sums for the process terms, since these are
generated from the component definitions.
<<Process: process: TBP>>=
procedure :: compute_md5sum => process_compute_md5sum
<<Process: procedures>>=
subroutine process_compute_md5sum (process)
class(process_t), intent(inout) :: process
integer :: i
call process%config%compute_md5sum ()
do i = 1, process%config%n_components
associate (component => process%component(i))
if (component%active) then
call component%compute_md5sum ()
end if
end associate
end do
call process%beam_config%compute_md5sum ()
do i = 1, process%config%n_mci
call process%mci_entry(i)%compute_md5sum &
(process%config, process%component, process%beam_config)
end do
end subroutine process_compute_md5sum
@ %def process_compute_md5sum
@
<<Process: process: TBP>>=
procedure :: sampler_test => process_sampler_test
<<Process: procedures>>=
subroutine process_sampler_test (process, sampler, n_calls, i_mci)
class(process_t), intent(inout) :: process
class(mci_sampler_t), intent(inout) :: sampler
integer, intent(in) :: n_calls, i_mci
call process%mci_entry(i_mci)%sampler_test (sampler, n_calls)
end subroutine process_sampler_test
@ %def process_sampler_test
@ The finalizer should be called after all integration passes have been
completed. It will, for instance, write a summary of the integration
results.
[[integrate_dummy]] does a ``dummy'' integration in the sense that
nothing is done but just empty integration results appended.
<<Process: process: TBP>>=
procedure :: final_integration => process_final_integration
procedure :: integrate_dummy => process_integrate_dummy
<<Process: procedures>>=
subroutine process_final_integration (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
call process%mci_entry(i_mci)%final_integration ()
end subroutine process_final_integration
subroutine process_integrate_dummy (process)
class(process_t), intent(inout) :: process
type(integration_results_t) :: results
integer :: u_log
u_log = logfile_unit ()
call results%init (process%meta%type)
call results%display_init (screen = .true., unit = u_log)
call results%new_pass ()
call results%record (1, 0, 0._default, 0._default, 0._default)
call results%display_final ()
end subroutine process_integrate_dummy
@ %def process_final_integration
@ %def process_integrate_dummy
@
<<Process: process: TBP>>=
procedure :: integrate => process_integrate
<<Process: procedures>>=
subroutine process_integrate (process, i_mci, mci_work, &
mci_sampler, n_it, n_calls, adapt_grids, adapt_weights, final, &
pacify, nlo_type)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it, n_calls
logical, intent(in), optional :: adapt_grids, adapt_weights
logical, intent(in), optional :: final
logical, intent(in), optional :: pacify
integer, intent(in), optional :: nlo_type
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%integrate (mci_work%mci, mci_sampler, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify, &
nlo_type = nlo_type)
call mci_entry%results%display_pass (pacify)
end associate
end subroutine process_integrate
@ %def process_integrate
@
<<Process: process: TBP>>=
procedure :: generate_weighted_event => process_generate_weighted_event
<<Process: procedures>>=
subroutine process_generate_weighted_event (process, i_mci, mci_work, &
mci_sampler, keep_failed_events)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed_events
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%generate_weighted_event (mci_work%mci, &
mci_sampler, keep_failed_events)
end associate
end subroutine process_generate_weighted_event
@ %def process_generate_weighted_event
<<Process: process: TBP>>=
procedure :: generate_unweighted_event => process_generate_unweighted_event
<<Process: procedures>>=
subroutine process_generate_unweighted_event (process, i_mci, &
mci_work, mci_sampler)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%generate_unweighted_event &
(mci_work%mci, mci_sampler)
end associate
end subroutine process_generate_unweighted_event
@ %def process_generate_unweighted_event
@ Display the final results for the sum of all components. This is useful,
obviously, only if there is more than one component and not if a combined
integration of all components together has been performed.
<<Process: process: TBP>>=
procedure :: display_summed_results => process_display_summed_results
<<Process: procedures>>=
subroutine process_display_summed_results (process, pacify)
class(process_t), intent(inout) :: process
logical, intent(in) :: pacify
type(integration_results_t) :: results
integer :: u_log
u_log = logfile_unit ()
call results%init (process%meta%type)
call results%display_init (screen = .true., unit = u_log)
call results%new_pass ()
call results%record (1, 0, &
process%get_integral (), &
process%get_error (), &
process%get_efficiency (), suppress = pacify)
select type (pcm => process%pcm)
class is (pcm_nlo_t)
!!! Check that Born integral is there
if (.not. pcm%settings%combined_integration .and. &
process%component_can_be_integrated (1)) then
call results%record_correction (process%get_correction (), &
process%get_correction_error ())
end if
end select
call results%display_final ()
end subroutine process_display_summed_results
@ %def process_display_summed_results
@ Run LaTeX/Metapost to generate a ps/pdf file for the integration
history. We (re)write the driver file -- just in case it has been
missed before -- then we compile it.
<<Process: process: TBP>>=
procedure :: display_integration_history => &
process_display_integration_history
<<Process: procedures>>=
subroutine process_display_integration_history &
(process, i_mci, filename, os_data, eff_reset)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: eff_reset
call integration_results_write_driver &
(process%mci_entry(i_mci)%results, filename, eff_reset)
call integration_results_compile_driver &
(process%mci_entry(i_mci)%results, filename, os_data)
end subroutine process_display_integration_history
@ %def subroutine process_display_integration_history
@ Write a complete logfile (with hardcoded name based on the process ID).
We do not write internal data.
<<Process: process: TBP>>=
procedure :: write_logfile => process_write_logfile
<<Process: procedures>>=
subroutine process_write_logfile (process, i_mci, filename)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
type(time_t) :: time
integer :: unit, u
unit = free_unit ()
open (unit = unit, file = char (filename), action = "write", &
status = "replace")
u = given_output_unit (unit)
write (u, "(A)") repeat ("#", 79)
call process%meta%write (u, .false.)
write (u, "(A)") repeat ("#", 79)
write (u, "(3x,A,ES17.10)") "Integral = ", &
process%mci_entry(i_mci)%get_integral ()
write (u, "(3x,A,ES17.10)") "Error = ", &
process%mci_entry(i_mci)%get_error ()
write (u, "(3x,A,ES17.10)") "Accuracy = ", &
process%mci_entry(i_mci)%get_accuracy ()
write (u, "(3x,A,ES17.10)") "Chi2 = ", &
process%mci_entry(i_mci)%get_chi2 ()
write (u, "(3x,A,ES17.10)") "Efficiency = ", &
process%mci_entry(i_mci)%get_efficiency ()
call process%mci_entry(i_mci)%get_time (time, 10000)
if (time%is_known ()) then
write (u, "(3x,A,1x,A)") "T(10k evt) = ", char (time%to_string_dhms ())
else
write (u, "(3x,A)") "T(10k evt) = [undefined]"
end if
call process%mci_entry(i_mci)%results%write (u)
write (u, "(A)") repeat ("#", 79)
call process%mci_entry(i_mci)%results%write_chain_weights (u)
write (u, "(A)") repeat ("#", 79)
call process%mci_entry(i_mci)%counter%write (u)
write (u, "(A)") repeat ("#", 79)
call process%mci_entry(i_mci)%mci%write_log_entry (u)
write (u, "(A)") repeat ("#", 79)
call process%beam_config%data%write (u)
write (u, "(A)") repeat ("#", 79)
if (allocated (process%config%ef_cuts)) then
write (u, "(3x,A)") "Cut expression:"
call process%config%ef_cuts%write (u)
else
write (u, "(3x,A)") "No cuts used."
end if
call write_separator (u)
if (allocated (process%config%ef_scale)) then
write (u, "(3x,A)") "Scale expression:"
call process%config%ef_scale%write (u)
else
write (u, "(3x,A)") "No scale expression was given."
end if
call write_separator (u)
if (allocated (process%config%ef_fac_scale)) then
write (u, "(3x,A)") "Factorization scale expression:"
call process%config%ef_fac_scale%write (u)
else
write (u, "(3x,A)") "No factorization scale expression was given."
end if
call write_separator (u)
if (allocated (process%config%ef_ren_scale)) then
write (u, "(3x,A)") "Renormalization scale expression:"
call process%config%ef_ren_scale%write (u)
else
write (u, "(3x,A)") "No renormalization scale expression was given."
end if
call write_separator (u)
if (allocated (process%config%ef_weight)) then
call write_separator (u)
write (u, "(3x,A)") "Weight expression:"
call process%config%ef_weight%write (u)
else
write (u, "(3x,A)") "No weight expression was given."
end if
write (u, "(A)") repeat ("#", 79)
write (u, "(1x,A)") "Summary of quantum-number states:"
write (u, "(1x,A)") " + sign: allowed and contributing"
write (u, "(1x,A)") " no + : switched off at runtime"
call process%write_state_summary (u)
write (u, "(A)") repeat ("#", 79)
call process%env%write (u, show_var_list=.true., &
show_model=.false., show_lib=.false., show_os_data=.false.)
write (u, "(A)") repeat ("#", 79)
close (u)
end subroutine process_write_logfile
@ %def process_write_logfile
@ Display the quantum-number combinations of the process components, and their
current status (allowed or switched off).
<<Process: process: TBP>>=
procedure :: write_state_summary => process_write_state_summary
<<Process: procedures>>=
subroutine process_write_state_summary (process, unit)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
integer :: i, i_component, u
u = given_output_unit (unit)
do i = 1, size (process%term)
call write_separator (u)
i_component = process%term(i)%i_component
if (i_component /= 0) then
call process%term(i)%write_state_summary &
(process%get_core_term(i), unit)
end if
end do
end subroutine process_write_state_summary
@ %def process_write_state_summary
@ Prepare event generation for the specified MCI entry. This implies, in
particular, checking the phase-space file.
<<Process: process: TBP>>=
procedure :: prepare_simulation => process_prepare_simulation
<<Process: procedures>>=
subroutine process_prepare_simulation (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
call process%mci_entry(i_mci)%prepare_simulation ()
end subroutine process_prepare_simulation
@ %def process_prepare_simulation
@
\subsubsection{Retrieve process data}
Tell whether integral (and error) are known.
<<Process: process: TBP>>=
generic :: has_integral => has_integral_tot, has_integral_mci
procedure :: has_integral_tot => process_has_integral_tot
procedure :: has_integral_mci => process_has_integral_mci
<<Process: procedures>>=
function process_has_integral_mci (process, i_mci) result (flag)
logical :: flag
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
if (allocated (process%mci_entry)) then
flag = process%mci_entry(i_mci)%has_integral ()
else
flag = .false.
end if
end function process_has_integral_mci
function process_has_integral_tot (process) result (flag)
logical :: flag
class(process_t), intent(in) :: process
integer :: i, j, i_component
if (allocated (process%mci_entry)) then
flag = .true.
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated (i_component)) &
flag = flag .and. process%mci_entry(i)%has_integral ()
end do
end do
else
flag = .false.
end if
end function process_has_integral_tot
@ %def process_has_integral
@
Return the current integral and error obtained by the integrator [[i_mci]].
<<Process: process: TBP>>=
generic :: get_integral => get_integral_tot, get_integral_mci
generic :: get_error => get_error_tot, get_error_mci
generic :: get_efficiency => get_efficiency_tot, get_efficiency_mci
procedure :: get_integral_tot => process_get_integral_tot
procedure :: get_integral_mci => process_get_integral_mci
procedure :: get_error_tot => process_get_error_tot
procedure :: get_error_mci => process_get_error_mci
procedure :: get_efficiency_tot => process_get_efficiency_tot
procedure :: get_efficiency_mci => process_get_efficiency_mci
<<Process: procedures>>=
function process_get_integral_mci (process, i_mci) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integral = process%mci_entry(i_mci)%get_integral ()
end function process_get_integral_mci
function process_get_error_mci (process, i_mci) result (error)
real(default) :: error
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
error = process%mci_entry(i_mci)%get_error ()
end function process_get_error_mci
function process_get_efficiency_mci (process, i_mci) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
efficiency = process%mci_entry(i_mci)%get_efficiency ()
end function process_get_efficiency_mci
function process_get_integral_tot (process) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
integer :: i, j, i_component
integral = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) &
integral = integral + process%mci_entry(i)%get_integral ()
end do
end do
end if
end function process_get_integral_tot
function process_get_error_tot (process) result (error)
real(default) :: variance
class(process_t), intent(in) :: process
real(default) :: error
integer :: i, j, i_component
variance = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) &
variance = variance + process%mci_entry(i)%get_error () ** 2
end do
end do
end if
error = sqrt (variance)
end function process_get_error_tot
function process_get_efficiency_tot (process) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
real(default) :: den, eff, int
integer :: i, j, i_component
den = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) then
int = process%get_integral (i)
if (int > 0) then
eff = process%mci_entry(i)%get_efficiency ()
if (eff > 0) then
den = den + int / eff
else
efficiency = 0
return
end if
end if
end if
end do
end do
end if
if (den > 0) then
efficiency = process%get_integral () / den
else
efficiency = 0
end if
end function process_get_efficiency_tot
@ %def process_get_integral process_get_efficiency
@ Let us call the ratio of the NLO and the LO result $\iota = I_{NLO} / I_{LO}$. Then
usual error propagation gives
\begin{equation*}
\sigma_{\iota}^2 = \left(\frac{\partial \iota}{\partial I_{LO}}\right)^2 \sigma_{I_{LO}}^2
+ \left(\frac{\partial \iota}{\partial I_{NLO}}\right)^2 \sigma_{I_{NLO}}^2
= \frac{I_{NLO}^2\sigma_{I_{LO}}^2}{I_{LO}^4} + \frac{\sigma_{I_{NLO}}^2}{I_{LO}^2}.
\end{equation*}
<<Process: process: TBP>>=
procedure :: get_correction => process_get_correction
procedure :: get_correction_error => process_get_correction_error
<<Process: procedures>>=
function process_get_correction (process) result (ratio)
real(default) :: ratio
class(process_t), intent(in) :: process
integer :: i_mci, i_component
real(default) :: int_born, int_nlo
int_nlo = zero
int_born = process%mci_entry(1)%get_integral ()
i_mci = 2
do i_component = 2, size (process%component)
if (process%component_can_be_integrated (i_component)) then
int_nlo = int_nlo + process%mci_entry(i_mci)%get_integral ()
i_mci = i_mci + 1
end if
end do
ratio = int_nlo / int_born * 100
end function process_get_correction
function process_get_correction_error (process) result (error)
real(default) :: error
class(process_t), intent(in) :: process
real(default) :: int_born, sum_int_nlo
real(default) :: err_born, err2
integer :: i_mci, i_component
sum_int_nlo = zero; err2 = zero
int_born = process%mci_entry(1)%get_integral ()
err_born = process%mci_entry(1)%get_error ()
i_mci = 2
do i_component = 2, size (process%component)
if (process%component_can_be_integrated (i_component)) then
sum_int_nlo = sum_int_nlo + process%mci_entry(i_mci)%get_integral ()
err2 = err2 + process%mci_entry(i_mci)%get_error()**2
i_mci = i_mci + 1
end if
end do
error = sqrt (err2 / int_born**2 + sum_int_nlo**2 * err_born**2 / int_born**4) * 100
end function process_get_correction_error
@ %def process_get_correction process_get_correction_error
@
<<Process: process: TBP>>=
procedure :: lab_is_cm => process_lab_is_cm
<<Process: procedures>>=
pure function process_lab_is_cm (process) result (lab_is_cm)
logical :: lab_is_cm
class(process_t), intent(in) :: process
lab_is_cm = process%beam_config%lab_is_cm
! This asks beam_config for the frame
end function process_lab_is_cm
@ %def process_lab_is_cm
@
<<Process: process: TBP>>=
procedure :: get_component_ptr => process_get_component_ptr
<<Process: procedures>>=
function process_get_component_ptr (process, i) result (component)
type(process_component_t), pointer :: component
class(process_t), intent(in), target :: process
integer, intent(in) :: i
component => process%component(i)
end function process_get_component_ptr
@ %def process_get_component_ptr
@
<<Process: process: TBP>>=
procedure :: get_qcd => process_get_qcd
<<Process: procedures>>=
function process_get_qcd (process) result (qcd)
type(qcd_t) :: qcd
class(process_t), intent(in) :: process
qcd = process%config%get_qcd ()
end function process_get_qcd
@ %def process_get_qcd
@
<<Process: process: TBP>>=
generic :: get_component_type => get_component_type_single
procedure :: get_component_type_single => process_get_component_type_single
<<Process: procedures>>=
elemental function process_get_component_type_single &
(process, i_component) result (comp_type)
integer :: comp_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
comp_type = process%component(i_component)%component_type
end function process_get_component_type_single
@ %def process_get_component_type_single
@
<<Process: process: TBP>>=
generic :: get_component_type => get_component_type_all
procedure :: get_component_type_all => process_get_component_type_all
<<Process: procedures>>=
function process_get_component_type_all &
(process) result (comp_type)
integer, dimension(:), allocatable :: comp_type
class(process_t), intent(in) :: process
allocate (comp_type (size (process%component)))
comp_type = process%component%component_type
end function process_get_component_type_all
@ %def process_get_component_type_all
@
<<Process: process: TBP>>=
procedure :: get_component_i_terms => process_get_component_i_terms
<<Process: procedures>>=
function process_get_component_i_terms (process, i_component) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
allocate (i_term (size (process%component(i_component)%i_term)))
i_term = process%component(i_component)%i_term
end function process_get_component_i_terms
@ %def process_get_component_i_terms
@
<<Process: process: TBP>>=
procedure :: get_n_allowed_born => process_get_n_allowed_born
<<Process: procedures>>=
function process_get_n_allowed_born (process, i_born) result (n_born)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_born
integer :: n_born
n_born = process%term(i_born)%n_allowed
end function process_get_n_allowed_born
@ %def process_get_n_allowed_born
@ Workaround getter. Would be better to remove this.
<<Process: process: TBP>>=
procedure :: get_pcm_ptr => process_get_pcm_ptr
<<Process: procedures>>=
function process_get_pcm_ptr (process) result (pcm)
class(pcm_t), pointer :: pcm
class(process_t), intent(in), target :: process
pcm => process%pcm
end function process_get_pcm_ptr
@ %def process_get_pcm_ptr
<<Process: process: TBP>>=
generic :: component_can_be_integrated => component_can_be_integrated_single
generic :: component_can_be_integrated => component_can_be_integrated_all
procedure :: component_can_be_integrated_single => process_component_can_be_integrated_single
<<Process: procedures>>=
function process_component_can_be_integrated_single (process, i_component) &
result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
logical :: combined_integration
select type (pcm => process%pcm)
type is (pcm_nlo_t)
combined_integration = pcm%settings%combined_integration
class default
combined_integration = .false.
end select
associate (component => process%component(i_component))
active = component%can_be_integrated ()
if (combined_integration) &
active = active .and. component%component_type <= COMP_MASTER
end associate
end function process_component_can_be_integrated_single
@ %def process_component_can_be_integrated_single
@
<<Process: process: TBP>>=
procedure :: component_can_be_integrated_all => process_component_can_be_integrated_all
<<Process: procedures>>=
function process_component_can_be_integrated_all (process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
integer :: i
allocate (val (size (process%component)))
do i = 1, size (process%component)
val(i) = process%component_can_be_integrated (i)
end do
end function process_component_can_be_integrated_all
@ %def process_component_can_be_integrated_all
@
<<Process: process: TBP>>=
procedure :: reset_selected_cores => process_reset_selected_cores
<<Process: procedures>>=
pure subroutine process_reset_selected_cores (process)
class(process_t), intent(inout) :: process
process%pcm%component_selected = .false.
end subroutine process_reset_selected_cores
@ %def process_reset_selected_cores
@
<<Process: process: TBP>>=
procedure :: select_components => process_select_components
<<Process: procedures>>=
pure subroutine process_select_components (process, indices)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: indices
associate (pcm => process%pcm)
pcm%component_selected(indices) = .true.
end associate
end subroutine process_select_components
@ %def process_select_components
@
<<Process: process: TBP>>=
procedure :: component_is_selected => process_component_is_selected
<<Process: procedures>>=
pure function process_component_is_selected (process, index) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: index
associate (pcm => process%pcm)
val = pcm%component_selected(index)
end associate
end function process_component_is_selected
@ %def process_component_is_selected
@
<<Process: process: TBP>>=
procedure :: get_coupling_powers => process_get_coupling_powers
<<Process: procedures>>=
pure subroutine process_get_coupling_powers (process, alpha_power, alphas_power)
class(process_t), intent(in) :: process
integer, intent(out) :: alpha_power, alphas_power
call process%component(1)%config%get_coupling_powers (alpha_power, alphas_power)
end subroutine process_get_coupling_powers
@ %def process_get_coupling_powers
@
<<Process: process: TBP>>=
procedure :: get_real_component => process_get_real_component
<<Process: procedures>>=
function process_get_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer :: i_component
type(process_component_def_t), pointer :: config => null ()
i_real = 0
do i_component = 1, size (process%component)
config => process%get_component_def_ptr (i_component)
if (config%get_nlo_type () == NLO_REAL) then
i_real = i_component
exit
end if
end do
end function process_get_real_component
@ %def process_get_real_component
@
<<Process: process: TBP>>=
procedure :: extract_active_component_mci => process_extract_active_component_mci
<<Process: procedures>>=
function process_extract_active_component_mci (process) result (i_active)
integer :: i_active
class(process_t), intent(in) :: process
integer :: i_mci, j, i_component, n_active
call count_n_active ()
if (n_active /= 1) i_active = 0
contains
subroutine count_n_active ()
n_active = 0
do i_mci = 1, size (process%mci_entry)
associate (mci_entry => process%mci_entry(i_mci))
do j = 1, size (mci_entry%i_component)
i_component = mci_entry%i_component(j)
associate (component => process%component (i_component))
if (component%can_be_integrated ()) then
i_active = i_mci
n_active = n_active + 1
end if
end associate
end do
end associate
end do
end subroutine count_n_active
end function process_extract_active_component_mci
@ %def process_extract_active_component_mci
@
<<Process: process: TBP>>=
procedure :: uses_real_partition => process_uses_real_partition
<<Process: procedures>>=
function process_uses_real_partition (process) result (val)
logical :: val
class(process_t), intent(in) :: process
val = any (process%mci_entry%real_partition_type /= REAL_FULL)
end function process_uses_real_partition
@ %def process_uses_real_partition
@ Return the MD5 sums that summarize the process component
definitions. These values should be independent of parameters, beam
details, expressions, etc. They can be used for checking the
integrity of a process when reusing an old event file.
<<Process: process: TBP>>=
procedure :: get_md5sum_prc => process_get_md5sum_prc
<<Process: procedures>>=
function process_get_md5sum_prc (process, i_component) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
if (process%component(i_component)%active) then
md5sum = process%component(i_component)%config%get_md5sum ()
else
md5sum = ""
end if
end function process_get_md5sum_prc
@ %def process_get_md5sum_prc
@ Return the MD5 sums that summarize the state of the MCI integrators.
These values should encode all process data, integration and phase
space configuration, etc., and the integration results. They can thus
be used for checking the integrity of an event-generation setup when
reusing an old event file.
<<Process: process: TBP>>=
procedure :: get_md5sum_mci => process_get_md5sum_mci
<<Process: procedures>>=
function process_get_md5sum_mci (process, i_mci) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
md5sum = process%mci_entry(i_mci)%get_md5sum ()
end function process_get_md5sum_mci
@ %def process_get_md5sum_mci
@ Return the MD5 sum of the process configuration. This should encode
the process setup, data, and expressions, but no integration results.
<<Process: process: TBP>>=
procedure :: get_md5sum_cfg => process_get_md5sum_cfg
<<Process: procedures>>=
function process_get_md5sum_cfg (process) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
md5sum = process%config%md5sum
end function process_get_md5sum_cfg
@ %def process_get_md5sum_cfg
@
<<Process: process: TBP>>=
procedure :: get_n_cores => process_get_n_cores
<<Process: procedures>>=
function process_get_n_cores (process) result (n)
integer :: n
class(process_t), intent(in) :: process
n = process%pcm%n_cores
end function process_get_n_cores
@ %def process_get_n_cores
@
<<Process: process: TBP>>=
procedure :: get_base_i_term => process_get_base_i_term
<<Process: procedures>>=
function process_get_base_i_term (process, i_component) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
i_term = process%component(i_component)%i_term(1)
end function process_get_base_i_term
@ %def process_get_base_i_term
@
<<Process: process: TBP>>=
procedure :: get_core_term => process_get_core_term
<<Process: procedures>>=
function process_get_core_term (process, i_term) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
integer :: i_core
i_core = process%term(i_term)%i_core
core => process%core_entry(i_core)%get_core_ptr ()
end function process_get_core_term
@ %def process_get_core_term
@
<<Process: process: TBP>>=
procedure :: get_core_ptr => process_get_core_ptr
<<Process: procedures>>=
function process_get_core_ptr (process, i_core) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
integer, intent(in) :: i_core
if (allocated (process%core_entry)) then
core => process%core_entry(i_core)%get_core_ptr ()
else
core => null ()
end if
end function process_get_core_ptr
@ %def process_get_core_ptr
@
<<Process: process: TBP>>=
procedure :: get_term_ptr => process_get_term_ptr
<<Process: procedures>>=
function process_get_term_ptr (process, i) result (term)
type(process_term_t), pointer :: term
class(process_t), intent(in), target :: process
integer, intent(in) :: i
term => process%term(i)
end function process_get_term_ptr
@ %def process_get_term_ptr
@
<<Process: process: TBP>>=
procedure :: get_i_term => process_get_i_term
<<Process: procedures>>=
function process_get_i_term (process, i_core) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
do i_term = 1, process%get_n_terms ()
if (process%term(i_term)%i_core == i_core) return
end do
i_term = -1
end function process_get_i_term
@ %def process_get_i_term
@
<<Process: process: TBP>>=
procedure :: get_i_core => process_get_i_core
<<Process: procedures>>=
integer function process_get_i_core (process, i_term) result (i_core)
class(process_t), intent(in) :: process
integer, intent(in) :: i_term
i_core = process%term(i_term)%i_core
end function process_get_i_core
@ %def process_get_i_core
@
<<Process: process: TBP>>=
procedure :: set_i_mci_work => process_set_i_mci_work
<<Process: procedures>>=
subroutine process_set_i_mci_work (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
process%mci_entry(i_mci)%i_mci = i_mci
end subroutine process_set_i_mci_work
@ %def process_set_i_mci_work
@
<<Process: process: TBP>>=
procedure :: get_i_mci_work => process_get_i_mci_work
<<Process: procedures>>=
pure function process_get_i_mci_work (process, i_mci) result (i_mci_work)
integer :: i_mci_work
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
i_mci_work = process%mci_entry(i_mci)%i_mci
end function process_get_i_mci_work
@ %def process_get_i_mci_work
@
<<Process: process: TBP>>=
procedure :: get_i_sub => process_get_i_sub
<<Process: procedures>>=
elemental function process_get_i_sub (process, i_term) result (i_sub)
integer :: i_sub
class(process_t), intent(in) :: process
integer, intent(in) :: i_term
i_sub = process%term(i_term)%i_sub
end function process_get_i_sub
@ %def process_get_i_sub
@
<<Process: process: TBP>>=
procedure :: get_i_term_virtual => process_get_i_term_virtual
<<Process: procedures>>=
elemental function process_get_i_term_virtual (process) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer :: i_component
i_term = 0
do i_component = 1, size (process%component)
if (process%component(i_component)%get_nlo_type () == NLO_VIRTUAL) &
i_term = process%component(i_component)%i_term(1)
end do
end function process_get_i_term_virtual
@ %def process_get_i_term_virtual
@
<<Process: process: TBP>>=
generic :: component_is_active => component_is_active_single
procedure :: component_is_active_single => process_component_is_active_single
<<Process: procedures>>=
elemental function process_component_is_active_single (process, i_comp) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_comp
val = process%component(i_comp)%is_active ()
end function process_component_is_active_single
@ %def process_component_is_active_single
@
<<Process: process: TBP>>=
generic :: component_is_active => component_is_active_all
procedure :: component_is_active_all => process_component_is_active_all
<<Process: procedures>>=
pure function process_component_is_active_all (process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
allocate (val (size (process%component)))
val = process%component%is_active ()
end function process_component_is_active_all
@ %def process_component_is_active_all
@
\subsection{Default iterations}
If the user does not specify the passes and iterations for
integration, we should be able to give reasonable defaults. These
depend on the process, therefore we implement the following procedures
as methods of the process object. The algorithm is not very
sophisticated yet, it may be improved by looking at the process in
more detail.
We investigate only the first process component, assuming that it
characterizes the complexity of the process reasonable well.
The number of passes is limited to two: one for adaption, one for
integration.
<<Process: process: TBP>>=
procedure :: get_n_pass_default => process_get_n_pass_default
procedure :: adapt_grids_default => process_adapt_grids_default
procedure :: adapt_weights_default => process_adapt_weights_default
<<Process: procedures>>=
function process_get_n_pass_default (process) result (n_pass)
class(process_t), intent(in) :: process
integer :: n_pass
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
n_pass = 1
case default
n_pass = 2
end select
end function process_get_n_pass_default
function process_adapt_grids_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
flag = .false.
case default
select case (pass)
case (1); flag = .true.
case (2); flag = .false.
case default
call msg_bug ("adapt grids default: impossible pass index")
end select
end select
end function process_adapt_grids_default
function process_adapt_weights_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
flag = .false.
case default
select case (pass)
case (1); flag = .true.
case (2); flag = .false.
case default
call msg_bug ("adapt weights default: impossible pass index")
end select
end select
end function process_adapt_weights_default
@ %def process_get_n_pass_default
@ %def process_adapt_grids_default
@ %def process_adapt_weights_default
@ The number of iterations and calls per iteration depends on the
number of outgoing particles.
<<Process: process: TBP>>=
procedure :: get_n_it_default => process_get_n_it_default
procedure :: get_n_calls_default => process_get_n_calls_default
<<Process: procedures>>=
function process_get_n_it_default (process, pass) result (n_it)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_it
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (pass)
case (1)
select case (n_eff)
case (1); n_it = 1
case (2); n_it = 3
case (3); n_it = 5
case (4:5); n_it = 10
case (6); n_it = 15
case (7:); n_it = 20
end select
case (2)
select case (n_eff)
case (:3); n_it = 3
case (4:); n_it = 5
end select
end select
end function process_get_n_it_default
function process_get_n_calls_default (process, pass) result (n_calls)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_calls
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (pass)
case (1)
select case (n_eff)
case (1); n_calls = 100
case (2); n_calls = 1000
case (3); n_calls = 5000
case (4); n_calls = 10000
case (5); n_calls = 20000
case (6:); n_calls = 50000
end select
case (2)
select case (n_eff)
case (:3); n_calls = 10000
case (4); n_calls = 20000
case (5); n_calls = 50000
case (6); n_calls = 100000
case (7:); n_calls = 200000
end select
end select
end function process_get_n_calls_default
@ %def process_get_n_it_default
@ %def process_get_n_calls_default
@
\subsection{Constant process data}
Manually set the Run ID (unit test only).
<<Process: process: TBP>>=
procedure :: set_run_id => process_set_run_id
<<Process: procedures>>=
subroutine process_set_run_id (process, run_id)
class(process_t), intent(inout) :: process
type(string_t), intent(in) :: run_id
process%meta%run_id = run_id
end subroutine process_set_run_id
@ %def process_set_run_id
@
The following methods return basic process data that stay constant
after initialization.
The process and IDs.
<<Process: process: TBP>>=
procedure :: get_id => process_get_id
procedure :: get_num_id => process_get_num_id
procedure :: get_run_id => process_get_run_id
procedure :: get_library_name => process_get_library_name
<<Process: procedures>>=
function process_get_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%id
end function process_get_id
function process_get_num_id (process) result (id)
class(process_t), intent(in) :: process
integer :: id
id = process%meta%num_id
end function process_get_num_id
function process_get_run_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%run_id
end function process_get_run_id
function process_get_library_name (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%lib_name
end function process_get_library_name
@ %def process_get_id process_get_num_id
@ %def process_get_run_id process_get_library_name
@ The number of incoming particles.
<<Process: process: TBP>>=
procedure :: get_n_in => process_get_n_in
<<Process: procedures>>=
function process_get_n_in (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_in
end function process_get_n_in
@ %def process_get_n_in
@ The number of MCI data sets.
<<Process: process: TBP>>=
procedure :: get_n_mci => process_get_n_mci
<<Process: procedures>>=
function process_get_n_mci (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_mci
end function process_get_n_mci
@ %def process_get_n_mci
@ The number of process components, total.
<<Process: process: TBP>>=
procedure :: get_n_components => process_get_n_components
<<Process: procedures>>=
function process_get_n_components (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%meta%n_components
end function process_get_n_components
@ %def process_get_n_components
@ The number of process terms, total.
<<Process: process: TBP>>=
procedure :: get_n_terms => process_get_n_terms
<<Process: procedures>>=
function process_get_n_terms (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_terms
end function process_get_n_terms
@ %def process_get_n_terms
@ Return the indices of the components that belong to a
specific MCI entry.
<<Process: process: TBP>>=
procedure :: get_i_component => process_get_i_component
<<Process: procedures>>=
subroutine process_get_i_component (process, i_mci, i_component)
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer, dimension(:), intent(out), allocatable :: i_component
associate (mci_entry => process%mci_entry(i_mci))
allocate (i_component (size (mci_entry%i_component)))
i_component = mci_entry%i_component
end associate
end subroutine process_get_i_component
@ %def process_get_i_component
@ Return the ID of a specific component.
<<Process: process: TBP>>=
procedure :: get_component_id => process_get_component_id
<<Process: procedures>>=
function process_get_component_id (process, i_component) result (id)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t) :: id
id = process%meta%component_id(i_component)
end function process_get_component_id
@ %def process_get_component_id
@ Return a pointer to the definition of a specific component.
<<Process: process: TBP>>=
procedure :: get_component_def_ptr => process_get_component_def_ptr
<<Process: procedures>>=
function process_get_component_def_ptr (process, i_component) result (ptr)
type(process_component_def_t), pointer :: ptr
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
ptr => process%config%process_def%get_component_def_ptr (i_component)
end function process_get_component_def_ptr
@ %def process_get_component_def_ptr
@ These procedures extract and restore (by transferring the
allocation) the process core. This is useful for changing process
parameters from outside this module.
<<Process: process: TBP>>=
procedure :: extract_core => process_extract_core
procedure :: restore_core => process_restore_core
<<Process: procedures>>=
subroutine process_extract_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
integer :: i_core
i_core = process%term(i_term)%i_core
call move_alloc (from = process%core_entry(i_core)%core, to = core)
end subroutine process_extract_core
subroutine process_restore_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
integer :: i_core
i_core = process%term(i_term)%i_core
call move_alloc (from = core, to = process%core_entry(i_core)%core)
end subroutine process_restore_core
@ %def process_extract_core
@ %def process_restore_core
@ The block of process constants.
<<Process: process: TBP>>=
procedure :: get_constants => process_get_constants
<<Process: procedures>>=
function process_get_constants (process, i_core) result (data)
type(process_constants_t) :: data
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
data = process%core_entry(i_core)%core%data
end function process_get_constants
@ %def process_get_constants
@
<<Process: process: TBP>>=
procedure :: get_config => process_get_config
<<Process: procedures>>=
function process_get_config (process) result (config)
type(process_config_data_t) :: config
class(process_t), intent(in) :: process
config = process%config
end function process_get_config
@ %def process_get_config
@
Construct an MD5 sum for the constant data, including the NLO type.
For the NLO type [[NLO_MISMATCH]], we pretend that this was
[[NLO_SUBTRACTION]] instead.
TODO wk 2018: should not depend explicitly on NLO data.
<<Process: process: TBP>>=
procedure :: get_md5sum_constants => process_get_md5sum_constants
<<Process: procedures>>=
function process_get_md5sum_constants (process, i_component, &
type_string, nlo_type) result (this_md5sum)
character(32) :: this_md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t), intent(in) :: type_string
integer, intent(in) :: nlo_type
type(process_constants_t) :: data
integer :: unit
call process%env%fill_process_constants (process%meta%id, i_component, data)
unit = data%fill_unit_for_md5sum (.false.)
write (unit, '(A)') char(type_string)
select case (nlo_type)
case (NLO_MISMATCH)
write (unit, '(I0)') NLO_SUBTRACTION
case default
write (unit, '(I0)') nlo_type
end select
rewind (unit)
this_md5sum = md5sum (unit)
close (unit)
end function process_get_md5sum_constants
@ %def process_get_md5sum_constants
@ Return the set of outgoing flavors that are associated with a particular
term. We deduce this from the effective interaction.
<<Process: process: TBP>>=
procedure :: get_term_flv_out => process_get_term_flv_out
<<Process: procedures>>=
subroutine process_get_term_flv_out (process, i_term, flv)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
type(interaction_t), pointer :: int
int => process%term(i_term)%int_eff
if (.not. associated (int)) int => process%term(i_term)%int
call interaction_get_flv_out (int, flv)
end subroutine process_get_term_flv_out
@ %def process_get_term_flv_out
@ Return true if there is any unstable particle in any of the process
terms. We decide this based on the provided model instance, not the
one that is stored in the process object.
<<Process: process: TBP>>=
procedure :: contains_unstable => process_contains_unstable
<<Process: procedures>>=
function process_contains_unstable (process, model) result (flag)
class(process_t), intent(in) :: process
class(model_data_t), intent(in), target :: model
logical :: flag
integer :: i_term
type(flavor_t), dimension(:,:), allocatable :: flv
flag = .false.
do i_term = 1, process%get_n_terms ()
call process%get_term_flv_out (i_term, flv)
call flv%set_model (model)
flag = .not. all (flv%is_stable ())
deallocate (flv)
if (flag) return
end do
end function process_contains_unstable
@ %def process_contains_unstable
@ The nominal process energy.
<<Process: process: TBP>>=
procedure :: get_sqrts => process_get_sqrts
<<Process: procedures>>=
function process_get_sqrts (process) result (sqrts)
class(process_t), intent(in) :: process
real(default) :: sqrts
sqrts = process%beam_config%data%get_sqrts ()
end function process_get_sqrts
@ %def process_get_sqrts
@ The beam polarization in case of simple degrees.
<<Process: process: TBP>>=
procedure :: get_polarization => process_get_polarization
<<Process: procedures>>=
function process_get_polarization (process) result (pol)
class(process_t), intent(in) :: process
real(default), dimension(2) :: pol
pol = process%beam_config%data%get_polarization ()
end function process_get_polarization
@ %def process_get_polarization
@
<<Process: process: TBP>>=
procedure :: get_meta => process_get_meta
<<Process: procedures>>=
function process_get_meta (process) result (meta)
type(process_metadata_t) :: meta
class(process_t), intent(in) :: process
meta = process%meta
end function process_get_meta
@ %def process_get_meta
<<Process: process: TBP>>=
procedure :: has_matrix_element => process_has_matrix_element
<<Process: procedures>>=
function process_has_matrix_element (process, i, is_term_index) result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in), optional :: i
logical, intent(in), optional :: is_term_index
integer :: i_component
logical :: is_term
is_term = .false.
if (present (i)) then
if (present (is_term_index)) is_term = is_term_index
if (is_term) then
i_component = process%term(i)%i_component
else
i_component = i
end if
active = process%component(i_component)%active
else
active = any (process%component%active)
end if
end function process_has_matrix_element
@ %def process_has_matrix_element
@ Pointer to the beam data object.
<<Process: process: TBP>>=
procedure :: get_beam_data_ptr => process_get_beam_data_ptr
<<Process: procedures>>=
function process_get_beam_data_ptr (process) result (beam_data)
class(process_t), intent(in), target :: process
type(beam_data_t), pointer :: beam_data
beam_data => process%beam_config%data
end function process_get_beam_data_ptr
@ %def process_get_beam_data_ptr
@
<<Process: process: TBP>>=
procedure :: get_beam_config => process_get_beam_config
<<Process: procedures>>=
function process_get_beam_config (process) result (beam_config)
type(process_beam_config_t) :: beam_config
class(process_t), intent(in) :: process
beam_config = process%beam_config
end function process_get_beam_config
@ %def process_get_beam_config
@
<<Process: process: TBP>>=
procedure :: get_beam_config_ptr => process_get_beam_config_ptr
<<Process: procedures>>=
function process_get_beam_config_ptr (process) result (beam_config)
type(process_beam_config_t), pointer :: beam_config
class(process_t), intent(in), target :: process
beam_config => process%beam_config
end function process_get_beam_config_ptr
@ %def process_get_beam_config_ptr
@ Get the PDF set currently in use, if any.
<<Process: process: TBP>>=
procedure :: get_pdf_set => process_get_pdf_set
<<Process: procedures>>=
function process_get_pdf_set (process) result (pdf_set)
class(process_t), intent(in) :: process
integer :: pdf_set
pdf_set = process%beam_config%get_pdf_set ()
end function process_get_pdf_set
@ %def process_get_pdf_set
@
<<Process: process: TBP>>=
procedure :: pcm_contains_pdfs => process_pcm_contains_pdfs
<<Process: procedures>>=
function process_pcm_contains_pdfs (process) result (has_pdfs)
logical :: has_pdfs
class(process_t), intent(in) :: process
has_pdfs = process%pcm%has_pdfs
end function process_pcm_contains_pdfs
@ %def process_pcm_contains_pdfs
@ Get the beam spectrum file currently in use, if any.
<<Process: process: TBP>>=
procedure :: get_beam_file => process_get_beam_file
<<Process: procedures>>=
function process_get_beam_file (process) result (file)
class(process_t), intent(in) :: process
type(string_t) :: file
file = process%beam_config%get_beam_file ()
end function process_get_beam_file
@ %def process_get_beam_file
@ Pointer to the process variable list.
<<Process: process: TBP>>=
procedure :: get_var_list_ptr => process_get_var_list_ptr
<<Process: procedures>>=
function process_get_var_list_ptr (process) result (ptr)
class(process_t), intent(in), target :: process
type(var_list_t), pointer :: ptr
ptr => process%env%get_var_list_ptr ()
end function process_get_var_list_ptr
@ %def process_get_var_list_ptr
@ Pointer to the common model.
<<Process: process: TBP>>=
procedure :: get_model_ptr => process_get_model_ptr
<<Process: procedures>>=
function process_get_model_ptr (process) result (ptr)
class(process_t), intent(in) :: process
class(model_data_t), pointer :: ptr
ptr => process%config%model
end function process_get_model_ptr
@ %def process_get_model_ptr
@ Use the embedded RNG factory to spawn a new random-number generator
instance. (This modifies the state of the factory.)
<<Process: process: TBP>>=
procedure :: make_rng => process_make_rng
<<Process: procedures>>=
subroutine process_make_rng (process, rng)
class(process_t), intent(inout) :: process
class(rng_t), intent(out), allocatable :: rng
if (allocated (process%rng_factory)) then
call process%rng_factory%make (rng)
else
call msg_bug ("Process: make rng: factory not allocated")
end if
end subroutine process_make_rng
@ %def process_make_rng
@
\subsection{Compute an amplitude}
Each process variant should allow for computing an amplitude value
directly, without generating a process instance.
The process component is selected by the index [[i]]. The term within the
process component is selected by [[j]]. The momentum
combination is transferred as the array [[p]]. The function sets the specific
quantum state via the indices of a flavor [[f]], helicity [[h]], and color
[[c]] combination. Each index refers to the list of flavor, helicity, and
color states, respectively, as stored in the process data.
Optionally, we may set factorization and renormalization scale. If unset, the
partonic c.m.\ energy is inserted.
The function checks arguments for validity.
For invalid arguments (quantum states), we return zero.
<<Process: process: TBP>>=
procedure :: compute_amplitude => process_compute_amplitude
<<Process: procedures>>=
function process_compute_amplitude &
(process, i_core, i, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced) &
result (amp)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_core
integer, intent(in) :: i, j
type(vector4_t), dimension(:), intent(in) :: p
integer, intent(in) :: f, h, c
real(default), intent(in), optional :: fac_scale, ren_scale
real(default), intent(in), allocatable, optional :: alpha_qcd_forced
real(default) :: fscale, rscale
real(default), allocatable :: aqcd_forced
complex(default) :: amp
class(prc_core_t), pointer :: core
amp = 0
if (0 < i .and. i <= process%meta%n_components) then
if (process%component(i)%active) then
associate (core => process%core_entry(i_core)%core)
associate (data => core%data)
if (size (p) == data%n_in + data%n_out &
.and. 0 < f .and. f <= data%n_flv &
.and. 0 < h .and. h <= data%n_hel &
.and. 0 < c .and. c <= data%n_col) then
if (present (fac_scale)) then
fscale = fac_scale
else
fscale = sum (p(data%n_in+1:)) ** 1
end if
if (present (ren_scale)) then
rscale = ren_scale
else
rscale = fscale
end if
if (present (alpha_qcd_forced)) then
if (allocated (alpha_qcd_forced)) &
allocate (aqcd_forced, source = alpha_qcd_forced)
end if
amp = core%compute_amplitude (j, p, f, h, c, &
fscale, rscale, aqcd_forced)
end if
end associate
end associate
else
amp = 0
end if
end if
end function process_compute_amplitude
@ %def process_compute_amplitude
@ Sanity check for the process library. We abort the program if it
has changed after process initialization.
<<Process: process: TBP>>=
procedure :: check_library_sanity => process_check_library_sanity
<<Process: procedures>>=
subroutine process_check_library_sanity (process)
class(process_t), intent(in) :: process
call process%env%check_lib_sanity (process%meta)
end subroutine process_check_library_sanity
@ %def process_check_library_sanity
@ Reset the association to a process library.
<<Process: process: TBP>>=
procedure :: reset_library_ptr => process_reset_library_ptr
<<Process: procedures>>=
subroutine process_reset_library_ptr (process)
class(process_t), intent(inout) :: process
call process%env%reset_lib_ptr ()
end subroutine process_reset_library_ptr
@ %def process_reset_library_ptr
@
<<Process: process: TBP>>=
procedure :: set_component_type => process_set_component_type
<<Process: procedures>>=
subroutine process_set_component_type (process, i_component, i_type)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_component, i_type
process%component(i_component)%component_type = i_type
end subroutine process_set_component_type
@ %def process_set_component_type
@
<<Process: process: TBP>>=
procedure :: set_counter_mci_entry => process_set_counter_mci_entry
<<Process: procedures>>=
subroutine process_set_counter_mci_entry (process, i_mci, counter)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(process_counter_t), intent(in) :: counter
process%mci_entry(i_mci)%counter = counter
end subroutine process_set_counter_mci_entry
@ %def process_set_counter_mci_entry
@ This is for suppression of numerical noise in the integration results
stored in the [[process_mci_entry]] type. As the error and efficiency
enter the MD5 sum, we recompute it.
<<Process: process: TBP>>=
procedure :: pacify => process_pacify
<<Process: procedures>>=
subroutine process_pacify (process, efficiency_reset, error_reset)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: efficiency_reset, error_reset
logical :: eff_reset, err_reset
integer :: i
eff_reset = .false.
err_reset = .false.
if (present (efficiency_reset)) eff_reset = efficiency_reset
if (present (error_reset)) err_reset = error_reset
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
call process%mci_entry(i)%results%pacify (efficiency_reset)
if (allocated (process%mci_entry(i)%mci)) then
associate (mci => process%mci_entry(i)%mci)
if (process%mci_entry(i)%mci%error_known &
.and. err_reset) &
mci%error = 0
if (process%mci_entry(i)%mci%efficiency_known &
.and. eff_reset) &
mci%efficiency = 1
call mci%pacify (efficiency_reset, error_reset)
call mci%compute_md5sum ()
end associate
end if
end do
end if
end subroutine process_pacify
@ %def process_pacify
@ The following methods are used only in the unit tests; the access
process internals directly that would otherwise be hidden.
<<Process: process: TBP>>=
procedure :: test_allocate_sf_channels
procedure :: test_set_component_sf_channel
procedure :: test_get_mci_ptr
<<Process: procedures>>=
subroutine test_allocate_sf_channels (process, n)
class(process_t), intent(inout) :: process
integer, intent(in) :: n
call process%beam_config%allocate_sf_channels (n)
end subroutine test_allocate_sf_channels
subroutine test_set_component_sf_channel (process, c)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: c
call process%component(1)%phs_config%set_sf_channel (c)
end subroutine test_set_component_sf_channel
subroutine test_get_mci_ptr (process, mci)
class(process_t), intent(in), target :: process
class(mci_t), intent(out), pointer :: mci
mci => process%mci_entry(1)%mci
end subroutine test_get_mci_ptr
@ %def test_allocate_sf_channels
@ %def test_set_component_sf_channel
@ %def test_get_mci_ptr
@
<<Process: process: TBP>>=
procedure :: init_mci_work => process_init_mci_work
<<Process: procedures>>=
subroutine process_init_mci_work (process, mci_work, i)
class(process_t), intent(in), target :: process
type(mci_work_t), intent(out) :: mci_work
integer, intent(in) :: i
call mci_work%init (process%mci_entry(i))
end subroutine process_init_mci_work
@ %def process_init_mci_work
@
Prepare the process core with type [[test_me]], or otherwise the externally
provided [[type_string]] version. The toy dispatchers as a procedure
argument come handy, knowing that we need to support only the [[test_me]] and
[[template]] matrix-element types.
<<Process: process: TBP>>=
procedure :: setup_test_cores => process_setup_test_cores
<<Process: procedures>>=
subroutine process_setup_test_cores (process, type_string)
class(process_t), intent(inout) :: process
class(prc_core_t), allocatable :: core
type(string_t), intent(in), optional :: type_string
if (present (type_string)) then
select case (char (type_string))
case ("template")
call process%setup_cores (dispatch_template_core)
case ("test_me")
call process%setup_cores (dispatch_test_me_core)
case default
call msg_bug ("process setup test cores: unsupported type string")
end select
else
call process%setup_cores (dispatch_test_me_core)
end if
end subroutine process_setup_test_cores
subroutine dispatch_test_me_core (core, core_def, model, &
helicity_selection, qcd, use_color_factors, has_beam_pol)
use prc_test_core, only: test_t
class(prc_core_t), allocatable, intent(inout) :: core
class(prc_core_def_t), intent(in) :: core_def
class(model_data_t), intent(in), target, optional :: model
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(qcd_t), intent(in), optional :: qcd
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
allocate (test_t :: core)
end subroutine dispatch_test_me_core
subroutine dispatch_template_core (core, core_def, model, &
helicity_selection, qcd, use_color_factors, has_beam_pol)
use prc_template_me, only: prc_template_me_t
class(prc_core_t), allocatable, intent(inout) :: core
class(prc_core_def_t), intent(in) :: core_def
class(model_data_t), intent(in), target, optional :: model
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(qcd_t), intent(in), optional :: qcd
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
allocate (prc_template_me_t :: core)
select type (core)
type is (prc_template_me_t)
call core%set_parameters (model)
end select
end subroutine dispatch_template_core
@ %def process_setup_test_cores
@
<<Process: process: TBP>>=
procedure :: get_connected_states => process_get_connected_states
<<Process: procedures>>=
function process_get_connected_states (process, i_component, &
connected_terms) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(connected_state_t), dimension(:), intent(in) :: connected_terms
integer :: i, i_conn
integer :: n_conn
n_conn = 0
do i = 1, process%get_n_terms ()
if (process%term(i)%i_component == i_component) then
n_conn = n_conn + 1
end if
end do
allocate (connected (n_conn))
i_conn = 1
do i = 1, process%get_n_terms ()
if (process%term(i)%i_component == i_component) then
connected (i_conn) = connected_terms(i)
i_conn = i_conn + 1
end if
end do
end function process_get_connected_states
@ %def process_get_connected_states
@
\subsection{NLO specifics}
These subroutines (and the NLO specific properties they work on) could
potentially be moved to [[pcm_nlo_t]] and used more generically in
[[process_t]] with an appropriate interface in [[pcm_t]]
TODO wk 2018: This is used only by event initialization, which deals with an incomplete
process object.
<<Process: process: TBP>>=
procedure :: init_nlo_settings => process_init_nlo_settings
<<Process: procedures>>=
subroutine process_init_nlo_settings (process, var_list)
class(process_t), intent(inout) :: process
type(var_list_t), intent(in), target :: var_list
select type (pcm => process%pcm)
type is (pcm_nlo_t)
call pcm%init_nlo_settings (var_list)
if (debug_active (D_SUBTRACTION) .or. debug_active (D_VIRTUAL)) &
call pcm%settings%write ()
class default
call msg_fatal ("Attempt to set nlo_settings with a non-NLO pcm!")
end select
end subroutine process_init_nlo_settings
@ %def process_init_nlo_settings
@
<<Process: process: TBP>>=
generic :: get_nlo_type_component => get_nlo_type_component_single
procedure :: get_nlo_type_component_single => process_get_nlo_type_component_single
<<Process: procedures>>=
elemental function process_get_nlo_type_component_single (process, i_component) result (val)
integer :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
val = process%component(i_component)%get_nlo_type ()
end function process_get_nlo_type_component_single
@ %def process_get_nlo_type_component_single
@
<<Process: process: TBP>>=
generic :: get_nlo_type_component => get_nlo_type_component_all
procedure :: get_nlo_type_component_all => process_get_nlo_type_component_all
<<Process: procedures>>=
pure function process_get_nlo_type_component_all (process) result (val)
integer, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
allocate (val (size (process%component)))
val = process%component%get_nlo_type ()
end function process_get_nlo_type_component_all
@ %def process_get_nlo_type_component_all
@
<<Process: process: TBP>>=
procedure :: is_nlo_calculation => process_is_nlo_calculation
<<Process: procedures>>=
function process_is_nlo_calculation (process) result (nlo)
logical :: nlo
class(process_t), intent(in) :: process
select type (pcm => process%pcm)
type is (pcm_nlo_t)
nlo = .true.
class default
nlo = .false.
end select
end function process_is_nlo_calculation
@ %def process_is_nlo_calculation
@
<<Process: process: TBP>>=
procedure :: is_combined_nlo_integration &
=> process_is_combined_nlo_integration
<<Process: procedures>>=
function process_is_combined_nlo_integration (process) result (combined)
logical :: combined
class(process_t), intent(in) :: process
select type (pcm => process%pcm)
type is (pcm_nlo_t)
combined = pcm%settings%combined_integration
class default
combined = .false.
end select
end function process_is_combined_nlo_integration
@ %def process_is_combined_nlo_integration
@
<<Process: process: TBP>>=
procedure :: component_is_real_finite => process_component_is_real_finite
<<Process: procedures>>=
pure function process_component_is_real_finite (process, i_component) &
result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
val = process%component(i_component)%component_type == COMP_REAL_FIN
end function process_component_is_real_finite
@ %def process_component_is_real_finite
@ Return nlo data of a process component
<<Process: process: TBP>>=
procedure :: get_component_nlo_type => process_get_component_nlo_type
<<Process: procedures>>=
elemental function process_get_component_nlo_type (process, i_component) &
result (nlo_type)
integer :: nlo_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
nlo_type = process%component(i_component)%config%get_nlo_type ()
end function process_get_component_nlo_type
@ %def process_get_component_nlo_type
@ Return a pointer to the core that belongs to a component.
<<Process: process: TBP>>=
procedure :: get_component_core_ptr => process_get_component_core_ptr
<<Process: procedures>>=
function process_get_component_core_ptr (process, i_component) result (core)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_component
class(prc_core_t), pointer :: core
integer :: i_core
i_core = process%pcm%get_i_core(i_component)
core => process%core_entry(i_core)%core
end function process_get_component_core_ptr
@ %def process_get_component_core_ptr
@
<<Process: process: TBP>>=
procedure :: get_component_associated_born &
=> process_get_component_associated_born
<<Process: procedures>>=
function process_get_component_associated_born (process, i_component) &
result (i_born)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
integer :: i_born
i_born = process%component(i_component)%config%get_associated_born ()
end function process_get_component_associated_born
@ %def process_get_component_associated_born
@
<<Process: process: TBP>>=
procedure :: get_first_real_component => process_get_first_real_component
<<Process: procedures>>=
function process_get_first_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
i_real = process%component(1)%config%get_associated_real ()
end function process_get_first_real_component
@ %def process_get_first_real_component
@
<<Process: process: TBP>>=
procedure :: get_first_real_term => process_get_first_real_term
<<Process: procedures>>=
function process_get_first_real_term (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer :: i_component, i_term
i_component = process%component(1)%config%get_associated_real ()
i_real = 0
do i_term = 1, size (process%term)
if (process%term(i_term)%i_component == i_component) then
i_real = i_term
exit
end if
end do
if (i_real == 0) call msg_fatal ("Did not find associated real term!")
end function process_get_first_real_term
@ %def process_get_first_real_term
@
<<Process: process: TBP>>=
procedure :: get_associated_real_fin => process_get_associated_real_fin
<<Process: procedures>>=
elemental function process_get_associated_real_fin (process, i_component) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
i_real = process%component(i_component)%config%get_associated_real_fin ()
end function process_get_associated_real_fin
@ %def process_get_associated_real_fin
@
<<Process: process: TBP>>=
procedure :: select_i_term => process_select_i_term
<<Process: procedures>>=
pure function process_select_i_term (process, i_mci) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer :: i_component, i_sub
i_component = process%mci_entry(i_mci)%i_component(1)
i_term = process%component(i_component)%i_term(1)
i_sub = process%term(i_term)%i_sub
if (i_sub > 0) &
i_term = process%term(i_sub)%i_term_global
end function process_select_i_term
@ %def process_select_i_term
@ Would be better to do this at the level of the writer of the core but
one has to bring NLO information there.
<<Process: process: TBP>>=
procedure :: prepare_any_external_code &
=> process_prepare_any_external_code
<<Process: procedures>>=
subroutine process_prepare_any_external_code (process)
class(process_t), intent(inout), target :: process
integer :: i
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_prepare_external_code")
associate (pcm => process%pcm)
do i = 1, pcm%n_cores
call pcm%prepare_any_external_code ( &
process%core_entry(i), i, &
process%get_library_name (), &
process%config%model, &
process%env%get_var_list_ptr ())
end do
end associate
end subroutine process_prepare_any_external_code
@ %def process_prepare_any_external_code
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process config}
<<[[process_config.f90]]>>=
<<File header>>
module process_config
<<Use kinds>>
<<Use strings>>
use format_utils, only: write_separator
use io_units
use md5
use os_interface
use diagnostics
use sf_base
use sf_mappings
use mappings, only: mapping_defaults_t
use phs_forests, only: phs_parameters_t
use sm_qcd
use physics_defs
use integration_results
use model_data
use models
use interactions
use quantum_numbers
use flavors
use helicities
use colors
use rng_base
use state_matrices
use process_libraries
use process_constants
use prc_core
use prc_external
use prc_openloops, only: prc_openloops_t
use prc_threshold, only: prc_threshold_t
use beams
use dispatch_beams, only: dispatch_qcd
use mci_base
use beam_structures
use phs_base
use variables
use expr_base
use blha_olp_interfaces, only: prc_blha_t
<<Standard module head>>
<<Process config: public>>
<<Process config: parameters>>
<<Process config: types>>
contains
<<Process config: procedures>>
end module process_config
@ %def process_config
@ Identifiers for the NLO setup.
<<Process config: parameters>>=
integer, parameter, public :: COMP_DEFAULT = 0
integer, parameter, public :: COMP_REAL_FIN = 1
integer, parameter, public :: COMP_MASTER = 2
integer, parameter, public :: COMP_VIRT = 3
integer, parameter, public :: COMP_REAL = 4
integer, parameter, public :: COMP_REAL_SING = 5
integer, parameter, public :: COMP_MISMATCH = 6
integer, parameter, public :: COMP_PDF = 7
integer, parameter, public :: COMP_SUB = 8
integer, parameter, public :: COMP_RESUM = 9
@
\subsection{Output selection flags}
We declare a number of identifiers for write methods, so they only
displays selected parts. The identifiers can be supplied to the [[vlist]]
array argument of the standard F2008 derived-type writer call.
<<Process config: parameters>>=
integer, parameter, public :: F_PACIFY = 1
integer, parameter, public :: F_SHOW_VAR_LIST = 11
integer, parameter, public :: F_SHOW_EXPRESSIONS = 12
integer, parameter, public :: F_SHOW_LIB = 13
integer, parameter, public :: F_SHOW_MODEL = 14
integer, parameter, public :: F_SHOW_QCD = 15
integer, parameter, public :: F_SHOW_OS_DATA = 16
integer, parameter, public :: F_SHOW_RNG = 17
integer, parameter, public :: F_SHOW_BEAMS = 18
@ %def SHOW_VAR_LIST
@ %def SHOW_EXPRESSIONS
@
This is a simple function that returns true if a flag value is present in
[[v_list]], but not its negative. If neither is present, it returns
[[default]].
<<Process config: public>>=
public :: flagged
<<Process config: procedures>>=
function flagged (v_list, id, def) result (flag)
logical :: flag
integer, dimension(:), intent(in) :: v_list
integer, intent(in) :: id
logical, intent(in), optional :: def
logical :: default_result
default_result = .false.; if (present (def)) default_result = def
if (default_result) then
flag = all (v_list /= -id)
else
flag = all (v_list /= -id) .and. any (v_list == id)
end if
end function flagged
@ %def flagged
@
Related: if flag is set (unset), append [[value]] (its negative) to the
[[v_list]], respectively. [[v_list]] must be allocated.
<<Process config: public>>=
public :: set_flag
<<Process config: procedures>>=
subroutine set_flag (v_list, value, flag)
integer, dimension(:), intent(inout), allocatable :: v_list
integer, intent(in) :: value
logical, intent(in), optional :: flag
if (present (flag)) then
if (flag) then
v_list = [v_list, value]
else
v_list = [v_list, -value]
end if
end if
end subroutine set_flag
@ %def set_flag
@
\subsection{Generic configuration data}
This information concerns physical and technical properties of the
process. It is fixed upon initialization, using data from the
process specification and the variable list.
The number [[n_in]] is the number of incoming beam particles,
simultaneously the number of incoming partons, 1 for a decay and 2 for
a scattering process. (The number of outgoing partons may depend on
the process component.)
The number [[n_components]] is the number of components that constitute
the current process.
The number [[n_terms]] is the number of distinct contributions to the
scattering matrix that constitute the current process. Each component
may generate several terms.
The number [[n_mci]] is the number of independent MC
integration configurations that this process uses. Distinct process
components that share a MCI configuration may be combined pointwise.
(Nevertheless, a given MC variable set may correspond to several
``nearby'' kinematical configurations.) This is also the number of
distinct sampling-function results that this process can generate.
Process components that use distinct variable sets are added only once
after an integration pass has completed.
The [[model]] pointer identifies the physics model and its
parameters. This is a pointer to an external object.
Various [[parse_node_t]] objects are taken from the SINDARIN input.
They encode expressions for evaluating cuts and scales. The
workspaces for evaluating those expressions are set up in the
[[effective_state]] subobjects. Note that these are really pointers,
so the actual nodes are not stored inside the process object.
The [[md5sum]] is taken and used to verify the process configuration
when re-reading data from file.
<<Process config: public>>=
public :: process_config_data_t
<<Process config: types>>=
type :: process_config_data_t
class(process_def_t), pointer :: process_def => null ()
integer :: n_in = 0
integer :: n_components = 0
integer :: n_terms = 0
integer :: n_mci = 0
type(string_t) :: model_name
class(model_data_t), pointer :: model => null ()
type(qcd_t) :: qcd
class(expr_factory_t), allocatable :: ef_cuts
class(expr_factory_t), allocatable :: ef_scale
class(expr_factory_t), allocatable :: ef_fac_scale
class(expr_factory_t), allocatable :: ef_ren_scale
class(expr_factory_t), allocatable :: ef_weight
character(32) :: md5sum = ""
contains
<<Process config: process config data: TBP>>
end type process_config_data_t
@ %def process_config_data_t
@ Here, we may compress the expressions for cuts etc.
<<Process config: process config data: TBP>>=
procedure :: write => process_config_data_write
<<Process config: procedures>>=
subroutine process_config_data_write (config, u, counters, model, expressions)
class(process_config_data_t), intent(in) :: config
integer, intent(in) :: u
logical, intent(in) :: counters
logical, intent(in) :: model
logical, intent(in) :: expressions
write (u, "(1x,A)") "Configuration data:"
if (counters) then
write (u, "(3x,A,I0)") "Number of incoming particles = ", &
config%n_in
write (u, "(3x,A,I0)") "Number of process components = ", &
config%n_components
write (u, "(3x,A,I0)") "Number of process terms = ", &
config%n_terms
write (u, "(3x,A,I0)") "Number of MCI configurations = ", &
config%n_mci
end if
if (associated (config%model)) then
write (u, "(3x,A,A)") "Model = ", char (config%model_name)
if (model) then
call write_separator (u)
call config%model%write (u)
call write_separator (u)
end if
else
write (u, "(3x,A,A,A)") "Model = ", char (config%model_name), &
" [not associated]"
end if
call config%qcd%write (u, show_md5sum = .false.)
call write_separator (u)
if (expressions) then
if (allocated (config%ef_cuts)) then
call write_separator (u)
write (u, "(3x,A)") "Cut expression:"
call config%ef_cuts%write (u)
end if
if (allocated (config%ef_scale)) then
call write_separator (u)
write (u, "(3x,A)") "Scale expression:"
call config%ef_scale%write (u)
end if
if (allocated (config%ef_fac_scale)) then
call write_separator (u)
write (u, "(3x,A)") "Factorization scale expression:"
call config%ef_fac_scale%write (u)
end if
if (allocated (config%ef_ren_scale)) then
call write_separator (u)
write (u, "(3x,A)") "Renormalization scale expression:"
call config%ef_ren_scale%write (u)
end if
if (allocated (config%ef_weight)) then
call write_separator (u)
write (u, "(3x,A)") "Weight expression:"
call config%ef_weight%write (u)
end if
else
call write_separator (u)
write (u, "(3x,A)") "Expressions (cut, scales, weight): [not shown]"
end if
if (config%md5sum /= "") then
call write_separator (u)
write (u, "(3x,A,A,A)") "MD5 sum (config) = '", config%md5sum, "'"
end if
end subroutine process_config_data_write
@ %def process_config_data_write
@ Initialize. We use information from the process metadata and from
the process library, given the process ID. We also store the
currently active OS data set.
The model pointer references the model data within the [[env]] record. That
should be an instance of the global model.
We initialize the QCD object, unless the environment information is unavailable
(unit tests).
The RNG factory object is imported by moving the allocation.
<<Process config: process config data: TBP>>=
procedure :: init => process_config_data_init
<<Process config: procedures>>=
subroutine process_config_data_init (config, meta, env)
class(process_config_data_t), intent(out) :: config
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
config%process_def => env%lib%get_process_def_ptr (meta%id)
config%n_in = config%process_def%get_n_in ()
config%n_components = size (meta%component_id)
config%model => env%get_model_ptr ()
config%model_name = config%model%get_name ()
if (env%got_var_list ()) then
call dispatch_qcd &
(config%qcd, env%get_var_list_ptr (), env%get_os_data ())
end if
end subroutine process_config_data_init
@ %def process_config_data_init
@ Current implementation: nothing to finalize.
<<Process config: process config data: TBP>>=
procedure :: final => process_config_data_final
<<Process config: procedures>>=
subroutine process_config_data_final (config)
class(process_config_data_t), intent(inout) :: config
end subroutine process_config_data_final
@ %def process_config_data_final
@ Return a copy of the QCD data block.
<<Process config: process config data: TBP>>=
procedure :: get_qcd => process_config_data_get_qcd
<<Process config: procedures>>=
function process_config_data_get_qcd (config) result (qcd)
class(process_config_data_t), intent(in) :: config
type(qcd_t) :: qcd
qcd = config%qcd
end function process_config_data_get_qcd
@ %def process_config_data_get_qcd
@ Compute the MD5 sum of the configuration data. This encodes, in
particular, the model and the expressions for cut, scales, weight,
etc. It should not contain the IDs and number of components, etc.,
since the MD5 sum should be useful for integrating individual
components.
This is done only once. If the MD5 sum is nonempty, the calculation
is skipped.
<<Process config: process config data: TBP>>=
procedure :: compute_md5sum => process_config_data_compute_md5sum
<<Process config: procedures>>=
subroutine process_config_data_compute_md5sum (config)
class(process_config_data_t), intent(inout) :: config
integer :: u
if (config%md5sum == "") then
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call config%write (u, counters = .false., &
model = .true., expressions = .true.)
rewind (u)
config%md5sum = md5sum (u)
close (u)
end if
end subroutine process_config_data_compute_md5sum
@ %def process_config_data_compute_md5sum
@
<<Process config: process config data: TBP>>=
procedure :: get_md5sum => process_config_data_get_md5sum
<<Process config: procedures>>=
pure function process_config_data_get_md5sum (config) result (md5)
character(32) :: md5
class(process_config_data_t), intent(in) :: config
md5 = config%md5sum
end function process_config_data_get_md5sum
@ %def process_config_data_get_md5sum
@
\subsection{Environment}
This record stores a snapshot of the process environment at the point where
the process object is created.
Model and variable list are implemented as pointer, so they always have the
[[target]] attribute.
For unit-testing purposes, setting the var list is optional. If not set, the
pointer is null.
<<Process config: public>>=
public :: process_environment_t
<<Process config: types>>=
type :: process_environment_t
private
type(model_t), pointer :: model => null ()
type(var_list_t), pointer :: var_list => null ()
logical :: var_list_is_set = .false.
type(process_library_t), pointer :: lib => null ()
type(beam_structure_t) :: beam_structure
type(os_data_t) :: os_data
contains
<<Process config: process environment: TBP>>
end type process_environment_t
@ %def process_environment_t
@ Model and local var list are snapshots and need a finalizer.
<<Process config: process environment: TBP>>=
procedure :: final => process_environment_final
<<Process config: procedures>>=
subroutine process_environment_final (env)
class(process_environment_t), intent(inout) :: env
if (associated (env%model)) then
call env%model%final ()
deallocate (env%model)
end if
if (associated (env%var_list)) then
call env%var_list%final (follow_link=.true.)
deallocate (env%var_list)
end if
end subroutine process_environment_final
@ %def process_environment_final
@ Output, DTIO compatible.
<<Process config: process environment: TBP>>=
procedure :: write => process_environment_write
procedure :: write_formatted => process_environment_write_formatted
! generic :: write (formatted) => write_formatted
<<Process config: procedures>>=
subroutine process_environment_write (env, unit, &
show_var_list, show_model, show_lib, show_beams, show_os_data)
class(process_environment_t), intent(in) :: env
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_var_list
logical, intent(in), optional :: show_model
logical, intent(in), optional :: show_lib
logical, intent(in), optional :: show_beams
logical, intent(in), optional :: show_os_data
integer :: u, iostat
integer, dimension(:), allocatable :: v_list
character(0) :: iomsg
u = given_output_unit (unit)
allocate (v_list (0))
call set_flag (v_list, F_SHOW_VAR_LIST, show_var_list)
call set_flag (v_list, F_SHOW_MODEL, show_model)
call set_flag (v_list, F_SHOW_LIB, show_lib)
call set_flag (v_list, F_SHOW_BEAMS, show_beams)
call set_flag (v_list, F_SHOW_OS_DATA, show_os_data)
call env%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
end subroutine process_environment_write
@ %def process_environment_write
@ DTIO standard write.
<<Process config: procedures>>=
subroutine process_environment_write_formatted &
(dtv, unit, iotype, v_list, iostat, iomsg)
class(process_environment_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
associate (env => dtv)
if (flagged (v_list, F_SHOW_VAR_LIST, .true.)) then
write (unit, "(1x,A)") "Variable list:"
if (associated (env%var_list)) then
call write_separator (unit)
call env%var_list%write (unit)
else
write (unit, "(3x,A)") "[not allocated]"
end if
call write_separator (unit)
end if
if (flagged (v_list, F_SHOW_MODEL, .true.)) then
write (unit, "(1x,A)") "Model:"
if (associated (env%model)) then
call write_separator (unit)
call env%model%write (unit)
else
write (unit, "(3x,A)") "[not allocated]"
end if
call write_separator (unit)
end if
if (flagged (v_list, F_SHOW_LIB, .true.)) then
write (unit, "(1x,A)") "Process library:"
if (associated (env%lib)) then
call write_separator (unit)
call env%lib%write (unit)
else
write (unit, "(3x,A)") "[not allocated]"
end if
end if
if (flagged (v_list, F_SHOW_BEAMS, .true.)) then
call write_separator (unit)
call env%beam_structure%write (unit)
end if
if (flagged (v_list, F_SHOW_OS_DATA, .true.)) then
write (unit, "(1x,A)") "Operating-system data:"
call write_separator (unit)
call env%os_data%write (unit)
end if
end associate
iostat = 0
end subroutine process_environment_write_formatted
@ %def process_environment_write_formatted
@ Initialize: Make a snapshot of the provided model. Make a link to the
current process library.
Also make a snapshot of the variable list, if provided. If none is
provided, there is an empty variable list nevertheless, so a pointer
lookup does not return null.
If no beam structure is provided, the beam-structure member is empty and will
yield a number of zero beams when queried.
<<Process config: process environment: TBP>>=
procedure :: init => process_environment_init
<<Process config: procedures>>=
subroutine process_environment_init &
(env, model, lib, os_data, var_list, beam_structure)
class(process_environment_t), intent(out) :: env
type(model_t), intent(in), target :: model
type(process_library_t), intent(in), target :: lib
type(os_data_t), intent(in) :: os_data
type(var_list_t), intent(in), target, optional :: var_list
type(beam_structure_t), intent(in), optional :: beam_structure
allocate (env%model)
call env%model%init_instance (model)
env%lib => lib
env%os_data = os_data
allocate (env%var_list)
if (present (var_list)) then
call env%var_list%init_snapshot (var_list, follow_link=.true.)
env%var_list_is_set = .true.
end if
if (present (beam_structure)) then
env%beam_structure = beam_structure
end if
end subroutine process_environment_init
@ %def process_environment_init
@ Indicate whether a variable list has been provided upon initialization.
<<Process config: process environment: TBP>>=
procedure :: got_var_list => process_environment_got_var_list
<<Process config: procedures>>=
function process_environment_got_var_list (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
flag = env%var_list_is_set
end function process_environment_got_var_list
@ %def process_environment_got_var_list
@ Return a pointer to the variable list.
<<Process config: process environment: TBP>>=
procedure :: get_var_list_ptr => process_environment_get_var_list_ptr
<<Process config: procedures>>=
function process_environment_get_var_list_ptr (env) result (var_list)
class(process_environment_t), intent(in) :: env
type(var_list_t), pointer :: var_list
var_list => env%var_list
end function process_environment_get_var_list_ptr
@ %def process_environment_get_var_list_ptr
@ Return a pointer to the model, if it exists.
<<Process config: process environment: TBP>>=
procedure :: get_model_ptr => process_environment_get_model_ptr
<<Process config: procedures>>=
function process_environment_get_model_ptr (env) result (model)
class(process_environment_t), intent(in) :: env
type(model_t), pointer :: model
model => env%model
end function process_environment_get_model_ptr
@ %def process_environment_get_model_ptr
@ Return the process library pointer.
<<Process config: process environment: TBP>>=
procedure :: get_lib_ptr => process_environment_get_lib_ptr
<<Process config: procedures>>=
function process_environment_get_lib_ptr (env) result (lib)
class(process_environment_t), intent(inout) :: env
type(process_library_t), pointer :: lib
lib => env%lib
end function process_environment_get_lib_ptr
@ %def process_environment_get_lib_ptr
@ Clear the process library pointer, in case the library is deleted.
<<Process config: process environment: TBP>>=
procedure :: reset_lib_ptr => process_environment_reset_lib_ptr
<<Process config: procedures>>=
subroutine process_environment_reset_lib_ptr (env)
class(process_environment_t), intent(inout) :: env
env%lib => null ()
end subroutine process_environment_reset_lib_ptr
@ %def process_environment_reset_lib_ptr
@ Check whether the process library has changed, in case the library is
recompiled, etc.
<<Process config: process environment: TBP>>=
procedure :: check_lib_sanity => process_environment_check_lib_sanity
<<Process config: procedures>>=
subroutine process_environment_check_lib_sanity (env, meta)
class(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
if (associated (env%lib)) then
if (env%lib%get_update_counter () /= meta%lib_update_counter) then
call msg_fatal ("Process '" // char (meta%id) &
// "': library has been recompiled after integration")
end if
end if
end subroutine process_environment_check_lib_sanity
@ %def process_environment_check_lib_sanity
@ Fill the [[data]] block using the appropriate process-library access entry.
<<Process config: process environment: TBP>>=
procedure :: fill_process_constants => &
process_environment_fill_process_constants
<<Process config: procedures>>=
subroutine process_environment_fill_process_constants &
(env, id, i_component, data)
class(process_environment_t), intent(in) :: env
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
type(process_constants_t), intent(out) :: data
call env%lib%fill_constants (id, i_component, data)
end subroutine process_environment_fill_process_constants
@ %def process_environment_fill_process_constants
@ Return the entire beam structure.
<<Process config: process environment: TBP>>=
procedure :: get_beam_structure => process_environment_get_beam_structure
<<Process config: procedures>>=
function process_environment_get_beam_structure (env) result (beam_structure)
class(process_environment_t), intent(in) :: env
type(beam_structure_t) :: beam_structure
beam_structure = env%beam_structure
end function process_environment_get_beam_structure
@ %def process_environment_get_beam_structure
@ Check the beam structure for PDFs.
<<Process config: process environment: TBP>>=
procedure :: has_pdfs => process_environment_has_pdfs
<<Process config: procedures>>=
function process_environment_has_pdfs (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
flag = env%beam_structure%has_pdf ()
end function process_environment_has_pdfs
@ %def process_environment_has_pdfs
@ Check the beam structure for polarized beams.
<<Process config: process environment: TBP>>=
procedure :: has_polarized_beams => process_environment_has_polarized_beams
<<Process config: procedures>>=
function process_environment_has_polarized_beams (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
flag = env%beam_structure%has_polarized_beams ()
end function process_environment_has_polarized_beams
@ %def process_environment_has_polarized_beams
@ Return a copy of the OS data block.
<<Process config: process environment: TBP>>=
procedure :: get_os_data => process_environment_get_os_data
<<Process config: procedures>>=
function process_environment_get_os_data (env) result (os_data)
class(process_environment_t), intent(in) :: env
type(os_data_t) :: os_data
os_data = env%os_data
end function process_environment_get_os_data
@ %def process_environment_get_os_data
@
\subsection{Metadata}
This information describes the process. It is fixed upon initialization.
The [[id]] string is the name of the process object, as given by the
user. The matrix element generator will use this string for naming
Fortran procedures and types, so it should qualify as a Fortran name.
The [[num_id]] is meaningful if nonzero. It is used for communication
with external programs or file standards which do not support string IDs.
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.
The [[lib_name]] identifies the process library where the process
definition and the process driver are located.
The [[lib_index]] is the index of entry in the process library that
corresponds to the current process.
The [[component_id]] array identifies the individual process components.
The [[component_description]] is an array of human-readable strings
that characterize the process components, for instance [[a, b => c, d]].
The [[active]] mask array marks those components which are active. The others
are skipped.
<<Process config: public>>=
public :: process_metadata_t
<<Process config: types>>=
type :: process_metadata_t
integer :: type = PRC_UNKNOWN
type(string_t) :: id
integer :: num_id = 0
type(string_t) :: run_id
type(string_t), allocatable :: lib_name
integer :: lib_update_counter = 0
integer :: lib_index = 0
integer :: n_components = 0
type(string_t), dimension(:), allocatable :: component_id
type(string_t), dimension(:), allocatable :: component_description
logical, dimension(:), allocatable :: active
contains
<<Process config: process metadata: TBP>>
end type process_metadata_t
@ %def process_metadata_t
@ Output: ID and run ID.
We write the variable list only upon request.
<<Process config: process metadata: TBP>>=
procedure :: write => process_metadata_write
<<Process config: procedures>>=
subroutine process_metadata_write (meta, u, screen)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
logical, intent(in) :: screen
integer :: i
select case (meta%type)
case (PRC_UNKNOWN)
if (screen) then
write (msg_buffer, "(A)") "Process [undefined]"
else
write (u, "(1x,A)") "Process [undefined]"
end if
return
case (PRC_DECAY)
if (screen) then
write (msg_buffer, "(A,1x,A,A,A)") "Process [decay]:", &
"'", char (meta%id), "'"
else
write (u, "(1x,A)", advance="no") "Process [decay]:"
end if
case (PRC_SCATTERING)
if (screen) then
write (msg_buffer, "(A,1x,A,A,A)") "Process [scattering]:", &
"'", char (meta%id), "'"
else
write (u, "(1x,A)", advance="no") "Process [scattering]:"
end if
case default
call msg_bug ("process_write: undefined process type")
end select
if (screen) then
call msg_message ()
else
write (u, "(1x,A,A,A)") "'", char (meta%id), "'"
end if
if (meta%num_id /= 0) then
if (screen) then
write (msg_buffer, "(2x,A,I0)") "ID (num) = ", meta%num_id
call msg_message ()
else
write (u, "(3x,A,I0)") "ID (num) = ", meta%num_id
end if
end if
if (screen) then
if (meta%run_id /= "") then
write (msg_buffer, "(2x,A,A,A)") "Run ID = '", &
char (meta%run_id), "'"
call msg_message ()
end if
else
write (u, "(3x,A,A,A)") "Run ID = '", char (meta%run_id), "'"
end if
if (allocated (meta%lib_name)) then
if (screen) then
write (msg_buffer, "(2x,A,A,A)") "Library name = '", &
char (meta%lib_name), "'"
call msg_message ()
else
write (u, "(3x,A,A,A)") "Library name = '", &
char (meta%lib_name), "'"
end if
else
if (screen) then
write (msg_buffer, "(2x,A)") "Library name = [not associated]"
call msg_message ()
else
write (u, "(3x,A)") "Library name = [not associated]"
end if
end if
if (screen) then
write (msg_buffer, "(2x,A,I0)") "Process index = ", meta%lib_index
call msg_message ()
else
write (u, "(3x,A,I0)") "Process index = ", meta%lib_index
end if
if (allocated (meta%component_id)) then
if (screen) then
if (any (meta%active)) then
write (msg_buffer, "(2x,A)") "Process components:"
else
write (msg_buffer, "(2x,A)") "Process components: [none]"
end if
call msg_message ()
else
write (u, "(3x,A)") "Process components:"
end if
do i = 1, size (meta%component_id)
if (.not. meta%active(i)) cycle
if (screen) then
write (msg_buffer, "(4x,I0,9A)") i, ": '", &
char (meta%component_id (i)), "': ", &
char (meta%component_description (i))
call msg_message ()
else
write (u, "(5x,I0,9A)") i, ": '", &
char (meta%component_id (i)), "': ", &
char (meta%component_description (i))
end if
end do
end if
if (screen) then
write (msg_buffer, "(A)") repeat ("-", 72)
call msg_message ()
else
call write_separator (u)
end if
end subroutine process_metadata_write
@ %def process_metadata_write
@ Short output: list components.
<<Process config: process metadata: TBP>>=
procedure :: show => process_metadata_show
<<Process config: procedures>>=
subroutine process_metadata_show (meta, u, model_name)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
type(string_t), intent(in) :: model_name
integer :: i
select case (meta%type)
case (PRC_UNKNOWN)
write (u, "(A)") "Process: [undefined]"
return
case default
write (u, "(A)", advance="no") "Process:"
end select
write (u, "(1x,A)", advance="no") char (meta%id)
select case (meta%num_id)
case (0)
case default
write (u, "(1x,'(',I0,')')", advance="no") meta%num_id
end select
select case (char (model_name))
case ("")
case default
write (u, "(1x,'[',A,']')", advance="no") char (model_name)
end select
write (u, *)
if (allocated (meta%component_id)) then
do i = 1, size (meta%component_id)
if (meta%active(i)) then
write (u, "(2x,I0,':',1x,A)") i, &
char (meta%component_description (i))
end if
end do
end if
end subroutine process_metadata_show
@ %def process_metadata_show
@ Initialize. Find process ID and run ID.
Also find the process ID in the process library and retrieve some metadata from
there.
<<Process config: process metadata: TBP>>=
procedure :: init => process_metadata_init
<<Process config: procedures>>=
subroutine process_metadata_init (meta, id, lib, var_list)
class(process_metadata_t), intent(out) :: meta
type(string_t), intent(in) :: id
type(process_library_t), intent(in), target :: lib
type(var_list_t), intent(in) :: var_list
select case (lib%get_n_in (id))
case (1); meta%type = PRC_DECAY
case (2); meta%type = PRC_SCATTERING
case default
call msg_bug ("Process '" // char (id) // "': impossible n_in")
end select
meta%id = id
meta%run_id = var_list%get_sval (var_str ("$run_id"))
allocate (meta%lib_name)
meta%lib_name = lib%get_name ()
meta%lib_update_counter = lib%get_update_counter ()
if (lib%contains (id)) then
meta%lib_index = lib%get_entry_index (id)
meta%num_id = lib%get_num_id (id)
call lib%get_component_list (id, meta%component_id)
meta%n_components = size (meta%component_id)
call lib%get_component_description_list &
(id, meta%component_description)
allocate (meta%active (meta%n_components), source = .true.)
else
call msg_fatal ("Process library doesn't contain process '" &
// char (id) // "'")
end if
if (.not. lib%is_active ()) then
call msg_bug ("Process init: inactive library not handled yet")
end if
end subroutine process_metadata_init
@ %def process_metadata_init
@ Mark a component as inactive.
<<Process config: process metadata: TBP>>=
procedure :: deactivate_component => process_metadata_deactivate_component
<<Process config: procedures>>=
subroutine process_metadata_deactivate_component (meta, i)
class(process_metadata_t), intent(inout) :: meta
integer, intent(in) :: i
call msg_message ("Process component '" &
// char (meta%component_id(i)) // "': matrix element vanishes")
meta%active(i) = .false.
end subroutine process_metadata_deactivate_component
@ %def process_metadata_deactivate_component
@
\subsection{Phase-space configuration}
A process can have a number of independent phase-space configuration entries,
depending on the process definition and evaluation algorithm. Each entry
holds various configuration-parameter data and the actual [[phs_config_t]]
record, which can vary in concrete type.
<<Process config: public>>=
public :: process_phs_config_t
<<Process config: types>>=
type :: process_phs_config_t
type(phs_parameters_t) :: phs_par
type(mapping_defaults_t) :: mapping_defs
class(phs_config_t), allocatable :: phs_config
contains
<<Process config: process phs config: TBP>>
end type process_phs_config_t
@ %def process_phs_config_t
@ Output, DTIO compatible.
<<Process config: process phs config: TBP>>=
procedure :: write => process_phs_config_write
procedure :: write_formatted => process_phs_config_write_formatted
! generic :: write (formatted) => write_formatted
<<Process config: procedures>>=
subroutine process_phs_config_write (phs_config, unit)
class(process_phs_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
integer :: u, iostat
integer, dimension(:), allocatable :: v_list
character(0) :: iomsg
u = given_output_unit (unit)
allocate (v_list (0))
call phs_config%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
end subroutine process_phs_config_write
@ %def process_phs_config_write
@ DTIO standard write.
<<Process config: procedures>>=
subroutine process_phs_config_write_formatted &
(dtv, unit, iotype, v_list, iostat, iomsg)
class(process_phs_config_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
associate (phs_config => dtv)
write (unit, "(1x, A)") "Phase-space configuration entry:"
call phs_config%phs_par%write (unit)
call phs_config%mapping_defs%write (unit)
end associate
iostat = 0
end subroutine process_phs_config_write_formatted
@ %def process_phs_config_write_formatted
@
\subsection{Beam configuration}
The object [[data]] holds all details about the initial beam
configuration. The allocatable array [[sf]] holds the structure-function
configuration blocks. There are [[n_strfun]] entries in the
structure-function chain (not counting the initial beam object). We
maintain [[n_channel]] independent parameterizations of this chain.
If this is greater than zero, we need a multi-channel sampling
algorithm, where for each point one channel is selected to generate
kinematics.
The number of parameters that are required for generating a
structure-function chain is [[n_sfpar]].
The flag [[azimuthal_dependence]] tells whether the process setup is
symmetric about the beam axis in the c.m.\ system. This implies that
there is no transversal beam polarization. The flag [[lab_is_cm]] is
obvious.
<<Process config: public>>=
public :: process_beam_config_t
<<Process config: types>>=
type :: process_beam_config_t
type(beam_data_t) :: data
integer :: n_strfun = 0
integer :: n_channel = 1
integer :: n_sfpar = 0
type(sf_config_t), dimension(:), allocatable :: sf
type(sf_channel_t), dimension(:), allocatable :: sf_channel
logical :: azimuthal_dependence = .false.
logical :: lab_is_cm = .true.
character(32) :: md5sum = ""
logical :: sf_trace = .false.
type(string_t) :: sf_trace_file
contains
<<Process config: process beam config: TBP>>
end type process_beam_config_t
@ %def process_beam_config_t
@ Here we write beam data only if they are actually used.
The [[verbose]] flag is passed to the beam-data writer.
<<Process config: process beam config: TBP>>=
procedure :: write => process_beam_config_write
<<Process config: procedures>>=
subroutine process_beam_config_write (object, unit, verbose)
class(process_beam_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i, c
u = given_output_unit (unit)
call object%data%write (u, verbose = verbose)
if (object%data%initialized) then
write (u, "(3x,A,L1)") "Azimuthal dependence = ", &
object%azimuthal_dependence
write (u, "(3x,A,L1)") "Lab frame is c.m. frame = ", &
object%lab_is_cm
if (object%md5sum /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (beams/strf) = '", &
object%md5sum, "'"
end if
if (allocated (object%sf)) then
do i = 1, size (object%sf)
call object%sf(i)%write (u)
end do
if (any_sf_channel_has_mapping (object%sf_channel)) then
write (u, "(1x,A,L1)") "Structure-function mappings per channel:"
do c = 1, object%n_channel
write (u, "(3x,I0,':')", advance="no") c
call object%sf_channel(c)%write (u)
end do
end if
end if
end if
end subroutine process_beam_config_write
@ %def process_beam_config_write
@ The beam data have a finalizer. We assume that there is none for the
structure-function data.
<<Process config: process beam config: TBP>>=
procedure :: final => process_beam_config_final
<<Process config: procedures>>=
subroutine process_beam_config_final (object)
class(process_beam_config_t), intent(inout) :: object
call object%data%final ()
end subroutine process_beam_config_final
@ %def process_beam_config_final
@ Initialize the beam setup with a given beam structure object.
<<Process config: process beam config: TBP>>=
procedure :: init_beam_structure => process_beam_config_init_beam_structure
<<Process config: procedures>>=
subroutine process_beam_config_init_beam_structure &
(beam_config, beam_structure, sqrts, model, decay_rest_frame)
class(process_beam_config_t), intent(out) :: beam_config
type(beam_structure_t), intent(in) :: beam_structure
logical, intent(in), optional :: decay_rest_frame
real(default), intent(in) :: sqrts
class(model_data_t), intent(in), target :: model
call beam_config%data%init_structure (beam_structure, &
sqrts, model, decay_rest_frame)
beam_config%lab_is_cm = beam_config%data%lab_is_cm
end subroutine process_beam_config_init_beam_structure
@ %def process_beam_config_init_beam_structure
@ Initialize the beam setup for a scattering process with specified
flavor combination, other properties taken from the beam structure
object (if any).
<<Process config: process beam config: TBP>>=
procedure :: init_scattering => process_beam_config_init_scattering
<<Process config: procedures>>=
subroutine process_beam_config_init_scattering &
(beam_config, flv_in, sqrts, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(2), intent(in) :: flv_in
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
if (present (beam_structure)) then
if (beam_structure%polarized ()) then
call beam_config%data%init_sqrts (sqrts, flv_in, &
beam_structure%get_smatrix (), beam_structure%get_pol_f ())
else
call beam_config%data%init_sqrts (sqrts, flv_in)
end if
else
call beam_config%data%init_sqrts (sqrts, flv_in)
end if
end subroutine process_beam_config_init_scattering
@ %def process_beam_config_init_scattering
@ Initialize the beam setup for a decay process with specified flavor,
other properties taken from the beam structure object (if present).
For a cascade decay, we set
[[rest_frame]] to false, indicating a event-wise varying momentum.
The beam data itself are initialized for the particle at rest.
<<Process config: process beam config: TBP>>=
procedure :: init_decay => process_beam_config_init_decay
<<Process config: procedures>>=
subroutine process_beam_config_init_decay &
(beam_config, flv_in, rest_frame, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(1), intent(in) :: flv_in
logical, intent(in), optional :: rest_frame
type(beam_structure_t), intent(in), optional :: beam_structure
if (present (beam_structure)) then
if (beam_structure%polarized ()) then
call beam_config%data%init_decay (flv_in, &
beam_structure%get_smatrix (), beam_structure%get_pol_f (), &
rest_frame = rest_frame)
else
call beam_config%data%init_decay (flv_in, rest_frame = rest_frame)
end if
else
call beam_config%data%init_decay (flv_in, &
rest_frame = rest_frame)
end if
beam_config%lab_is_cm = beam_config%data%lab_is_cm
end subroutine process_beam_config_init_decay
@ %def process_beam_config_init_decay
@ Print an informative message.
<<Process config: process beam config: TBP>>=
procedure :: startup_message => process_beam_config_startup_message
<<Process config: procedures>>=
subroutine process_beam_config_startup_message &
(beam_config, unit, beam_structure)
class(process_beam_config_t), intent(in) :: beam_config
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
integer :: u
u = free_unit ()
open (u, status="scratch", action="readwrite")
if (present (beam_structure)) then
call beam_structure%write (u)
end if
call beam_config%data%write (u)
rewind (u)
do
read (u, "(1x,A)", end=1) msg_buffer
call msg_message ()
end do
1 continue
close (u)
end subroutine process_beam_config_startup_message
@ %def process_beam_config_startup_message
@ Allocate the structure-function array.
<<Process config: process beam config: TBP>>=
procedure :: init_sf_chain => process_beam_config_init_sf_chain
<<Process config: procedures>>=
subroutine process_beam_config_init_sf_chain &
(beam_config, sf_config, sf_trace_file)
class(process_beam_config_t), intent(inout) :: beam_config
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
integer :: i
beam_config%n_strfun = size (sf_config)
allocate (beam_config%sf (beam_config%n_strfun))
do i = 1, beam_config%n_strfun
associate (sf => sf_config(i))
call beam_config%sf(i)%init (sf%i, sf%data)
if (.not. sf%data%is_generator ()) then
beam_config%n_sfpar = beam_config%n_sfpar + sf%data%get_n_par ()
end if
end associate
end do
if (present (sf_trace_file)) then
beam_config%sf_trace = .true.
beam_config%sf_trace_file = sf_trace_file
end if
end subroutine process_beam_config_init_sf_chain
@ %def process_beam_config_init_sf_chain
@ Allocate the structure-function mapping channel array, given the
requested number of channels.
<<Process config: process beam config: TBP>>=
procedure :: allocate_sf_channels => process_beam_config_allocate_sf_channels
<<Process config: procedures>>=
subroutine process_beam_config_allocate_sf_channels (beam_config, n_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: n_channel
beam_config%n_channel = n_channel
call allocate_sf_channels (beam_config%sf_channel, &
n_channel = n_channel, &
n_strfun = beam_config%n_strfun)
end subroutine process_beam_config_allocate_sf_channels
@ %def process_beam_config_allocate_sf_channels
@ Set a structure-function mapping channel for an array of
structure-function entries, for a single channel. (The default is no mapping.)
<<Process config: process beam config: TBP>>=
procedure :: set_sf_channel => process_beam_config_set_sf_channel
<<Process config: procedures>>=
subroutine process_beam_config_set_sf_channel (beam_config, c, sf_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
beam_config%sf_channel(c) = sf_channel
end subroutine process_beam_config_set_sf_channel
@ %def process_beam_config_set_sf_channel
@ Print an informative startup message.
<<Process config: process beam config: TBP>>=
procedure :: sf_startup_message => process_beam_config_sf_startup_message
<<Process config: procedures>>=
subroutine process_beam_config_sf_startup_message &
(beam_config, sf_string, unit)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
if (beam_config%n_strfun > 0) then
call msg_message ("Beam structure: " // char (sf_string), unit = unit)
write (msg_buffer, "(A,3(1x,I0,1x,A))") &
"Beam structure:", &
beam_config%n_channel, "channels,", &
beam_config%n_sfpar, "dimensions"
call msg_message (unit = unit)
if (beam_config%sf_trace) then
call msg_message ("Beam structure: tracing &
&values in '" // char (beam_config%sf_trace_file) // "'")
end if
end if
end subroutine process_beam_config_sf_startup_message
@ %def process_beam_config_startup_message
@ Return the PDF set currently in use, if any. This should be unique,
so we scan the structure functions until we get a nonzero number.
(This implies that if the PDF set is not unique (e.g., proton and
photon structure used together), this does not work correctly.)
<<Process config: process beam config: TBP>>=
procedure :: get_pdf_set => process_beam_config_get_pdf_set
<<Process config: procedures>>=
function process_beam_config_get_pdf_set (beam_config) result (pdf_set)
class(process_beam_config_t), intent(in) :: beam_config
integer :: pdf_set
integer :: i
pdf_set = 0
if (allocated (beam_config%sf)) then
do i = 1, size (beam_config%sf)
pdf_set = beam_config%sf(i)%get_pdf_set ()
if (pdf_set /= 0) return
end do
end if
end function process_beam_config_get_pdf_set
@ %def process_beam_config_get_pdf_set
@ Return the beam file.
<<Process config: process beam config: TBP>>=
procedure :: get_beam_file => process_beam_config_get_beam_file
<<Process config: procedures>>=
function process_beam_config_get_beam_file (beam_config) result (file)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t) :: file
integer :: i
file = ""
if (allocated (beam_config%sf)) then
do i = 1, size (beam_config%sf)
file = beam_config%sf(i)%get_beam_file ()
if (file /= "") return
end do
end if
end function process_beam_config_get_beam_file
@ %def process_beam_config_get_beam_file
@ Compute the MD5 sum for the complete beam setup. We rely on the
default output of [[write]] to contain all relevant data.
This is done only once, when the MD5 sum is still empty.
<<Process config: process beam config: TBP>>=
procedure :: compute_md5sum => process_beam_config_compute_md5sum
<<Process config: procedures>>=
subroutine process_beam_config_compute_md5sum (beam_config)
class(process_beam_config_t), intent(inout) :: beam_config
integer :: u
if (beam_config%md5sum == "") then
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call beam_config%write (u, verbose=.true.)
rewind (u)
beam_config%md5sum = md5sum (u)
close (u)
end if
end subroutine process_beam_config_compute_md5sum
@ %def process_beam_config_compute_md5sum
@
<<Process config: process beam config: TBP>>=
procedure :: get_md5sum => process_beam_config_get_md5sum
<<Process config: procedures>>=
pure function process_beam_config_get_md5sum (beam_config) result (md5)
character(32) :: md5
class(process_beam_config_t), intent(in) :: beam_config
md5 = beam_config%md5sum
end function process_beam_config_get_md5sum
@ %def process_beam_config_get_md5sum
@
<<Process config: process beam config: TBP>>=
procedure :: has_structure_function => process_beam_config_has_structure_function
<<Process config: procedures>>=
pure function process_beam_config_has_structure_function (beam_config) result (has_sf)
logical :: has_sf
class(process_beam_config_t), intent(in) :: beam_config
has_sf = beam_config%n_strfun > 0
end function process_beam_config_has_structure_function
@ %def process_beam_config_has_structure_function
@
\subsection{Process components}
A process component is an individual contribution to a process
(scattering or decay) which needs not be physical. The sum over all
components should be physical.
The [[index]] indentifies this component within its parent process.
The actual process component is stored in the [[core]] subobject. We
use a polymorphic subobject instead of an extension of
[[process_component_t]], because the individual entries in the array
of process components can have different types. In short,
[[process_component_t]] is a wrapper for the actual process variants.
If the [[active]] flag is false, we should skip this component. This happens
if the associated process has vanishing matrix element.
The index array [[i_term]] points to the individual terms generated by
this component. The indices refer to the parent process.
The index [[i_mci]] is the index of the MC integrator and parameter set which
are associated to this process component.
<<Process config: public>>=
public :: process_component_t
<<Process config: types>>=
type :: process_component_t
type(process_component_def_t), pointer :: config => null ()
integer :: index = 0
logical :: active = .false.
integer, dimension(:), allocatable :: i_term
integer :: i_mci = 0
class(phs_config_t), allocatable :: phs_config
character(32) :: md5sum_phs = ""
integer :: component_type = COMP_DEFAULT
contains
<<Process config: process component: TBP>>
end type process_component_t
@ %def process_component_t
@ Finalizer. The MCI template may (potentially) need a finalizer. The process
configuration finalizer may include closing an open scratch file.
<<Process config: process component: TBP>>=
procedure :: final => process_component_final
<<Process config: procedures>>=
subroutine process_component_final (object)
class(process_component_t), intent(inout) :: object
if (allocated (object%phs_config)) then
call object%phs_config%final ()
end if
end subroutine process_component_final
@ %def process_component_final
@ The meaning of [[verbose]] depends on the process variant.
<<Process config: process component: TBP>>=
procedure :: write => process_component_write
<<Process config: procedures>>=
subroutine process_component_write (object, unit)
class(process_component_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (associated (object%config)) then
write (u, "(1x,A,I0)") "Component #", object%index
call object%config%write (u)
if (object%md5sum_phs /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (phs) = '", &
object%md5sum_phs, "'"
end if
else
write (u, "(1x,A)") "Process component: [not allocated]"
end if
if (.not. object%active) then
write (u, "(1x,A)") "[Inactive]"
return
end if
write (u, "(1x,A)") "Referenced data:"
if (allocated (object%i_term)) then
write (u, "(3x,A,999(1x,I0))") "Terms =", &
object%i_term
else
write (u, "(3x,A)") "Terms = [undefined]"
end if
if (object%i_mci /= 0) then
write (u, "(3x,A,I0)") "MC dataset = ", object%i_mci
else
write (u, "(3x,A)") "MC dataset = [undefined]"
end if
if (allocated (object%phs_config)) then
call object%phs_config%write (u)
end if
end subroutine process_component_write
@ %def process_component_write
@ Initialize the component.
<<Process config: process component: TBP>>=
procedure :: init => process_component_init
<<Process config: procedures>>=
subroutine process_component_init (component, &
i_component, env, meta, config, &
active, &
phs_config_template)
class(process_component_t), intent(out) :: component
integer, intent(in) :: i_component
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
logical, intent(in) :: active
class(phs_config_t), intent(in), allocatable :: phs_config_template
type(process_constants_t) :: data
component%index = i_component
component%config => &
config%process_def%get_component_def_ptr (i_component)
component%active = active
if (component%active) then
allocate (component%phs_config, source = phs_config_template)
call env%fill_process_constants (meta%id, i_component, data)
call component%phs_config%init (data, config%model)
end if
end subroutine process_component_init
@ %def process_component_init
@
<<Process config: process component: TBP>>=
procedure :: is_active => process_component_is_active
<<Process config: procedures>>=
elemental function process_component_is_active (component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
active = component%active
end function process_component_is_active
@ %def process_component_is_active
@ Finalize the phase-space configuration.
<<Process config: process component: TBP>>=
procedure :: configure_phs => process_component_configure_phs
<<Process config: procedures>>=
subroutine process_component_configure_phs &
(component, sqrts, beam_config, rebuild, &
ignore_mismatch, subdir)
class(process_component_t), intent(inout) :: component
real(default), intent(in) :: sqrts
type(process_beam_config_t), intent(in) :: beam_config
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
type(string_t), intent(in), optional :: subdir
logical :: no_strfun
integer :: nlo_type
no_strfun = beam_config%n_strfun == 0
nlo_type = component%config%get_nlo_type ()
call component%phs_config%configure (sqrts, &
azimuthal_dependence = beam_config%azimuthal_dependence, &
sqrts_fixed = no_strfun, &
lab_is_cm = beam_config%lab_is_cm .and. no_strfun, &
rebuild = rebuild, ignore_mismatch = ignore_mismatch, &
nlo_type = nlo_type, &
subdir = subdir)
end subroutine process_component_configure_phs
@ %def process_component_configure_phs
@ The process component possesses two MD5 sums: the checksum of the
component definition, which should be available when the component is
initialized, and the phase-space MD5 sum, which is available after
configuration.
<<Process config: process component: TBP>>=
procedure :: compute_md5sum => process_component_compute_md5sum
<<Process config: procedures>>=
subroutine process_component_compute_md5sum (component)
class(process_component_t), intent(inout) :: component
component%md5sum_phs = component%phs_config%get_md5sum ()
end subroutine process_component_compute_md5sum
@ %def process_component_compute_md5sum
@ Match phase-space channels with structure-function channels, where
applicable.
This calls a method of the [[phs_config]] phase-space implementation.
<<Process config: process component: TBP>>=
procedure :: collect_channels => process_component_collect_channels
<<Process config: procedures>>=
subroutine process_component_collect_channels (component, coll)
class(process_component_t), intent(inout) :: component
type(phs_channel_collection_t), intent(inout) :: coll
call component%phs_config%collect_channels (coll)
end subroutine process_component_collect_channels
@ %def process_component_collect_channels
@
<<Process config: process component: TBP>>=
procedure :: get_config => process_component_get_config
<<Process config: procedures>>=
function process_component_get_config (component) &
result (config)
type(process_component_def_t) :: config
class(process_component_t), intent(in) :: component
config = component%config
end function process_component_get_config
@ %def process_component_get_config
@
<<Process config: process component: TBP>>=
procedure :: get_md5sum => process_component_get_md5sum
<<Process config: procedures>>=
pure function process_component_get_md5sum (component) result (md5)
type(string_t) :: md5
class(process_component_t), intent(in) :: component
md5 = component%config%get_md5sum () // component%md5sum_phs
end function process_component_get_md5sum
@ %def process_component_get_md5sum
@ Return the number of phase-space parameters.
<<Process config: process component: TBP>>=
procedure :: get_n_phs_par => process_component_get_n_phs_par
<<Process config: procedures>>=
function process_component_get_n_phs_par (component) result (n_par)
class(process_component_t), intent(in) :: component
integer :: n_par
n_par = component%phs_config%get_n_par ()
end function process_component_get_n_phs_par
@ %def process_component_get_n_phs_par
@
<<Process config: process component: TBP>>=
procedure :: get_phs_config => process_component_get_phs_config
<<Process config: procedures>>=
subroutine process_component_get_phs_config (component, phs_config)
class(process_component_t), intent(in), target :: component
class(phs_config_t), intent(out), pointer :: phs_config
phs_config => component%phs_config
end subroutine process_component_get_phs_config
@ %def process_component_get_phs_config
@
<<Process config: process component: TBP>>=
procedure :: get_nlo_type => process_component_get_nlo_type
<<Process config: procedures>>=
elemental function process_component_get_nlo_type (component) result (nlo_type)
integer :: nlo_type
class(process_component_t), intent(in) :: component
nlo_type = component%config%get_nlo_type ()
end function process_component_get_nlo_type
@ %def process_component_get_nlo_type
@
<<Process config: process component: TBP>>=
procedure :: needs_mci_entry => process_component_needs_mci_entry
<<Process config: procedures>>=
function process_component_needs_mci_entry (component, combined_integration) result (value)
logical :: value
class(process_component_t), intent(in) :: component
logical, intent(in), optional :: combined_integration
value = component%active
if (present (combined_integration)) then
if (combined_integration) &
value = value .and. component%component_type <= COMP_MASTER
end if
end function process_component_needs_mci_entry
@ %def process_component_needs_mci_entry
@
<<Process config: process component: TBP>>=
procedure :: can_be_integrated => process_component_can_be_integrated
<<Process config: procedures>>=
elemental function process_component_can_be_integrated (component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
active = component%config%can_be_integrated ()
end function process_component_can_be_integrated
@ %def process_component_can_be_integrated
@
\subsection{Process terms}
For straightforward tree-level calculations, each process component
corresponds to a unique elementary interaction. However, in the case
of NLO calculations with subtraction terms, a process component may
split into several separate contributions to the scattering, which are
qualified by interactions with distinct kinematics and particle
content. We represent their configuration as [[process_term_t]]
objects, the actual instances will be introduced below as
[[term_instance_t]]. In any case, the process term contains an
elementary interaction with a definite quantum-number and momentum
content.
The index [[i_term_global]] identifies the term relative to the
process.
The index [[i_component]] identifies the process component which
generates this term, relative to the parent process.
The index [[i_term]] identifies the term relative to the process
component (not the process).
The [[data]] subobject holds all process constants.
The number of allowed flavor/helicity/color combinations is stored as
[[n_allowed]]. This is the total number of independent entries in the
density matrix. For each combination, the index of the flavor,
helicity, and color state is stored in the arrays [[flv]], [[hel]],
and [[col]], respectively.
The flag [[rearrange]] is true if we need to rearrange the particles of the
hard interaction, to obtain the effective parton state.
The interaction [[int]] holds the quantum state for the (resolved) hard
interaction, the parent-child relations of the particles, and their momenta.
The momenta are not filled yet; this is postponed to copies of [[int]] which
go into the process instances.
If recombination is in effect, we should allocate [[int_eff]] to describe the
rearranged partonic state.
This type is public only for use in a unit test.
<<Process config: public>>=
public :: process_term_t
<<Process config: types>>=
type :: process_term_t
integer :: i_term_global = 0
integer :: i_component = 0
integer :: i_term = 0
integer :: i_sub = 0
integer :: i_core = 0
integer :: n_allowed = 0
type(process_constants_t) :: data
real(default) :: alpha_s = 0
integer, dimension(:), allocatable :: flv, hel, col
integer :: n_sub, n_sub_color, n_sub_spin
type(interaction_t) :: int
type(interaction_t), pointer :: int_eff => null ()
contains
<<Process config: process term: TBP>>
end type process_term_t
@ %def process_term_t
@ For the output, we skip the process constants and the tables of
allowed quantum numbers. Those can also be read off from the
interaction object.
<<Process config: process term: TBP>>=
procedure :: write => process_term_write
<<Process config: procedures>>=
subroutine process_term_write (term, unit)
class(process_term_t), intent(in) :: term
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A,I0)") "Term #", term%i_term_global
write (u, "(3x,A,I0)") "Process component index = ", &
term%i_component
write (u, "(3x,A,I0)") "Term index w.r.t. component = ", &
term%i_term
call write_separator (u)
write (u, "(1x,A)") "Hard interaction:"
call write_separator (u)
call term%int%basic_write (u)
end subroutine process_term_write
@ %def process_term_write
@ Write an account of all quantum number states and their current status.
<<Process config: process term: TBP>>=
procedure :: write_state_summary => process_term_write_state_summary
<<Process config: procedures>>=
subroutine process_term_write_state_summary (term, core, unit)
class(process_term_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
integer, intent(in), optional :: unit
integer :: u, i, f, h, c
type(state_iterator_t) :: it
character :: sgn
u = given_output_unit (unit)
write (u, "(1x,A,I0)") "Term #", term%i_term_global
call it%init (term%int%get_state_matrix_ptr ())
do while (it%is_valid ())
i = it%get_me_index ()
f = term%flv(i)
h = term%hel(i)
if (allocated (term%col)) then
c = term%col(i)
else
c = 1
end if
if (core%is_allowed (term%i_term, f, h, c)) then
sgn = "+"
else
sgn = " "
end if
write (u, "(1x,A1,1x,I0,2x)", advance="no") sgn, i
call quantum_numbers_write (it%get_quantum_numbers (), u)
write (u, *)
call it%advance ()
end do
end subroutine process_term_write_state_summary
@ %def process_term_write_state_summary
@ Finalizer: the [[int]] and potentially [[int_eff]] components have a
finalizer that we must call.
<<Process config: process term: TBP>>=
procedure :: final => process_term_final
<<Process config: procedures>>=
subroutine process_term_final (term)
class(process_term_t), intent(inout) :: term
call term%int%final ()
end subroutine process_term_final
@ %def process_term_final
@ Initialize the term. We copy the process constants from the [[core]]
object and set up the [[int]] hard interaction accordingly.
The [[alpha_s]] value is useful for writing external event records. This is
the constant value which may be overridden by a event-specific running value.
If the model does not contain the strong coupling, the value is zero.
The [[rearrange]] part is commented out; this or something equivalent
could become relevant for NLO algorithms.
<<Process config: process term: TBP>>=
procedure :: init => process_term_init
<<Process config: procedures>>=
subroutine process_term_init &
(term, i_term_global, i_component, i_term, core, model, &
nlo_type, use_beam_pol, subtraction_method, &
has_pdfs, n_emitters)
class(process_term_t), intent(inout), target :: term
integer, intent(in) :: i_term_global
integer, intent(in) :: i_component
integer, intent(in) :: i_term
class(prc_core_t), intent(inout) :: core
class(model_data_t), intent(in), target :: model
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: use_beam_pol
type(string_t), intent(in), optional :: subtraction_method
logical, intent(in), optional :: has_pdfs
integer, intent(in), optional :: n_emitters
class(modelpar_data_t), pointer :: alpha_s_ptr
logical :: use_internal_color
term%i_term_global = i_term_global
term%i_component = i_component
term%i_term = i_term
call core%get_constants (term%data, i_term)
alpha_s_ptr => model%get_par_data_ptr (var_str ("alphas"))
if (associated (alpha_s_ptr)) then
term%alpha_s = alpha_s_ptr%get_real ()
else
term%alpha_s = -1
end if
use_internal_color = .false.
if (present (subtraction_method)) &
use_internal_color = (char (subtraction_method) == 'omega') &
.or. (char (subtraction_method) == 'threshold')
call term%setup_interaction (core, model, nlo_type = nlo_type, &
pol_beams = use_beam_pol, use_internal_color = use_internal_color, &
has_pdfs = has_pdfs, n_emitters = n_emitters)
end subroutine process_term_init
@ %def process_term_init
@ We fetch the process constants which determine the quantum numbers and
use those to create the interaction. The interaction contains
incoming and outgoing particles, no virtuals. The incoming particles
are parents of the outgoing ones.
Keeping previous \whizard\ conventions, we invert the color assignment
(but not flavor or helicity) for the incoming particles. When the
color-flow square matrix is evaluated, this inversion is done again,
so in the color-flow sequence we get the color assignments of the
matrix element.
\textbf{Why are these four subtraction entries for structure-function
aware interactions?} Taking the soft or collinear limit of the real-emission
matrix element, the behavior of the parton energy fractions has to be
taken into account. In the pure real case, $x_\oplus$ and $x_\ominus$
are given by
\begin{equation*}
x_\oplus = \frac{\bar{x}_\oplus}{\sqrt{1-\xi}}
\sqrt{\frac{2 - \xi(1-y)}{2 - \xi(1+y)}},
\quad
x_\ominus = \frac{\bar{x}_\ominus}{\sqrt{1-\xi}}
\sqrt{\frac{2 - \xi(1+y)}{2 - \xi(1-y)}}.
\end{equation*}
In the soft limit, $\xi \to 0$, this yields $x_\oplus = \bar{x}_\oplus$
and $x_\ominus = \bar{x}_\ominus$. In the collinear limit, $y \to 1$,
it is $x_\oplus = \bar{x}_\oplus / (1 - \xi)$ and $x_\ominus = \bar{x}_\ominus$.
Likewise, in the anti-collinear limit $y \to -1$, the inverse relation holds.
We therefore have to distinguish four cases with the PDF assignments
$f(x_\oplus) \cdot f(x_\ominus)$, $f(\bar{x}_\oplus) \cdot f(\bar{x}_\ominus)$,
$f\left(\bar{x}_\oplus / (1-\xi)\right) \cdot f(\bar{x}_\ominus)$ and
$f(\bar{x}_\oplus) \cdot f\left(\bar{x}_\ominus / (1-\xi)\right)$.
The [[n_emitters]] optional argument is provided by the caller if this term
requires spin-correlated matrix elements, and thus involves additional
subtractions.
<<Process config: process term: TBP>>=
procedure :: setup_interaction => process_term_setup_interaction
<<Process config: procedures>>=
subroutine process_term_setup_interaction (term, core, model, &
nlo_type, pol_beams, has_pdfs, use_internal_color, n_emitters)
class(process_term_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
class(model_data_t), intent(in), target :: model
logical, intent(in), optional :: pol_beams
logical, intent(in), optional :: has_pdfs
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: use_internal_color
integer, intent(in), optional :: n_emitters
integer :: n, n_tot
type(flavor_t), dimension(:), allocatable :: flv
type(color_t), dimension(:), allocatable :: col
type(helicity_t), dimension(:), allocatable :: hel
type(quantum_numbers_t), dimension(:), allocatable :: qn
logical :: is_pol, use_color
integer :: nlo_t, n_sub
is_pol = .false.; if (present (pol_beams)) is_pol = pol_beams
nlo_t = BORN; if (present (nlo_type)) nlo_t = nlo_type
n_tot = term%data%n_in + term%data%n_out
call count_number_of_states ()
term%n_allowed = n
call compute_n_sub (n_emitters, has_pdfs)
call fill_quantum_numbers ()
call term%int%basic_init &
(term%data%n_in, 0, term%data%n_out, set_relations = .true.)
select type (core)
class is (prc_blha_t)
call setup_states_blha_olp ()
type is (prc_threshold_t)
call setup_states_threshold ()
class is (prc_external_t)
call setup_states_other_prc_external ()
class default
call setup_states_omega ()
end select
call term%int%freeze ()
contains
subroutine count_number_of_states ()
integer :: f, h, c
n = 0
select type (core)
class is (prc_external_t)
do f = 1, term%data%n_flv
do h = 1, term%data%n_hel
do c = 1, term%data%n_col
n = n + 1
end do
end do
end do
class default !!! Omega and all test cores
do f = 1, term%data%n_flv
do h = 1, term%data%n_hel
do c = 1, term%data%n_col
if (core%is_allowed (term%i_term, f, h, c)) n = n + 1
end do
end do
end do
end select
end subroutine count_number_of_states
subroutine compute_n_sub (n_emitters, has_pdfs)
integer, intent(in), optional :: n_emitters
logical, intent(in), optional :: has_pdfs
logical :: can_have_sub
integer :: n_sub_color, n_sub_spin
use_color = .false.; if (present (use_internal_color)) &
use_color = use_internal_color
can_have_sub = nlo_t == NLO_VIRTUAL .or. &
(nlo_t == NLO_REAL .and. term%i_term_global == term%i_sub) .or. &
nlo_t == NLO_MISMATCH
n_sub_color = 0; n_sub_spin = 0
if (can_have_sub) then
if (.not. use_color) n_sub_color = n_tot * (n_tot - 1) / 2
if (nlo_t == NLO_REAL) then
if (present (n_emitters)) then
n_sub_spin = 6 * n_emitters
end if
end if
end if
n_sub = n_sub_color + n_sub_spin
!!! For the virtual subtraction we also need the finite virtual contribution
!!! corresponding to the $\epsilon^0$-pole
if (nlo_t == NLO_VIRTUAL) n_sub = n_sub + 1
if (present (has_pdfs)) then
if (has_pdfs &
.and. ((nlo_t == NLO_REAL .and. can_have_sub) &
.or. nlo_t == NLO_DGLAP)) then
!!! necessary dummy, needs refactoring,
!!! c.f. [[term_instance_evaluate_interaction_userdef_tree]]
n_sub = n_sub + n_beams_rescaled
end if
end if
term%n_sub = n_sub
term%n_sub_color = n_sub_color
term%n_sub_spin = n_sub_spin
end subroutine compute_n_sub
subroutine fill_quantum_numbers ()
integer :: nn
logical :: can_have_sub
select type (core)
class is (prc_external_t)
can_have_sub = nlo_t == NLO_VIRTUAL .or. &
(nlo_t == NLO_REAL .and. term%i_term_global == term%i_sub) .or. &
nlo_t == NLO_MISMATCH .or. nlo_t == NLO_DGLAP
if (can_have_sub) then
nn = (n_sub + 1) * n
else
nn = n
end if
class default
nn = n
end select
allocate (term%flv (nn), term%col (nn), term%hel (nn))
allocate (flv (n_tot), col (n_tot), hel (n_tot))
allocate (qn (n_tot))
end subroutine fill_quantum_numbers
subroutine setup_states_blha_olp ()
integer :: s, f, c, h, i
i = 0
associate (data => term%data)
do s = 0, n_sub
do f = 1, data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
i = i + 1
term%flv(i) = f
term%hel(i) = h
!!! Dummy-initialization of color
term%col(i) = c
call flv%init (data%flv_state (:,f), model)
call color_init_from_array (col, &
data%col_state(:,:,c), data%ghost_flag(:,c))
call col(1:data%n_in)%invert ()
if (is_pol) then
select type (core)
type is (prc_openloops_t)
call hel%init (data%hel_state (:,h))
call qn%init (flv, hel, col, s)
class default
call msg_fatal ("Polarized beams only supported by OpenLoops")
end select
else
call qn%init (flv, col, s)
end if
call qn%tag_hard_process ()
call term%int%add_state (qn)
end do
end do
end do
end do
end associate
end subroutine setup_states_blha_olp
subroutine setup_states_threshold ()
integer :: s, f, c, h, i
i = 0
n_sub = 0; if (nlo_t == NLO_VIRTUAL) n_sub = 1
associate (data => term%data)
do s = 0, n_sub
do f = 1, term%data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
i = i + 1
term%flv(i) = f
term%hel(i) = h
!!! Dummy-initialization of color
term%col(i) = 1
call flv%init (term%data%flv_state (:,f), model)
if (is_pol) then
call hel%init (data%hel_state (:,h))
call qn%init (flv, hel, s)
else
call qn%init (flv, s)
end if
call qn%tag_hard_process ()
call term%int%add_state (qn)
end do
end do
end do
end do
end associate
end subroutine setup_states_threshold
subroutine setup_states_other_prc_external ()
integer :: s, f, i, c, h
if (is_pol) &
call msg_fatal ("Polarized beams only supported by OpenLoops")
i = 0
!!! n_sub = 0; if (nlo_t == NLO_VIRTUAL) n_sub = 1
associate (data => term%data)
do s = 0, n_sub
do f = 1, data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
i = i + 1
term%flv(i) = f
term%hel(i) = h
!!! Dummy-initialization of color
term%col(i) = c
call flv%init (data%flv_state (:,f), model)
call color_init_from_array (col, &
data%col_state(:,:,c), data%ghost_flag(:,c))
call col(1:data%n_in)%invert ()
call qn%init (flv, col, s)
call qn%tag_hard_process ()
call term%int%add_state (qn)
end do
end do
end do
end do
end associate
end subroutine setup_states_other_prc_external
subroutine setup_states_omega ()
integer :: f, h, c, i
i = 0
associate (data => term%data)
do f = 1, data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
if (core%is_allowed (term%i_term, f, h, c)) then
i = i + 1
term%flv(i) = f
term%hel(i) = h
term%col(i) = c
call flv%init (data%flv_state(:,f), model)
call color_init_from_array (col, &
data%col_state(:,:,c), &
data%ghost_flag(:,c))
call col(:data%n_in)%invert ()
call hel%init (data%hel_state(:,h))
call qn%init (flv, col, hel)
call qn%tag_hard_process ()
call term%int%add_state (qn)
end if
end do
end do
end do
end associate
end subroutine setup_states_omega
end subroutine process_term_setup_interaction
@ %def process_term_setup_interaction
@
<<Process config: process term: TBP>>=
procedure :: get_process_constants => process_term_get_process_constants
<<Process config: procedures>>=
subroutine process_term_get_process_constants &
(term, prc_constants)
class(process_term_t), intent(inout) :: term
type(process_constants_t), intent(out) :: prc_constants
prc_constants = term%data
end subroutine process_term_get_process_constants
@ %def process_term_get_process_constants
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process call statistics}
Very simple object for statistics. Could be moved to a more basic chapter.
<<[[process_counter.f90]]>>=
<<File header>>
module process_counter
use io_units
<<Standard module head>>
<<Process counter: public>>
<<Process counter: parameters>>
<<Process counter: types>>
contains
<<Process counter: procedures>>
end module process_counter
@ %def process_counter
@ This object can record process calls, categorized by evaluation
status. It is a part of the [[mci_entry]] component below.
<<Process counter: public>>=
public :: process_counter_t
<<Process counter: types>>=
type :: process_counter_t
integer :: total = 0
integer :: failed_kinematics = 0
integer :: failed_cuts = 0
integer :: has_passed = 0
integer :: evaluated = 0
integer :: complete = 0
contains
<<Process counter: process counter: TBP>>
end type process_counter_t
@ %def process_counter_t
@ Here are the corresponding numeric codes:
<<Process counter: parameters>>=
integer, parameter, public :: STAT_UNDEFINED = 0
integer, parameter, public :: STAT_INITIAL = 1
integer, parameter, public :: STAT_ACTIVATED = 2
integer, parameter, public :: STAT_BEAM_MOMENTA = 3
integer, parameter, public :: STAT_FAILED_KINEMATICS = 4
integer, parameter, public :: STAT_SEED_KINEMATICS = 5
integer, parameter, public :: STAT_HARD_KINEMATICS = 6
integer, parameter, public :: STAT_EFF_KINEMATICS = 7
integer, parameter, public :: STAT_FAILED_CUTS = 8
integer, parameter, public :: STAT_PASSED_CUTS = 9
integer, parameter, public :: STAT_EVALUATED_TRACE = 10
integer, parameter, public :: STAT_EVENT_COMPLETE = 11
@ %def STAT_UNDEFINED STAT_INITIAL STAT_ACTIVATED
@ %def STAT_BEAM_MOMENTA STAT_FAILED_KINEMATICS
@ %def STAT_SEED_KINEMATICS STAT_HARD_KINEMATICS STAT_EFF_KINEMATICS
@ %def STAT_EVALUATED_TRACE STAT_EVENT_COMPLETE
@ Output.
<<Process counter: process counter: TBP>>=
procedure :: write => process_counter_write
<<Process counter: procedures>>=
subroutine process_counter_write (object, unit)
class(process_counter_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (object%total > 0) then
write (u, "(1x,A)") "Call statistics (current run):"
write (u, "(3x,A,I0)") "total = ", object%total
write (u, "(3x,A,I0)") "failed kin. = ", object%failed_kinematics
write (u, "(3x,A,I0)") "failed cuts = ", object%failed_cuts
write (u, "(3x,A,I0)") "passed cuts = ", object%has_passed
write (u, "(3x,A,I0)") "evaluated = ", object%evaluated
else
write (u, "(1x,A)") "Call statistics (current run): [no calls]"
end if
end subroutine process_counter_write
@ %def process_counter_write
@ Reset. Just enforce default initialization.
<<Process counter: process counter: TBP>>=
procedure :: reset => process_counter_reset
<<Process counter: procedures>>=
subroutine process_counter_reset (counter)
class(process_counter_t), intent(out) :: counter
counter%total = 0
counter%failed_kinematics = 0
counter%failed_cuts = 0
counter%has_passed = 0
counter%evaluated = 0
counter%complete = 0
end subroutine process_counter_reset
@ %def process_counter_reset
@ We record an event according to the lowest status code greater or
equal to the actual status. This is actually done by the process
instance; the process object just copies the instance counter.
<<Process counter: process counter: TBP>>=
procedure :: record => process_counter_record
<<Process counter: procedures>>=
subroutine process_counter_record (counter, status)
class(process_counter_t), intent(inout) :: counter
integer, intent(in) :: status
if (status <= STAT_FAILED_KINEMATICS) then
counter%failed_kinematics = counter%failed_kinematics + 1
else if (status <= STAT_FAILED_CUTS) then
counter%failed_cuts = counter%failed_cuts + 1
else if (status <= STAT_PASSED_CUTS) then
counter%has_passed = counter%has_passed + 1
else
counter%evaluated = counter%evaluated + 1
end if
counter%total = counter%total + 1
end subroutine process_counter_record
@ %def process_counter_record
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Multi-channel integration}
<<[[process_mci.f90]]>>=
<<File header>>
module process_mci
<<Use kinds>>
<<Use strings>>
<<Use debug>>
use io_units
use diagnostics
use physics_defs
use md5
use cputime
use rng_base
use mci_base
use variables
use integration_results
use process_libraries
use phs_base
use process_counter
use process_config
<<Standard module head>>
<<Process mci: public>>
<<Process mci: parameters>>
<<Process mci: types>>
contains
<<Process mci: procedures>>
end module process_mci
@ %def process_mci
\subsection{Process MCI entry}
The [[process_mci_entry_t]] block contains, for each process component that is
integrated independently, the configuration data for its MC input parameters.
Each input parameter set is handled by a [[mci_t]] integrator.
The MC input parameter set is broken down into the parameters required by the
structure-function chain and the parameters required by the phase space of the
elementary process.
The MD5 sum collects all information about the associated processes
that may affect the integration. It does not contain the MCI object
itself or integration results.
MC integration is organized in passes. Each pass may consist of
several iterations, and for each iteration there is a number of
calls. We store explicitly the values that apply to the current
pass. Previous values are archived in the [[results]] object.
The [[counter]] receives the counter statistics from the associated
process instance, for diagnostics.
The [[results]] object records results, broken down in passes and iterations.
<<Process mci: public>>=
public :: process_mci_entry_t
<<Process mci: types>>=
type :: process_mci_entry_t
integer :: i_mci = 0
integer, dimension(:), allocatable :: i_component
integer :: process_type = PRC_UNKNOWN
integer :: n_par = 0
integer :: n_par_sf = 0
integer :: n_par_phs = 0
character(32) :: md5sum = ""
integer :: pass = 0
integer :: n_it = 0
integer :: n_calls = 0
logical :: activate_timer = .false.
real(default) :: error_threshold = 0
class(mci_t), allocatable :: mci
type(process_counter_t) :: counter
type(integration_results_t) :: results
logical :: negative_weights = .false.
logical :: combined_integration = .false.
integer :: real_partition_type = REAL_FULL
integer :: associated_real_component = 0
contains
<<Process mci: process mci entry: TBP>>
end type process_mci_entry_t
@ %def process_mci_entry_t
@ Finalizer for the [[mci]] component.
<<Process mci: process mci entry: TBP>>=
procedure :: final => process_mci_entry_final
<<Process mci: procedures>>=
subroutine process_mci_entry_final (object)
class(process_mci_entry_t), intent(inout) :: object
if (allocated (object%mci)) call object%mci%final ()
end subroutine process_mci_entry_final
@ %def process_mci_entry_final
@ Output. Write pass/iteration information only if set (the pass
index is nonzero). Write the MCI block only if it exists (for some
self-tests it does not). Write results only if there are any.
<<Process mci: process mci entry: TBP>>=
procedure :: write => process_mci_entry_write
<<Process mci: procedures>>=
subroutine process_mci_entry_write (object, unit, pacify)
class(process_mci_entry_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,I0)") "Associated components = ", object%i_component
write (u, "(3x,A,I0)") "MC input parameters = ", object%n_par
write (u, "(3x,A,I0)") "MC parameters (SF) = ", object%n_par_sf
write (u, "(3x,A,I0)") "MC parameters (PHS) = ", object%n_par_phs
if (object%pass > 0) then
write (u, "(3x,A,I0)") "Current pass = ", object%pass
write (u, "(3x,A,I0)") "Number of iterations = ", object%n_it
write (u, "(3x,A,I0)") "Number of calls = ", object%n_calls
end if
if (object%md5sum /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (components) = '", object%md5sum, "'"
end if
if (allocated (object%mci)) then
call object%mci%write (u)
end if
call object%counter%write (u)
if (object%results%exist ()) then
call object%results%write (u, suppress = pacify)
call object%results%write_chain_weights (u)
end if
end subroutine process_mci_entry_write
@ %def process_mci_entry_write
@ Configure the MCI entry. This is intent(inout) since some specific settings
may be done before this. The actual [[mci_t]] object is an instance of the
[[mci_template]] argument, which determines the concrete types.
In a unit-test context, the [[mci_template]] argument may be unallocated.
We obtain the number of channels and the number of parameters, separately for
the structure-function chain and for the associated process component. We
assume that the phase-space object has already been configured.
We assume that there is only one process component directly associated with a
MCI entry.
<<Process mci: process mci entry: TBP>>=
procedure :: configure => process_mci_entry_configure
<<Process mci: procedures>>=
subroutine process_mci_entry_configure (mci_entry, mci_template, &
process_type, i_mci, i_component, component, &
n_sfpar, rng_factory)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_t), intent(in), allocatable :: mci_template
integer, intent(in) :: process_type
integer, intent(in) :: i_mci
integer, intent(in) :: i_component
type(process_component_t), intent(in), target :: component
integer, intent(in) :: n_sfpar
class(rng_factory_t), intent(inout) :: rng_factory
class(rng_t), allocatable :: rng
associate (phs_config => component%phs_config)
mci_entry%i_mci = i_mci
call mci_entry%create_component_list (i_component, component%get_config ())
mci_entry%n_par_sf = n_sfpar
mci_entry%n_par_phs = phs_config%get_n_par ()
mci_entry%n_par = mci_entry%n_par_sf + mci_entry%n_par_phs
mci_entry%process_type = process_type
if (allocated (mci_template)) then
allocate (mci_entry%mci, source = mci_template)
call mci_entry%mci%record_index (mci_entry%i_mci)
call mci_entry%mci%set_dimensions &
(mci_entry%n_par, phs_config%get_n_channel ())
call mci_entry%mci%declare_flat_dimensions &
(phs_config%get_flat_dimensions ())
if (phs_config%provides_equivalences) then
call mci_entry%mci%declare_equivalences &
(phs_config%channel, mci_entry%n_par_sf)
end if
if (phs_config%provides_chains) then
call mci_entry%mci%declare_chains (phs_config%chain)
end if
call rng_factory%make (rng)
call mci_entry%mci%import_rng (rng)
end if
call mci_entry%results%init (process_type)
end associate
end subroutine process_mci_entry_configure
@ %def process_mci_entry_configure
@
<<Process mci: parameters>>=
integer, parameter, public :: REAL_FULL = 0
integer, parameter, public :: REAL_SINGULAR = 1
integer, parameter, public :: REAL_FINITE = 2
@
<<Process mci: process mci entry: TBP>>=
procedure :: create_component_list => &
process_mci_entry_create_component_list
<<Process mci: procedures>>=
subroutine process_mci_entry_create_component_list (mci_entry, &
i_component, component_config)
class (process_mci_entry_t), intent(inout) :: mci_entry
integer, intent(in) :: i_component
type(process_component_def_t), intent(in) :: component_config
integer, dimension(:), allocatable :: i_list
integer :: n
integer, save :: i_rfin_offset = 0
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_mci_entry_create_component_list")
if (mci_entry%combined_integration) then
n = get_n_components (mci_entry%real_partition_type)
allocate (i_list (n))
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
"mci_entry%real_partition_type", mci_entry%real_partition_type)
select case (mci_entry%real_partition_type)
case (REAL_FULL)
i_list = component_config%get_association_list ()
allocate (mci_entry%i_component (size (i_list)))
mci_entry%i_component = i_list
case (REAL_SINGULAR)
i_list = component_config%get_association_list (ASSOCIATED_REAL_FIN)
allocate (mci_entry%i_component (size(i_list)))
mci_entry%i_component = i_list
case (REAL_FINITE)
allocate (mci_entry%i_component (1))
mci_entry%i_component(1) = &
component_config%get_associated_real_fin () + i_rfin_offset
i_rfin_offset = i_rfin_offset + 1
end select
else
allocate (mci_entry%i_component (1))
mci_entry%i_component(1) = i_component
end if
contains
function get_n_components (damping_type) result (n_components)
integer :: n_components
integer, intent(in) :: damping_type
select case (damping_type)
case (REAL_FULL)
n_components = size (component_config%get_association_list ())
case (REAL_SINGULAR)
n_components = size (component_config%get_association_list &
(ASSOCIATED_REAL_FIN))
end select
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "n_components", n_components)
end function get_n_components
end subroutine process_mci_entry_create_component_list
@ %def process_mci_entry_create_component_list
@
<<Process mci: process mci entry: TBP>>=
procedure :: set_associated_real_component &
=> process_mci_entry_set_associated_real_component
<<Process mci: procedures>>=
subroutine process_mci_entry_set_associated_real_component (mci_entry, i)
class(process_mci_entry_t), intent(inout) :: mci_entry
integer, intent(in) :: i
mci_entry%associated_real_component = i
end subroutine process_mci_entry_set_associated_real_component
@ %def process_mci_entry_set_associated_real_component
@ Set some additional parameters.
<<Process mci: process mci entry: TBP>>=
procedure :: set_parameters => process_mci_entry_set_parameters
<<Process mci: procedures>>=
subroutine process_mci_entry_set_parameters (mci_entry, var_list)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(var_list_t), intent(in) :: var_list
integer :: integration_results_verbosity
real(default) :: error_threshold
integration_results_verbosity = &
var_list%get_ival (var_str ("integration_results_verbosity"))
error_threshold = &
var_list%get_rval (var_str ("error_threshold"))
mci_entry%activate_timer = &
var_list%get_lval (var_str ("?integration_timer"))
call mci_entry%results%set_verbosity (integration_results_verbosity)
call mci_entry%results%set_error_threshold (error_threshold)
end subroutine process_mci_entry_set_parameters
@ %def process_mci_entry_set_parameters
@ Compute an MD5 sum that summarizes all information that could
influence integration results, for the associated process components.
We take the process-configuration MD5 sum which represents parameters,
cuts, etc., the MD5 sums for the process component definitions and
their phase space objects (which should be configured), and the beam
configuration MD5 sum. (The QCD setup is included in the process
configuration data MD5 sum.)
Done only once, when the MD5 sum is still empty.
<<Process mci: process mci entry: TBP>>=
procedure :: compute_md5sum => process_mci_entry_compute_md5sum
<<Process mci: procedures>>=
subroutine process_mci_entry_compute_md5sum (mci_entry, &
config, component, beam_config)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(process_config_data_t), intent(in) :: config
type(process_component_t), dimension(:), intent(in) :: component
type(process_beam_config_t), intent(in) :: beam_config
type(string_t) :: buffer
integer :: i
if (mci_entry%md5sum == "") then
buffer = config%get_md5sum () // beam_config%get_md5sum ()
do i = 1, size (component)
if (component(i)%is_active ()) then
buffer = buffer // component(i)%get_md5sum ()
end if
end do
mci_entry%md5sum = md5sum (char (buffer))
end if
if (allocated (mci_entry%mci)) then
call mci_entry%mci%set_md5sum (mci_entry%md5sum)
end if
end subroutine process_mci_entry_compute_md5sum
@ %def process_mci_entry_compute_md5sum
@ Test the MCI sampler by calling it a given number of time, discarding the
results. The instance should be initialized.
The [[mci_entry]] is [[intent(inout)]] because the integrator contains
the random-number state.
<<Process mci: process mci entry: TBP>>=
procedure :: sampler_test => process_mci_entry_sampler_test
<<Process mci: procedures>>=
subroutine process_mci_entry_sampler_test (mci_entry, mci_sampler, n_calls)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_sampler_t), intent(inout), target :: mci_sampler
integer, intent(in) :: n_calls
call mci_entry%mci%sampler_test (mci_sampler, n_calls)
end subroutine process_mci_entry_sampler_test
@ %def process_mci_entry_sampler_test
@ Integrate.
The [[integrate]] method counts as an integration pass; the pass count is
increased by one. We transfer the pass parameters (number of iterations and
number of calls) to the actual integration routine.
The [[mci_entry]] is [[intent(inout)]] because the integrator contains
the random-number state.
Note: The results are written to screen and to logfile. This behavior
is hardcoded.
<<Process mci: process mci entry: TBP>>=
procedure :: integrate => process_mci_entry_integrate
procedure :: final_integration => process_mci_entry_final_integration
<<Process mci: procedures>>=
subroutine process_mci_entry_integrate (mci_entry, mci_instance, &
mci_sampler, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify, &
nlo_type)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
integer, intent(in), optional :: nlo_type
integer :: u_log
u_log = logfile_unit ()
mci_entry%pass = mci_entry%pass + 1
mci_entry%n_it = n_it
mci_entry%n_calls = n_calls
if (mci_entry%pass == 1) &
call mci_entry%mci%startup_message (n_calls = n_calls)
call mci_entry%mci%set_timer (active = mci_entry%activate_timer)
call mci_entry%results%display_init (screen = .true., unit = u_log)
call mci_entry%results%new_pass ()
if (present (nlo_type)) then
select case (nlo_type)
case (NLO_VIRTUAL, NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
mci_instance%negative_weights = .true.
end select
end if
call mci_entry%mci%add_pass (adapt_grids, adapt_weights, final)
call mci_entry%mci%start_timer ()
call mci_entry%mci%integrate (mci_instance, mci_sampler, n_it, &
n_calls, mci_entry%results, pacify = pacify)
call mci_entry%mci%stop_timer ()
if (signal_is_pending ()) return
end subroutine process_mci_entry_integrate
subroutine process_mci_entry_final_integration (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
call mci_entry%results%display_final ()
call mci_entry%time_message ()
end subroutine process_mci_entry_final_integration
@ %def process_mci_entry_integrate
@ %def process_mci_entry_final_integration
@ If appropriate, issue an informative message about the expected time
for an event sample.
<<Process mci: process mci entry: TBP>>=
procedure :: get_time => process_mci_entry_get_time
procedure :: time_message => process_mci_entry_time_message
<<Process mci: procedures>>=
subroutine process_mci_entry_get_time (mci_entry, time, sample)
class(process_mci_entry_t), intent(in) :: mci_entry
type(time_t), intent(out) :: time
integer, intent(in) :: sample
real(default) :: time_last_pass, efficiency, calls
time_last_pass = mci_entry%mci%get_time ()
calls = mci_entry%results%get_n_calls ()
efficiency = mci_entry%mci%get_efficiency ()
if (time_last_pass > 0 .and. calls > 0 .and. efficiency > 0) then
time = nint (time_last_pass / calls / efficiency * sample)
end if
end subroutine process_mci_entry_get_time
subroutine process_mci_entry_time_message (mci_entry)
class(process_mci_entry_t), intent(in) :: mci_entry
type(time_t) :: time
integer :: sample
sample = 10000
call mci_entry%get_time (time, sample)
if (time%is_known ()) then
call msg_message ("Time estimate for generating 10000 events: " &
// char (time%to_string_dhms ()))
end if
end subroutine process_mci_entry_time_message
@ %def process_mci_entry_time_message
@ Prepare event generation. (For the test integrator, this does nothing. It
is relevant for the VAMP integrator.)
<<Process mci: process mci entry: TBP>>=
procedure :: prepare_simulation => process_mci_entry_prepare_simulation
<<Process mci: procedures>>=
subroutine process_mci_entry_prepare_simulation (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
call mci_entry%mci%prepare_simulation ()
end subroutine process_mci_entry_prepare_simulation
@ %def process_mci_entry_prepare_simulation
@ Generate an event. The instance should be initialized,
otherwise event generation is directed by the [[mci]] integrator
subobject. The integrator instance is contained in a [[mci_work]]
subobject of the process instance, which simultaneously serves as the
sampler object. (We avoid the anti-aliasing rules if we assume that
the sampling itself does not involve the integrator instance contained in the
process instance.)
Regarding weighted events, we only take events which are valid, which
means that they have valid kinematics and have passed cuts.
Therefore, we have a rejection loop. For unweighted events, the
unweighting routine should already take care of this.
The [[keep_failed]] flag determines whether events which failed cuts
are nevertheless produced, to be recorded with zero weight.
Alternatively, failed events are dropped, and this fact is recorded by
the counter [[n_dropped]].
<<Process mci: process mci entry: TBP>>=
procedure :: generate_weighted_event => &
process_mci_entry_generate_weighted_event
procedure :: generate_unweighted_event => &
process_mci_entry_generate_unweighted_event
<<Process mci: procedures>>=
subroutine process_mci_entry_generate_weighted_event (mci_entry, &
mci_instance, mci_sampler, keep_failed)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed
logical :: generate_new
generate_new = .true.
call mci_instance%reset_n_event_dropped ()
REJECTION: do while (generate_new)
call mci_entry%mci%generate_weighted_event (mci_instance, mci_sampler)
if (signal_is_pending ()) return
if (.not. mci_sampler%is_valid()) then
if (keep_failed) then
generate_new = .false.
else
call mci_instance%record_event_dropped ()
generate_new = .true.
end if
else
generate_new = .false.
end if
end do REJECTION
end subroutine process_mci_entry_generate_weighted_event
subroutine process_mci_entry_generate_unweighted_event (mci_entry, mci_instance, mci_sampler)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
call mci_entry%mci%generate_unweighted_event (mci_instance, mci_sampler)
end subroutine process_mci_entry_generate_unweighted_event
@ %def process_mci_entry_generate_weighted_event
@ %def process_mci_entry_generate_unweighted_event
@ Extract results.
<<Process mci: process mci entry: TBP>>=
procedure :: has_integral => process_mci_entry_has_integral
procedure :: get_integral => process_mci_entry_get_integral
procedure :: get_error => process_mci_entry_get_error
procedure :: get_accuracy => process_mci_entry_get_accuracy
procedure :: get_chi2 => process_mci_entry_get_chi2
procedure :: get_efficiency => process_mci_entry_get_efficiency
<<Process mci: procedures>>=
function process_mci_entry_has_integral (mci_entry) result (flag)
class(process_mci_entry_t), intent(in) :: mci_entry
logical :: flag
flag = mci_entry%results%exist ()
end function process_mci_entry_has_integral
function process_mci_entry_get_integral (mci_entry) result (integral)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: integral
integral = mci_entry%results%get_integral ()
end function process_mci_entry_get_integral
function process_mci_entry_get_error (mci_entry) result (error)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: error
error = mci_entry%results%get_error ()
end function process_mci_entry_get_error
function process_mci_entry_get_accuracy (mci_entry) result (accuracy)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: accuracy
accuracy = mci_entry%results%get_accuracy ()
end function process_mci_entry_get_accuracy
function process_mci_entry_get_chi2 (mci_entry) result (chi2)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: chi2
chi2 = mci_entry%results%get_chi2 ()
end function process_mci_entry_get_chi2
function process_mci_entry_get_efficiency (mci_entry) result (efficiency)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: efficiency
efficiency = mci_entry%results%get_efficiency ()
end function process_mci_entry_get_efficiency
@ %def process_mci_entry_get_integral process_mci_entry_get_error
@ %def process_mci_entry_get_accuracy process_mci_entry_get_chi2
@ %def process_mci_entry_get_efficiency
@ Return the MCI checksum. This may be the one used for
configuration, but may also incorporate results, if they change the
state of the integrator (adaptation).
<<Process mci: process mci entry: TBP>>=
procedure :: get_md5sum => process_mci_entry_get_md5sum
<<Process mci: procedures>>=
pure function process_mci_entry_get_md5sum (entry) result (md5sum)
class(process_mci_entry_t), intent(in) :: entry
character(32) :: md5sum
md5sum = entry%mci%get_md5sum ()
end function process_mci_entry_get_md5sum
@ %def process_mci_entry_get_md5sum
@
\subsection{MC parameter set and MCI instance}
For each process component that is associated with a multi-channel integration
(MCI) object, the [[mci_work_t]] object contains the currently active
parameter set. It also holds the implementation of the [[mci_instance_t]]
that the integrator needs for doing its work.
<<Process mci: public>>=
public :: mci_work_t
<<Process mci: types>>=
type :: mci_work_t
type(process_mci_entry_t), pointer :: config => null ()
real(default), dimension(:), allocatable :: x
class(mci_instance_t), pointer :: mci => null ()
type(process_counter_t) :: counter
logical :: keep_failed_events = .false.
integer :: n_event_dropped = 0
contains
<<Process mci: mci work: TBP>>
end type mci_work_t
@ %def mci_work_t
@ First write configuration data, then the current values.
<<Process mci: mci work: TBP>>=
procedure :: write => mci_work_write
<<Process mci: procedures>>=
subroutine mci_work_write (mci_work, unit, testflag)
class(mci_work_t), intent(in) :: mci_work
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A,I0,A)") "Active MCI instance #", &
mci_work%config%i_mci, " ="
write (u, "(2x)", advance="no")
do i = 1, mci_work%config%n_par
write (u, "(1x,F7.5)", advance="no") mci_work%x(i)
if (i == mci_work%config%n_par_sf) &
write (u, "(1x,'|')", advance="no")
end do
write (u, *)
if (associated (mci_work%mci)) then
call mci_work%mci%write (u, pacify = testflag)
call mci_work%counter%write (u)
end if
end subroutine mci_work_write
@ %def mci_work_write
@ The [[mci]] component may require finalization.
<<Process mci: mci work: TBP>>=
procedure :: final => mci_work_final
<<Process mci: procedures>>=
subroutine mci_work_final (mci_work)
class(mci_work_t), intent(inout) :: mci_work
if (associated (mci_work%mci)) then
call mci_work%mci%final ()
deallocate (mci_work%mci)
end if
end subroutine mci_work_final
@ %def mci_work_final
@ Initialize with the maximum length that we will need. Contents are
not initialized.
The integrator inside the [[mci_entry]] object is responsible for
allocating and initializing its own instance, which is referred to by
a pointer in the [[mci_work]] object.
<<Process mci: mci work: TBP>>=
procedure :: init => mci_work_init
<<Process mci: procedures>>=
subroutine mci_work_init (mci_work, mci_entry)
class(mci_work_t), intent(out) :: mci_work
type(process_mci_entry_t), intent(in), target :: mci_entry
mci_work%config => mci_entry
allocate (mci_work%x (mci_entry%n_par))
if (allocated (mci_entry%mci)) then
call mci_entry%mci%allocate_instance (mci_work%mci)
call mci_work%mci%init (mci_entry%mci)
end if
end subroutine mci_work_init
@ %def mci_work_init
@ Set parameters explicitly, either all at once, or separately for the
structure-function and process parts.
<<Process mci: mci work: TBP>>=
procedure :: set => mci_work_set
procedure :: set_x_strfun => mci_work_set_x_strfun
procedure :: set_x_process => mci_work_set_x_process
<<Process mci: procedures>>=
subroutine mci_work_set (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x = x
end subroutine mci_work_set
subroutine mci_work_set_x_strfun (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x(1 : mci_work%config%n_par_sf) = x
end subroutine mci_work_set_x_strfun
subroutine mci_work_set_x_process (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par) = x
end subroutine mci_work_set_x_process
@ %def mci_work_set
@ %def mci_work_set_x_strfun
@ %def mci_work_set_x_process
@ Return the array of active components, i.e., those that correspond
to the currently selected MC parameter set.
<<Process mci: mci work: TBP>>=
procedure :: get_active_components => mci_work_get_active_components
<<Process mci: procedures>>=
function mci_work_get_active_components (mci_work) result (i_component)
class(mci_work_t), intent(in) :: mci_work
integer, dimension(:), allocatable :: i_component
allocate (i_component (size (mci_work%config%i_component)))
i_component = mci_work%config%i_component
end function mci_work_get_active_components
@ %def mci_work_get_active_components
@ Return the active parameters as a simple array with correct length.
Do this separately for the structure-function parameters and the
process parameters.
<<Process mci: mci work: TBP>>=
procedure :: get_x_strfun => mci_work_get_x_strfun
procedure :: get_x_process => mci_work_get_x_process
<<Process mci: procedures>>=
pure function mci_work_get_x_strfun (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_sf) :: x
x = mci_work%x(1 : mci_work%config%n_par_sf)
end function mci_work_get_x_strfun
pure function mci_work_get_x_process (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_phs) :: x
x = mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par)
end function mci_work_get_x_process
@ %def mci_work_get_x_strfun
@ %def mci_work_get_x_process
@ Initialize and finalize event generation for the specified MCI
entry. This also resets the counter.
<<Process mci: mci work: TBP>>=
procedure :: init_simulation => mci_work_init_simulation
procedure :: final_simulation => mci_work_final_simulation
<<Process mci: procedures>>=
subroutine mci_work_init_simulation (mci_work, safety_factor, keep_failed_events)
class(mci_work_t), intent(inout) :: mci_work
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
call mci_work%mci%init_simulation (safety_factor)
call mci_work%counter%reset ()
if (present (keep_failed_events)) &
mci_work%keep_failed_events = keep_failed_events
end subroutine mci_work_init_simulation
subroutine mci_work_final_simulation (mci_work)
class(mci_work_t), intent(inout) :: mci_work
call mci_work%mci%final_simulation ()
end subroutine mci_work_final_simulation
@ %def mci_work_init_simulation
@ %def mci_work_final_simulation
@ Counter.
<<Process mci: mci work: TBP>>=
procedure :: reset_counter => mci_work_reset_counter
procedure :: record_call => mci_work_record_call
procedure :: get_counter => mci_work_get_counter
<<Process mci: procedures>>=
subroutine mci_work_reset_counter (mci_work)
class(mci_work_t), intent(inout) :: mci_work
call mci_work%counter%reset ()
end subroutine mci_work_reset_counter
subroutine mci_work_record_call (mci_work, status)
class(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: status
call mci_work%counter%record (status)
end subroutine mci_work_record_call
pure function mci_work_get_counter (mci_work) result (counter)
class(mci_work_t), intent(in) :: mci_work
type(process_counter_t) :: counter
counter = mci_work%counter
end function mci_work_get_counter
@ %def mci_work_reset_counter
@ %def mci_work_record_call
@ %def mci_work_get_counter
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process component manager}
<<[[pcm.f90]]>>=
<<File header>>
module pcm
<<Use kinds>>
<<Use strings>>
<<Use debug>>
use constants, only: zero, two
use diagnostics
use lorentz
use io_units, only: free_unit
use os_interface
use process_constants, only: process_constants_t
use physics_defs
use model_data, only: model_data_t
use models, only: model_t
use interactions, only: interaction_t
use quantum_numbers, only: quantum_numbers_t, quantum_numbers_mask_t
use flavors, only: flavor_t
use variables, only: var_list_t
use nlo_data, only: nlo_settings_t
use mci_base, only: mci_t
use phs_base, only: phs_config_t
use mappings, only: mapping_defaults_t
use phs_forests, only: phs_parameters_t
use phs_fks, only: isr_kinematics_t, real_kinematics_t
use phs_fks, only: phs_identifier_t
use dispatch_fks, only: dispatch_fks_s
use fks_regions, only: region_data_t
use nlo_data, only: fks_template_t
use phs_fks, only: phs_fks_generator_t
use phs_fks, only: dalitz_plot_t
use phs_fks, only: phs_fks_config_t, get_filtered_resonance_histories
use dispatch_phase_space, only: dispatch_phs
use process_libraries, only: process_component_def_t
use real_subtraction, only: real_subtraction_t, soft_mismatch_t
use real_subtraction, only: FIXED_ORDER_EVENTS, POWHEG
use real_subtraction, only: real_partition_t, powheg_damping_simple_t
use real_subtraction, only: real_partition_fixed_order_t
use virtual, only: virtual_t
use dglap_remnant, only: dglap_remnant_t
use prc_threshold, only: threshold_def_t
use resonances, only: resonance_history_t, resonance_history_set_t
use nlo_data, only: FKS_DEFAULT, FKS_RESONANCES
use blha_config, only: blha_master_t
use blha_olp_interfaces, only: prc_blha_t
use pcm_base
use process_config
use process_mci, only: process_mci_entry_t
use process_mci, only: REAL_SINGULAR, REAL_FINITE
<<Standard module head>>
<<Pcm: public>>
<<Pcm: types>>
contains
<<Pcm: procedures>>
end module pcm
@ %def pcm
@
\subsection{Default process component manager}
This is the configuration object which has the duty of allocating the
corresponding instance. The default version is trivial.
<<Pcm: public>>=
public :: pcm_default_t
<<Pcm: types>>=
type, extends (pcm_t) :: pcm_default_t
contains
<<Pcm: pcm default: TBP>>
end type pcm_default_t
@ %def pcm_default_t
<<Pcm: pcm default: TBP>>=
procedure :: allocate_instance => pcm_default_allocate_instance
<<Pcm: procedures>>=
subroutine pcm_default_allocate_instance (pcm, instance)
class(pcm_default_t), intent(in) :: pcm
class(pcm_instance_t), intent(inout), allocatable :: instance
allocate (pcm_instance_default_t :: instance)
end subroutine pcm_default_allocate_instance
@ %def pcm_default_allocate_instance
@
Finalizer: apply to core manager.
<<Pcm: pcm default: TBP>>=
procedure :: final => pcm_default_final
<<Pcm: procedures>>=
subroutine pcm_default_final (pcm)
class(pcm_default_t), intent(inout) :: pcm
end subroutine pcm_default_final
@ %def pcm_default_final
@
<<Pcm: pcm default: TBP>>=
procedure :: is_nlo => pcm_default_is_nlo
<<Pcm: procedures>>=
function pcm_default_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_default_t), intent(in) :: pcm
is_nlo = .false.
end function pcm_default_is_nlo
@ %def pcm_default_is_nlo
@
Initialize configuration data, using environment variables.
<<Pcm: pcm default: TBP>>=
procedure :: init => pcm_default_init
<<Pcm: procedures>>=
subroutine pcm_default_init (pcm, env, meta)
class(pcm_default_t), intent(out) :: pcm
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
pcm%has_pdfs = env%has_pdfs ()
call pcm%set_blha_defaults &
(env%has_polarized_beams (), env%get_var_list_ptr ())
pcm%os_data = env%get_os_data ()
end subroutine pcm_default_init
@ %def pcm_default_init
@
<<Pcm: types>>=
type, extends (pcm_instance_t) :: pcm_instance_default_t
contains
<<Pcm: pcm instance default: TBP>>
end type pcm_instance_default_t
@ %def pcm_instance_default_t
@
<<Pcm: pcm instance default: TBP>>=
procedure :: final => pcm_instance_default_final
<<Pcm: procedures>>=
subroutine pcm_instance_default_final (pcm_instance)
class(pcm_instance_default_t), intent(inout) :: pcm_instance
end subroutine pcm_instance_default_final
@ %def pcm_instance_default_final
@
\subsection{Implementations for the default manager}
Categorize components. Nothing to do here, all components are of Born type.
<<Pcm: pcm default: TBP>>=
procedure :: categorize_components => pcm_default_categorize_components
<<Pcm: procedures>>=
subroutine pcm_default_categorize_components (pcm, config)
class(pcm_default_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
end subroutine pcm_default_categorize_components
@ %def pcm_default_categorize_components
@
\subsubsection{Phase-space configuration}
Default setup for tree processes: a single phase-space configuration that is
valid for all components.
<<Pcm: pcm default: TBP>>=
procedure :: init_phs_config => pcm_default_init_phs_config
<<Pcm: procedures>>=
subroutine pcm_default_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
class(pcm_default_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
allocate (phs_entry (1))
allocate (pcm%i_phs_config (pcm%n_components), source=1)
call dispatch_phs (phs_entry(1)%phs_config, &
env%get_var_list_ptr (), &
env%get_os_data (), &
meta%id, &
mapping_defs, phs_par)
end subroutine pcm_default_init_phs_config
@ %def pcm_default_init_phs_config
@
\subsubsection{Core management}
The default component manager assigns one core per component. We allocate and
configure the core objects, using the process-component configuration data.
<<Pcm: pcm default: TBP>>=
procedure :: allocate_cores => pcm_default_allocate_cores
<<Pcm: procedures>>=
subroutine pcm_default_allocate_cores (pcm, config, core_entry)
class(pcm_default_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
type(process_component_def_t), pointer :: component_def
integer :: i
allocate (pcm%i_core (pcm%n_components), source = 0)
pcm%n_cores = pcm%n_components
allocate (core_entry (pcm%n_cores))
do i = 1, pcm%n_cores
pcm%i_core(i) = i
core_entry(i)%i_component = i
component_def => config%process_def%get_component_def_ptr (i)
core_entry(i)%core_def => component_def%get_core_def_ptr ()
core_entry(i)%active = component_def%can_be_integrated ()
end do
end subroutine pcm_default_allocate_cores
@ %def pcm_default_allocate_cores
@ Extra code is required for certain core types (threshold) or if BLHA uses an
external OLP (Born only, this case) for getting its matrix elements.
<<Pcm: pcm default: TBP>>=
procedure :: prepare_any_external_code => &
pcm_default_prepare_any_external_code
<<Pcm: procedures>>=
subroutine pcm_default_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
if (core_entry%active) then
associate (core => core_entry%core)
if (core%needs_external_code ()) then
call core%prepare_external_code &
(core%data%flv_state, &
var_list, pcm%os_data, libname, model, i_core, .false.)
end if
call core%set_equivalent_flv_hel_indices ()
end associate
end if
end subroutine pcm_default_prepare_any_external_code
@ %def pcm_default_prepare_any_external_code
@ Allocate and configure the BLHA record for a specific core, assuming that
the core type requires it. In the default case, this is a Born
configuration.
<<Pcm: pcm default: TBP>>=
procedure :: setup_blha => pcm_default_setup_blha
<<Pcm: procedures>>=
subroutine pcm_default_setup_blha (pcm, core_entry)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
allocate (core_entry%blha_config, source = pcm%blha_defaults)
call core_entry%blha_config%set_born ()
end subroutine pcm_default_setup_blha
@ %def pcm_default_setup_blha
@ Apply the configuration, using [[pcm]] data.
<<Pcm: pcm default: TBP>>=
procedure :: prepare_blha_core => pcm_default_prepare_blha_core
<<Pcm: procedures>>=
subroutine pcm_default_prepare_blha_core (pcm, core_entry, model)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
integer :: n_in
integer :: n_legs
integer :: n_flv
integer :: n_hel
select type (core => core_entry%core)
class is (prc_blha_t)
associate (blha_config => core_entry%blha_config)
n_in = core%data%n_in
n_legs = core%data%get_n_tot ()
n_flv = core%data%n_flv
n_hel = blha_config%get_n_hel (core%data%flv_state (1:n_in,1), model)
call core%init_blha (blha_config, n_in, n_legs, n_flv, n_hel)
call core%init_driver (pcm%os_data)
end associate
end select
end subroutine pcm_default_prepare_blha_core
@ %def pcm_default_prepare_blha_core
@ Read the method settings from the variable list and store them in the BLHA
master. This version: no NLO flag.
<<Pcm: pcm default: TBP>>=
procedure :: set_blha_methods => pcm_default_set_blha_methods
<<Pcm: procedures>>=
subroutine pcm_default_set_blha_methods (pcm, blha_master, var_list)
class(pcm_default_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
call blha_master%set_methods (.false., var_list)
end subroutine pcm_default_set_blha_methods
@ %def pcm_default_set_blha_methods
@ Produce the LO and NLO flavor-state tables (as far as available), as
appropriate for BLHA configuration.
The default version looks at the first process core only, to get the Born
data. (Multiple cores are thus unsupported.) The NLO flavor table is left
unallocated.
<<Pcm: pcm default: TBP>>=
procedure :: get_blha_flv_states => pcm_default_get_blha_flv_states
<<Pcm: procedures>>=
subroutine pcm_default_get_blha_flv_states &
(pcm, core_entry, flv_born, flv_real)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
flv_born = core_entry(1)%core%data%flv_state
end subroutine pcm_default_get_blha_flv_states
@ %def pcm_default_get_blha_flv_states
@ Allocate and configure the MCI (multi-channel integrator) records. There is
one record per active process component. Second procedure: call the MCI
dispatcher with default-setup arguments.
<<Pcm: pcm default: TBP>>=
procedure :: setup_mci => pcm_default_setup_mci
procedure :: call_dispatch_mci => pcm_default_call_dispatch_mci
<<Pcm: procedures>>=
subroutine pcm_default_setup_mci (pcm, mci_entry)
class(pcm_default_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
class(mci_t), allocatable :: mci_template
integer :: i, i_mci
pcm%n_mci = count (pcm%component_active)
allocate (pcm%i_mci (pcm%n_components), source = 0)
i_mci = 0
do i = 1, pcm%n_components
if (pcm%component_active(i)) then
i_mci = i_mci + 1
pcm%i_mci(i) = i_mci
end if
end do
allocate (mci_entry (pcm%n_mci))
end subroutine pcm_default_setup_mci
subroutine pcm_default_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
class(pcm_default_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), allocatable, intent(out) :: mci_template
call dispatch_mci (mci_template, var_list, process_id)
end subroutine pcm_default_call_dispatch_mci
@ %def pcm_default_setup_mci
@ %def pcm_default_call_dispatch_mci
@ Nothing left to do for the default algorithm.
<<Pcm: pcm default: TBP>>=
procedure :: complete_setup => pcm_default_complete_setup
<<Pcm: procedures>>=
subroutine pcm_default_complete_setup (pcm, core_entry, component, model)
class(pcm_default_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
end subroutine pcm_default_complete_setup
@ %def pcm_default_complete_setup
@
\subsubsection{Component management}
Initialize a single component. We require all process-configuration blocks,
and specific templates for the phase-space and integrator configuration.
We also provide the current component index [[i]] and the [[active]] flag.
In the default mode, all components are marked as master components.
<<Pcm: pcm default: TBP>>=
procedure :: init_component => pcm_default_init_component
<<Pcm: procedures>>=
subroutine pcm_default_init_component &
(pcm, component, i, active, &
phs_config, env, meta, config)
class(pcm_default_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
call component%init (i, &
env, meta, config, &
active, &
phs_config)
component%component_type = COMP_MASTER
end subroutine pcm_default_init_component
@ %def pcm_default_init_component
@
\subsection{NLO process component manager}
The NLO-aware version of the process-component manager.
This is the configuration object, which has the duty of allocating the
corresponding instance. This is the nontrivial NLO version.
<<Pcm: public>>=
public :: pcm_nlo_t
<<Pcm: types>>=
type, extends (pcm_t) :: pcm_nlo_t
type(string_t) :: id
logical :: combined_integration = .false.
logical :: vis_fks_regions = .false.
integer, dimension(:), allocatable :: nlo_type
integer, dimension(:), allocatable :: nlo_type_core
integer, dimension(:), allocatable :: component_type
integer :: i_born = 0
integer :: i_real = 0
integer :: i_sub = 0
type(nlo_settings_t) :: settings
type(region_data_t) :: region_data
logical :: use_real_partition = .false.
real(default) :: real_partition_scale = 0
class(real_partition_t), allocatable :: real_partition
type(dalitz_plot_t) :: dalitz_plot
type(quantum_numbers_t), dimension(:,:), allocatable :: qn_real, qn_born
contains
<<Pcm: pcm nlo: TBP>>
end type pcm_nlo_t
@ %def pcm_nlo_t
@
Initialize configuration data, using environment variables.
<<Pcm: pcm nlo: TBP>>=
procedure :: init => pcm_nlo_init
<<Pcm: procedures>>=
subroutine pcm_nlo_init (pcm, env, meta)
class(pcm_nlo_t), intent(out) :: pcm
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(var_list_t), pointer :: var_list
type(fks_template_t) :: fks_template
pcm%id = meta%id
pcm%has_pdfs = env%has_pdfs ()
var_list => env%get_var_list_ptr ()
call dispatch_fks_s (fks_template, var_list)
call pcm%settings%init (var_list, fks_template)
pcm%combined_integration = &
var_list%get_lval (var_str ('?combined_nlo_integration'))
pcm%use_real_partition = &
var_list%get_lval (var_str ("?nlo_use_real_partition"))
pcm%real_partition_scale = &
var_list%get_rval (var_str ("real_partition_scale"))
pcm%vis_fks_regions = &
var_list%get_lval (var_str ("?vis_fks_regions"))
call pcm%set_blha_defaults &
(env%has_polarized_beams (), env%get_var_list_ptr ())
pcm%os_data = env%get_os_data ()
end subroutine pcm_nlo_init
@ %def pcm_nlo_init
@ Init/rewrite NLO settings without the FKS template.
<<Pcm: pcm nlo: TBP>>=
procedure :: init_nlo_settings => pcm_nlo_init_nlo_settings
<<Pcm: procedures>>=
subroutine pcm_nlo_init_nlo_settings (pcm, var_list)
class(pcm_nlo_t), intent(inout) :: pcm
type(var_list_t), intent(in), target :: var_list
call pcm%settings%init (var_list)
end subroutine pcm_nlo_init_nlo_settings
@ %def pcm_nlo_init_nlo_settings
@
As appropriate for the NLO/FKS algorithm, the category defined by the
process, is called [[nlo_type]]. We refine this by setting the component
category [[component_type]] separately.
The component types [[COMP_MISMATCH]], [[COMP_PDF]], [[COMP_SUB]] are set only
if the algorithm uses combined integration. Otherwise, they are set to
[[COMP_DEFAULT]].
The component type [[COMP_REAL]] is further distinguished between
[[COMP_REAL_SING]] or [[COMP_REAL_FIN]], if the algorithm uses real
partitions. The former acts as a reference component for the latter, and we
always assume that it is the first real component.
Each component is assigned its own core. Exceptions: the finite-real
component gets the same core as the singular-real component. The mismatch
component gets the same core as the subtraction component.
TODO wk 2018: this convention for real components can be improved. Check whether
all component types should be assigned, not just for combined
integration.
<<Pcm: pcm nlo: TBP>>=
procedure :: categorize_components => pcm_nlo_categorize_components
<<Pcm: procedures>>=
subroutine pcm_nlo_categorize_components (pcm, config)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(process_component_def_t), pointer :: component_def
integer :: i
allocate (pcm%nlo_type (pcm%n_components), source = COMPONENT_UNDEFINED)
allocate (pcm%component_type (pcm%n_components), source = COMP_DEFAULT)
do i = 1, pcm%n_components
component_def => config%process_def%get_component_def_ptr (i)
pcm%nlo_type(i) = component_def%get_nlo_type ()
if (pcm%combined_integration) then
select case (pcm%nlo_type(i))
case (BORN)
pcm%i_born = i
pcm%component_type(i) = COMP_MASTER
case (NLO_REAL)
pcm%component_type(i) = COMP_REAL
case (NLO_VIRTUAL)
pcm%component_type(i) = COMP_VIRT
case (NLO_MISMATCH)
pcm%component_type(i) = COMP_MISMATCH
case (NLO_DGLAP)
pcm%component_type(i) = COMP_PDF
case (NLO_SUBTRACTION)
pcm%component_type(i) = COMP_SUB
pcm%i_sub = i
end select
else
select case (pcm%nlo_type(i))
case (BORN)
pcm%i_born = i
pcm%component_type(i) = COMP_MASTER
case (NLO_REAL)
pcm%component_type(i) = COMP_REAL
case (NLO_VIRTUAL)
pcm%component_type(i) = COMP_VIRT
case (NLO_MISMATCH)
pcm%component_type(i) = COMP_MISMATCH
case (NLO_SUBTRACTION)
pcm%i_sub = i
end select
end if
end do
call refine_real_type ( &
pack ([(i, i=1, pcm%n_components)], &
pcm%component_type==COMP_REAL))
contains
subroutine refine_real_type (i_real)
integer, dimension(:), intent(in) :: i_real
pcm%i_real = i_real(1)
if (pcm%use_real_partition) then
pcm%component_type (i_real(1)) = COMP_REAL_SING
pcm%component_type (i_real(2:)) = COMP_REAL_FIN
end if
end subroutine refine_real_type
end subroutine pcm_nlo_categorize_components
@ %def pcm_nlo_categorize_components
@
\subsubsection{Phase-space initial configuration}
Setup for the NLO/PHS processes: two phase-space configurations, (1)
Born/wood, (2) real correction/FKS. All components use either one of these
two configurations.
TODO wk 2018: The [[first_real_component]] identifier is really ugly. Nothing should
rely on the ordering.
<<Pcm: pcm nlo: TBP>>=
procedure :: init_phs_config => pcm_nlo_init_phs_config
<<Pcm: procedures>>=
subroutine pcm_nlo_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
integer :: i
logical :: first_real_component
allocate (phs_entry (2))
call dispatch_phs (phs_entry(1)%phs_config, &
env%get_var_list_ptr (), &
env%get_os_data (), &
meta%id, &
mapping_defs, phs_par, &
var_str ("wood"))
call dispatch_phs (phs_entry(2)%phs_config, &
env%get_var_list_ptr (), &
env%get_os_data (), &
meta%id, &
mapping_defs, phs_par, &
var_str ("fks"))
allocate (pcm%i_phs_config (pcm%n_components), source=0)
first_real_component = .true.
do i = 1, pcm%n_components
select case (pcm%nlo_type(i))
case (BORN, NLO_VIRTUAL, NLO_SUBTRACTION)
pcm%i_phs_config(i) = 1
case (NLO_REAL)
if (first_real_component) then
pcm%i_phs_config(i) = 2
if (pcm%use_real_partition) first_real_component = .false.
else
pcm%i_phs_config(i) = 1
end if
case (NLO_MISMATCH, NLO_DGLAP, GKS)
pcm%i_phs_config(i) = 2
end select
end do
end subroutine pcm_nlo_init_phs_config
@ %def pcm_nlo_init_phs_config
@
\subsubsection{Core management}
Allocate the core (matrix-element interface) objects that we will need for
evaluation. Every component gets an associated core, except for the
real-finite and mismatch components (if any). Those components are associated
with their previous corresponding real-singular and subtraction cores,
respectively.
After cores are allocated, configure the region-data block that is maintained
by the NLO process-component manager.
<<Pcm: pcm nlo: TBP>>=
procedure :: allocate_cores => pcm_nlo_allocate_cores
<<Pcm: procedures>>=
subroutine pcm_nlo_allocate_cores (pcm, config, core_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
type(process_component_def_t), pointer :: component_def
integer :: i, i_core
allocate (pcm%i_core (pcm%n_components), source = 0)
pcm%n_cores = pcm%n_components &
- count (pcm%component_type(:) == COMP_REAL_FIN) &
- count (pcm%component_type(:) == COMP_MISMATCH)
allocate (core_entry (pcm%n_cores))
allocate (pcm%nlo_type_core (pcm%n_cores), source = BORN)
i_core = 0
do i = 1, pcm%n_components
select case (pcm%component_type(i))
case default
i_core = i_core + 1
pcm%i_core(i) = i_core
pcm%nlo_type_core(i_core) = pcm%nlo_type(i)
core_entry(i_core)%i_component = i
component_def => config%process_def%get_component_def_ptr (i)
core_entry(i_core)%core_def => component_def%get_core_def_ptr ()
select case (pcm%nlo_type(i))
case default
core_entry(i)%active = component_def%can_be_integrated ()
case (NLO_REAL, NLO_SUBTRACTION)
core_entry(i)%active = .true.
end select
case (COMP_REAL_FIN)
pcm%i_core(i) = pcm%i_core(pcm%i_real)
case (COMP_MISMATCH)
pcm%i_core(i) = pcm%i_core(pcm%i_sub)
end select
end do
end subroutine pcm_nlo_allocate_cores
@ %def pcm_nlo_allocate_cores
@ Extra code is required for certain core types (threshold) or if BLHA uses an
external OLP for getting its matrix elements. OMega matrix elements, by
definition, do not need extra code. NLO-virtual or subtraction
matrix elements always need extra code.
More precisely: for the Born and virtual matrix element, the extra code is
accessed only if the component is active. The radiation (real) and the
subtraction corrections (singular and finite), extra code is accessed in any
case.
The flavor state is taken from the [[region_data]] table in the [[pcm]]
record. We use the Born and real flavor-state tables as appropriate.
<<Pcm: pcm nlo: TBP>>=
procedure :: prepare_any_external_code => &
pcm_nlo_prepare_any_external_code
<<Pcm: procedures>>=
subroutine pcm_nlo_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
integer, dimension(:,:), allocatable :: flv_born, flv_real
integer :: i
call pcm%region_data%get_all_flv_states (flv_born, flv_real)
if (core_entry%active) then
associate (core => core_entry%core)
if (core%needs_external_code ()) then
select case (pcm%nlo_type (core_entry%i_component))
case default
call core%data%set_flv_state (flv_born)
case (NLO_REAL)
call core%data%set_flv_state (flv_real)
end select
call core%prepare_external_code &
(core%data%flv_state, &
var_list, pcm%os_data, libname, model, i_core, .true.)
end if
call core%set_equivalent_flv_hel_indices ()
end associate
end if
end subroutine pcm_nlo_prepare_any_external_code
@ %def pcm_nlo_prepare_any_external_code
@ Allocate and configure the BLHA record for a specific core, assuming that
the core type requires it. The configuration depends on the NLO type of the
core.
<<Pcm: pcm nlo: TBP>>=
procedure :: setup_blha => pcm_nlo_setup_blha
<<Pcm: procedures>>=
subroutine pcm_nlo_setup_blha (pcm, core_entry)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
allocate (core_entry%blha_config, source = pcm%blha_defaults)
select case (pcm%nlo_type(core_entry%i_component))
case (BORN)
call core_entry%blha_config%set_born ()
case (NLO_REAL)
call core_entry%blha_config%set_real_trees ()
case (NLO_VIRTUAL)
call core_entry%blha_config%set_loop ()
case (NLO_SUBTRACTION)
call core_entry%blha_config%set_subtraction ()
call core_entry%blha_config%set_internal_color_correlations ()
case (NLO_DGLAP)
call core_entry%blha_config%set_dglap ()
end select
end subroutine pcm_nlo_setup_blha
@ %def pcm_nlo_setup_blha
@ After phase-space configuration data and core entries are available, we fill
tables and compute the remaining NLO data that will steer the integration
and subtraction algorithm.
There are three parts: recognize a threshold-type process core (if it exists),
prepare the region-data tables (always), and prepare for real partitioning (if
requested).
The real-component phase space acts as the source for resonance-history
information, required for the region data.
<<Pcm: pcm nlo: TBP>>=
procedure :: complete_setup => pcm_nlo_complete_setup
<<Pcm: procedures>>=
subroutine pcm_nlo_complete_setup (pcm, core_entry, component, model)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
integer :: i
call pcm%handle_threshold_core (core_entry)
call pcm%setup_region_data &
(core_entry, component(pcm%i_real)%phs_config, model)
call pcm%setup_real_partition ()
end subroutine pcm_nlo_complete_setup
@ %def pcm_nlo_complete_setup
@ Apply the BLHA configuration to a core object, using the region data from
[[pcm]] for determining the particle content.
<<Pcm: pcm nlo: TBP>>=
procedure :: prepare_blha_core => pcm_nlo_prepare_blha_core
<<Pcm: procedures>>=
subroutine pcm_nlo_prepare_blha_core (pcm, core_entry, model)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
integer :: n_in
integer :: n_legs
integer :: n_flv
integer :: n_hel
select type (core => core_entry%core)
class is (prc_blha_t)
associate (blha_config => core_entry%blha_config)
n_in = core%data%n_in
select case (pcm%nlo_type(core_entry%i_component))
case (NLO_REAL)
n_legs = pcm%region_data%get_n_legs_real ()
n_flv = pcm%region_data%get_n_flv_real ()
case default
n_legs = pcm%region_data%get_n_legs_born ()
n_flv = pcm%region_data%get_n_flv_born ()
end select
n_hel = blha_config%get_n_hel (core%data%flv_state (1:n_in,1), model)
call core%init_blha (blha_config, n_in, n_legs, n_flv, n_hel)
call core%init_driver (pcm%os_data)
end associate
end select
end subroutine pcm_nlo_prepare_blha_core
@ %def pcm_nlo_prepare_blha_core
@ Read the method settings from the variable list and store them in the BLHA
master. This version: NLO flag set.
<<Pcm: pcm nlo: TBP>>=
procedure :: set_blha_methods => pcm_nlo_set_blha_methods
<<Pcm: procedures>>=
subroutine pcm_nlo_set_blha_methods (pcm, blha_master, var_list)
class(pcm_nlo_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
call blha_master%set_methods (.true., var_list)
call pcm%blha_defaults%set_loop_method (blha_master)
end subroutine pcm_nlo_set_blha_methods
@ %def pcm_nlo_set_blha_methods
@ Produce the LO and NLO flavor-state tables (as far as available), as
appropriate for BLHA configuration.
The NLO version copies the tables from the region data inside [[pcm]]. The
core array is not needed.
<<Pcm: pcm nlo: TBP>>=
procedure :: get_blha_flv_states => pcm_nlo_get_blha_flv_states
<<Pcm: procedures>>=
subroutine pcm_nlo_get_blha_flv_states &
(pcm, core_entry, flv_born, flv_real)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
call pcm%region_data%get_all_flv_states (flv_born, flv_real)
end subroutine pcm_nlo_get_blha_flv_states
@ %def pcm_nlo_get_blha_flv_states
@ Allocate and configure the MCI (multi-channel integrator) records. The
relation depends on the [[combined_integration]] setting. If we integrate
components separately, each component gets its own record, except for the
subtraction component. If we do the combination, there is one record for
the master (Born) component and a second one for the real-finite component, if
present.
Each entry acquires some NLO-specific initialization. Generic configuration
follows later.
Second procedure: call the MCI dispatcher with NLO-setup arguments.
<<Pcm: pcm nlo: TBP>>=
procedure :: setup_mci => pcm_nlo_setup_mci
procedure :: call_dispatch_mci => pcm_nlo_call_dispatch_mci
<<Pcm: procedures>>=
subroutine pcm_nlo_setup_mci (pcm, mci_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
class(mci_t), allocatable :: mci_template
integer :: i, i_mci
if (pcm%combined_integration) then
pcm%n_mci = 1 &
+ count (pcm%component_active(:) &
& .and. pcm%component_type(:) == COMP_REAL_FIN)
allocate (pcm%i_mci (pcm%n_components), source = 0)
do i = 1, pcm%n_components
if (pcm%component_active(i)) then
select case (pcm%component_type(i))
case (COMP_MASTER)
pcm%i_mci(i) = 1
case (COMP_REAL_FIN)
pcm%i_mci(i) = 2
end select
end if
end do
else
pcm%n_mci = count (pcm%component_active(:) &
& .and. pcm%nlo_type(:) /= NLO_SUBTRACTION)
allocate (pcm%i_mci (pcm%n_components), source = 0)
i_mci = 0
do i = 1, pcm%n_components
if (pcm%component_active(i)) then
select case (pcm%nlo_type(i))
case default
i_mci = i_mci + 1
pcm%i_mci(i) = i_mci
case (NLO_SUBTRACTION)
end select
end if
end do
end if
allocate (mci_entry (pcm%n_mci))
mci_entry(:)%combined_integration = pcm%combined_integration
if (pcm%use_real_partition) then
do i = 1, pcm%n_components
i_mci = pcm%i_mci(i)
if (i_mci > 0) then
select case (pcm%component_type(i))
case (COMP_REAL_FIN)
mci_entry(i_mci)%real_partition_type = REAL_FINITE
case default
mci_entry(i_mci)%real_partition_type = REAL_SINGULAR
end select
end if
end do
end if
end subroutine pcm_nlo_setup_mci
subroutine pcm_nlo_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
class(pcm_nlo_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), allocatable, intent(out) :: mci_template
call dispatch_mci (mci_template, var_list, process_id, is_nlo = .true.)
end subroutine pcm_nlo_call_dispatch_mci
@ %def pcm_nlo_setup_mci
@ %def pcm_nlo_call_dispatch_mci
@ Check for a threshold core and adjust the configuration accordingly, before
singular region data are considered.
<<Pcm: pcm nlo: TBP>>=
procedure :: handle_threshold_core => pcm_nlo_handle_threshold_core
<<Pcm: procedures>>=
subroutine pcm_nlo_handle_threshold_core (pcm, core_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer :: i
do i = 1, size (core_entry)
select type (core => core_entry(i)%core_def)
type is (threshold_def_t)
pcm%settings%factorization_mode = FACTORIZATION_THRESHOLD
return
end select
end do
end subroutine pcm_nlo_handle_threshold_core
@ %def pcm_nlo_handle_threshold_core
@ Configure the singular-region tables based on the process data for the Born
and Real (singular) cores, using also the appropriate FKS phase-space
configuration object.
In passing, we may create a table of resonance histories that are relevant for
the singular-region configuration.
TODO wk 2018: check whether [[phs_entry]] needs to be intent(inout).
<<Pcm: pcm nlo: TBP>>=
procedure :: setup_region_data => pcm_nlo_setup_region_data
<<Pcm: procedures>>=
subroutine pcm_nlo_setup_region_data (pcm, core_entry, phs_config, model)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
class(phs_config_t), intent(inout) :: phs_config
type(model_t), intent(in), target :: model
type(process_constants_t) :: data_born, data_real
integer, dimension (:,:), allocatable :: flavor_born, flavor_real
type(resonance_history_t), dimension(:), allocatable :: resonance_histories
type(var_list_t), pointer :: var_list
logical :: success
data_born = core_entry(pcm%i_core(pcm%i_born))%core%data
data_real = core_entry(pcm%i_core(pcm%i_real))%core%data
call data_born%get_flv_state (flavor_born)
call data_real%get_flv_state (flavor_real)
call pcm%region_data%init &
(data_born%n_in, model, flavor_born, flavor_real, &
pcm%settings%nlo_correction_type)
associate (template => pcm%settings%fks_template)
if (template%mapping_type == FKS_RESONANCES) then
select type (phs_config)
type is (phs_fks_config_t)
call get_filtered_resonance_histories (phs_config, &
data_born%n_in, flavor_born, model, &
template%excluded_resonances, &
resonance_histories, success)
end select
if (.not. success) template%mapping_type = FKS_DEFAULT
end if
call pcm%region_data%setup_fks_mappings (template, data_born%n_in)
!!! Check again, mapping_type might have changed
if (template%mapping_type == FKS_RESONANCES) then
call pcm%region_data%set_resonance_mappings (resonance_histories)
call pcm%region_data%init_resonance_information ()
pcm%settings%use_resonance_mappings = .true.
end if
end associate
if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
call pcm%region_data%set_isr_pseudo_regions ()
call pcm%region_data%split_up_interference_regions_for_threshold ()
end if
call pcm%region_data%compute_number_of_phase_spaces ()
call pcm%region_data%set_i_phs_to_i_con ()
call pcm%region_data%write_to_file &
(pcm%id, pcm%vis_fks_regions, pcm%os_data)
if (debug_active (D_SUBTRACTION)) &
call pcm%region_data%check_consistency (.true.)
end subroutine pcm_nlo_setup_region_data
@ %def pcm_nlo_setup_region_data
@ After region data are set up, we allocate and configure the
[[real_partition]] objects, if requested.
<<Pcm: pcm nlo: TBP>>=
procedure :: setup_real_partition => pcm_nlo_setup_real_partition
<<Pcm: procedures>>=
subroutine pcm_nlo_setup_real_partition (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (pcm%use_real_partition) then
if (.not. allocated (pcm%real_partition)) then
allocate (real_partition_fixed_order_t :: pcm%real_partition)
select type (partition => pcm%real_partition)
type is (real_partition_fixed_order_t)
call pcm%region_data%get_all_ftuples (partition%fks_pairs)
partition%scale = pcm%real_partition_scale
end select
end if
end if
end subroutine pcm_nlo_setup_real_partition
@ %def pcm_nlo_setup_real_partition
@
Initialize a single component. We require all process-configuration blocks,
and specific templates for the phase-space and integrator configuration.
We also provide the current component index [[i]] and the [[active]] flag.
For a subtraction component, the [[active]] flag is overridden.
In the nlo mode, the component types have been determined before.
TODO wk 2018: the component type need not be stored in the component; we may remove
this when everything is controlled by [[pcm]].
<<Pcm: pcm nlo: TBP>>=
procedure :: init_component => pcm_nlo_init_component
<<Pcm: procedures>>=
subroutine pcm_nlo_init_component &
(pcm, component, i, active, &
phs_config, env, meta, config)
class(pcm_nlo_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
logical :: activate
select case (pcm%nlo_type(i))
case default; activate = active
case (NLO_SUBTRACTION); activate = .false.
end select
call component%init (i, &
env, meta, config, &
activate, &
phs_config)
component%component_type = pcm%component_type(i)
end subroutine pcm_nlo_init_component
@ %def pcm_nlo_init_component
@
Override the base method: record the active components in the PCM object, and
report inactive components (except for the subtraction component).
<<Pcm: pcm nlo: TBP>>=
procedure :: record_inactive_components => pcm_nlo_record_inactive_components
<<Pcm: procedures>>=
subroutine pcm_nlo_record_inactive_components (pcm, component, meta)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_component_t), dimension(:), intent(in) :: component
type(process_metadata_t), intent(inout) :: meta
integer :: i
pcm%component_active = component%active
do i = 1, pcm%n_components
select case (pcm%nlo_type(i))
case (NLO_SUBTRACTION)
case default
if (.not. component(i)%active) call meta%deactivate_component (i)
end select
end do
end subroutine pcm_nlo_record_inactive_components
@ %def pcm_nlo_record_inactive_components
@
<<Pcm: pcm nlo: TBP>>=
procedure :: core_is_radiation => pcm_nlo_core_is_radiation
<<Pcm: procedures>>=
function pcm_nlo_core_is_radiation (pcm, i_core) result (is_rad)
logical :: is_rad
class(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_core
is_rad = pcm%nlo_type(i_core) == NLO_REAL ! .and. .not. pcm%cm%sub(i_core)
end function pcm_nlo_core_is_radiation
@ %def pcm_nlo_core_is_radiation
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_n_flv_born => pcm_nlo_get_n_flv_born
<<Pcm: procedures>>=
function pcm_nlo_get_n_flv_born (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
n_flv = pcm_nlo%region_data%n_flv_born
end function pcm_nlo_get_n_flv_born
@ %def pcm_nlo_get_n_flv_born
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_n_flv_real => pcm_nlo_get_n_flv_real
<<Pcm: procedures>>=
function pcm_nlo_get_n_flv_real (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
n_flv = pcm_nlo%region_data%n_flv_real
end function pcm_nlo_get_n_flv_real
@ %def pcm_nlo_get_n_flv_real
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_n_alr => pcm_nlo_get_n_alr
<<Pcm: procedures>>=
function pcm_nlo_get_n_alr (pcm) result (n_alr)
integer :: n_alr
class(pcm_nlo_t), intent(in) :: pcm
n_alr = pcm%region_data%n_regions
end function pcm_nlo_get_n_alr
@ %def pcm_nlo_get_n_alr
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_flv_states => pcm_nlo_get_flv_states
<<Pcm: procedures>>=
function pcm_nlo_get_flv_states (pcm, born) result (flv)
integer, dimension(:,:), allocatable :: flv
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
if (born) then
flv = pcm%region_data%get_flv_states_born ()
else
flv = pcm%region_data%get_flv_states_real ()
end if
end function pcm_nlo_get_flv_states
@ %def pcm_nlo_get_flv_states
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_qn => pcm_nlo_get_qn
<<Pcm: procedures>>=
function pcm_nlo_get_qn (pcm, born) result (qn)
type(quantum_numbers_t), dimension(:,:), allocatable :: qn
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
if (born) then
qn = pcm%qn_born
else
qn = pcm%qn_real
end if
end function pcm_nlo_get_qn
@ %def pcm_nlo_get_qn
@ Check if there are massive emitters. Since the mass-structure of all
underlying Born configurations have to be the same (\textbf{This does
not have to be the case when different components are generated at LO})
, we just use the first one to determine this.
<<Pcm: pcm nlo: TBP>>=
procedure :: has_massive_emitter => pcm_nlo_has_massive_emitter
<<Pcm: procedures>>=
function pcm_nlo_has_massive_emitter (pcm) result (val)
logical :: val
class(pcm_nlo_t), intent(in) :: pcm
integer :: i
val = .false.
associate (reg_data => pcm%region_data)
do i = reg_data%n_in + 1, reg_data%n_legs_born
if (any (i == reg_data%emitters)) &
val = val .or. reg_data%flv_born(1)%massive(i)
end do
end associate
end function pcm_nlo_has_massive_emitter
@ %def pcm_nlo_has_massive_emitter
@ Returns an array which specifies if the particle at position [[i]] is massive.
<<Pcm: pcm nlo: TBP>>=
procedure :: get_mass_info => pcm_nlo_get_mass_info
<<Pcm: procedures>>=
function pcm_nlo_get_mass_info (pcm, i_flv) result (massive)
class(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
logical, dimension(:), allocatable :: massive
allocate (massive (size (pcm%region_data%flv_born(i_flv)%massive)))
massive = pcm%region_data%flv_born(i_flv)%massive
end function pcm_nlo_get_mass_info
@ %def pcm_nlo_get_mass_info
@
<<Pcm: pcm nlo: TBP>>=
procedure :: allocate_instance => pcm_nlo_allocate_instance
<<Pcm: procedures>>=
subroutine pcm_nlo_allocate_instance (pcm, instance)
class(pcm_nlo_t), intent(in) :: pcm
class(pcm_instance_t), intent(inout), allocatable :: instance
allocate (pcm_instance_nlo_t :: instance)
end subroutine pcm_nlo_allocate_instance
@ %def pcm_nlo_allocate_instance
@
<<Pcm: pcm nlo: TBP>>=
procedure :: init_qn => pcm_nlo_init_qn
<<Pcm: procedures>>=
subroutine pcm_nlo_init_qn (pcm, model)
class(pcm_nlo_t), intent(inout) :: pcm
class(model_data_t), intent(in) :: model
integer, dimension(:,:), allocatable :: flv_states
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
type(quantum_numbers_t), dimension(:), allocatable :: qn
allocate (flv_states (pcm%region_data%n_legs_born, pcm%region_data%n_flv_born))
flv_states = pcm%get_flv_states (.true.)
allocate (pcm%qn_born (size (flv_states, dim = 1), size (flv_states, dim = 2)))
allocate (flv (size (flv_states, dim = 1)))
allocate (qn (size (flv_states, dim = 1)))
do i = 1, pcm%get_n_flv_born ()
call flv%init (flv_states (:,i), model)
call qn%init (flv)
pcm%qn_born(:,i) = qn
end do
deallocate (flv); deallocate (qn)
deallocate (flv_states)
allocate (flv_states (pcm%region_data%n_legs_real, pcm%region_data%n_flv_real))
flv_states = pcm%get_flv_states (.false.)
allocate (pcm%qn_real (size (flv_states, dim = 1), size (flv_states, dim = 2)))
allocate (flv (size (flv_states, dim = 1)))
allocate (qn (size (flv_states, dim = 1)))
do i = 1, pcm%get_n_flv_real ()
call flv%init (flv_states (:,i), model)
call qn%init (flv)
pcm%qn_real(:,i) = qn
end do
end subroutine pcm_nlo_init_qn
@ %def pcm_nlo_init_qn
@
<<Pcm: pcm nlo: TBP>>=
procedure :: allocate_ps_matching => pcm_nlo_allocate_ps_matching
<<Pcm: procedures>>=
subroutine pcm_nlo_allocate_ps_matching (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (.not. allocated (pcm%real_partition)) then
allocate (powheg_damping_simple_t :: pcm%real_partition)
end if
end subroutine pcm_nlo_allocate_ps_matching
@ %def pcm_nlo_allocate_ps_matching
@
<<Pcm: pcm nlo: TBP>>=
procedure :: activate_dalitz_plot => pcm_nlo_activate_dalitz_plot
<<Pcm: procedures>>=
subroutine pcm_nlo_activate_dalitz_plot (pcm, filename)
class(pcm_nlo_t), intent(inout) :: pcm
type(string_t), intent(in) :: filename
call pcm%dalitz_plot%init (free_unit (), filename, .false.)
call pcm%dalitz_plot%write_header ()
end subroutine pcm_nlo_activate_dalitz_plot
@ %def pcm_nlo_activate_dalitz_plot
@
<<Pcm: pcm nlo: TBP>>=
procedure :: register_dalitz_plot => pcm_nlo_register_dalitz_plot
<<Pcm: procedures>>=
subroutine pcm_nlo_register_dalitz_plot (pcm, emitter, p)
class(pcm_nlo_t), intent(inout) :: pcm
integer, intent(in) :: emitter
type(vector4_t), intent(in), dimension(:) :: p
real(default) :: k0_n, k0_np1
k0_n = p(emitter)%p(0)
k0_np1 = p(size(p))%p(0)
call pcm%dalitz_plot%register (k0_n, k0_np1)
end subroutine pcm_nlo_register_dalitz_plot
@ %def pcm_nlo_register_dalitz_plot
@
<<Pcm: pcm nlo: TBP>>=
procedure :: setup_phs_generator => pcm_nlo_setup_phs_generator
<<Pcm: procedures>>=
subroutine pcm_nlo_setup_phs_generator (pcm, pcm_instance, generator, &
sqrts, mode, singular_jacobian)
class(pcm_nlo_t), intent(in) :: pcm
type(phs_fks_generator_t), intent(inout) :: generator
type(pcm_instance_nlo_t), intent(in), target :: pcm_instance
real(default), intent(in) :: sqrts
integer, intent(in), optional:: mode
logical, intent(in), optional :: singular_jacobian
logical :: yorn
yorn = .false.; if (present (singular_jacobian)) yorn = singular_jacobian
call generator%connect_kinematics (pcm_instance%isr_kinematics, &
pcm_instance%real_kinematics, pcm%has_massive_emitter ())
generator%n_in = pcm%region_data%n_in
call generator%set_sqrts_hat (sqrts)
call generator%set_emitters (pcm%region_data%emitters)
call generator%setup_masses (pcm%region_data%n_legs_born)
generator%is_massive = pcm%get_mass_info (1)
generator%singular_jacobian = yorn
if (present (mode)) generator%mode = mode
call generator%set_xi_and_y_bounds (pcm%settings%fks_template%xi_min, &
pcm%settings%fks_template%y_max)
end subroutine pcm_nlo_setup_phs_generator
@ %def pcm_nlo_setup_phs_generator
@
<<Pcm: pcm nlo: TBP>>=
procedure :: final => pcm_nlo_final
<<Pcm: procedures>>=
subroutine pcm_nlo_final (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (allocated (pcm%real_partition)) deallocate (pcm%real_partition)
call pcm%dalitz_plot%final ()
end subroutine pcm_nlo_final
@ %def pcm_nlo_final
@
<<Pcm: pcm nlo: TBP>>=
procedure :: is_nlo => pcm_nlo_is_nlo
<<Pcm: procedures>>=
function pcm_nlo_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_nlo_t), intent(in) :: pcm
is_nlo = .true.
end function pcm_nlo_is_nlo
@ %def pcm_nlo_is_nlo
@ As a first implementation, it acts as a wrapper for the NLO controller
object and the squared matrix-element collector.
<<Pcm: public>>=
public :: pcm_instance_nlo_t
<<Pcm: types>>=
type, extends (pcm_instance_t) :: pcm_instance_nlo_t
logical :: use_internal_color_correlation = .true.
type(real_kinematics_t), pointer :: real_kinematics => null ()
type(isr_kinematics_t), pointer :: isr_kinematics => null ()
type(real_subtraction_t) :: real_sub
type(virtual_t) :: virtual
type(soft_mismatch_t) :: soft_mismatch
type(dglap_remnant_t) :: dglap_remnant
integer, dimension(:), allocatable :: i_mci_to_real_component
contains
<<Pcm: pcm instance: TBP>>
end type pcm_instance_nlo_t
@ %def pcm_instance_nlo_t
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_radiation_event => pcm_instance_nlo_set_radiation_event
procedure :: set_subtraction_event => pcm_instance_nlo_set_subtraction_event
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_radiation_event (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%radiation_event = .true.
pcm_instance%real_sub%subtraction_event = .false.
end subroutine pcm_instance_nlo_set_radiation_event
subroutine pcm_instance_nlo_set_subtraction_event (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%radiation_event = .false.
pcm_instance%real_sub%subtraction_event = .true.
end subroutine pcm_instance_nlo_set_subtraction_event
@ %def pcm_instance_nlo_set_radiation_event
@ %def pcm_instance_nlo_set_subtraction_event
<<Pcm: pcm instance: TBP>>=
procedure :: disable_subtraction => pcm_instance_nlo_disable_subtraction
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_disable_subtraction (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%subtraction_deactivated = .true.
end subroutine pcm_instance_nlo_disable_subtraction
@ %def pcm_instance_nlo_disable_subtraction
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_config => pcm_instance_nlo_init_config
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_config (pcm_instance, active_components, &
nlo_types, sqrts, i_real_fin, model)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
logical, intent(in), dimension(:) :: active_components
integer, intent(in), dimension(:) :: nlo_types
real(default), intent(in) :: sqrts
integer, intent(in) :: i_real_fin
class(model_data_t), intent(in) :: model
integer :: i_component
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "pcm_instance_nlo_init_config")
call pcm_instance%init_real_and_isr_kinematics (sqrts)
select type (pcm => pcm_instance%config)
type is (pcm_nlo_t)
do i_component = 1, size (active_components)
if (active_components(i_component) .or. pcm%settings%combined_integration) then
select case (nlo_types(i_component))
case (NLO_REAL)
if (i_component /= i_real_fin) then
call pcm_instance%setup_real_component &
(pcm%settings%fks_template%subtraction_disabled)
end if
case (NLO_VIRTUAL)
call pcm_instance%init_virtual (model)
case (NLO_MISMATCH)
call pcm_instance%init_soft_mismatch ()
case (NLO_DGLAP)
call pcm_instance%init_dglap_remnant ()
end select
end if
end do
end select
end subroutine pcm_instance_nlo_init_config
@ %def pcm_instance_nlo_init_config
@
<<Pcm: pcm instance: TBP>>=
procedure :: setup_real_component => pcm_instance_nlo_setup_real_component
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_setup_real_component (pcm_instance, &
subtraction_disabled)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
logical, intent(in) :: subtraction_disabled
call pcm_instance%init_real_subtraction ()
if (subtraction_disabled) call pcm_instance%disable_subtraction ()
end subroutine pcm_instance_nlo_setup_real_component
@ %def pcm_instance_nlo_setup_real_component
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_real_and_isr_kinematics => &
pcm_instance_nlo_init_real_and_isr_kinematics
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_real_and_isr_kinematics (pcm_instance, sqrts)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default) :: sqrts
integer :: n_contr
allocate (pcm_instance%real_kinematics)
allocate (pcm_instance%isr_kinematics)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (region_data => config%region_data)
if (allocated (region_data%alr_contributors)) then
n_contr = size (region_data%alr_contributors)
else if (config%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
n_contr = 2
else
n_contr = 1
end if
call pcm_instance%real_kinematics%init &
(region_data%n_legs_real, region_data%n_phs, &
region_data%n_regions, n_contr)
if (config%settings%factorization_mode == FACTORIZATION_THRESHOLD) &
call pcm_instance%real_kinematics%init_onshell &
(region_data%n_legs_real, region_data%n_phs)
pcm_instance%isr_kinematics%n_in = region_data%n_in
end associate
end select
pcm_instance%isr_kinematics%beam_energy = sqrts / two
end subroutine pcm_instance_nlo_init_real_and_isr_kinematics
@ %def pcm_instance_nlo_init_real_and_isr_kinematics
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_real_and_isr_kinematics => &
pcm_instance_nlo_set_real_and_isr_kinematics
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_real_and_isr_kinematics (pcm_instance, phs_identifiers, sqrts)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
real(default), intent(in) :: sqrts
call pcm_instance%real_sub%set_real_kinematics &
(pcm_instance%real_kinematics)
call pcm_instance%real_sub%set_isr_kinematics &
(pcm_instance%isr_kinematics)
end subroutine pcm_instance_nlo_set_real_and_isr_kinematics
@ %def pcm_instance_nlo_set_real_and_isr_kinematics
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_real_subtraction => pcm_instance_nlo_init_real_subtraction
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_real_subtraction (pcm_instance)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (region_data => config%region_data)
call pcm_instance%real_sub%init (region_data, config%settings)
if (allocated (config%settings%selected_alr)) then
associate (selected_alr => config%settings%selected_alr)
if (any (selected_alr < 0)) then
call msg_fatal ("Fixed alpha region must be non-negative!")
else if (any (selected_alr > region_data%n_regions)) then
call msg_fatal ("Fixed alpha region is larger than the total"&
&" number of singular regions!")
else
allocate (pcm_instance%real_sub%selected_alr (size (selected_alr)))
pcm_instance%real_sub%selected_alr = selected_alr
end if
end associate
end if
end associate
end select
end subroutine pcm_instance_nlo_init_real_subtraction
@ %def pcm_instance_nlo_init_real_subtraction
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_momenta_and_scales_virtual => &
pcm_instance_nlo_set_momenta_and_scales_virtual
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_momenta_and_scales_virtual (pcm_instance, p, &
ren_scale, fac_scale, es_scale)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: ren_scale, fac_scale, es_scale
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (virtual => pcm_instance%virtual)
call virtual%set_ren_scale (p, ren_scale)
call virtual%set_fac_scale (p, fac_scale)
call virtual%set_ellis_sexton_scale (es_scale)
end associate
end select
end subroutine pcm_instance_nlo_set_momenta_and_scales_virtual
@ %def pcm_instance_nlo_set_momenta_and_scales_virtual
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_fac_scale => pcm_instance_nlo_set_fac_scale
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_fac_scale (pcm_instance, fac_scale)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in) :: fac_scale
pcm_instance%isr_kinematics%fac_scale = fac_scale
end subroutine pcm_instance_nlo_set_fac_scale
@ %def pcm_instance_nlo_set_fac_scale
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_momenta => pcm_instance_nlo_set_momenta
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_momenta (pcm_instance, p_born, p_real, i_phs, cms)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
type(vector4_t), dimension(:), intent(in) :: p_born, p_real
integer, intent(in) :: i_phs
logical, intent(in), optional :: cms
logical :: yorn
yorn = .false.; if (present (cms)) yorn = cms
associate (kinematics => pcm_instance%real_kinematics)
if (yorn) then
if (.not. kinematics%p_born_cms%initialized) &
call kinematics%p_born_cms%init (size (p_born), 1)
if (.not. kinematics%p_real_cms%initialized) &
call kinematics%p_real_cms%init (size (p_real), 1)
kinematics%p_born_cms%phs_point(1)%p = p_born
kinematics%p_real_cms%phs_point(i_phs)%p = p_real
else
if (.not. kinematics%p_born_lab%initialized) &
call kinematics%p_born_lab%init (size (p_born), 1)
if (.not. kinematics%p_real_lab%initialized) &
call kinematics%p_real_lab%init (size (p_real), 1)
kinematics%p_born_lab%phs_point(1)%p = p_born
kinematics%p_real_lab%phs_point(i_phs)%p = p_real
end if
end associate
end subroutine pcm_instance_nlo_set_momenta
@ %def pcm_instance_nlo_set_momenta
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_momenta => pcm_instance_nlo_get_momenta
<<Pcm: procedures>>=
function pcm_instance_nlo_get_momenta (pcm_instance, i_phs, born_phsp, cms) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
integer, intent(in) :: i_phs
logical, intent(in) :: born_phsp
logical, intent(in), optional :: cms
logical :: yorn
yorn = .false.; if (present (cms)) yorn = cms
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (born_phsp) then
if (yorn) then
allocate (p (1 : config%region_data%n_legs_born), &
source = pcm_instance%real_kinematics%p_born_cms%phs_point(1)%p)
else
allocate (p (1 : config%region_data%n_legs_born), &
source = pcm_instance%real_kinematics%p_born_lab%phs_point(1)%p)
end if
else
if (yorn) then
allocate (p (1 : config%region_data%n_legs_real), &
source = pcm_instance%real_kinematics%p_real_cms%phs_point(i_phs)%p)
else
allocate (p ( 1 : config%region_data%n_legs_real), &
source = pcm_instance%real_kinematics%p_real_lab%phs_point(i_phs)%p)
end if
end if
end select
end function pcm_instance_nlo_get_momenta
@ %def pcm_instance_nlo_get_momenta
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_xi_max => pcm_instance_nlo_get_xi_max
<<Pcm: procedures>>=
function pcm_instance_nlo_get_xi_max (pcm_instance, alr) result (xi_max)
real(default) :: xi_max
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
integer, intent(in) :: alr
integer :: i_phs
i_phs = pcm_instance%real_kinematics%alr_to_i_phs (alr)
xi_max = pcm_instance%real_kinematics%xi_max (i_phs)
end function pcm_instance_nlo_get_xi_max
@ %def pcm_instance_nlo_get_xi_max
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_n_born => pcm_instance_nlo_get_n_born
<<Pcm: procedures>>=
function pcm_instance_nlo_get_n_born (pcm_instance) result (n_born)
integer :: n_born
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_born = config%region_data%n_legs_born
end select
end function pcm_instance_nlo_get_n_born
@ %def pcm_instance_nlo_get_n_born
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_n_real => pcm_instance_nlo_get_n_real
<<Pcm: procedures>>=
function pcm_instance_nlo_get_n_real (pcm_instance) result (n_real)
integer :: n_real
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_real = config%region_data%n_legs_real
end select
end function pcm_instance_nlo_get_n_real
@ %def pcm_instance_nlo_get_n_real
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_n_regions => pcm_instance_nlo_get_n_regions
<<Pcm: procedures>>=
function pcm_instance_nlo_get_n_regions (pcm_instance) result (n_regions)
integer :: n_regions
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_regions = config%region_data%n_regions
end select
end function pcm_instance_nlo_get_n_regions
@ %def pcm_instance_nlo_get_n_regions
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_x_rad => pcm_instance_nlo_set_x_rad
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_x_rad (pcm_instance, x_tot)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in), dimension(:) :: x_tot
integer :: n_par
n_par = size (x_tot)
if (n_par < 3) then
pcm_instance%real_kinematics%x_rad = zero
else
pcm_instance%real_kinematics%x_rad = x_tot (n_par - 2 : n_par)
end if
end subroutine pcm_instance_nlo_set_x_rad
@ %def pcm_instance_nlo_set_x_rad
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_virtual => pcm_instance_nlo_init_virtual
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_virtual (pcm_instance, model)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
class(model_data_t), intent(in) :: model
type(nlo_settings_t), pointer :: settings
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (region_data => config%region_data)
settings => config%settings
call pcm_instance%virtual%init (region_data%get_flv_states_born (), &
region_data%n_in, settings, &
region_data%regions(1)%nlo_correction_type, model, config%has_pdfs)
end associate
end select
end subroutine pcm_instance_nlo_init_virtual
@ %def pcm_instance_nlo_init_virtual
@
<<Pcm: pcm instance: TBP>>=
procedure :: disable_virtual_subtraction => pcm_instance_nlo_disable_virtual_subtraction
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_disable_virtual_subtraction (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
end subroutine pcm_instance_nlo_disable_virtual_subtraction
@ %def pcm_instance_nlo_disable_virtual_subtraction
@
<<Pcm: pcm instance: TBP>>=
procedure :: compute_sqme_virt => pcm_instance_nlo_compute_sqme_virt
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_compute_sqme_virt (pcm_instance, p, &
alpha_coupling, separate_uborns, sqme_virt)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: alpha_coupling
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_virt
type(vector4_t), dimension(:), allocatable :: pp
associate (virtual => pcm_instance%virtual)
allocate (pp (size (p)))
if (virtual%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
pp = pcm_instance%real_kinematics%p_born_onshell%get_momenta (1)
else
pp = p
end if
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (separate_uborns) then
allocate (sqme_virt (config%get_n_flv_born ()))
else
allocate (sqme_virt (1))
end if
sqme_virt = zero
call virtual%evaluate (config%region_data, &
alpha_coupling, pp, separate_uborns, sqme_virt)
end select
end associate
end subroutine pcm_instance_nlo_compute_sqme_virt
@ %def pcm_instance_nlo_compute_sqme_virt
@
<<Pcm: pcm instance: TBP>>=
procedure :: compute_sqme_mismatch => pcm_instance_nlo_compute_sqme_mismatch
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_compute_sqme_mismatch (pcm_instance, &
alpha_s, separate_uborns, sqme_mism)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in) :: alpha_s
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_mism
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (separate_uborns) then
allocate (sqme_mism (config%get_n_flv_born ()))
else
allocate (sqme_mism (1))
end if
sqme_mism = zero
sqme_mism = pcm_instance%soft_mismatch%evaluate (alpha_s)
end select
end subroutine pcm_instance_nlo_compute_sqme_mismatch
@ %def pcm_instance_nlo_compute_sqme_mismatch
@
<<Pcm: pcm instance: TBP>>=
procedure :: compute_sqme_dglap_remnant => pcm_instance_nlo_compute_sqme_dglap_remnant
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_compute_sqme_dglap_remnant (pcm_instance, &
alpha_s, separate_uborns, sqme_dglap)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in) :: alpha_s
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_dglap
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (separate_uborns) then
allocate (sqme_dglap (config%get_n_flv_born ()))
else
allocate (sqme_dglap (1))
end if
end select
sqme_dglap = zero
call pcm_instance%dglap_remnant%evaluate (alpha_s, separate_uborns, sqme_dglap)
end subroutine pcm_instance_nlo_compute_sqme_dglap_remnant
@ %def pcm_instance_nlo_compute_sqme_dglap_remnant
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_fixed_order_event_mode => pcm_instance_nlo_set_fixed_order_event_mode
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_fixed_order_event_mode (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%purpose = FIXED_ORDER_EVENTS
end subroutine pcm_instance_nlo_set_fixed_order_event_mode
<<Pcm: pcm instance: TBP>>=
procedure :: set_powheg_mode => pcm_instance_nlo_set_powheg_mode
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_powheg_mode (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%purpose = POWHEG
end subroutine pcm_instance_nlo_set_powheg_mode
@ %def pcm_instance_nlo_set_fixed_order_event_mode
@ %def pcm_instance_nlo_set_powheg_mode
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_soft_mismatch => pcm_instance_nlo_init_soft_mismatch
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_soft_mismatch (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
call pcm_instance%soft_mismatch%init (config%region_data, &
pcm_instance%real_kinematics, config%settings%factorization_mode)
end select
end subroutine pcm_instance_nlo_init_soft_mismatch
@ %def pcm_instance_nlo_init_soft_mismatch
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_dglap_remnant => pcm_instance_nlo_init_dglap_remnant
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_dglap_remnant (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
call pcm_instance%dglap_remnant%init ( &
config%settings, &
config%region_data, &
pcm_instance%isr_kinematics)
end select
end subroutine pcm_instance_nlo_init_dglap_remnant
@ %def pcm_instance_nlo_init_dglap_remnant
@
<<Pcm: pcm instance: TBP>>=
procedure :: is_fixed_order_nlo_events &
=> pcm_instance_nlo_is_fixed_order_nlo_events
<<Pcm: procedures>>=
function pcm_instance_nlo_is_fixed_order_nlo_events (pcm_instance) result (is_nlo)
logical :: is_nlo
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
is_nlo = pcm_instance%real_sub%purpose == FIXED_ORDER_EVENTS
end function pcm_instance_nlo_is_fixed_order_nlo_events
@ %def pcm_instance_nlo_is_fixed_order_nlo_events
@
<<Pcm: pcm instance: TBP>>=
procedure :: final => pcm_instance_nlo_final
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_final (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
call pcm_instance%real_sub%final ()
call pcm_instance%virtual%final ()
call pcm_instance%soft_mismatch%final ()
call pcm_instance%dglap_remnant%final ()
if (associated (pcm_instance%real_kinematics)) then
call pcm_instance%real_kinematics%final ()
nullify (pcm_instance%real_kinematics)
end if
if (associated (pcm_instance%isr_kinematics)) then
nullify (pcm_instance%isr_kinematics)
end if
end subroutine pcm_instance_nlo_final
@ %def pcm_instance_nlo_final
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Kinematics instance}
In this data type we combine all objects (instances) necessary for
generating (or recovering) a kinematical configuration. The
components work together as an implementation of multi-channel phase
space.
[[sf_chain]] is an instance of the structure-function chain. It is
used both for generating kinematics and, after the proper scale has
been determined, evaluating the structure function entries.
[[phs]] is an instance of the phase space for the elementary process.
The array [[f]] contains the products of the Jacobians that originate
from parameter mappings in the structure-function chain or in the
phase space. We allocate this explicitly if either [[sf_chain]] or
[[phs]] are explicitly allocated, otherwise we can take over a pointer.
All components are implemented as pointers to (anonymous) targets.
For each component, there is a flag that tells whether this component
is to be regarded as a proper component (`owned' by the object) or as
a pointer.
@
<<[[kinematics.f90]]>>=
<<File header>>
module kinematics
<<Use kinds>>
<<Use debug>>
use format_utils, only: write_separator
use diagnostics
use io_units
use lorentz
use physics_defs
use sf_base
use phs_base
use interactions
use mci_base
use phs_fks
use fks_regions
use process_config
use process_mci
use pcm, only: pcm_instance_nlo_t
use ttv_formfactors, only: m1s_to_mpole
<<Standard module head>>
<<Kinematics: public>>
<<Kinematics: types>>
contains
<<Kinematics: procedures>>
end module kinematics
@ %def kinematics
<<Kinematics: public>>=
public :: kinematics_t
<<Kinematics: types>>=
type :: kinematics_t
integer :: n_in = 0
integer :: n_channel = 0
integer :: selected_channel = 0
type(sf_chain_instance_t), pointer :: sf_chain => null ()
class(phs_t), pointer :: phs => null ()
real(default), dimension(:), pointer :: f => null ()
real(default) :: phs_factor
logical :: sf_chain_allocated = .false.
logical :: phs_allocated = .false.
logical :: f_allocated = .false.
integer :: emitter = -1
integer :: i_phs = 0
integer :: i_con = 0
logical :: only_cm_frame = .false.
logical :: new_seed = .true.
logical :: threshold = .false.
contains
<<Kinematics: kinematics: TBP>>
end type kinematics_t
@ %def kinematics_t
@ Output. Show only those components which are marked as owned.
<<Kinematics: kinematics: TBP>>=
procedure :: write => kinematics_write
<<Kinematics: procedures>>=
subroutine kinematics_write (object, unit)
class(kinematics_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, c
u = given_output_unit (unit)
if (object%f_allocated) then
write (u, "(1x,A)") "Flux * PHS volume:"
write (u, "(2x,ES19.12)") object%phs_factor
write (u, "(1x,A)") "Jacobian factors per channel:"
do c = 1, size (object%f)
write (u, "(3x,I0,':',1x,ES14.7)", advance="no") c, object%f(c)
if (c == object%selected_channel) then
write (u, "(1x,A)") "[selected]"
else
write (u, *)
end if
end do
end if
if (object%sf_chain_allocated) then
call write_separator (u)
call object%sf_chain%write (u)
end if
if (object%phs_allocated) then
call write_separator (u)
call object%phs%write (u)
end if
end subroutine kinematics_write
@ %def kinematics_write
@ Finalizer. Delete only those components which are marked as owned.
<<Kinematics: kinematics: TBP>>=
procedure :: final => kinematics_final
<<Kinematics: procedures>>=
subroutine kinematics_final (object)
class(kinematics_t), intent(inout) :: object
if (object%sf_chain_allocated) then
call object%sf_chain%final ()
deallocate (object%sf_chain)
object%sf_chain_allocated = .false.
end if
if (object%phs_allocated) then
call object%phs%final ()
deallocate (object%phs)
object%phs_allocated = .false.
end if
if (object%f_allocated) then
deallocate (object%f)
object%f_allocated = .false.
end if
end subroutine kinematics_final
@ %def kinematics_final
@ Set the flags indicating whether the phase space shall be set up for the calculation of the real contribution. For this case, also set the emitter.
<<Kinematics: kinematics: TBP>>=
procedure :: set_nlo_info => kinematics_set_nlo_info
<<Kinematics: procedures>>=
subroutine kinematics_set_nlo_info (k, nlo_type)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: nlo_type
if (nlo_type == NLO_VIRTUAL) k%only_cm_frame = .true.
end subroutine kinematics_set_nlo_info
@ %def kinematics_set_nlo_info
@ Allocate the structure-function chain instance, initialize it as a
copy of the [[sf_chain]] template, and prepare it for evaluation.
The [[sf_chain]] remains a target because the (usually constant) beam momenta
are taken from there.
<<Kinematics: kinematics: TBP>>=
procedure :: init_sf_chain => kinematics_init_sf_chain
<<Kinematics: procedures>>=
subroutine kinematics_init_sf_chain (k, sf_chain, config, extended_sf)
class(kinematics_t), intent(inout) :: k
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in) :: config
logical, intent(in), optional :: extended_sf
integer :: n_strfun, n_channel
integer :: c
k%n_in = config%data%get_n_in ()
n_strfun = config%n_strfun
n_channel = config%n_channel
allocate (k%sf_chain)
k%sf_chain_allocated = .true.
call k%sf_chain%init (sf_chain, n_channel)
if (n_strfun /= 0) then
do c = 1, n_channel
call k%sf_chain%set_channel (c, config%sf_channel(c))
end do
end if
call k%sf_chain%link_interactions ()
call k%sf_chain%exchange_mask ()
call k%sf_chain%init_evaluators (extended_sf = extended_sf)
end subroutine kinematics_init_sf_chain
@ %def kinematics_init_sf_chain
@ Allocate and initialize the phase-space part and the array of
Jacobian factors.
<<Kinematics: kinematics: TBP>>=
procedure :: init_phs => kinematics_init_phs
<<Kinematics: procedures>>=
subroutine kinematics_init_phs (k, config)
class(kinematics_t), intent(inout) :: k
class(phs_config_t), intent(in), target :: config
k%n_channel = config%get_n_channel ()
call config%allocate_instance (k%phs)
call k%phs%init (config)
k%phs_allocated = .true.
allocate (k%f (k%n_channel))
k%f = 0
k%f_allocated = .true.
end subroutine kinematics_init_phs
@ %def kinematics_init_phs
@
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_radiation_kinematics => kinematics_evaluate_radiation_kinematics
<<Kinematics: procedures>>=
subroutine kinematics_evaluate_radiation_kinematics (k, r_in)
class(kinematics_t), intent(inout) :: k
real(default), intent(in), dimension(:) :: r_in
select type (phs => k%phs)
type is (phs_fks_t)
call phs%generate_radiation_variables &
(r_in(phs%n_r_born + 1 : phs%n_r_born + 3), k%threshold)
call phs%compute_cms_energy ()
end select
end subroutine kinematics_evaluate_radiation_kinematics
@ %def kinematics_evaluate_radiation_kinematics
@
<<Kinematics: kinematics: TBP>>=
procedure :: compute_xi_ref_momenta => kinematics_compute_xi_ref_momenta
<<Kinematics: procedures>>=
subroutine kinematics_compute_xi_ref_momenta (k, reg_data, nlo_type)
class(kinematics_t), intent(inout) :: k
type(region_data_t), intent(in) :: reg_data
integer, intent(in) :: nlo_type
logical :: use_contributors
use_contributors = allocated (reg_data%alr_contributors)
select type (phs => k%phs)
type is (phs_fks_t)
if (use_contributors) then
call phs%compute_xi_ref_momenta (contributors = reg_data%alr_contributors)
else if (k%threshold) then
if (.not. is_subtraction_component (k%emitter, nlo_type)) &
call phs%compute_xi_ref_momenta_threshold ()
else
call phs%compute_xi_ref_momenta ()
end if
end select
end subroutine kinematics_compute_xi_ref_momenta
@ %def kinematics_compute_xi_ref_momenta
@ Generate kinematics, given a phase-space channel and a MC
parameter set. The main result is the momentum array [[p]], but we
also fill the momentum entries in the structure-function chain and the
Jacobian-factor array [[f]]. Regarding phase space, We fill only the
parameter arrays for the selected channel.
<<Kinematics: kinematics: TBP>>=
procedure :: compute_selected_channel => kinematics_compute_selected_channel
<<Kinematics: procedures>>=
subroutine kinematics_compute_selected_channel &
(k, mci_work, phs_channel, p, success)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(out) :: p
logical, intent(out) :: success
integer :: sf_channel
k%selected_channel = phs_channel
sf_channel = k%phs%config%get_sf_channel (phs_channel)
call k%sf_chain%compute_kinematics (sf_channel, mci_work%get_x_strfun ())
call k%sf_chain%get_out_momenta (p(1:k%n_in))
call k%phs%set_incoming_momenta (p(1:k%n_in))
call k%phs%compute_flux ()
call k%phs%select_channel (phs_channel)
call k%phs%evaluate_selected_channel (phs_channel, &
mci_work%get_x_process ())
select type (phs => k%phs)
type is (phs_fks_t)
if (debug_on) call msg_debug2 (D_REAL, "phase space is phs_FKS")
if (phs%q_defined) then
call phs%get_born_momenta (p)
if (debug_on) then
call msg_debug2 (D_REAL, "q is defined")
call msg_debug2 (D_REAL, "get_born_momenta called")
end if
k%phs_factor = phs%get_overall_factor ()
success = .true.
else
k%phs_factor = 0
success = .false.
end if
class default
if (phs%q_defined) then
call k%phs%get_outgoing_momenta (p(k%n_in + 1 :))
k%phs_factor = k%phs%get_overall_factor ()
success = .true.
else
k%phs_factor = 0
success = .false.
end if
end select
end subroutine kinematics_compute_selected_channel
@ %def kinematics_compute_selected_channel
@ Complete kinematics by filling the non-selected phase-space parameter
arrays.
<<Kinematics: kinematics: TBP>>=
procedure :: compute_other_channels => kinematics_compute_other_channels
<<Kinematics: procedures>>=
subroutine kinematics_compute_other_channels (k, mci_work, phs_channel)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
integer :: c, c_sf
call k%phs%evaluate_other_channels (phs_channel)
do c = 1, k%n_channel
c_sf = k%phs%config%get_sf_channel (c)
k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
end do
end subroutine kinematics_compute_other_channels
@ %def kinematics_compute_other_channels
@ Just fetch the outgoing momenta of the [[sf_chain]] subobject, which
become the incoming (seed) momenta of the hard interaction.
This is a stripped down-version of the above which we use when
recovering kinematics. Momenta are known, but no MC parameters yet.
(We do not use the [[get_out_momenta]] method of the chain, since this
relies on the structure-function interactions, which are not necessary
filled here. We do rely on the momenta of the last evaluator in the
chain, however.)
<<Kinematics: kinematics: TBP>>=
procedure :: get_incoming_momenta => kinematics_get_incoming_momenta
<<Kinematics: procedures>>=
subroutine kinematics_get_incoming_momenta (k, p)
class(kinematics_t), intent(in) :: k
type(vector4_t), dimension(:), intent(out) :: p
type(interaction_t), pointer :: int
integer :: i
int => k%sf_chain%get_out_int_ptr ()
do i = 1, k%n_in
p(i) = int%get_momentum (k%sf_chain%get_out_i (i))
end do
end subroutine kinematics_get_incoming_momenta
@ %def kinematics_get_incoming_momenta
@ This inverts the remainder of the above [[compute]] method. We know
the momenta and recover the rest, as far as needed. If we select a
channel, we can complete the inversion and reconstruct the
MC parameter set.
<<Kinematics: kinematics: TBP>>=
procedure :: recover_mcpar => kinematics_recover_mcpar
<<Kinematics: procedures>>=
subroutine kinematics_recover_mcpar (k, mci_work, phs_channel, p)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(in) :: p
integer :: c, c_sf
real(default), dimension(:), allocatable :: x_sf, x_phs
c = phs_channel
c_sf = k%phs%config%get_sf_channel (c)
k%selected_channel = c
call k%sf_chain%recover_kinematics (c_sf)
call k%phs%set_incoming_momenta (p(1:k%n_in))
call k%phs%compute_flux ()
call k%phs%set_outgoing_momenta (p(k%n_in+1:))
call k%phs%inverse ()
do c = 1, k%n_channel
c_sf = k%phs%config%get_sf_channel (c)
k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
end do
k%phs_factor = k%phs%get_overall_factor ()
c = phs_channel
c_sf = k%phs%config%get_sf_channel (c)
allocate (x_sf (k%sf_chain%config%get_n_bound ()))
allocate (x_phs (k%phs%config%get_n_par ()))
call k%phs%select_channel (c)
call k%sf_chain%get_mcpar (c_sf, x_sf)
call k%phs%get_mcpar (c, x_phs)
call mci_work%set_x_strfun (x_sf)
call mci_work%set_x_process (x_phs)
end subroutine kinematics_recover_mcpar
@ %def kinematics_recover_mcpar
@ This first part of [[recover_mcpar]]: just handle the sfchain.
<<Kinematics: kinematics: TBP>>=
procedure :: recover_sfchain => kinematics_recover_sfchain
<<Kinematics: procedures>>=
subroutine kinematics_recover_sfchain (k, channel, p)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: channel
type(vector4_t), dimension(:), intent(in) :: p
k%selected_channel = channel
call k%sf_chain%recover_kinematics (channel)
end subroutine kinematics_recover_sfchain
@ %def kinematics_recover_sfchain
@ Retrieve the MC input parameter array for a specific channel. We assume
that the kinematics is complete, so this is known for all channels.
<<Kinematics: kinematics: TBP>>=
procedure :: get_mcpar => kinematics_get_mcpar
<<Kinematics: procedures>>=
subroutine kinematics_get_mcpar (k, phs_channel, r)
class(kinematics_t), intent(in) :: k
integer, intent(in) :: phs_channel
real(default), dimension(:), intent(out) :: r
integer :: sf_channel, n_par_sf, n_par_phs
sf_channel = k%phs%config%get_sf_channel (phs_channel)
n_par_phs = k%phs%config%get_n_par ()
n_par_sf = k%sf_chain%config%get_n_bound ()
if (n_par_sf > 0) then
call k%sf_chain%get_mcpar (sf_channel, r(1:n_par_sf))
end if
if (n_par_phs > 0) then
call k%phs%get_mcpar (phs_channel, r(n_par_sf+1:))
end if
end subroutine kinematics_get_mcpar
@ %def kinematics_get_mcpar
@ Evaluate the structure function chain, assuming that kinematics is known.
The status must be precisely [[SF_DONE_KINEMATICS]]. We thus avoid
evaluating the chain twice via different pointers to the same target.
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_sf_chain => kinematics_evaluate_sf_chain
<<Kinematics: procedures>>=
subroutine kinematics_evaluate_sf_chain (k, fac_scale, sf_rescale)
class(kinematics_t), intent(inout) :: k
real(default), intent(in) :: fac_scale
class(sf_rescale_t), intent(inout), optional :: sf_rescale
select case (k%sf_chain%get_status ())
case (SF_DONE_KINEMATICS)
call k%sf_chain%evaluate (fac_scale, sf_rescale)
end select
end subroutine kinematics_evaluate_sf_chain
@ %def kinematics_evaluate_sf_chain
@ Recover beam momenta, i.e., return the beam momenta stored in the
current [[sf_chain]] to their source. This is a side effect.
<<Kinematics: kinematics: TBP>>=
procedure :: return_beam_momenta => kinematics_return_beam_momenta
<<Kinematics: procedures>>=
subroutine kinematics_return_beam_momenta (k)
class(kinematics_t), intent(in) :: k
call k%sf_chain%return_beam_momenta ()
end subroutine kinematics_return_beam_momenta
@ %def kinematics_return_beam_momenta
@ Check wether the phase space is configured in the center-of-mass frame.
Relevant for using the proper momenta input for BLHA matrix elements.
<<Kinematics: kinematics: TBP>>=
procedure :: lab_is_cm => kinematics_lab_is_cm
<<Kinematics: procedures>>=
function kinematics_lab_is_cm (k) result (lab_is_cm)
logical :: lab_is_cm
class(kinematics_t), intent(in) :: k
lab_is_cm = k%phs%config%lab_is_cm
end function kinematics_lab_is_cm
@ %def kinematics_lab_is_cm
@
<<Kinematics: kinematics: TBP>>=
procedure :: modify_momenta_for_subtraction => kinematics_modify_momenta_for_subtraction
<<Kinematics: procedures>>=
subroutine kinematics_modify_momenta_for_subtraction (k, p_in, p_out)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
allocate (p_out (size (p_in)))
if (k%threshold) then
select type (phs => k%phs)
type is (phs_fks_t)
p_out = phs%get_onshell_projected_momenta ()
end select
else
p_out = p_in
end if
end subroutine kinematics_modify_momenta_for_subtraction
@ %def kinematics_modify_momenta_for_subtraction
@
<<Kinematics: kinematics: TBP>>=
procedure :: threshold_projection => kinematics_threshold_projection
<<Kinematics: procedures>>=
subroutine kinematics_threshold_projection (k, pcm_instance, nlo_type)
class(kinematics_t), intent(inout) :: k
type(pcm_instance_nlo_t), intent(inout) :: pcm_instance
integer, intent(in) :: nlo_type
real(default) :: sqrts, mtop
type(lorentz_transformation_t) :: L_to_cms
type(vector4_t), dimension(:), allocatable :: p_tot
integer :: n_tot
n_tot = k%phs%get_n_tot ()
allocate (p_tot (size (pcm_instance%real_kinematics%p_born_cms%phs_point(1)%p)))
select type (phs => k%phs)
type is (phs_fks_t)
p_tot = pcm_instance%real_kinematics%p_born_cms%phs_point(1)%p
class default
p_tot(1 : k%n_in) = phs%p
p_tot(k%n_in + 1 : n_tot) = phs%q
end select
sqrts = sum (p_tot (1:k%n_in))**1
mtop = m1s_to_mpole (sqrts)
L_to_cms = get_boost_for_threshold_projection (p_tot, sqrts, mtop)
call pcm_instance%real_kinematics%p_born_cms%set_momenta (1, p_tot)
associate (p_onshell => pcm_instance%real_kinematics%p_born_onshell%phs_point(1)%p)
call threshold_projection_born (mtop, L_to_cms, p_tot, p_onshell)
if (debug2_active (D_THRESHOLD)) then
print *, 'On-shell projected Born: '
call vector4_write_set (p_onshell)
end if
end associate
end subroutine kinematics_threshold_projection
@ %def kinematics_threshold_projection
@
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_radiation => kinematics_evaluate_radiation
<<Kinematics: procedures>>=
subroutine kinematics_evaluate_radiation (k, p_in, p_out, success)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
logical, intent(out) :: success
type(vector4_t), dimension(:), allocatable :: p_real
type(vector4_t), dimension(:), allocatable :: p_born
real(default) :: xi_max_offshell, xi_offshell, y_offshell, jac_rand_dummy, phi
select type (phs => k%phs)
type is (phs_fks_t)
allocate (p_born (size (p_in)))
if (k%threshold) then
p_born = phs%get_onshell_projected_momenta ()
else
p_born = p_in
end if
if (.not. k%phs%lab_is_cm () .and. .not. k%threshold) then
p_born = inverse (k%phs%lt_cm_to_lab) * p_born
end if
call phs%compute_xi_max (p_born, k%threshold)
if (k%emitter >= 0) then
allocate (p_real (size (p_born) + 1))
allocate (p_out (size (p_born) + 1))
if (k%emitter <= k%n_in) then
call phs%generate_isr (k%i_phs, p_real)
else
if (k%threshold) then
jac_rand_dummy = 1._default
call compute_y_from_emitter (phs%generator%real_kinematics%x_rad (I_Y), &
phs%generator%real_kinematics%p_born_cms%get_momenta(1), &
k%n_in, k%emitter, .false., phs%generator%y_max, jac_rand_dummy, &
y_offshell)
call phs%compute_xi_max (k%emitter, k%i_phs, y_offshell, &
phs%generator%real_kinematics%p_born_cms%get_momenta(1), &
xi_max_offshell)
xi_offshell = xi_max_offshell * phs%generator%real_kinematics%xi_tilde
phi = phs%generator%real_kinematics%phi
call phs%generate_fsr (k%emitter, k%i_phs, p_real, &
xi_y_phi = [xi_offshell, y_offshell, phi], no_jacobians = .true.)
call phs%generator%real_kinematics%p_real_cms%set_momenta (k%i_phs, p_real)
call phs%generate_fsr_threshold (k%emitter, k%i_phs, p_real)
if (debug2_active (D_SUBTRACTION)) &
call generate_fsr_threshold_for_other_emitters (k%emitter, k%i_phs)
else if (k%i_con > 0) then
call phs%generate_fsr (k%emitter, k%i_phs, p_real, k%i_con)
else
call phs%generate_fsr (k%emitter, k%i_phs, p_real)
end if
end if
success = check_scalar_products (p_real)
if (debug2_active (D_SUBTRACTION)) then
call msg_debug2 (D_SUBTRACTION, "Real phase-space: ")
call vector4_write_set (p_real)
end if
p_out = p_real
else
allocate (p_out (size (p_in))); p_out = p_in
success = .true.
end if
end select
contains
subroutine generate_fsr_threshold_for_other_emitters (emitter, i_phs)
integer, intent(in) :: emitter, i_phs
integer :: ii_phs, this_emitter
select type (phs => k%phs)
type is (phs_fks_t)
do ii_phs = 1, size (phs%phs_identifiers)
this_emitter = phs%phs_identifiers(ii_phs)%emitter
if (ii_phs /= i_phs .and. this_emitter /= emitter) &
call phs%generate_fsr_threshold (this_emitter, i_phs)
end do
end select
end subroutine
end subroutine kinematics_evaluate_radiation
@ %def kinematics_evaluate_radiation
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Instances}
<<[[instances.f90]]>>=
<<File header>>
module instances
<<Use kinds>>
<<Use strings>>
<<Use debug>>
use io_units
use format_utils, only: write_separator
use constants
use diagnostics
use os_interface
use numeric_utils
use lorentz
use mci_base
use particles
use sm_qcd, only: qcd_t
use interactions
use quantum_numbers
use model_data
use helicities
use flavors
use beam_structures
use variables
use pdg_arrays, only: is_quark
use sf_base
use physics_defs
use process_constants
use process_libraries
use state_matrices
use integration_results
use phs_base
use prc_core, only: prc_core_t, prc_core_state_t
!!! We should depend less on these modules (move it to pcm_nlo_t e.g.)
use phs_wood, only: phs_wood_t
use phs_fks
use blha_olp_interfaces, only: prc_blha_t
use blha_config, only: BLHA_AMP_COLOR_C
use prc_external, only: prc_external_t, prc_external_state_t
use prc_threshold, only: prc_threshold_t
use blha_olp_interfaces, only: blha_result_array_size
use prc_openloops, only: prc_openloops_t, openloops_state_t
use prc_recola, only: prc_recola_t
use blha_olp_interfaces, only: blha_color_c_fill_offdiag, blha_color_c_fill_diag
use ttv_formfactors, only: m1s_to_mpole
!!! local modules
use parton_states
use process_counter
use pcm_base
use pcm
use process_config
use process_mci
use process
use kinematics
<<Standard module head>>
<<Instances: public>>
<<Instances: types>>
<<Instances: interfaces>>
contains
<<Instances: procedures>>
end module instances
@ %def instances
@
\subsection{Term instance}
A [[term_instance_t]] object contains all data that describe a term. Each
process component consists of one or more distinct terms which may differ in
kinematics, but whose squared transition matrices have to be added pointwise.
The [[active]] flag is set when this term is connected to an active
process component. Inactive terms are skipped for kinematics and evaluation.
The [[k_term]] object is the instance of the kinematics setup
(structure-function chain, phase space, etc.) that applies
specifically to this term. In ordinary cases, it consists of straight
pointers to the seed kinematics.
The [[amp]] array stores the amplitude values when we get them from evaluating
the associated matrix-element code.
The [[int_hard]] interaction describes the elementary hard process.
It receives the momenta and the amplitude entries for each sampling point.
The [[isolated]] object holds the effective parton state for the
elementary interaction. The amplitude entries are
computed from [[int_hard]].
The [[connected]] evaluator set
convolutes this scattering matrix with the beam (and possibly
structure-function) density matrix.
The [[checked]] flag is set once we have applied cuts on this term.
The result of this is stored in the [[passed]] flag.
Although each [[term_instance]] carries a [[weight]], this currently
always keeps the value $1$ and is only used to be given to routines
to fulfill their signature.
<<Instances: types>>=
type :: term_instance_t
type(process_term_t), pointer :: config => null ()
logical :: active = .false.
type(kinematics_t) :: k_term
complex(default), dimension(:), allocatable :: amp
type(interaction_t) :: int_hard
type(isolated_state_t) :: isolated
type(connected_state_t) :: connected
class(prc_core_state_t), allocatable :: core_state
logical :: checked = .false.
logical :: passed = .false.
real(default) :: scale = 0
real(default) :: fac_scale = 0
real(default) :: ren_scale = 0
real(default) :: es_scale = 0
real(default), allocatable :: alpha_qcd_forced
real(default) :: weight = 1
type(vector4_t), dimension(:), allocatable :: p_seed
type(vector4_t), dimension(:), allocatable :: p_hard
class(pcm_instance_t), pointer :: pcm_instance => null ()
integer :: nlo_type = BORN
integer, dimension(:), allocatable :: same_kinematics
contains
<<Instances: term instance: TBP>>
end type term_instance_t
@ %def term_instance_t
@
<<Instances: term instance: TBP>>=
procedure :: write => term_instance_write
<<Instances: procedures>>=
subroutine term_instance_write (term, unit, show_eff_state, testflag)
class(term_instance_t), intent(in) :: term
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_eff_state
logical, intent(in), optional :: testflag
integer :: u
logical :: state
u = given_output_unit (unit)
state = .true.; if (present (show_eff_state)) state = show_eff_state
if (term%active) then
if (associated (term%config)) then
write (u, "(1x,A,I0,A,I0,A)") "Term #", term%config%i_term, &
" (component #", term%config%i_component, ")"
else
write (u, "(1x,A)") "Term [undefined]"
end if
else
write (u, "(1x,A,I0,A)") "Term #", term%config%i_term, &
" [inactive]"
end if
if (term%checked) then
write (u, "(3x,A,L1)") "passed cuts = ", term%passed
end if
if (term%passed) then
write (u, "(3x,A,ES19.12)") "overall scale = ", term%scale
write (u, "(3x,A,ES19.12)") "factorization scale = ", term%fac_scale
write (u, "(3x,A,ES19.12)") "renormalization scale = ", term%ren_scale
if (allocated (term%alpha_qcd_forced)) then
write (u, "(3x,A,ES19.12)") "alpha(QCD) forced = ", &
term%alpha_qcd_forced
end if
write (u, "(3x,A,ES19.12)") "reweighting factor = ", term%weight
end if
call term%k_term%write (u)
call write_separator (u)
write (u, "(1x,A)") "Amplitude (transition matrix of the &
&hard interaction):"
call write_separator (u)
call term%int_hard%basic_write (u, testflag = testflag)
if (state .and. term%isolated%has_trace) then
call write_separator (u)
write (u, "(1x,A)") "Evaluators for the hard interaction:"
call term%isolated%write (u, testflag = testflag)
end if
if (state .and. term%connected%has_trace) then
call write_separator (u)
write (u, "(1x,A)") "Evaluators for the connected process:"
call term%connected%write (u, testflag = testflag)
end if
end subroutine term_instance_write
@ %def term_instance_write
@ The interactions and evaluators must be finalized.
<<Instances: term instance: TBP>>=
procedure :: final => term_instance_final
<<Instances: procedures>>=
subroutine term_instance_final (term)
class(term_instance_t), intent(inout) :: term
if (allocated (term%amp)) deallocate (term%amp)
if (allocated (term%core_state)) deallocate (term%core_state)
if (allocated (term%alpha_qcd_forced)) &
deallocate (term%alpha_qcd_forced)
if (allocated (term%p_seed)) deallocate(term%p_seed)
if (allocated (term%p_hard)) deallocate (term%p_hard)
call term%k_term%final ()
call term%connected%final ()
call term%isolated%final ()
call term%int_hard%final ()
term%pcm_instance => null ()
end subroutine term_instance_final
@ %def term_instance_final
@ For initialization, we make use of defined assignment for the
[[interaction_t]] type. This creates a deep copy.
The hard interaction (incoming momenta) is linked to the structure
function instance. In the isolated state, we either set pointers to
both, or we create modified copies ([[rearrange]]) as effective
structure-function chain and interaction, respectively.
Finally, we set up the [[subevt]] component that will be used for
evaluating observables, collecting particles from the trace evaluator
in the effective connected state. Their quantum numbers must be
determined by following back source links and set explicitly, since
they are already eliminated in that trace.
The [[rearrange]] parts are still commented out; they could become
relevant for a NLO algorithm.
<<Instances: term instance: TBP>>=
procedure :: init => term_instance_init
<<Instances: procedures>>=
subroutine term_instance_init (term, process, i_term, real_finite)
class(term_instance_t), intent(inout), target :: term
type(process_t), intent(in), target:: process
integer, intent(in) :: i_term
logical, intent(in), optional :: real_finite
class(prc_core_t), pointer :: core => null ()
type(process_beam_config_t) :: beam_config
type(interaction_t), pointer :: sf_chain_int
type(interaction_t), pointer :: src_int
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
type(state_matrix_t), pointer :: state_matrix
type(flavor_t), dimension(:), allocatable :: flv_int, flv_src, f_in, f_out
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(flavor_t), dimension(:,:), allocatable :: flv_pdf
type(quantum_numbers_t), dimension(:,:), allocatable :: qn_pdf
integer :: n_in, n_vir, n_out, n_tot, n_sub
integer :: n_flv_born, n_flv_real, n_flv_total
integer :: i, j
logical :: me_already_squared, keep_fs_flavors
logical :: decrease_n_tot
logical :: requires_extended_sf
me_already_squared = .false.
keep_fs_flavors = .false.
term%config => process%get_term_ptr (i_term)
term%int_hard = term%config%int
core => process%get_core_term (i_term)
call core%allocate_workspace (term%core_state)
select type (core)
class is (prc_external_t)
call reduce_interaction (term%int_hard, &
core%includes_polarization (), .true., .false.)
me_already_squared = .true.
allocate (term%amp (term%int_hard%get_n_matrix_elements ()))
class default
allocate (term%amp (term%config%n_allowed))
end select
if (allocated (term%core_state)) then
select type (core_state => term%core_state)
type is (openloops_state_t)
call core_state%init_threshold (process%get_model_ptr ())
end select
end if
term%amp = cmplx (0, 0, default)
decrease_n_tot = term%nlo_type == NLO_REAL .and. &
term%config%i_term_global /= term%config%i_sub
if (present (real_finite)) then
if (real_finite) decrease_n_tot = .false.
end if
if (decrease_n_tot) then
allocate (term%p_seed (term%int_hard%get_n_tot () - 1))
else
allocate (term%p_seed (term%int_hard%get_n_tot ()))
end if
allocate (term%p_hard (term%int_hard%get_n_tot ()))
sf_chain_int => term%k_term%sf_chain%get_out_int_ptr ()
n_in = term%int_hard%get_n_in ()
do j = 1, n_in
i = term%k_term%sf_chain%get_out_i (j)
call term%int_hard%set_source_link (j, sf_chain_int, i)
end do
call term%isolated%init (term%k_term%sf_chain, term%int_hard)
allocate (mask_in (n_in))
mask_in = term%k_term%sf_chain%get_out_mask ()
select type (phs => term%k_term%phs)
type is (phs_wood_t)
if (me_already_squared) then
call term%isolated%setup_identity_trace (core, mask_in, .true., .false.)
else
call term%isolated%setup_square_trace (core, mask_in, term%config%col, .false.)
end if
type is (phs_fks_t)
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
if (me_already_squared) then
call term%isolated%setup_identity_trace (core, mask_in, .true., .false.)
else
keep_fs_flavors = term%config%data%n_flv > 1
call term%isolated%setup_square_trace (core, mask_in, term%config%col, &
keep_fs_flavors)
end if
case (PHS_MODE_COLLINEAR_REMNANT)
if (me_already_squared) then
call term%isolated%setup_identity_trace (core, mask_in, .true., .false.)
else
call term%isolated%setup_square_trace (core, mask_in, term%config%col, .false.)
end if
end select
class default
call term%isolated%setup_square_trace (core, mask_in, term%config%col, .false.)
end select
if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL .and. &
term%config%i_term_global == term%config%i_sub) .or. &
term%nlo_type == NLO_MISMATCH) then
n_sub = term%get_n_sub ()
else if (term%nlo_type == NLO_DGLAP) then
n_sub = n_beams_rescaled
else
!!! No integration of real subtraction in interactions yet
n_sub = 0
end if
keep_fs_flavors = keep_fs_flavors .or. me_already_squared
requires_extended_sf = term%nlo_type == NLO_DGLAP .or. &
(term%is_subtraction () .and. process%pcm_contains_pdfs ())
call term%connected%setup_connected_trace (term%isolated, &
undo_helicities = undo_helicities (core, me_already_squared), &
keep_fs_flavors = keep_fs_flavors, &
requires_extended_sf = requires_extended_sf)
associate (int_eff => term%isolated%int_eff)
state_matrix => int_eff%get_state_matrix_ptr ()
n_tot = int_eff%get_n_tot ()
flv_int = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (1))
allocate (f_in (n_in))
f_in = flv_int(1:n_in)
deallocate (flv_int)
end associate
n_in = term%connected%trace%get_n_in ()
n_vir = term%connected%trace%get_n_vir ()
n_out = term%connected%trace%get_n_out ()
allocate (f_out (n_out))
do j = 1, n_out
call term%connected%trace%find_source &
(n_in + n_vir + j, src_int, i)
if (associated (src_int)) then
state_matrix => src_int%get_state_matrix_ptr ()
flv_src = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (1))
f_out(j) = flv_src(i)
deallocate (flv_src)
end if
end do
beam_config = process%get_beam_config ()
call term%connected%setup_subevt (term%isolated%sf_chain_eff, &
beam_config%data%flv, f_in, f_out)
call term%connected%setup_var_list &
(process%get_var_list_ptr (), beam_config%data)
! Does connected%trace never have any helicity qn?
call term%init_interaction_qn_index (core, term%connected%trace, n_sub, &
- is_polarized = .false.)
- call term%init_interaction_qn_index (core, term%int_hard, n_sub)
+ process%get_model_ptr (), is_polarized = .false.)
+ call term%init_interaction_qn_index (core, term%int_hard, n_sub, process%get_model_ptr ())
if (requires_extended_sf) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
n_in = config%region_data%get_n_in ()
flv_born = config%region_data%get_flv_states_born ()
flv_real = config%region_data%get_flv_states_real ()
n_flv_born = config%region_data%get_n_flv_born ()
n_flv_real = config%region_data%get_n_flv_real ()
n_flv_total = n_flv_born + n_flv_real
allocate (flv_pdf(n_in, n_flv_total), &
qn_pdf(n_in, n_flv_total))
call flv_pdf(:, :n_flv_born)%init (flv_born(:n_in, :))
call flv_pdf(:, n_flv_born + 1:n_flv_total)%init (flv_real(:n_in, :))
call qn_pdf%init (flv_pdf)
call sf_chain_int%init_qn_index (qn_pdf, n_flv_born, n_flv_real)
end select
end if
contains
function undo_helicities (core, me_squared) result (val)
logical :: val
class(prc_core_t), intent(in) :: core
logical, intent(in) :: me_squared
select type (core)
class is (prc_external_t)
val = me_squared .and. .not. core%includes_polarization ()
class default
val = .false.
end select
end function undo_helicities
subroutine reduce_interaction (int, polarized_beams, keep_fs_flavors, &
keep_colors)
type(interaction_t), intent(inout) :: int
logical, intent(in) :: polarized_beams
logical, intent(in) :: keep_fs_flavors, keep_colors
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
logical, dimension(:), allocatable :: mask_f, mask_c, mask_h
integer :: n_tot, n_in
n_in = int%get_n_in (); n_tot = int%get_n_tot ()
allocate (qn_mask (n_tot))
allocate (mask_f (n_tot), mask_c (n_tot), mask_h (n_tot))
mask_c = .not. keep_colors
mask_f (1 : n_in) = .false.
if (keep_fs_flavors) then
mask_f (n_in + 1 : ) = .false.
else
mask_f (n_in + 1 : ) = .true.
end if
if (polarized_beams) then
mask_h (1 : n_in) = .false.
else
mask_h (1 : n_in) = .true.
end if
mask_h (n_in + 1 : ) = .true.
call qn_mask%init (mask_f, mask_c, mask_h)
call int%reduce_state_matrix (qn_mask, keep_order = .true.)
end subroutine reduce_interaction
<<Instances: term instance init: procedures>>
end subroutine term_instance_init
@ %def term_instance_init
@ Set up index mapping from state matrix to index pair [[i_flv]], [[i_sub]].
<<Instances: public>>=
public :: setup_interaction_qn_index
<<Instances: procedures>>=
subroutine setup_interaction_qn_index (int, data, qn_config, n_sub, is_polarized)
class(interaction_t), intent(inout) :: int
class(process_constants_t), intent(in) :: data
type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_config
integer, intent(in) :: n_sub
logical, intent(in) :: is_polarized
integer :: i
type(quantum_numbers_t), dimension(:, :), allocatable :: qn_hel
if (is_polarized) then
call setup_interaction_qn_hel (int, data, qn_hel)
call int%init_qn_index (qn_config, n_sub, qn_hel)
call int%set_qn_index_helicity_flip (.true.)
else
call int%init_qn_index (qn_config, n_sub)
end if
end subroutine setup_interaction_qn_index
@ %def setup_interaction_qn_index
@ Set up beam polarisation quantum numbers, if beam polarisation is required.
We retrieve the full helicity information from [[term%config%data]] and reduce
the information only to the inital state. Afterwards, we uniquify the initial
state polarization by a applying an index (hash) table.
The helicity information is fed into an array of quantum numbers to assign
flavor, helicity and subtraction indices correctly to their matrix element.
<<Instances: public>>=
public :: setup_interaction_qn_hel
<<Instances: procedures>>=
subroutine setup_interaction_qn_hel (int, data, qn_hel)
class(interaction_t), intent(in) :: int
class(process_constants_t), intent(in) :: data
type(quantum_numbers_t), dimension(:, :), allocatable, intent(out) :: qn_hel
type(helicity_t), dimension(:), allocatable :: hel
integer, dimension(:), allocatable :: index_table
integer, dimension(:, :), allocatable :: hel_state
integer :: i, j, n_hel_unique
associate (n_in => int%get_n_in (), n_tot => int%get_n_tot ())
allocate (hel_state (n_tot, data%get_n_hel ()), &
source = data%hel_state)
allocate (index_table (data%get_n_hel ()), &
source = 0)
forall (j=1:data%get_n_hel (), i=n_in+1:n_tot) hel_state(i, j) = 0
n_hel_unique = 0
HELICITY: do i = 1, data%get_n_hel ()
do j = 1, data%get_n_hel ()
if (index_table (j) == 0) then
index_table(j) = i; n_hel_unique = n_hel_unique + 1
cycle HELICITY
else if (all (hel_state(:, i) == &
hel_state(:, index_table(j)))) then
cycle HELICITY
end if
end do
end do HELICITY
allocate (qn_hel (n_tot, n_hel_unique))
allocate (hel (n_tot))
do j = 1, n_hel_unique
call hel%init (hel_state(:, index_table(j)))
call qn_hel(:, j)%init (hel)
end do
end associate
end subroutine setup_interaction_qn_hel
@ %def setup_interaction_qn_hel
@
<<Instances: term instance: TBP>>=
procedure :: init_interaction_qn_index => term_instance_init_interaction_qn_index
<<Instances: procedures>>=
- subroutine term_instance_init_interaction_qn_index (term, core, int, n_sub, is_polarized)
+ subroutine term_instance_init_interaction_qn_index (term, core, int, n_sub, &
+ model, is_polarized)
class(term_instance_t), intent(inout), target :: term
class(prc_core_t), intent(in) :: core
class(interaction_t), intent(inout) :: int
integer, intent(in) :: n_sub
+ class(model_data_t), intent(in) :: model
logical, intent(in), optional :: is_polarized
logical :: polarized
type(quantum_numbers_t), dimension(:, :), allocatable :: qn_config
+ integer, dimension(:,:), allocatable :: flv_born
+ type(flavor_t), dimension(:), allocatable :: flv
+ integer :: i
select type (core)
class is (prc_external_t)
+ if (present (is_polarized)) then
+ polarized = is_polarized
+ else
+ polarized = core%includes_polarization ()
+ end if
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
associate (is_born => .not. (term%nlo_type == NLO_REAL .and. &
.not. term%is_subtraction ()))
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
qn_config = config%get_qn (is_born)
end select
- if (present (is_polarized)) then
- polarized = is_polarized
- else
- polarized = core%includes_polarization ()
- end if
call setup_interaction_qn_index (int, term%config%data, &
qn_config, n_sub, polarized)
end associate
class default
- call int%init_qn_index ()
+ call term%config%data%get_flv_state (flv_born)
+ allocate (flv (size (flv_born, dim = 1)))
+ allocate (qn_config (size (flv_born, dim = 1), size (flv_born, dim = 2)))
+ do i = 1, core%data%n_flv
+ call flv%init (flv_born(:,i), model)
+ call qn_config(:, i)%init (flv)
+ end do
+ call setup_interaction_qn_index (int, term%config%data, &
+ qn_config, n_sub, polarized)
end select
class default
call int%init_qn_index ()
end select
end subroutine term_instance_init_interaction_qn_index
@ %def term_instance_init_interaction_qn_index
@
<<Instances: term instance: TBP>>=
procedure :: init_from_process => term_instance_init_from_process
<<Instances: procedures>>=
subroutine term_instance_init_from_process (term_instance, &
process, i, pcm_instance, sf_chain)
class(term_instance_t), intent(inout), target :: term_instance
type(process_t), intent(in), target :: process
integer, intent(in) :: i
class(pcm_instance_t), intent(in), target :: pcm_instance
type(sf_chain_t), intent(in), target :: sf_chain
type(process_term_t) :: term
integer :: i_component
logical :: requires_extended_sf
term = process%get_term_ptr (i)
i_component = term%i_component
if (i_component /= 0) then
term_instance%pcm_instance => pcm_instance
term_instance%nlo_type = process%get_nlo_type_component (i_component)
requires_extended_sf = term_instance%nlo_type == NLO_DGLAP .or. &
(term_instance%nlo_type == NLO_REAL .and. process%get_i_sub (i) == i)
call term_instance%setup_kinematics (sf_chain, &
process%get_beam_config_ptr (), &
process%get_phs_config (i_component), &
requires_extended_sf)
call term_instance%init (process, i, &
real_finite = process%component_is_real_finite (i_component))
select type (phs => term_instance%k_term%phs)
type is (phs_fks_t)
call term_instance%set_emitter (process%get_pcm_ptr ())
call term_instance%setup_fks_kinematics (process%get_var_list_ptr (), &
process%get_beam_config_ptr ())
end select
call term_instance%set_threshold (process%get_pcm_ptr ())
call term_instance%setup_expressions (process%get_meta (), process%get_config ())
end if
end subroutine term_instance_init_from_process
@ %def term_instance_init_from_process
@ Initialize the seed-kinematics configuration. All subobjects are
allocated explicitly.
<<Instances: term instance: TBP>>=
procedure :: setup_kinematics => term_instance_setup_kinematics
<<Instances: procedures>>=
subroutine term_instance_setup_kinematics (term, sf_chain, &
beam_config, phs_config, extended_sf)
class(term_instance_t), intent(inout) :: term
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in), target :: beam_config
class(phs_config_t), intent(in), target :: phs_config
logical, intent(in) :: extended_sf
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
call term%k_term%init_sf_chain (sf_chain, beam_config, &
extended_sf = config%has_pdfs .and. extended_sf)
class default
call term%k_term%init_sf_chain (sf_chain, beam_config)
end select
!!! Add one for additional Born matrix element
call term%k_term%init_phs (phs_config)
call term%k_term%set_nlo_info (term%nlo_type)
select type (phs => term%k_term%phs)
type is (phs_fks_t)
call phs%allocate_momenta (phs_config, &
.not. (term%nlo_type == NLO_REAL))
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
call config%region_data%init_phs_identifiers (phs%phs_identifiers)
!!! The triple select type pyramid of doom
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (allocated (pcm_instance%real_kinematics%alr_to_i_phs)) &
call config%region_data%set_alr_to_i_phs (phs%phs_identifiers, &
pcm_instance%real_kinematics%alr_to_i_phs)
end select
end select
end select
end subroutine term_instance_setup_kinematics
@ %def term_instance_setup_kinematics
@
<<Instances: term instance: TBP>>=
procedure :: setup_fks_kinematics => term_instance_setup_fks_kinematics
<<Instances: procedures>>=
subroutine term_instance_setup_fks_kinematics (term, var_list, beam_config)
class(term_instance_t), intent(inout), target :: term
type(var_list_t), intent(in) :: var_list
type(process_beam_config_t), intent(in) :: beam_config
integer :: mode
logical :: singular_jacobian
if (.not. (term%nlo_type == NLO_REAL .or. term%nlo_type == NLO_DGLAP .or. &
term%nlo_type == NLO_MISMATCH)) return
singular_jacobian = var_list%get_lval (var_str ("?powheg_use_singular_jacobian"))
if (term%nlo_type == NLO_REAL) then
mode = check_generator_mode (GEN_REAL_PHASE_SPACE)
else if (term%nlo_type == NLO_MISMATCH) then
mode = check_generator_mode (GEN_SOFT_MISMATCH)
else
mode = PHS_MODE_UNDEFINED
end if
select type (phs => term%k_term%phs)
type is (phs_fks_t)
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call config%setup_phs_generator (pcm_instance, &
phs%generator, phs%config%sqrts, mode, singular_jacobian)
if (beam_config%has_structure_function ()) then
pcm_instance%isr_kinematics%isr_mode = SQRTS_VAR
else
pcm_instance%isr_kinematics%isr_mode = SQRTS_FIXED
end if
if (debug_on) call msg_debug (D_PHASESPACE, "isr_mode: ", pcm_instance%isr_kinematics%isr_mode)
end select
end select
class default
call msg_fatal ("Phase space should be an FKS phase space!")
end select
contains
function check_generator_mode (gen_mode_default) result (gen_mode)
integer :: gen_mode
integer, intent(in) :: gen_mode_default
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
associate (settings => config%settings)
if (settings%test_coll_limit .and. settings%test_anti_coll_limit) &
call msg_fatal ("You cannot check the collinear and anti-collinear limit "&
&"at the same time!")
if (settings%test_soft_limit .and. .not. settings%test_coll_limit &
.and. .not. settings%test_anti_coll_limit) then
gen_mode = GEN_SOFT_LIMIT_TEST
else if (.not. settings%test_soft_limit .and. settings%test_coll_limit) then
gen_mode = GEN_COLL_LIMIT_TEST
else if (.not. settings%test_soft_limit .and. settings%test_anti_coll_limit) then
gen_mode = GEN_ANTI_COLL_LIMIT_TEST
else if (settings%test_soft_limit .and. settings%test_coll_limit) then
gen_mode = GEN_SOFT_COLL_LIMIT_TEST
else if (settings%test_soft_limit .and. settings%test_anti_coll_limit) then
gen_mode = GEN_SOFT_ANTI_COLL_LIMIT_TEST
else
gen_mode = gen_mode_default
end if
end associate
end select
end function check_generator_mode
end subroutine term_instance_setup_fks_kinematics
@ %def term_instance_setup_fks_kinematics
@ Set up seed kinematics, starting from the MC parameter set given as
argument. As a result, the [[k_seed]] kinematics object is evaluated
(except for the structure-function matrix-element evaluation, which we
postpone until we know the factorization scale), and we have a valid
[[p_seed]] momentum array.
<<Instances: term instance: TBP>>=
procedure :: compute_seed_kinematics => term_instance_compute_seed_kinematics
<<Instances: procedures>>=
subroutine term_instance_compute_seed_kinematics &
(term, mci_work, phs_channel, success)
class(term_instance_t), intent(inout), target :: term
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
logical, intent(out) :: success
call term%k_term%compute_selected_channel &
(mci_work, phs_channel, term%p_seed, success)
end subroutine term_instance_compute_seed_kinematics
@ %def term_instance_compute_seed_kinematics
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_radiation_kinematics => term_instance_evaluate_radiation_kinematics
<<Instances: procedures>>=
subroutine term_instance_evaluate_radiation_kinematics (term, x)
class(term_instance_t), intent(inout) :: term
real(default), dimension(:), intent(in) :: x
select type (phs => term%k_term%phs)
type is (phs_fks_t)
if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) &
call term%k_term%evaluate_radiation_kinematics (x)
end select
end subroutine term_instance_evaluate_radiation_kinematics
@ %def term_instance_evaluate_radiation_kinematics
@
<<Instances: term instance: TBP>>=
procedure :: compute_xi_ref_momenta => term_instance_compute_xi_ref_momenta
<<Instances: procedures>>=
subroutine term_instance_compute_xi_ref_momenta (term)
class(term_instance_t), intent(inout) :: term
select type (pcm => term%pcm_instance%config)
type is (pcm_nlo_t)
call term%k_term%compute_xi_ref_momenta (pcm%region_data, term%nlo_type)
end select
end subroutine term_instance_compute_xi_ref_momenta
@ %def term_instance_compute_xi_ref_momenta
@
<<Instances: term instance: TBP>>=
procedure :: generate_fsr_in => term_instance_generate_fsr_in
<<Instances: procedures>>=
subroutine term_instance_generate_fsr_in (term)
class(term_instance_t), intent(inout) :: term
select type (phs => term%k_term%phs)
type is (phs_fks_t)
call phs%generate_fsr_in ()
end select
end subroutine term_instance_generate_fsr_in
@ %def term_instance_generate_fsr_in
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_projections => term_instance_evaluate_projections
<<Instances: procedures>>=
subroutine term_instance_evaluate_projections (term)
class(term_instance_t), intent(inout) :: term
if (term%k_term%threshold .and. term%nlo_type > BORN) then
if (debug2_active (D_THRESHOLD)) &
print *, 'Evaluate on-shell projection: ', &
char (component_status (term%nlo_type))
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call term%k_term%threshold_projection (pcm_instance, term%nlo_type)
end select
end if
end subroutine term_instance_evaluate_projections
@ %def term_instance_evaluate_projections
@
<<Instances: term instance: TBP>>=
procedure :: redo_sf_chain => term_instance_redo_sf_chain
<<Instances: procedures>>=
subroutine term_instance_redo_sf_chain (term, mci_work, phs_channel)
class(term_instance_t), intent(inout) :: term
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
real(default), dimension(:), allocatable :: x
integer :: sf_channel, n
real(default) :: xi, y
n = size (mci_work%get_x_strfun ())
if (n > 0) then
allocate (x(n))
x = mci_work%get_x_strfun ()
associate (k => term%k_term)
sf_channel = k%phs%config%get_sf_channel (phs_channel)
call k%sf_chain%compute_kinematics (sf_channel, x)
deallocate (x)
end associate
end if
end subroutine term_instance_redo_sf_chain
@ %def term_instance_redo_sf_chain
@ Inverse: recover missing parts of the kinematics, given a complete
set of seed momenta. Select a channel and reconstruct the MC parameter set.
<<Instances: term instance: TBP>>=
procedure :: recover_mcpar => term_instance_recover_mcpar
<<Instances: procedures>>=
subroutine term_instance_recover_mcpar (term, mci_work, phs_channel)
class(term_instance_t), intent(inout), target :: term
type(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: phs_channel
call term%k_term%recover_mcpar (mci_work, phs_channel, term%p_seed)
end subroutine term_instance_recover_mcpar
@ %def term_instance_recover_mcpar
@ Part of [[recover_mcpar]], separately accessible. Reconstruct all
kinematics data in the structure-function chain instance.
<<Instances: term instance: TBP>>=
procedure :: recover_sfchain => term_instance_recover_sfchain
<<Instances: procedures>>=
subroutine term_instance_recover_sfchain (term, channel)
class(term_instance_t), intent(inout), target :: term
integer, intent(in) :: channel
call term%k_term%recover_sfchain (channel, term%p_seed)
end subroutine term_instance_recover_sfchain
@ %def term_instance_recover_sfchain
@ Compute the momenta in the hard interactions, one for each term that
constitutes this process component. In simple cases this amounts to
just copying momenta. In more advanced cases, we may generate
distinct sets of momenta from the seed kinematics.
The interactions in the term instances are accessed individually. We may
choose to calculate all terms at once together with the seed kinematics, use
[[component%core_state]] for storage, and just fill the interactions here.
<<Instances: term instance: TBP>>=
procedure :: compute_hard_kinematics => &
term_instance_compute_hard_kinematics
<<Instances: procedures>>=
subroutine term_instance_compute_hard_kinematics (term, skip_term, success)
class(term_instance_t), intent(inout) :: term
integer, intent(in), optional :: skip_term
logical, intent(out) :: success
type(vector4_t), dimension(:), allocatable :: p
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
if (present (skip_term)) then
if (term%config%i_term_global == skip_term) return
end if
if (term%nlo_type == NLO_REAL .and. term%k_term%emitter >= 0) then
call term%k_term%evaluate_radiation (term%p_seed, p, success)
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (config%dalitz_plot%active) then
if (term%k_term%emitter > term%k_term%n_in) then
if (p(term%k_term%emitter)**2 > tiny_07) &
call config%register_dalitz_plot (term%k_term%emitter, p)
end if
end if
end select
else if (is_subtraction_component (term%k_term%emitter, term%nlo_type)) then
call term%k_term%modify_momenta_for_subtraction (term%p_seed, p)
success = .true.
else
allocate (p (size (term%p_seed))); p = term%p_seed
success = .true.
end if
call term%int_hard%set_momenta (p)
if (debug_on) then
call msg_debug2 (D_REAL, "inside compute_hard_kinematics")
if (debug2_active (D_REAL)) call vector4_write_set (p)
end if
end subroutine term_instance_compute_hard_kinematics
@ %def term_instance_compute_hard_kinematics
@ Here, we invert this. We fetch the incoming momenta which reside
in the appropriate [[sf_chain]] object, stored within the [[k_seed]]
subobject. On the other hand, we have the outgoing momenta of the
effective interaction. We rely on the process core to compute the
remaining seed momenta and to fill the momenta within the hard
interaction. (The latter is trivial if hard and effective interaction
coincide.)
After this is done, the incoming momenta in the trace evaluator that
corresponds to the hard (effective) interaction, are still
left undefined. We remedy this by calling [[receive_kinematics]] once.
<<Instances: term instance: TBP>>=
procedure :: recover_seed_kinematics => &
term_instance_recover_seed_kinematics
<<Instances: procedures>>=
subroutine term_instance_recover_seed_kinematics (term)
class(term_instance_t), intent(inout) :: term
integer :: n_in
n_in = term%k_term%n_in
call term%k_term%get_incoming_momenta (term%p_seed(1:n_in))
associate (int_eff => term%isolated%int_eff)
call int_eff%set_momenta (term%p_seed(1:n_in), outgoing = .false.)
term%p_seed(n_in + 1 : ) = int_eff%get_momenta (outgoing = .true.)
end associate
call term%isolated%receive_kinematics ()
end subroutine term_instance_recover_seed_kinematics
@ %def term_instance_recover_seed_kinematics
@ Compute the integration parameters for all channels except the selected
one.
<<Instances: term instance: TBP>>=
procedure :: compute_other_channels => &
term_instance_compute_other_channels
<<Instances: procedures>>=
subroutine term_instance_compute_other_channels &
(term, mci_work, phs_channel)
class(term_instance_t), intent(inout), target :: term
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
call term%k_term%compute_other_channels (mci_work, phs_channel)
end subroutine term_instance_compute_other_channels
@ %def term_instance_compute_other_channels
@ Recover beam momenta, i.e., return the beam momenta as currently
stored in the kinematics subobject to their source. This is a side effect.
<<Instances: term instance: TBP>>=
procedure :: return_beam_momenta => term_instance_return_beam_momenta
<<Instances: procedures>>=
subroutine term_instance_return_beam_momenta (term)
class(term_instance_t), intent(in) :: term
call term%k_term%return_beam_momenta ()
end subroutine term_instance_return_beam_momenta
@ %def term_instance_return_beam_momenta
@
<<Instances: term instance: TBP>>=
procedure :: apply_real_partition => term_instance_apply_real_partition
<<Instances: procedures>>=
subroutine term_instance_apply_real_partition (term, process)
class(term_instance_t), intent(inout) :: term
type(process_t), intent(in) :: process
real(default) :: f, sqme
integer :: i_component
integer :: i_amp, n_amps
logical :: is_subtraction
i_component = term%config%i_component
if (process%component_is_selected (i_component) .and. &
process%get_component_nlo_type (i_component) == NLO_REAL) then
is_subtraction = process%get_component_type (i_component) == COMP_REAL_SING &
.and. term%k_term%emitter < 0
if (is_subtraction) return
select type (pcm => process%get_pcm_ptr ())
type is (pcm_nlo_t)
f = pcm%real_partition%get_f (term%p_hard)
end select
n_amps = term%connected%trace%get_n_matrix_elements ()
do i_amp = 1, n_amps
sqme = real (term%connected%trace%get_matrix_element ( &
term%connected%trace%get_qn_index (i_amp, i_sub = 0)))
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "term_instance_apply_real_partition")
select type (pcm => term%pcm_instance%config)
type is (pcm_nlo_t)
select case (process%get_component_type (i_component))
case (COMP_REAL_FIN, COMP_REAL_SING)
select case (process%get_component_type (i_component))
case (COMP_REAL_FIN)
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "Real finite")
sqme = sqme * (one - f)
case (COMP_REAL_SING)
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "Real singular")
sqme = sqme * f
end select
end select
end select
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "apply_damping: sqme", sqme)
call term%connected%trace%set_matrix_element (i_amp, cmplx (sqme, zero, default))
end do
end if
end subroutine term_instance_apply_real_partition
@ %def term_instance_apply_real_partition
@
<<Instances: term instance: TBP>>=
procedure :: get_lorentz_transformation => term_instance_get_lorentz_transformation
<<Instances: procedures>>=
function term_instance_get_lorentz_transformation (term) result (lt)
type(lorentz_transformation_t) :: lt
class(term_instance_t), intent(in) :: term
lt = term%k_term%phs%get_lorentz_transformation ()
end function term_instance_get_lorentz_transformation
@ %def term_instance_get_lorentz_transformation
@
<<Instances: term instance: TBP>>=
procedure :: get_p_hard => term_instance_get_p_hard
<<Instances: procedures>>=
pure function term_instance_get_p_hard (term_instance) result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(term_instance_t), intent(in) :: term_instance
allocate (p_hard (size (term_instance%p_hard)))
p_hard = term_instance%p_hard
end function term_instance_get_p_hard
@ %def term_instance_get_p_hard
@
<<Instances: term instance: TBP>>=
procedure :: set_emitter => term_instance_set_emitter
<<Instances: procedures>>=
subroutine term_instance_set_emitter (term, pcm)
class(term_instance_t), intent(inout) :: term
class(pcm_t), intent(in) :: pcm
integer :: i_phs
logical :: set_emitter
select type (pcm)
type is (pcm_nlo_t)
!!! Without resonances, i_alr = i_phs
i_phs = term%config%i_term
term%k_term%i_phs = term%config%i_term
select type (phs => term%k_term%phs)
type is (phs_fks_t)
set_emitter = i_phs <= pcm%region_data%n_phs .and. term%nlo_type == NLO_REAL
if (set_emitter) then
term%k_term%emitter = phs%phs_identifiers(i_phs)%emitter
select type (pcm => term%pcm_instance%config)
type is (pcm_nlo_t)
if (allocated (pcm%region_data%i_phs_to_i_con)) &
term%k_term%i_con = pcm%region_data%i_phs_to_i_con (i_phs)
end select
end if
end select
end select
end subroutine term_instance_set_emitter
@ %def term_instance_set_emitter
@
<<Instances: term instance: TBP>>=
procedure :: set_threshold => term_instance_set_threshold
<<Instances: procedures>>=
subroutine term_instance_set_threshold (term, pcm)
class(term_instance_t), intent(inout) :: term
class(pcm_t), intent(in) :: pcm
select type (pcm)
type is (pcm_nlo_t)
term%k_term%threshold = pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD
class default
term%k_term%threshold = .false.
end select
end subroutine term_instance_set_threshold
@ %def term_instance_set_threshold
@ For initializing the expressions, we need the local variable list and the
parse trees.
<<Instances: term instance: TBP>>=
procedure :: setup_expressions => term_instance_setup_expressions
<<Instances: procedures>>=
subroutine term_instance_setup_expressions (term, meta, config)
class(term_instance_t), intent(inout), target :: term
type(process_metadata_t), intent(in), target :: meta
type(process_config_data_t), intent(in) :: config
if (allocated (config%ef_cuts)) &
call term%connected%setup_cuts (config%ef_cuts)
if (allocated (config%ef_scale)) &
call term%connected%setup_scale (config%ef_scale)
if (allocated (config%ef_fac_scale)) &
call term%connected%setup_fac_scale (config%ef_fac_scale)
if (allocated (config%ef_ren_scale)) &
call term%connected%setup_ren_scale (config%ef_ren_scale)
if (allocated (config%ef_weight)) &
call term%connected%setup_weight (config%ef_weight)
end subroutine term_instance_setup_expressions
@ %def term_instance_setup_expressions
@ Prepare the extra evaluators that we need for processing events.
The quantum numbers mask of the incoming particle
<<Instances: term instance: TBP>>=
procedure :: setup_event_data => term_instance_setup_event_data
<<Instances: procedures>>=
subroutine term_instance_setup_event_data (term, core, model)
class(term_instance_t), intent(inout), target :: term
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
integer :: n_in
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
n_in = term%int_hard%get_n_in ()
allocate (mask_in (n_in))
mask_in = term%k_term%sf_chain%get_out_mask ()
call setup_isolated (term%isolated, core, model, mask_in, term%config%col)
call setup_connected (term%connected, term%isolated, term%nlo_type)
- contains
- subroutine setup_isolated (isolated, core, model, mask, color)
- type(isolated_state_t), intent(inout), target :: isolated
- class(prc_core_t), intent(in) :: core
- class(model_data_t), intent(in), target :: model
- type(quantum_numbers_mask_t), intent(in), dimension(:) :: mask
- integer, intent(in), dimension(:) :: color
- call isolated%setup_square_matrix (core, model, mask, color)
- call isolated%setup_square_flows (core, model, mask)
- end subroutine setup_isolated
-
- subroutine setup_connected (connected, isolated, nlo_type)
- type(connected_state_t), intent(inout), target :: connected
- type(isolated_state_t), intent(in), target :: isolated
- integer :: nlo_type
- type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
- call connected%setup_connected_matrix (isolated)
- if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL &
- .and. term%config%i_term_global == term%config%i_sub) &
- .or. term%nlo_type == NLO_DGLAP) then
- !!! We don't care about the subtraction matrix elements in
- !!! connected%matrix, because all entries there are supposed
- !!! to be squared. To be able to match with flavor quantum numbers,
- !!! we remove the subtraction quantum entries from the state matrix.
- allocate (mask (connected%matrix%get_n_tot()))
- call mask%set_sub (1)
- call connected%matrix%reduce_state_matrix (mask, keep_order = .true.)
- end if
- call term%init_interaction_qn_index (core, connected%matrix, n_sub = 0, &
- is_polarized = .false.)
- call connected%setup_connected_flows (isolated)
- call connected%setup_state_flv (isolated%get_n_out ())
- end subroutine setup_connected
- end subroutine term_instance_setup_event_data
+ contains
+ subroutine setup_isolated (isolated, core, model, mask, color)
+ type(isolated_state_t), intent(inout), target :: isolated
+ class(prc_core_t), intent(in) :: core
+ class(model_data_t), intent(in), target :: model
+ type(quantum_numbers_mask_t), intent(in), dimension(:) :: mask
+ integer, intent(in), dimension(:) :: color
+ call isolated%setup_square_matrix (core, model, mask, color)
+ call isolated%setup_square_flows (core, model, mask)
+ end subroutine setup_isolated
+
+ subroutine setup_connected (connected, isolated, nlo_type)
+ type(connected_state_t), intent(inout), target :: connected
+ type(isolated_state_t), intent(in), target :: isolated
+ integer :: nlo_type
+ type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
+ call connected%setup_connected_matrix (isolated)
+ if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL &
+ .and. term%config%i_term_global == term%config%i_sub) &
+ .or. term%nlo_type == NLO_DGLAP) then
+ !!! We don't care about the subtraction matrix elements in
+ !!! connected%matrix, because all entries there are supposed
+ !!! to be squared. To be able to match with flavor quantum numbers,
+ !!! we remove the subtraction quantum entries from the state matrix.
+ allocate (mask (connected%matrix%get_n_tot()))
+ call mask%set_sub (1)
+ call connected%matrix%reduce_state_matrix (mask, keep_order = .true.)
+ end if
+ call term%init_interaction_qn_index (core, connected%matrix, 0, model, &
+ is_polarized = .false.)
+ call connected%setup_connected_flows (isolated)
+ call connected%setup_state_flv (isolated%get_n_out ())
+ end subroutine setup_connected
+ end subroutine term_instance_setup_event_data
@ %def term_instance_setup_event_data
@ Color-correlated matrix elements should be obtained from
the external BLHA provider. According to the standard, the
matrix elements output is a one-dimensional array. For FKS
subtraction, we require the matrix $B_{ij}$. BLHA prescribes
a mapping $(i, j) \to k$, where $k$ is the index of the matrix
element in the output array. It focusses on the off-diagonal entries,
i.e. $i \neq j$. The subroutine [[blha_color_c_fill_offdiag]] realizes
this mapping. The diagonal entries can simply be obtained as
the product of the Born matrix element and either $C_A$ or $C_F$,
which is achieved by [[blha_color_c_fill_diag]].
For simple processes, i.e. those with only one color line, it is
$B_{ij} = C_F \cdot B$. For those, we keep the possibility of computing
color correlations by a multiplication of the Born matrix element with $C_F$.
It is triggered by the [[use_internal_color_correlations]] flag and should
be used only for testing purposes. However, it is also used for
the threshold computation where the process is well-defined and fixed.
<<Instances: term instance: TBP>>=
procedure :: evaluate_color_correlations => &
term_instance_evaluate_color_correlations
<<Instances: procedures>>=
subroutine term_instance_evaluate_color_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv_born
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (debug_on) call msg_debug2 (D_SUBTRACTION, &
"term_instance_evaluate_color_correlations: " // &
"use_internal_color_correlations:", &
config%settings%use_internal_color_correlations)
if (debug_on) call msg_debug2 (D_SUBTRACTION, "fac_scale", term%fac_scale)
do i_flv_born = 1, config%region_data%n_flv_born
select case (term%nlo_type)
case (NLO_REAL)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%real_sub%sqme_born (i_flv_born), &
pcm_instance%real_sub%sqme_born_color_c (:, :, i_flv_born))
case (NLO_MISMATCH)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%soft_mismatch%sqme_born (i_flv_born), &
pcm_instance%soft_mismatch%sqme_born_color_c (:, :, i_flv_born))
case (NLO_VIRTUAL)
!!! This is just a copy of the above with a different offset and can for sure be unified
call transfer_me_array_to_bij (config, i_flv_born, &
-one, pcm_instance%virtual%sqme_color_c (:, :, i_flv_born))
end select
end do
end select
end select
contains
function get_trivial_cf_factors (n_tot, flv, factorization_mode) result (beta_ij)
integer, intent(in) :: n_tot, factorization_mode
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
if (factorization_mode == NO_FACTORIZATION) then
beta_ij = get_trivial_cf_factors_default (n_tot, flv)
else
beta_ij = get_trivial_cf_factors_threshold (n_tot, flv)
end if
end function get_trivial_cf_factors
function get_trivial_cf_factors_default (n_tot, flv) result (beta_ij)
integer, intent(in) :: n_tot
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
integer :: i, j
beta_ij = zero
if (count (is_quark (flv)) == 2) then
do i = 1, n_tot
do j = 1, n_tot
if (is_quark(flv(i)) .and. is_quark(flv(j))) then
if (i == j) then
beta_ij(i,j)= -cf
else
beta_ij(i,j) = cf
end if
end if
end do
end do
end if
end function get_trivial_cf_factors_default
function get_trivial_cf_factors_threshold (n_tot, flv) result (beta_ij)
integer, intent(in) :: n_tot
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
integer :: i
beta_ij = zero
do i = 1, 4
beta_ij(i,i) = -cf
end do
beta_ij(1,2) = cf; beta_ij(2,1) = cf
beta_ij(3,4) = cf; beta_ij(4,3) = cf
end function get_trivial_cf_factors_threshold
subroutine transfer_me_array_to_bij (pcm, i_flv, &
sqme_born, sqme_color_c)
type(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
real(default), intent(in) :: sqme_born
real(default), dimension(:,:), intent(inout) :: sqme_color_c
integer :: i_color_c, i_sub, n_offset
real(default), dimension(:), allocatable :: sqme
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "transfer_me_array_to_bij")
if (pcm%settings%use_internal_color_correlations) then
!!! A negative value for sqme_born indicates that the Born matrix
!!! element is multiplied at a different place, e.g. in the case
!!! of the virtual component
sqme_color_c = get_trivial_cf_factors &
(pcm%region_data%get_n_legs_born (), &
pcm%region_data%get_flv_states_born (i_flv), &
pcm%settings%factorization_mode)
if (sqme_born > zero) then
sqme_color_c = sqme_born * sqme_color_c
else if (sqme_born == zero) then
sqme_color_c = zero
end if
else
n_offset = 0
if (term%nlo_type == NLO_VIRTUAL) then
n_offset = 1
else if (pcm%has_pdfs .and. term%is_subtraction ()) then
n_offset = n_beams_rescaled
end if
allocate (sqme (term%get_n_sub_color ()), source = zero)
do i_sub = 1, term%get_n_sub_color ()
sqme(i_sub) = real(term%connected%trace%get_matrix_element ( &
term%connected%trace%get_qn_index (i_flv, i_sub = i_sub + n_offset)), &
default)
end do
call blha_color_c_fill_offdiag (pcm%region_data%n_legs_born, &
sqme, sqme_color_c)
call blha_color_c_fill_diag (real(term%connected%trace%get_matrix_element ( &
term%connected%trace%get_qn_index (i_flv, i_sub = 0)), default), &
pcm%region_data%get_flv_states_born (i_flv), &
sqme_color_c)
end if
end subroutine transfer_me_array_to_bij
end subroutine term_instance_evaluate_color_correlations
@ %def term_instance_evaluate_color_correlations
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_charge_correlations => &
term_instance_evaluate_charge_correlations
<<Instances: procedures>>=
subroutine term_instance_evaluate_charge_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv_born
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
do i_flv_born = 1, config%region_data%n_flv_born
select case (term%nlo_type)
case (NLO_REAL)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%real_sub%sqme_born (i_flv_born), &
pcm_instance%real_sub%sqme_born_charge_c (:, :, i_flv_born))
case (NLO_MISMATCH)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%soft_mismatch%sqme_born (i_flv_born), &
pcm_instance%soft_mismatch%sqme_born_charge_c (:, :, i_flv_born))
case (NLO_VIRTUAL)
call transfer_me_array_to_bij (config, i_flv_born, &
-one, pcm_instance%virtual%sqme_charge_c (:, :, i_flv_born))
end select
end do
end select
end select
contains
subroutine transfer_me_array_to_bij (pcm, i_flv, sqme_born, sqme_charge_c)
type(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
real(default), intent(in) :: sqme_born
real(default), dimension(:,:), intent(inout) :: sqme_charge_c
integer :: n_legs_born, i, j
integer, dimension(:), allocatable :: sigma
real(default), dimension(:), allocatable :: Q
n_legs_born = pcm%region_data%n_legs_born
associate (flv_born => pcm%region_data%flv_born(i_flv))
allocate (sigma (n_legs_born), Q (size (flv_born%charge)))
Q = flv_born%charge
sigma(1:flv_born%n_in) = sign (1, flv_born%flst(1:flv_born%n_in))
sigma(flv_born%n_in + 1: ) = -sign (1, flv_born%flst(flv_born%n_in + 1: ))
end associate
do i = 1, n_legs_born
do j = 1, n_legs_born
sqme_charge_c(i, j) = sigma(i) * sigma(j) * Q(i) * Q(j) * (-one)
end do
end do
sqme_charge_c = sqme_charge_c * sqme_born
end subroutine transfer_me_array_to_bij
end subroutine term_instance_evaluate_charge_correlations
@ %def term_instance_evaluate_charge_correlations
@ The information about spin correlations is not stored in the [[nlo_settings]] because
it is only available after the [[fks_regions]] have been created.
<<Instances: term instance: TBP>>=
procedure :: evaluate_spin_correlations => term_instance_evaluate_spin_correlations
<<Instances: procedures>>=
subroutine term_instance_evaluate_spin_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv, i_sub, i_emitter, emitter
integer :: n_flv, n_sub_color, n_sub_spin, n_offset,i,j
real(default), dimension(1:3, 1:3) :: sqme_spin_c
real(default), dimension(:), allocatable :: sqme_spin_c_all
real(default), dimension(:), allocatable :: sqme_spin_c_arr
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_spin_correlations")
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (pcm_instance%real_sub%requires_spin_correlations () &
.and. term%nlo_type == NLO_REAL) then
select type (core)
type is (prc_openloops_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_flv = term%connected%trace%get_qn_index_n_flv ()
n_sub_color = term%get_n_sub_color ()
n_sub_spin = term%get_n_sub_spin ()
n_offset = 0; if (config%has_pdfs) n_offset = n_beams_rescaled
allocate (sqme_spin_c_arr(6))
do i_flv = 1, n_flv
allocate (sqme_spin_c_all(n_sub_spin))
do i_sub = 1, n_sub_spin
sqme_spin_c_all(i_sub) = real(term%connected%trace%get_matrix_element &
(term%connected%trace%get_qn_index (i_flv, &
i_sub = i_sub + n_offset + n_sub_color)), default)
end do
do i_emitter = 1, config%region_data%n_emitters
emitter = config%region_data%emitters(i_emitter)
if (emitter > 0) then
call split_array (sqme_spin_c_all, sqme_spin_c_arr)
do j = 1, size (sqme_spin_c, dim=2)
do i = j, size (sqme_spin_c, dim=1)
!!! Restoring the symmetric matrix packed into a 1-dim array
!!! c.f. [[prc_openloops_compute_sqme_spin_c]]
sqme_spin_c(i,j) = sqme_spin_c_arr(j + i * (i - 1) / 2)
if (i /= j) sqme_spin_c(j,i) = sqme_spin_c(i,j)
end do
end do
pcm_instance%real_sub%sqme_born_spin_c(:,:,emitter,i_flv) = sqme_spin_c
end if
end do
deallocate (sqme_spin_c_all)
end do
end select
class default
call msg_fatal ("Spin correlations so far only supported by OpenLoops.")
end select
end if
end select
end subroutine term_instance_evaluate_spin_correlations
@ %def term_instance_evaluate_spin_correlations
@
<<Instances: term instance: TBP>>=
procedure :: apply_fks => term_instance_apply_fks
<<Instances: procedures>>=
subroutine term_instance_apply_fks (term, alpha_s_sub, alpha_qed_sub)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s_sub, alpha_qed_sub
real(default), dimension(:), allocatable :: sqme
integer :: i, i_phs, emitter
logical :: is_subtraction
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (term%connected%has_matrix) then
allocate (sqme (config%get_n_alr ()))
else
allocate (sqme (1))
end if
sqme = zero
select type (phs => term%k_term%phs)
type is (phs_fks_t)
call pcm_instance%set_real_and_isr_kinematics &
(phs%phs_identifiers, term%k_term%phs%get_sqrts ())
if (term%k_term%emitter < 0) then
call pcm_instance%set_subtraction_event ()
do i_phs = 1, config%region_data%n_phs
emitter = phs%phs_identifiers(i_phs)%emitter
call pcm_instance%real_sub%compute (emitter, &
i_phs, alpha_s_sub, alpha_qed_sub, term%connected%has_matrix, sqme)
end do
else
call pcm_instance%set_radiation_event ()
emitter = term%k_term%emitter; i_phs = term%k_term%i_phs
do i = 1, term%connected%trace%get_qn_index_n_flv ()
pcm_instance%real_sub%sqme_real_non_sub (i, i_phs) = &
real (term%connected%trace%get_matrix_element ( &
term%connected%trace%get_qn_index (i)))
end do
call pcm_instance%real_sub%compute (emitter, i_phs, alpha_s_sub, &
alpha_qed_sub, term%connected%has_matrix, sqme)
end if
end select
end select
end select
if (term%connected%has_trace) &
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum(sqme), 0, default))
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
is_subtraction = term%k_term%emitter < 0
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme * term%weight, 0, default), &
config%get_qn (is_subtraction), &
config%region_data%get_flavor_indices (is_subtraction), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme * term%weight, 0, default), &
config%get_qn (is_subtraction), &
config%region_data%get_flavor_indices (is_subtraction), &
term%connected%flows)
end select
end subroutine term_instance_apply_fks
@ %def term_instance_apply_fks
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_virt => term_instance_evaluate_sqme_virt
<<Instances: procedures>>=
subroutine term_instance_evaluate_sqme_virt (term, alpha_s, alpha_qed)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s, alpha_qed
real(default) :: alpha_coupling
type(vector4_t), dimension(:), allocatable :: p_born
real(default), dimension(:), allocatable :: sqme_virt
integer :: i_flv
if (term%nlo_type /= NLO_VIRTUAL) call msg_fatal &
("Trying to evaluate virtual matrix element with unsuited term_instance.")
if (debug2_active (D_VIRTUAL)) then
call msg_debug2 (D_VIRTUAL, "Evaluating virtual-subtracted matrix elements")
print *, 'ren_scale: ', term%ren_scale
print *, 'fac_scale: ', term%fac_scale
print *, 'Ellis-Sexton scale:', term%es_scale
end if
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select case (char (config%region_data%regions(1)%nlo_correction_type))
case ("QCD")
alpha_coupling = alpha_s
if (debug2_active (D_VIRTUAL)) print *, 'alpha_s: ', alpha_coupling
case ("EW")
alpha_coupling = alpha_qed
if (debug2_active (D_VIRTUAL)) print *, 'alpha_qed: ', alpha_coupling
end select
allocate (p_born (config%region_data%n_legs_born))
if (config%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
p_born = pcm_instance%real_kinematics%p_born_onshell%get_momenta(1)
else
p_born = term%int_hard%get_momenta ()
end if
call pcm_instance%set_momenta_and_scales_virtual &
(p_born, term%ren_scale, term%fac_scale, term%es_scale)
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
associate (virtual => pcm_instance%virtual)
do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
virtual%sqme_born(i_flv) = &
real (term%connected%trace%get_matrix_element ( &
term%connected%trace%get_qn_index (i_flv, i_sub = 0)))
virtual%sqme_virt_fin(i_flv) = &
real (term%connected%trace%get_matrix_element ( &
term%connected%trace%get_qn_index (i_flv, i_sub = 1)))
end do
end associate
end select
call pcm_instance%compute_sqme_virt (term%p_hard, alpha_coupling, &
term%connected%has_matrix, sqme_virt)
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum(sqme_virt), 0, default))
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme_virt * term%weight, 0, default), &
config%get_qn (.true.), &
remove_duplicates_from_int_array ( &
config%region_data%get_flavor_indices (.true.)), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme_virt * term%weight, 0, default), &
config%get_qn (.true.), &
remove_duplicates_from_int_array ( &
config%region_data%get_flavor_indices (.true.)), &
term%connected%flows)
end select
end select
end subroutine term_instance_evaluate_sqme_virt
@ %def term_instance_evaluate_sqme_virt
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_mismatch => term_instance_evaluate_sqme_mismatch
<<Instances: procedures>>=
subroutine term_instance_evaluate_sqme_mismatch (term, alpha_s)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s
real(default), dimension(:), allocatable :: sqme_mism
if (term%nlo_type /= NLO_MISMATCH) call msg_fatal &
("Trying to evaluate soft mismatch with unsuited term_instance.")
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call pcm_instance%compute_sqme_mismatch &
(alpha_s, term%connected%has_matrix, sqme_mism)
end select
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum (sqme_mism) * term%weight, 0, default))
if (term%connected%has_matrix) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme_mism * term%weight, 0, default), &
config%get_qn (.true.), &
remove_duplicates_from_int_array ( &
config%region_data%get_flavor_indices (.true.)), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme_mism * term%weight, 0, default), &
config%get_qn (.true.), &
remove_duplicates_from_int_array ( &
config%region_data%get_flavor_indices (.true.)), &
term%connected%flows)
end select
end if
end subroutine term_instance_evaluate_sqme_mismatch
@ %def term_instance_evaluate_sqme_mismatch
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_dglap => term_instance_evaluate_sqme_dglap
<<Instances: procedures>>=
subroutine term_instance_evaluate_sqme_dglap (term, alpha_s)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s
real(default), dimension(:), allocatable :: sqme_dglap
integer :: i_flv
if (term%nlo_type /= NLO_DGLAP) call msg_fatal &
("Trying to evaluate DGLAP remnant with unsuited term_instance.")
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "term_instance_evaluate_sqme_dglap")
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (debug2_active (D_PROCESS_INTEGRATION)) then
associate (n_flv => pcm_instance%dglap_remnant%reg_data%n_flv_born)
print *, "size(sqme_born) = ", size (pcm_instance%dglap_remnant%sqme_born)
call term%connected%trace%write ()
do i_flv = 1, n_flv
print *, "i_flv = ", i_flv, ", n_flv = ", n_flv
print *, "sqme_born(i_flv) = ", pcm_instance%dglap_remnant%sqme_born(i_flv)
end do
end associate
end if
call pcm_instance%compute_sqme_dglap_remnant (alpha_s, &
term%connected%has_matrix, sqme_dglap)
end select
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum (sqme_dglap) * term%weight, 0, default))
if (term%connected%has_matrix) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme_dglap * term%weight, 0, default), &
config%get_qn (.true.), &
remove_duplicates_from_int_array ( &
config%region_data%get_flavor_indices (.true.)), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme_dglap * term%weight, 0, default), &
config%get_qn (.true.), &
remove_duplicates_from_int_array ( &
config%region_data%get_flavor_indices (.true.)), &
term%connected%flows)
end select
end if
end subroutine term_instance_evaluate_sqme_dglap
@ %def term_instance_evaluate_sqme_dglap
@ Reset the term instance: clear the parton-state expressions and deactivate.
<<Instances: term instance: TBP>>=
procedure :: reset => term_instance_reset
<<Instances: procedures>>=
subroutine term_instance_reset (term)
class(term_instance_t), intent(inout) :: term
call term%connected%reset_expressions ()
if (allocated (term%alpha_qcd_forced)) deallocate (term%alpha_qcd_forced)
term%active = .false.
end subroutine term_instance_reset
@ %def term_instance_reset
@ Force an $\alpha_s$ value that should be used in the matrix-element
calculation.
<<Instances: term instance: TBP>>=
procedure :: set_alpha_qcd_forced => term_instance_set_alpha_qcd_forced
<<Instances: procedures>>=
subroutine term_instance_set_alpha_qcd_forced (term, alpha_qcd)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_qcd
if (allocated (term%alpha_qcd_forced)) then
term%alpha_qcd_forced = alpha_qcd
else
allocate (term%alpha_qcd_forced, source = alpha_qcd)
end if
end subroutine term_instance_set_alpha_qcd_forced
@ %def term_instance_set_alpha_qcd_forced
@ Complete the kinematics computation for the effective parton states.
We assume that the [[compute_hard_kinematics]] method of the process
component instance has already been called, so the [[int_hard]]
contains the correct hard kinematics. The duty of this procedure is
first to compute the effective kinematics and store this in the
[[int_eff]] effective interaction inside the [[isolated]] parton
state. The effective kinematics may differ from the kinematics in the hard
interaction. It may involve parton recombination or parton splitting.
The [[rearrange_partons]] method is responsible for this part.
We may also call a method to compute the effective structure-function
chain at this point. This is not implemented yet.
In the simple case that no rearrangement is necessary, as indicated by
the [[rearrange]] flag, the effective interaction is a pointer to the
hard interaction, and we can skip the rearrangement method. Similarly
for the effective structure-function chain. (If we have an algorithm
that uses rarrangement, it should evaluate [[k_term]] explicitly.)
The final step of kinematics setup is to transfer the effective
kinematics to the evaluators and to the [[subevt]].
<<Instances: term instance: TBP>>=
procedure :: compute_eff_kinematics => &
term_instance_compute_eff_kinematics
<<Instances: procedures>>=
subroutine term_instance_compute_eff_kinematics (term)
class(term_instance_t), intent(inout) :: term
term%checked = .false.
term%passed = .false.
call term%isolated%receive_kinematics ()
call term%connected%receive_kinematics ()
end subroutine term_instance_compute_eff_kinematics
@ %def term_instance_compute_eff_kinematics
@ Inverse. Reconstruct the connected state from the momenta in the
trace evaluator (which we assume to be set), then reconstruct the
isolated state as far as possible. The second part finalizes the
momentum configuration, using the incoming seed momenta
<<Instances: term instance: TBP>>=
procedure :: recover_hard_kinematics => &
term_instance_recover_hard_kinematics
<<Instances: procedures>>=
subroutine term_instance_recover_hard_kinematics (term)
class(term_instance_t), intent(inout) :: term
term%checked = .false.
term%passed = .false.
call term%connected%send_kinematics ()
call term%isolated%send_kinematics ()
end subroutine term_instance_recover_hard_kinematics
@ %def term_instance_recover_hard_kinematics
@ Check the term whether it passes cuts and, if successful, evaluate
scales and weights. The factorization scale is also given to the term
kinematics, enabling structure-function evaluation.
<<Instances: term instance: TBP>>=
procedure :: evaluate_expressions => &
term_instance_evaluate_expressions
<<Instances: procedures>>=
subroutine term_instance_evaluate_expressions (term, scale_forced)
class(term_instance_t), intent(inout) :: term
real(default), intent(in), allocatable, optional :: scale_forced
call term%connected%evaluate_expressions (term%passed, &
term%scale, term%fac_scale, term%ren_scale, term%weight, &
scale_forced, force_evaluation = .true.)
term%checked = .true.
end subroutine term_instance_evaluate_expressions
@ %def term_instance_evaluate_expressions
@ Evaluate the trace: first evaluate the hard interaction, then the trace
evaluator. We use the [[evaluate_interaction]] method of the process
component which generated this term. The [[subevt]] and cut expressions are
not yet filled.
The [[component]] argument is intent(inout) because the [[compute_amplitude]]
method may modify the [[core_state]] workspace object.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction => term_instance_evaluate_interaction
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in), pointer :: core
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction")
if (term%k_term%only_cm_frame .and. (.not. term%k_term%lab_is_cm())) then
term%p_hard = term%get_boost_to_cms () * term%int_hard%get_momenta ()
else
term%p_hard = term%int_hard%get_momenta ()
end if
select type (core)
class is (prc_external_t)
call term%evaluate_interaction_userdef (core)
class default
call term%evaluate_interaction_default (core)
end select
call term%int_hard%set_matrix_element (term%amp)
end subroutine term_instance_evaluate_interaction
@ %def term_instance_evaluate_interaction
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_default &
=> term_instance_evaluate_interaction_default
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_default (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: i
do i = 1, term%config%n_allowed
term%amp(i) = core%compute_amplitude (term%config%i_term, term%p_hard, &
term%config%flv(i), term%config%hel(i), term%config%col(i), &
term%fac_scale, term%ren_scale, term%alpha_qcd_forced, &
term%core_state)
end do
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call pcm_instance%set_fac_scale (term%fac_scale)
end select
end subroutine term_instance_evaluate_interaction_default
@ %def term_instance_evaluate_interaction_default
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_userdef &
=> term_instance_evaluate_interaction_userdef
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_userdef (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_userdef")
select type (core_state => term%core_state)
type is (openloops_state_t)
select type (core)
type is (prc_openloops_t)
call core%compute_alpha_s (core_state, term%ren_scale)
if (allocated (core_state%threshold_data)) &
call evaluate_threshold_parameters (core_state, core, term%k_term%phs%get_sqrts ())
end select
class is (prc_external_state_t)
select type (core)
class is (prc_external_t)
call core%compute_alpha_s (core_state, term%ren_scale)
end select
end select
call evaluate_threshold_interaction ()
if (term%nlo_type == NLO_VIRTUAL) then
call term%evaluate_interaction_userdef_loop (core)
else
call term%evaluate_interaction_userdef_tree (core)
end if
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call pcm_instance%set_fac_scale (term%fac_scale)
end select
contains
subroutine evaluate_threshold_parameters (core_state, core, sqrts)
type(openloops_state_t), intent(inout) :: core_state
type(prc_openloops_t), intent(inout) :: core
real(default), intent(in) :: sqrts
real(default) :: mtop, wtop
mtop = m1s_to_mpole (sqrts)
wtop = core_state%threshold_data%compute_top_width &
(mtop, core_state%alpha_qcd)
call core%set_mass_and_width (6, mtop, wtop)
end subroutine
subroutine evaluate_threshold_interaction ()
integer :: leg
select type (core)
type is (prc_threshold_t)
if (term%nlo_type > BORN) then
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (term%k_term%emitter >= 0) then
call core%set_offshell_momenta &
(pcm%real_kinematics%p_real_cms%get_momenta(term%config%i_term))
leg = thr_leg (term%k_term%emitter)
call core%set_leg (leg)
call core%set_onshell_momenta &
(pcm%real_kinematics%p_real_onshell(leg)%get_momenta(term%config%i_term))
else
call core%set_leg (0)
call core%set_offshell_momenta &
(pcm%real_kinematics%p_born_cms%get_momenta(1))
end if
end select
else
call core%set_leg (-1)
call core%set_offshell_momenta (term%p_hard)
end if
end select
end subroutine evaluate_threshold_interaction
end subroutine term_instance_evaluate_interaction_userdef
@ %def term_instance_evaluate_interaction_userdef
@ Retrieve the matrix elements from a matrix element provider and place them
into [[term%amp]].
For the handling of NLO calculations, FKS applies a book keeping handling
flavor and/or particle type (e.g. for QCD: quark/gluon and quark flavor) in
order to calculate the subtraction terms. Therefore, we have to insert the
calculated matrix elements correctly into the state matrix where each entry
corresponds to a set of quantum numbers. We apply a mapping [[hard_qn_ind]] from a list of
quantum numbers provided by FKS to the hard process [[int_hard]].
The calculated matrix elements are insert into [[term%amp]] in the following
way. The first [[n_born]] particles are the matrix element of the hard process.
In non-trivial beams, we store another [[n_beams_rescaled]] copies of these
matrix elements as the first [[n_beams_rescaled]] subtractions. This is a remnant
from times before the method [[term_instance_set_sf_factors]] and these entries are
not used anymore. However, eliminating these entries involves deeper changes in how
the connection tables for the evaluator product are set up and should therefore be
part of a larger refactoring of the interactions \& state matrices.
The next $n_{\text{born}}\times n_{sub_color}$ are color-correlated Born matrix elements,
with then again the next $n_{\text{born}}\times n_{emitters}\times n_{sub_spin}$ being
spin-correlated Born matrix elements.
If two or more flavor structures would produce the same amplitude we only compute
one and use the [[eqv_index]] determined by the [[prc_core]] and just copy the result
to improve performance.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_userdef_tree &
=> term_instance_evaluate_interaction_userdef_tree
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_userdef_tree (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
real(default) :: sqme
real(default), dimension(:), allocatable :: sqme_color_c
real(default), dimension(:), allocatable :: sqme_spin_c
real(default), dimension(6) :: sqme_spin_c_tmp
integer :: n_flv, n_hel, n_sub_color, n_sub_spin, n_pdf_off
integer :: i_flv, i_hel, i_sub, i_color_c, i_color_c_eqv, i_spin_c, i_spin_c_eqv
integer :: i_flv_eqv, i_hel_eqv
integer :: emitter, i_emitter
logical :: bad_point, bp
logical, dimension(:,:), allocatable :: eqv_me_evaluated
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_userdef_tree")
allocate (sqme_color_c (blha_result_array_size &
(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
n_flv = term%int_hard%get_qn_index_n_flv ()
n_hel = term%int_hard%get_qn_index_n_hel ()
n_sub_color = term%get_n_sub_color ()
n_sub_spin = term%get_n_sub_spin ()
allocate (eqv_me_evaluated(n_flv,n_hel))
eqv_me_evaluated = .false.
do i_flv = 1, n_flv
do i_hel = 1, n_hel
i_flv_eqv = core%data%eqv_flv_index(i_flv)
i_hel_eqv = core%data%eqv_hel_index(i_hel)
if (.not. eqv_me_evaluated(i_flv_eqv, i_hel_eqv)) then
select type (core)
class is (prc_external_t)
call core%update_alpha_s (term%core_state, term%ren_scale)
call core%compute_sqme (i_flv, i_hel, term%p_hard, term%ren_scale, &
sqme, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
associate (i_int => term%int_hard%get_qn_index &
(i_flv = i_flv, i_hel = i_hel, i_sub = 0))
term%amp(i_int) = cmplx (sqme, 0, default)
end associate
end select
n_pdf_off = 0
if (term%pcm_instance%config%has_pdfs .and. &
(term%is_subtraction () .or. term%nlo_type == NLO_DGLAP)) then
n_pdf_off = n_pdf_off + n_beams_rescaled
do i_sub = 1, n_pdf_off
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub)) = &
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub = 0))
end do
end if
if ((term%nlo_type == NLO_REAL .and. term%is_subtraction ()) .or. &
term%nlo_type == NLO_MISMATCH) then
sqme_color_c = zero
select type (core)
class is (prc_blha_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%ren_scale, sqme_color_c, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
class is (prc_recola_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%ren_scale, sqme_color_c, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
end select
do i_sub = 1, n_sub_color
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel, i_sub + n_pdf_off)
term%amp(i_color_c) = cmplx (sqme_color_c(i_sub), 0, default)
end do
if (n_sub_spin > 0) then
bad_point = .false.
allocate (sqme_spin_c(0))
select type (core)
type is (prc_openloops_t)
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
do i_emitter = 1, config%region_data%n_emitters
emitter = config%region_data%emitters(i_emitter)
if (emitter > 0) then
call core%compute_sqme_spin_c &
(i_flv, &
i_hel, &
emitter, &
term%p_hard, &
term%ren_scale, &
sqme_spin_c_tmp, &
bp)
sqme_spin_c = [sqme_spin_c, sqme_spin_c_tmp]
bad_point = bad_point .or. bp
end if
end do
end select
do i_sub = 1, n_sub_spin
i_spin_c = term%int_hard%get_qn_index (i_flv, i_hel, &
i_sub + n_pdf_off + n_sub_color)
term%amp(i_spin_c) = cmplx &
(sqme_spin_c(i_sub), 0, default)
end do
end select
deallocate (sqme_spin_c)
end if
end if
eqv_me_evaluated(i_flv_eqv, i_hel_eqv) = .true.
else
associate (i_int => term%int_hard%get_qn_index &
(i_flv = i_flv, i_hel = i_hel, i_sub = 0), &
i_int_eqv => term%int_hard%get_qn_index &
(i_flv = i_flv_eqv, i_hel = i_hel_eqv, i_sub = 0))
term%amp(i_int) = term%amp(i_int_eqv)
end associate
n_pdf_off = 0
if (term%pcm_instance%config%has_pdfs .and. &
(term%is_subtraction () .or. term%nlo_type == NLO_DGLAP)) then
n_pdf_off = n_pdf_off + n_beams_rescaled
do i_sub = 1, n_pdf_off
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub)) = &
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub = 0))
end do
end if
if ((term%nlo_type == NLO_REAL .and. term%is_subtraction ()) .or. &
term%nlo_type == NLO_MISMATCH) then
do i_sub = 1, n_sub_color
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel, i_sub + n_pdf_off)
i_color_c_eqv = term%int_hard%get_qn_index &
(i_flv_eqv, i_hel_eqv, i_sub + n_pdf_off)
term%amp(i_color_c) = term%amp(i_color_c_eqv)
end do
do i_sub = 1, n_sub_spin
i_spin_c = term%int_hard%get_qn_index (i_flv, i_hel, &
i_sub + n_pdf_off + n_sub_color)
i_spin_c_eqv = term%int_hard%get_qn_index (i_flv_eqv, i_hel_eqv, &
i_sub + n_pdf_off + n_sub_color)
term%amp(i_spin_c) = term%amp(i_spin_c_eqv)
end do
end if
end if
end do
end do
end subroutine term_instance_evaluate_interaction_userdef_tree
@ %def term_instance_evaluate_interaction_userdef_tree
@ Same as for [[term_instance_evaluate_interaction_userdef_tree]], but
for the integrated-subtraction and finite one-loop terms. We only need
color-correlated Born matrix elements, but an additional entry per
flavor structure for the finite one-loop contribution. We thus have
$2+n_{sub_color}$ entries in the [[term%amp]] for each [[i_flv]] and
[[i_hel]] combination.
If two or more flavor structures would produce the same amplitude we only compute
one and use the [[eqv_index]] determined by the [[prc_core]] and just copy the result
to improve performance.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_userdef_loop &
=> term_instance_evaluate_interaction_userdef_loop
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_userdef_loop (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: n_hel, n_sub, n_flv
integer :: i, i_flv, i_hel, i_sub, i_virt, i_color_c, i_color_c_eqv
integer :: i_flv_eqv, i_hel_eqv
real(default), dimension(4) :: sqme_virt
real(default), dimension(:), allocatable :: sqme_color_c
logical :: bad_point
logical, dimension(:,:), allocatable :: eqv_me_evaluated
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_userdef_loop")
allocate (sqme_color_c (blha_result_array_size &
(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
n_flv = term%int_hard%get_qn_index_n_flv ()
n_hel = term%int_hard%get_qn_index_n_hel ()
n_sub = term%int_hard%get_qn_index_n_sub ()
allocate (eqv_me_evaluated(n_flv,n_hel))
eqv_me_evaluated = .false.
i_virt = 1
do i_flv = 1, n_flv
do i_hel = 1, n_hel
i_flv_eqv = core%data%eqv_flv_index(i_flv)
i_hel_eqv = core%data%eqv_hel_index(i_hel)
if (.not. eqv_me_evaluated(i_flv_eqv, i_hel_eqv)) then
select type (core)
class is (prc_external_t)
call core%compute_sqme_virt (i_flv, i_hel, term%p_hard, &
term%ren_scale, term%es_scale, &
term%pcm_instance%config%blha_defaults%loop_method, &
sqme_virt, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
end select
associate (i_born => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = 0), &
i_loop => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = i_virt))
term%amp(i_loop) = cmplx (sqme_virt(3), 0, default)
term%amp(i_born) = cmplx (sqme_virt(4), 0, default)
end associate
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
select type (core)
class is (prc_blha_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%ren_scale, &
sqme_color_c, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
do i_sub = 1 + i_virt, n_sub
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel = i_hel, i_sub = i_sub)
! Index shift: i_sub - i_virt
term%amp(i_color_c) = &
cmplx (sqme_color_c(i_sub - i_virt), 0, default)
end do
type is (prc_recola_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%ren_scale, sqme_color_c, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
do i_sub = 1 + i_virt, n_sub
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel = i_hel, i_sub = i_sub)
! Index shift: i_sub - i_virt
term%amp(i_color_c) = &
cmplx (sqme_color_c(i_sub - i_virt), 0, default)
end do
end select
end select
eqv_me_evaluated(i_flv_eqv, i_hel_eqv) = .true.
else
associate (i_born => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = 0), &
i_loop => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = i_virt), &
i_born_eqv => term%int_hard%get_qn_index &
(i_flv_eqv, i_hel = i_hel_eqv, i_sub = 0), &
i_loop_eqv => term%int_hard%get_qn_index &
(i_flv_eqv, i_hel = i_hel_eqv, i_sub = 1))
term%amp(i_loop) = term%amp(i_loop_eqv)
term%amp(i_born) = term%amp(i_born_eqv)
end associate
do i_sub = 1 + i_virt, n_sub
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel = i_hel, i_sub = i_sub)
i_color_c_eqv = term%int_hard%get_qn_index &
(i_flv_eqv, i_hel = i_hel_eqv, i_sub = i_sub)
! Index shift: i_sub - i_virt
term%amp(i_color_c) = term%amp(i_color_c_eqv)
end do
end if
end do
end do
end subroutine term_instance_evaluate_interaction_userdef_loop
@ %def term_instance_evaluate_interaction_userdef_loop
@ Evaluate the trace. First evaluate the
structure-function chain (i.e., the density matrix of the incoming
partons). Do this twice, in case the sf-chain instances within
[[k_term]] and [[isolated]] differ. Next, evaluate the hard
interaction, then compute the convolution with the initial state.
<<Instances: term instance: TBP>>=
procedure :: evaluate_trace => term_instance_evaluate_trace
<<Instances: procedures>>=
subroutine term_instance_evaluate_trace (term)
class(term_instance_t), intent(inout) :: term
call term%k_term%evaluate_sf_chain (term%fac_scale)
call term%evaluate_scaled_sf_chains ()
call term%isolated%evaluate_sf_chain (term%fac_scale)
call term%isolated%evaluate_trace ()
call term%connected%evaluate_trace ()
end subroutine term_instance_evaluate_trace
@ %def term_instance_evaluate_trace
@ Include rescaled structure functions due to NLO calculation.
We rescale the structure function for the real subtraction [[sf_rescale_collinear]],
the collinear counter terms [[sf_rescale_dglap_t]] and for the case, in which we have
an emitter in the initial state, we rescale the kinematics for it using [[sf_rescale_real_t]].\\
References: arXiv:0709.2092, (2.35)-(2.42).\\
Obviously, it is completely irrelevant, which beam is treated.
It becomes problematic when handling [[e, p]]-beams.
<<Instances: term instance: TBP>>=
procedure :: evaluate_scaled_sf_chains => term_instance_evaluate_scaled_sf_chains
<<Instances: procedures>>=
subroutine term_instance_evaluate_scaled_sf_chains (term)
class(term_instance_t), intent(inout) :: term
class(sf_rescale_t), allocatable :: sf_rescale
if (.not. term%pcm_instance%config%has_pdfs) return
if (term%nlo_type == NLO_REAL) then
if (term%is_subtraction ()) then
allocate (sf_rescale_collinear_t :: sf_rescale)
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (sf_rescale)
type is (sf_rescale_collinear_t)
call sf_rescale%set (pcm%real_kinematics%xi_tilde)
end select
end select
call term%k_term%sf_chain%evaluate (term%fac_scale, sf_rescale)
deallocate (sf_rescale)
else if (term%k_term%emitter >= 0 .and. term%k_term%emitter <= term%k_term%n_in) then
allocate (sf_rescale_real_t :: sf_rescale)
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (sf_rescale)
type is (sf_rescale_real_t)
call sf_rescale%set (pcm%real_kinematics%xi_tilde * &
pcm%real_kinematics%xi_max (term%k_term%i_phs), &
pcm%real_kinematics%y (term%k_term%i_phs))
end select
end select
call term%k_term%sf_chain%evaluate (term%fac_scale, sf_rescale)
deallocate (sf_rescale)
else
call term%k_term%sf_chain%evaluate (term%fac_scale)
end if
else if (term%nlo_type == NLO_DGLAP) then
allocate (sf_rescale_dglap_t :: sf_rescale)
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (sf_rescale)
type is (sf_rescale_dglap_t)
call sf_rescale%set (pcm%isr_kinematics%z)
end select
end select
call term%k_term%sf_chain%evaluate (term%fac_scale, sf_rescale)
deallocate (sf_rescale)
end if
end subroutine term_instance_evaluate_scaled_sf_chains
@ %def term_instance_evaluate_scaled_sf_chains
@ Evaluate the extra data that we need for processing the object as a
physical event.
<<Instances: term instance: TBP>>=
procedure :: evaluate_event_data => term_instance_evaluate_event_data
<<Instances: procedures>>=
subroutine term_instance_evaluate_event_data (term)
class(term_instance_t), intent(inout) :: term
logical :: only_momenta
only_momenta = term%nlo_type > BORN
call term%isolated%evaluate_event_data (only_momenta)
call term%connected%evaluate_event_data (only_momenta)
end subroutine term_instance_evaluate_event_data
@ %def term_instance_evaluate_event_data
@
<<Instances: term instance: TBP>>=
procedure :: set_fac_scale => term_instance_set_fac_scale
<<Instances: procedures>>=
subroutine term_instance_set_fac_scale (term, fac_scale)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: fac_scale
term%fac_scale = fac_scale
end subroutine term_instance_set_fac_scale
@ %def term_instance_set_fac_scale
@ Return data that might be useful for external processing. The
factorization scale:
<<Instances: term instance: TBP>>=
procedure :: get_fac_scale => term_instance_get_fac_scale
<<Instances: procedures>>=
function term_instance_get_fac_scale (term) result (fac_scale)
class(term_instance_t), intent(in) :: term
real(default) :: fac_scale
fac_scale = term%fac_scale
end function term_instance_get_fac_scale
@ %def term_instance_get_fac_scale
@ We take the strong coupling from the process core. The value is calculated
when a new event is requested, so we should call it only after the event has
been evaluated. If it is not available there (a negative number is returned),
we take the value stored in the term configuration, which should be determined
by the model. If the model does not provide a value, the result is zero.
<<Instances: term instance: TBP>>=
procedure :: get_alpha_s => term_instance_get_alpha_s
<<Instances: procedures>>=
function term_instance_get_alpha_s (term, core) result (alpha_s)
class(term_instance_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
real(default) :: alpha_s
alpha_s = core%get_alpha_s (term%core_state)
if (alpha_s < zero) alpha_s = term%config%alpha_s
end function term_instance_get_alpha_s
@ %def term_instance_get_alpha_s
@
<<Instances: term instance: TBP>>=
procedure :: reset_phs_identifiers => term_instance_reset_phs_identifiers
<<Instances: procedures>>=
subroutine term_instance_reset_phs_identifiers (term)
class(term_instance_t), intent(inout) :: term
select type (phs => term%k_term%phs)
type is (phs_fks_t)
phs%phs_identifiers%evaluated = .false.
end select
end subroutine term_instance_reset_phs_identifiers
@ %def term_instance_reset_phs_identifiers
@ The second helicity for [[helicities]] comes with a minus sign
because OpenLoops inverts the helicity index of antiparticles.
<<Instances: term instance: TBP>>=
procedure :: get_helicities_for_openloops => term_instance_get_helicities_for_openloops
<<Instances: procedures>>=
subroutine term_instance_get_helicities_for_openloops (term, helicities)
class(term_instance_t), intent(in) :: term
integer, dimension(:,:), allocatable, intent(out) :: helicities
type(helicity_t), dimension(:), allocatable :: hel
type(quantum_numbers_t), dimension(:,:), allocatable :: qn
type(quantum_numbers_mask_t) :: qn_mask
integer :: h, i, j, n_in
call qn_mask%set_sub (1)
call term%isolated%trace%get_quantum_numbers_mask (qn_mask, qn)
n_in = term%int_hard%get_n_in ()
allocate (helicities (size (qn, dim=1), n_in))
allocate (hel (n_in))
do i = 1, size (qn, dim=1)
do j = 1, n_in
hel(j) = qn(i, j)%get_helicity ()
call hel(j)%diagonalize ()
call hel(j)%get_indices (h, h)
helicities (i, j) = h
end do
end do
end subroutine term_instance_get_helicities_for_openloops
@ %def term_instance_get_helicities_for_openloops
@
<<Instances: term instance: TBP>>=
procedure :: get_boost_to_lab => term_instance_get_boost_to_lab
<<Instances: procedures>>=
function term_instance_get_boost_to_lab (term) result (lt)
type(lorentz_transformation_t) :: lt
class(term_instance_t), intent(in) :: term
lt = term%k_term%phs%get_lorentz_transformation ()
end function term_instance_get_boost_to_lab
@ %def term_instance_get_boost_to_lab
@
<<Instances: term instance: TBP>>=
procedure :: get_boost_to_cms => term_instance_get_boost_to_cms
<<Instances: procedures>>=
function term_instance_get_boost_to_cms (term) result (lt)
type(lorentz_transformation_t) :: lt
class(term_instance_t), intent(in) :: term
lt = inverse (term%k_term%phs%get_lorentz_transformation ())
end function term_instance_get_boost_to_cms
@ %def term_instance_get_boost_to_cms
@
<<Instances: term instance: TBP>>=
procedure :: get_i_term_global => term_instance_get_i_term_global
<<Instances: procedures>>=
elemental function term_instance_get_i_term_global (term) result (i_term)
integer :: i_term
class(term_instance_t), intent(in) :: term
i_term = term%config%i_term_global
end function term_instance_get_i_term_global
@ %def term_instance_get_i_term_global
@
<<Instances: term instance: TBP>>=
procedure :: is_subtraction => term_instance_is_subtraction
<<Instances: procedures>>=
elemental function term_instance_is_subtraction (term) result (sub)
logical :: sub
class(term_instance_t), intent(in) :: term
sub = term%config%i_term_global == term%config%i_sub
end function term_instance_is_subtraction
@ %def term_instance_is_subtraction
@ Retrieve [[n_sub]] which was calculated in [[process_term_setup_interaction]].
<<Instances: term instance: TBP>>=
procedure :: get_n_sub => term_instance_get_n_sub
procedure :: get_n_sub_color => term_instance_get_n_sub_color
procedure :: get_n_sub_spin => term_instance_get_n_sub_spin
<<Instances: procedures>>=
function term_instance_get_n_sub (term) result (n_sub)
integer :: n_sub
class(term_instance_t), intent(in) :: term
n_sub = term%config%n_sub
end function term_instance_get_n_sub
function term_instance_get_n_sub_color (term) result (n_sub_color)
integer :: n_sub_color
class(term_instance_t), intent(in) :: term
n_sub_color = term%config%n_sub_color
end function term_instance_get_n_sub_color
function term_instance_get_n_sub_spin (term) result (n_sub_spin)
integer :: n_sub_spin
class(term_instance_t), intent(in) :: term
n_sub_spin = term%config%n_sub_spin
end function term_instance_get_n_sub_spin
@ %def term_instance_get_n_sub
@ %def term_instance_get_n_sub_color
@ %def term_instance_get_n_sub_spin
@
\subsection{The process instance}
A process instance contains all process data that depend on the
sampling point and thus change often. In essence, it is an event
record at the elementary (parton) level. We do not call it such, to
avoid confusion with the actual event records. If decays are
involved, the latter are compositions of several elementary processes
(i.e., their instances).
We implement the process instance as an extension of the
[[mci_sampler_t]] that we need for computing integrals and generate
events.
The base type contains: the [[integrand]], the [[selected_channel]],
the two-dimensional array [[x]] of parameters, and the one-dimensional
array [[f]] of Jacobians. These subobjects are public and used for
communicating with the multi-channel integrator.
The [[process]] pointer accesses the process of which this record is
an instance. It is required whenever the calculation needs invariant
configuration data, therefore the process should stay in memory for
the whole lifetime of its instances.
The [[evaluation_status]] code is used to check the current status.
In particular, failure at various stages is recorded there.
The [[count]] object records process evaluations, broken down
according to status.
The [[sqme]] value is the single real number that results from
evaluating and tracing the kinematics and matrix elements. This
is the number that is handed over to an integration routine.
The [[weight]] value is the event weight. It is defined when an event
has been generated from the process instance, either weighted or
unweighted. The value is the [[sqme]] value times Jacobian weights
from the integration, or unity, respectively.
The [[i_mci]] index chooses a subset of components that are associated with
a common parameter set and integrator, i.e., that are added coherently.
The [[sf_chain]] subobject is a realization of the beam and
structure-function configuration in the [[process]] object. It is not
used for calculation directly but serves as the template for the
sf-chain instances that are contained in the [[component]] objects.
The [[component]] subobjects determine the state of each component.
The [[term]] subobjects are workspace for evaluating kinematics,
matrix elements, cuts etc.
The [[mci_work]] subobject contains the array of real input parameters (random
numbers) that generates the kinematical point. It also contains the workspace
for the MC integrators. The active entry of the [[mci_work]] array is
selected by the [[i_mci]] index above.
The [[hook]] pointer accesses a list of after evaluate objects which are
evalutated after the matrix element.
<<Instances: public>>=
public :: process_instance_t
<<Instances: types>>=
type, extends (mci_sampler_t) :: process_instance_t
type(process_t), pointer :: process => null ()
integer :: evaluation_status = STAT_UNDEFINED
real(default) :: sqme = 0
real(default) :: weight = 0
real(default) :: excess = 0
integer :: n_dropped = 0
integer :: i_mci = 0
integer :: selected_channel = 0
type(sf_chain_t) :: sf_chain
type(term_instance_t), dimension(:), allocatable :: term
type(mci_work_t), dimension(:), allocatable :: mci_work
class(pcm_instance_t), allocatable :: pcm
class(process_instance_hook_t), pointer :: hook => null ()
contains
<<Instances: process instance: TBP>>
end type process_instance_t
@ %def process_instance
@
Wrapper type for storing pointers to process instance objects in arrays.
<<Instances: public>>=
public :: process_instance_ptr_t
<<Instances: types>>=
type :: process_instance_ptr_t
type(process_instance_t), pointer :: p => null ()
end type process_instance_ptr_t
@ %def process_instance_ptr_t
@ The process hooks are first-in-last-out list of objects which are evaluated
after the phase space and matrixelement are evaluated. It is possible to
retrieve the sampler object and read the sampler information.
The hook object are part of the [[process_instance]] and therefore, share a
common lifetime. A data transfer, after the usual lifetime of the
[[process_instance]], is not provided, as such the finalisation procedure has to take care
of this! E.g. write the object to file from which later the collected
information can then be retrieved.
<<Instances: public>>=
public :: process_instance_hook_t
<<Instances: types>>=
type, abstract :: process_instance_hook_t
class(process_instance_hook_t), pointer :: next => null ()
contains
procedure(process_instance_hook_init), deferred :: init
procedure(process_instance_hook_final), deferred :: final
procedure(process_instance_hook_evaluate), deferred :: evaluate
end type process_instance_hook_t
@ %def process_instance_hook_t
@ We have to provide a [[init]], a [[final]] procedure and, for after evaluation, the
[[evaluate]] procedure.
The [[init]] procedures accesses [[var_list]] and current [[instance]] object.
<<Instances: public>>=
public :: process_instance_hook_final, process_instance_hook_evaluate
<<Instances: interfaces>>=
abstract interface
subroutine process_instance_hook_init (hook, var_list, instance)
import :: process_instance_hook_t, var_list_t, process_instance_t
class(process_instance_hook_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
end subroutine process_instance_hook_init
subroutine process_instance_hook_final (hook)
import :: process_instance_hook_t
class(process_instance_hook_t), intent(inout) :: hook
end subroutine process_instance_hook_final
subroutine process_instance_hook_evaluate (hook, instance)
import :: process_instance_hook_t, process_instance_t
class(process_instance_hook_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
end subroutine process_instance_hook_evaluate
end interface
@ %def process_instance_hook_final, process_instance_hook_evaluate
@ The output routine contains a header with the most relevant
information about the process, copied from
[[process_metadata_write]]. We mark the active components by an asterisk.
The next section is the MC parameter input. The following sections
are written only if the evaluation status is beyond setting the
parameters, or if the [[verbose]] option is set.
<<Instances: process instance: TBP>>=
procedure :: write_header => process_instance_write_header
procedure :: write => process_instance_write
<<Instances: procedures>>=
subroutine process_instance_write_header (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
if (associated (object%process)) then
call object%process%write_meta (u, testflag)
else
write (u, "(1x,A)") "Process instance [undefined process]"
return
end if
write (u, "(3x,A)", advance = "no") "status = "
select case (object%evaluation_status)
case (STAT_INITIAL); write (u, "(A)") "initialized"
case (STAT_ACTIVATED); write (u, "(A)") "activated"
case (STAT_BEAM_MOMENTA); write (u, "(A)") "beam momenta set"
case (STAT_FAILED_KINEMATICS); write (u, "(A)") "failed kinematics"
case (STAT_SEED_KINEMATICS); write (u, "(A)") "seed kinematics"
case (STAT_HARD_KINEMATICS); write (u, "(A)") "hard kinematics"
case (STAT_EFF_KINEMATICS); write (u, "(A)") "effective kinematics"
case (STAT_FAILED_CUTS); write (u, "(A)") "failed cuts"
case (STAT_PASSED_CUTS); write (u, "(A)") "passed cuts"
case (STAT_EVALUATED_TRACE); write (u, "(A)") "evaluated trace"
call write_separator (u)
write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
case (STAT_EVENT_COMPLETE); write (u, "(A)") "event complete"
call write_separator (u)
write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
write (u, "(3x,A,ES19.12)") "weight = ", object%weight
if (.not. vanishes (object%excess)) &
write (u, "(3x,A,ES19.12)") "excess = ", object%excess
case default; write (u, "(A)") "undefined"
end select
if (object%i_mci /= 0) then
call write_separator (u)
call object%mci_work(object%i_mci)%write (u, testflag)
end if
call write_separator (u, 2)
end subroutine process_instance_write_header
subroutine process_instance_write (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
call object%write_header (u)
if (object%evaluation_status >= STAT_BEAM_MOMENTA) then
call object%sf_chain%write (u)
call write_separator (u, 2)
if (object%evaluation_status >= STAT_SEED_KINEMATICS) then
if (object%evaluation_status >= STAT_HARD_KINEMATICS) then
call write_separator (u, 2)
write (u, "(1x,A)") "Active terms:"
if (any (object%term%active)) then
do i = 1, size (object%term)
if (object%term(i)%active) then
call write_separator (u)
call object%term(i)%write (u, &
show_eff_state = &
object%evaluation_status >= STAT_EFF_KINEMATICS, &
testflag = testflag)
end if
end do
end if
end if
call write_separator (u, 2)
end if
end if
end subroutine process_instance_write
@ %def process_instance_write_header
@ %def process_instance_write
@ Initialization connects the instance with a process. All initial
information is transferred from the process object. The process
object contains templates for the interaction subobjects (beam and
term), but no evaluators. The initialization routine
creates evaluators for the matrix element trace, other evaluators
are left untouched.
Before we start generating, we double-check if the process library
has been updated after the process was initializated
([[check_library_sanity]]). This may happen if between integration
and event generation the library has been recompiled, so all links
become broken.
The [[instance]] object must have the [[target]] attribute (also in
any caller) since the initialization routine assigns various pointers
to subobject of [[instance]].
<<Instances: process instance: TBP>>=
procedure :: init => process_instance_init
<<Instances: procedures>>=
subroutine process_instance_init (instance, process)
class(process_instance_t), intent(out), target :: instance
type(process_t), intent(inout), target :: process
integer :: i
class(pcm_t), pointer :: pcm
type(process_term_t) :: term
type(var_list_t), pointer :: var_list
integer :: i_born, i_real, i_real_fin
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_instance_init")
instance%process => process
call instance%process%check_library_sanity ()
call instance%setup_sf_chain (process%get_beam_config_ptr ())
allocate (instance%mci_work (process%get_n_mci ()))
do i = 1, size (instance%mci_work)
call instance%process%init_mci_work (instance%mci_work(i), i)
end do
call instance%process%reset_selected_cores ()
pcm => instance%process%get_pcm_ptr ()
call pcm%allocate_instance (instance%pcm)
call instance%pcm%link_config (pcm)
select type (pcm)
type is (pcm_nlo_t)
!!! The process is kept when the integration is finalized, but not the
!!! process_instance. Thus, we check whether pcm has been initialized
!!! but set up the pcm_instance each time.
i_real_fin = process%get_associated_real_fin (1)
if (.not. pcm%initialized) then
! i_born = pcm%get_i_core_nlo_type (BORN)
i_born = pcm%get_i_core (pcm%i_born)
! i_real = pcm%get_i_core_nlo_type (NLO_REAL, include_sub = .false.)
! i_real = pcm%get_i_core_nlo_type (NLO_REAL)
i_real = pcm%get_i_core (pcm%i_real)
term = process%get_term_ptr (process%get_i_term (i_real))
call pcm%init_qn (process%get_model_ptr ())
if (i_real_fin > 0) call pcm%allocate_ps_matching ()
var_list => process%get_var_list_ptr ()
if (var_list%get_sval (var_str ("$dalitz_plot")) /= var_str ('')) &
call pcm%activate_dalitz_plot (var_list%get_sval (var_str ("$dalitz_plot")))
end if
pcm%initialized = .true.
select type (pcm_instance => instance%pcm)
type is (pcm_instance_nlo_t)
call pcm_instance%init_config (process%component_can_be_integrated (), &
process%get_nlo_type_component (), process%get_sqrts (), i_real_fin, &
process%get_model_ptr ())
end select
end select
allocate (instance%term (process%get_n_terms ()))
do i = 1, process%get_n_terms ()
call instance%term(i)%init_from_process (process, i, instance%pcm, &
instance%sf_chain)
end do
call instance%set_i_mci_to_real_component ()
call instance%find_same_kinematics ()
instance%evaluation_status = STAT_INITIAL
end subroutine process_instance_init
@ %def process_instance_init
@
@ Finalize all subobjects that may contain allocated pointers.
<<Instances: process instance: TBP>>=
procedure :: final => process_instance_final
<<Instances: procedures>>=
subroutine process_instance_final (instance)
class(process_instance_t), intent(inout) :: instance
class(process_instance_hook_t), pointer :: current
integer :: i
instance%process => null ()
if (allocated (instance%mci_work)) then
do i = 1, size (instance%mci_work)
call instance%mci_work(i)%final ()
end do
deallocate (instance%mci_work)
end if
call instance%sf_chain%final ()
if (allocated (instance%term)) then
do i = 1, size (instance%term)
call instance%term(i)%final ()
end do
deallocate (instance%term)
end if
call instance%pcm%final ()
instance%evaluation_status = STAT_UNDEFINED
do while (associated (instance%hook))
current => instance%hook
call current%final ()
instance%hook => current%next
deallocate (current)
end do
instance%hook => null ()
end subroutine process_instance_final
@ %def process_instance_final
@ Revert the process instance to initial state. We do not deallocate
anything, just reset the state index and deactivate all components and
terms.
We do not reset the choice of the MCI set [[i_mci]] unless this is
required explicitly.
<<Instances: process instance: TBP>>=
procedure :: reset => process_instance_reset
<<Instances: procedures>>=
subroutine process_instance_reset (instance, reset_mci)
class(process_instance_t), intent(inout) :: instance
logical, intent(in), optional :: reset_mci
integer :: i
call instance%process%reset_selected_cores ()
do i = 1, size (instance%term)
call instance%term(i)%reset ()
end do
instance%term%checked = .false.
instance%term%passed = .false.
instance%term%k_term%new_seed = .true.
if (present (reset_mci)) then
if (reset_mci) instance%i_mci = 0
end if
instance%selected_channel = 0
instance%evaluation_status = STAT_INITIAL
end subroutine process_instance_reset
@ %def process_instance_reset
@
\subsubsection{Integration and event generation}
The sampler test should just evaluate the squared matrix element [[n_calls]]
times, discarding the results, and return. This can be done before
integration, e.g., for timing estimates.
<<Instances: process instance: TBP>>=
procedure :: sampler_test => process_instance_sampler_test
<<Instances: procedures>>=
subroutine process_instance_sampler_test (instance, i_mci, n_calls)
class(process_instance_t), intent(inout), target :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_calls
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
call instance%reset_counter ()
call instance%process%sampler_test (instance, n_calls, i_mci_work)
call instance%process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
end subroutine process_instance_sampler_test
@ %def process_instance_sampler_test
@ Generate a weighted event. We select one of the available MCI
integrators by its index [[i_mci]] and thus generate an event for the
associated (group of) process component(s). The arguments exactly
correspond to the initializer and finalizer above.
The resulting event is stored in the [[process_instance]] object,
which also holds the workspace of the integrator.
Note: The [[process]] object contains the random-number state, which
changes for each event.
Otherwise, all volatile data are inside the [[instance]] object.
<<Instances: process instance: TBP>>=
procedure :: generate_weighted_event => process_instance_generate_weighted_event
<<Instances: procedures>>=
subroutine process_instance_generate_weighted_event (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
associate (mci_work => instance%mci_work(i_mci_work))
call instance%process%generate_weighted_event &
(i_mci_work, mci_work, instance, &
instance%keep_failed_events ())
end associate
end subroutine process_instance_generate_weighted_event
@ %def process_instance_generate_weighted_event
@
<<Instances: process instance: TBP>>=
procedure :: generate_unweighted_event => process_instance_generate_unweighted_event
<<Instances: procedures>>=
subroutine process_instance_generate_unweighted_event (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
associate (mci_work => instance%mci_work(i_mci_work))
call instance%process%generate_unweighted_event &
(i_mci_work, mci_work, instance)
end associate
end subroutine process_instance_generate_unweighted_event
@ %def process_instance_generate_unweighted_event
@
This replaces the event generation methods for the situation that the
process instance object has been filled by other means (i.e., reading
and/or recalculating its contents). We just have to fill in missing
MCI data, especially the event weight.
<<Instances: process instance: TBP>>=
procedure :: recover_event => process_instance_recover_event
<<Instances: procedures>>=
subroutine process_instance_recover_event (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_mci
i_mci = instance%i_mci
call instance%process%set_i_mci_work (i_mci)
associate (mci_instance => instance%mci_work(i_mci)%mci)
call mci_instance%fetch (instance, instance%selected_channel)
end associate
end subroutine process_instance_recover_event
@ %def process_instance_recover_event
@
@ Activate the components and terms that correspond to a currently
selected MCI parameter set.
<<Instances: process instance: TBP>>=
procedure :: activate => process_instance_activate
<<Instances: procedures>>=
subroutine process_instance_activate (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i, j
integer, dimension(:), allocatable :: i_term
associate (mci_work => instance%mci_work(instance%i_mci))
call instance%process%select_components (mci_work%get_active_components ())
end associate
associate (process => instance%process)
do i = 1, instance%process%get_n_components ()
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (process%get_component_i_terms (i))))
i_term = process%get_component_i_terms (i)
do j = 1, size (i_term)
instance%term(i_term(j))%active = .true.
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
end associate
instance%evaluation_status = STAT_ACTIVATED
end subroutine process_instance_activate
@ %def process_instance_activate
@
<<Instances: process instance: TBP>>=
procedure :: find_same_kinematics => process_instance_find_same_kinematics
<<Instances: procedures>>=
subroutine process_instance_find_same_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_term1, i_term2, k, n_same
do i_term1 = 1, size (instance%term)
if (.not. allocated (instance%term(i_term1)%same_kinematics)) then
n_same = 1 !!! Index group includes the index of its term_instance
do i_term2 = 1, size (instance%term)
if (i_term1 == i_term2) cycle
if (compare_md5s (i_term1, i_term2)) n_same = n_same + 1
end do
allocate (instance%term(i_term1)%same_kinematics (n_same))
associate (same_kinematics1 => instance%term(i_term1)%same_kinematics)
same_kinematics1 = 0
k = 1
do i_term2 = 1, size (instance%term)
if (compare_md5s (i_term1, i_term2)) then
same_kinematics1(k) = i_term2
k = k + 1
end if
end do
do k = 1, size (same_kinematics1)
if (same_kinematics1(k) == i_term1) cycle
i_term2 = same_kinematics1(k)
allocate (instance%term(i_term2)%same_kinematics (n_same))
instance%term(i_term2)%same_kinematics = same_kinematics1
end do
end associate
end if
end do
contains
function compare_md5s (i, j) result (same)
logical :: same
integer, intent(in) :: i, j
character(32) :: md5sum_1, md5sum_2
integer :: mode_1, mode_2
mode_1 = 0; mode_2 = 0
select type (phs => instance%term(i)%k_term%phs%config)
type is (phs_fks_config_t)
md5sum_1 = phs%md5sum_born_config
mode_1 = phs%mode
class default
md5sum_1 = phs%md5sum_phs_config
end select
select type (phs => instance%term(j)%k_term%phs%config)
type is (phs_fks_config_t)
md5sum_2 = phs%md5sum_born_config
mode_2 = phs%mode
class default
md5sum_2 = phs%md5sum_phs_config
end select
same = (md5sum_1 == md5sum_2) .and. (mode_1 == mode_2)
end function compare_md5s
end subroutine process_instance_find_same_kinematics
@ %def process_instance_find_same_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: transfer_same_kinematics => process_instance_transfer_same_kinematics
<<Instances: procedures>>=
subroutine process_instance_transfer_same_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: i, i_term_same
associate (same_kinematics => instance%term(i_term)%same_kinematics)
do i = 1, size (same_kinematics)
i_term_same = same_kinematics(i)
instance%term(i_term_same)%p_seed = instance%term(i_term)%p_seed
associate (phs => instance%term(i_term_same)%k_term%phs)
call phs%set_lorentz_transformation &
(instance%term(i_term)%k_term%phs%get_lorentz_transformation ())
select type (phs)
type is (phs_fks_t)
call phs%set_momenta (instance%term(i_term_same)%p_seed)
if (i_term_same /= i_term) then
call phs%set_reference_frames (.false.)
end if
end select
end associate
instance%term(i_term_same)%k_term%new_seed = .false.
end do
end associate
end subroutine process_instance_transfer_same_kinematics
@ %def process_instance_transfer_same_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: redo_sf_chains => process_instance_redo_sf_chains
<<Instances: procedures>>=
subroutine process_instance_redo_sf_chains (instance, i_term, phs_channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), dimension(:) :: i_term
integer, intent(in) :: phs_channel
integer :: i
do i = 1, size (i_term)
call instance%term(i_term(i))%redo_sf_chain &
(instance%mci_work(instance%i_mci), phs_channel)
end do
end subroutine process_instance_redo_sf_chains
@ %def process_instance_redo_sf_chains
@ Integrate the process, using a previously initialized process
instance. We select one of the available MCI integrators by its index
[[i_mci]] and thus integrate over (structure functions and) phase
space for the associated (group of) process component(s).
<<Instances: process instance: TBP>>=
procedure :: integrate => process_instance_integrate
<<Instances: procedures>>=
subroutine process_instance_integrate (instance, i_mci, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
integer :: nlo_type, i_mci_work
nlo_type = instance%process%get_component_nlo_type (i_mci)
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
call instance%reset_counter ()
associate (mci_work => instance%mci_work(i_mci_work), &
process => instance%process)
call process%integrate (i_mci_work, mci_work, &
instance, n_it, n_calls, adapt_grids, adapt_weights, &
final, pacify, nlo_type = nlo_type)
call process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
end associate
end subroutine process_instance_integrate
@ %def process_instance_integrate
@ Subroutine of the initialization above: initialize the beam and
structure-function chain template. We establish pointers to the
configuration data, so [[beam_config]] must have a [[target]]
attribute.
The resulting chain is not used directly for calculation. It will
acquire instances which are stored in the process-component instance
objects.
<<Instances: process instance: TBP>>=
procedure :: setup_sf_chain => process_instance_setup_sf_chain
<<Instances: procedures>>=
subroutine process_instance_setup_sf_chain (instance, config)
class(process_instance_t), intent(inout) :: instance
type(process_beam_config_t), intent(in), target :: config
integer :: n_strfun
n_strfun = config%n_strfun
if (n_strfun /= 0) then
call instance%sf_chain%init (config%data, config%sf)
else
call instance%sf_chain%init (config%data)
end if
if (config%sf_trace) then
call instance%sf_chain%setup_tracing (config%sf_trace_file)
end if
end subroutine process_instance_setup_sf_chain
@ %def process_instance_setup_sf_chain
@ This initialization routine should be called only for process
instances which we intend as a source for physical events. It
initializes the evaluators in the parton states of the terms. They
describe the (semi-)exclusive transition matrix and the distribution
of color flow for the partonic process, convoluted with the beam and
structure-function chain.
If the model is not provided explicitly, we may use the model instance that
belongs to the process. However, an explicit model allows us to override
particle settings.
<<Instances: process instance: TBP>>=
procedure :: setup_event_data => process_instance_setup_event_data
<<Instances: procedures>>=
subroutine process_instance_setup_event_data (instance, model, i_core)
class(process_instance_t), intent(inout), target :: instance
class(model_data_t), intent(in), optional, target :: model
integer, intent(in), optional :: i_core
class(model_data_t), pointer :: current_model
integer :: i
class(prc_core_t), pointer :: core => null ()
if (present (model)) then
current_model => model
else
current_model => instance%process%get_model_ptr ()
end if
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (associated (term%config)) then
core => instance%process%get_core_term (i)
call term%setup_event_data (core, current_model)
end if
end associate
end do
core => null ()
end subroutine process_instance_setup_event_data
@ %def process_instance_setup_event_data
@ Choose a MC parameter set and the corresponding integrator.
The choice persists beyond calls of the [[reset]] method above. This method
is automatically called here.
<<Instances: process instance: TBP>>=
procedure :: choose_mci => process_instance_choose_mci
<<Instances: procedures>>=
subroutine process_instance_choose_mci (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
instance%i_mci = i_mci
call instance%reset ()
end subroutine process_instance_choose_mci
@ %def process_instance_choose_mci
@ Explicitly set a MC parameter set. Works only if we are in initial
state. We assume that the length of the parameter set is correct.
After setting the parameters, activate the components and terms that
correspond to the chosen MC parameter set.
The [[warmup_flag]] is used when a dummy phase-space point is computed
for the warmup of e.g. OpenLoops helicities. The setting of the
the [[evaluation_status]] has to be avoided then.
<<Instances: process instance: TBP>>=
procedure :: set_mcpar => process_instance_set_mcpar
<<Instances: procedures>>=
subroutine process_instance_set_mcpar (instance, x, warmup_flag)
class(process_instance_t), intent(inout) :: instance
real(default), dimension(:), intent(in) :: x
logical, intent(in), optional :: warmup_flag
logical :: activate
activate = .true.; if (present (warmup_flag)) activate = .not. warmup_flag
if (instance%evaluation_status == STAT_INITIAL) then
associate (mci_work => instance%mci_work(instance%i_mci))
call mci_work%set (x)
end associate
if (activate) call instance%activate ()
end if
end subroutine process_instance_set_mcpar
@ %def process_instance_set_mcpar
@ Receive the beam momentum/momenta from a source interaction. This
applies to a cascade decay process instance, where the `beam' momentum
varies event by event.
The master beam momentum array is contained in the main structure
function chain subobject [[sf_chain]]. The sf-chain instance that
reside in the components will take their beam momenta from there.
The procedure transforms the instance status into
[[STAT_BEAM_MOMENTA]]. For process instance with fixed beam, this
intermediate status is skipped.
<<Instances: process instance: TBP>>=
procedure :: receive_beam_momenta => process_instance_receive_beam_momenta
<<Instances: procedures>>=
subroutine process_instance_receive_beam_momenta (instance)
class(process_instance_t), intent(inout) :: instance
if (instance%evaluation_status >= STAT_INITIAL) then
call instance%sf_chain%receive_beam_momenta ()
instance%evaluation_status = STAT_BEAM_MOMENTA
end if
end subroutine process_instance_receive_beam_momenta
@ %def process_instance_receive_beam_momenta
@ Set the beam momentum/momenta explicitly. Otherwise, analogous to
the previous procedure.
<<Instances: process instance: TBP>>=
procedure :: set_beam_momenta => process_instance_set_beam_momenta
<<Instances: procedures>>=
subroutine process_instance_set_beam_momenta (instance, p)
class(process_instance_t), intent(inout) :: instance
type(vector4_t), dimension(:), intent(in) :: p
if (instance%evaluation_status >= STAT_INITIAL) then
call instance%sf_chain%set_beam_momenta (p)
instance%evaluation_status = STAT_BEAM_MOMENTA
end if
end subroutine process_instance_set_beam_momenta
@ %def process_instance_set_beam_momenta
@ Recover the initial beam momenta (those in the [[sf_chain]]
component), given a valid (recovered) [[sf_chain_instance]] in one of
the active components. We need to do this only if the lab frame is
not the c.m.\ frame, otherwise those beams would be fixed anyway.
<<Instances: process instance: TBP>>=
procedure :: recover_beam_momenta => process_instance_recover_beam_momenta
<<Instances: procedures>>=
subroutine process_instance_recover_beam_momenta (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
if (.not. instance%process%lab_is_cm ()) then
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
call instance%term(i_term)%return_beam_momenta ()
end if
end if
end subroutine process_instance_recover_beam_momenta
@ %def process_instance_recover_beam_momenta
@ Explicitly choose MC integration channel. We assume here that the channel
count is identical for all active components.
<<Instances: process instance: TBP>>=
procedure :: select_channel => process_instance_select_channel
<<Instances: procedures>>=
subroutine process_instance_select_channel (instance, channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
instance%selected_channel = channel
end subroutine process_instance_select_channel
@ %def process_instance_select_channel
@ First step of process evaluation: set up seed kinematics. That is, for each
active process component, compute a momentum array from the MC input
parameters.
If [[skip_term]] is set, we skip the component that accesses this
term. We can assume that the associated data have already been
recovered, and we are just computing the rest.
<<Instances: process instance: TBP>>=
procedure :: compute_seed_kinematics => &
process_instance_compute_seed_kinematics
<<Instances: procedures>>=
subroutine process_instance_compute_seed_kinematics (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: channel, skip_component, i, j
logical :: success
integer, dimension(:), allocatable :: i_term
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Compute seed kinematics: undefined integration channel")
end if
if (present (skip_term)) then
skip_component = instance%term(skip_term)%config%i_component
else
skip_component = 0
end if
if (instance%evaluation_status >= STAT_ACTIVATED) then
success = .true.
do i = 1, instance%process%get_n_components ()
if (i == skip_component) cycle
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (instance%process%get_component_i_terms (i))))
i_term = instance%process%get_component_i_terms (i)
do j = 1, size (i_term)
if (instance%term(i_term(j))%k_term%new_seed) then
call instance%term(i_term(j))%compute_seed_kinematics &
(instance%mci_work(instance%i_mci), channel, success)
call instance%transfer_same_kinematics (i_term(j))
end if
if (.not. success) exit
call instance%term(i_term(j))%evaluate_projections ()
call instance%term(i_term(j))%evaluate_radiation_kinematics &
(instance%mci_work(instance%i_mci)%get_x_process ())
call instance%term(i_term(j))%generate_fsr_in ()
call instance%term(i_term(j))%compute_xi_ref_momenta ()
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
if (success) then
instance%evaluation_status = STAT_SEED_KINEMATICS
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
end if
associate (mci_work => instance%mci_work(instance%i_mci))
select type (pcm => instance%pcm)
class is (pcm_instance_nlo_t)
call pcm%set_x_rad (mci_work%get_x_process ())
end select
end associate
end subroutine process_instance_compute_seed_kinematics
@ %def process_instance_compute_seed_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: get_x_process => process_instance_get_x_process
<<Instances: procedures>>=
pure function process_instance_get_x_process (instance) result (x)
real(default), dimension(:), allocatable :: x
class(process_instance_t), intent(in) :: instance
allocate (x(size (instance%mci_work(instance%i_mci)%get_x_process ())))
x = instance%mci_work(instance%i_mci)%get_x_process ()
end function process_instance_get_x_process
@ %def process_instance_get_x_process
@
<<Instances: process instance: TBP>>=
procedure :: get_active_component_type => process_instance_get_active_component_type
<<Instances: procedures>>=
pure function process_instance_get_active_component_type (instance) &
result (nlo_type)
integer :: nlo_type
class(process_instance_t), intent(in) :: instance
nlo_type = instance%process%get_component_nlo_type (instance%i_mci)
end function process_instance_get_active_component_type
@ %def process_instance_get_active_component_type
@ Inverse: recover missing parts of the kinematics from the momentum
configuration, which we know for a single term and component. Given
a channel, reconstruct the MC parameter set.
<<Instances: process instance: TBP>>=
procedure :: recover_mcpar => process_instance_recover_mcpar
<<Instances: procedures>>=
subroutine process_instance_recover_mcpar (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: channel
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Recover MC parameters: undefined integration channel")
end if
call instance%term(i_term)%recover_mcpar &
(instance%mci_work(instance%i_mci), channel)
end if
end subroutine process_instance_recover_mcpar
@ %def process_instance_recover_mcpar
@ This is part of [[recover_mcpar]], extracted for the case when there is
no phase space and parameters to recover, but we still need the structure
function kinematics for evaluation.
<<Instances: process instance: TBP>>=
procedure :: recover_sfchain => process_instance_recover_sfchain
<<Instances: procedures>>=
subroutine process_instance_recover_sfchain (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: channel
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Recover sfchain: undefined integration channel")
end if
call instance%term(i_term)%recover_sfchain (channel)
end if
end subroutine process_instance_recover_sfchain
@ %def process_instance_recover_sfchain
@ Second step of process evaluation: compute all momenta, for all active
components, from the seed kinematics.
<<Instances: process instance: TBP>>=
procedure :: compute_hard_kinematics => &
process_instance_compute_hard_kinematics
<<Instances: procedures>>=
subroutine process_instance_compute_hard_kinematics (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: i
logical :: success
success = .true.
if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%term(i)%compute_hard_kinematics (skip_term, success)
if (.not. success) exit
!!! Ren scale is zero when this is commented out! Understand!
if (instance%term(i)%nlo_type == NLO_REAL) &
call instance%term(i)%redo_sf_chain (instance%mci_work(instance%i_mci), &
instance%selected_channel)
end if
end do
if (success) then
instance%evaluation_status = STAT_HARD_KINEMATICS
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
end if
end subroutine process_instance_compute_hard_kinematics
@ %def process_instance_setup_compute_hard_kinematics
@ Inverse: recover seed kinematics. We know the beam momentum
configuration and the outgoing momenta of the effective interaction,
for one specific term.
<<Instances: process instance: TBP>>=
procedure :: recover_seed_kinematics => &
process_instance_recover_seed_kinematics
<<Instances: procedures>>=
subroutine process_instance_recover_seed_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) &
call instance%term(i_term)%recover_seed_kinematics ()
end subroutine process_instance_recover_seed_kinematics
@ %def process_instance_recover_seed_kinematics
@ Third step of process evaluation: compute the effective momentum
configurations, for all active terms, from the hard kinematics.
<<Instances: process instance: TBP>>=
procedure :: compute_eff_kinematics => &
process_instance_compute_eff_kinematics
<<Instances: procedures>>=
subroutine process_instance_compute_eff_kinematics (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: i
if (instance%evaluation_status >= STAT_HARD_KINEMATICS) then
do i = 1, size (instance%term)
if (present (skip_term)) then
if (i == skip_term) cycle
end if
if (instance%term(i)%active) then
call instance%term(i)%compute_eff_kinematics ()
end if
end do
instance%evaluation_status = STAT_EFF_KINEMATICS
end if
end subroutine process_instance_compute_eff_kinematics
@ %def process_instance_setup_compute_eff_kinematics
@ Inverse: recover the hard kinematics from effective kinematics for
one term, then compute effective kinematics for the other terms.
<<Instances: process instance: TBP>>=
procedure :: recover_hard_kinematics => &
process_instance_recover_hard_kinematics
<<Instances: procedures>>=
subroutine process_instance_recover_hard_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: i
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
call instance%term(i_term)%recover_hard_kinematics ()
do i = 1, size (instance%term)
if (i /= i_term) then
if (instance%term(i)%active) then
call instance%term(i)%compute_eff_kinematics ()
end if
end if
end do
instance%evaluation_status = STAT_EFF_KINEMATICS
end if
end subroutine process_instance_recover_hard_kinematics
@ %def recover_hard_kinematics
@ Fourth step of process evaluation: check cuts for all terms. Where
successful, compute any scales and weights. Otherwise, deactive the term.
If any of the terms has passed, set the state to [[STAT_PASSED_CUTS]].
The argument [[scale_forced]], if present, will override the scale calculation
in the term expressions.
<<Instances: process instance: TBP>>=
procedure :: evaluate_expressions => &
process_instance_evaluate_expressions
<<Instances: procedures>>=
subroutine process_instance_evaluate_expressions (instance, scale_forced)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), allocatable, optional :: scale_forced
integer :: i
logical :: passed_real
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%term(i)%evaluate_expressions (scale_forced)
end if
end do
call evaluate_real_scales_and_cuts ()
call set_ellis_sexton_scale ()
if (.not. passed_real) then
instance%evaluation_status = STAT_FAILED_CUTS
else
if (any (instance%term%passed)) then
instance%evaluation_status = STAT_PASSED_CUTS
else
instance%evaluation_status = STAT_FAILED_CUTS
end if
end if
end if
contains
subroutine evaluate_real_scales_and_cuts ()
integer :: i
passed_real = .true.
select type (config => instance%pcm%config)
type is (pcm_nlo_t)
do i = 1, size (instance%term)
if (instance%term(i)%active .and. instance%term(i)%nlo_type == NLO_REAL) then
if (config%settings%cut_all_real_sqmes) &
passed_real = passed_real .and. instance%term(i)%passed
if (config%settings%use_born_scale) &
call replace_scales (instance%term(i))
end if
end do
end select
end subroutine evaluate_real_scales_and_cuts
subroutine replace_scales (this_term)
type(term_instance_t), intent(inout) :: this_term
integer :: i_sub
i_sub = this_term%config%i_sub
if (this_term%config%i_term_global /= i_sub .and. i_sub > 0) then
this_term%ren_scale = instance%term(i_sub)%ren_scale
this_term%fac_scale = instance%term(i_sub)%fac_scale
end if
end subroutine replace_scales
subroutine set_ellis_sexton_scale ()
real(default) :: es_scale
type(var_list_t), pointer :: var_list
integer :: i
var_list => instance%process%get_var_list_ptr ()
es_scale = var_list%get_rval (var_str ("ellis_sexton_scale"))
do i = 1, size (instance%term)
if (instance%term(i)%active .and. instance%term(i)%nlo_type == NLO_VIRTUAL) then
if (es_scale < zero) then
instance%term(i)%es_scale = instance%term(i)%ren_scale
else
instance%term(i)%es_scale = es_scale
end if
end if
end do
end subroutine set_ellis_sexton_scale
end subroutine process_instance_evaluate_expressions
@ %def process_instance_evaluate_expressions
@ Fifth step of process evaluation: fill the parameters for the non-selected
,channels, that have not been used for seeding. We should do this after
evaluating cuts, since we may save some expensive calculations if the phase
space point fails the cuts.
If [[skip_term]] is set, we skip the component that accesses this
term. We can assume that the associated data have already been
recovered, and we are just computing the rest.
<<Instances: process instance: TBP>>=
procedure :: compute_other_channels => &
process_instance_compute_other_channels
<<Instances: procedures>>=
subroutine process_instance_compute_other_channels (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: channel, skip_component, i, j
integer, dimension(:), allocatable :: i_term
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Compute other channels: undefined integration channel")
end if
if (present (skip_term)) then
skip_component = instance%term(skip_term)%config%i_component
else
skip_component = 0
end if
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, instance%process%get_n_components ()
if (i == skip_component) cycle
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (instance%process%get_component_i_terms (i))))
i_term = instance%process%get_component_i_terms (i)
do j = 1, size (i_term)
call instance%term(i_term(j))%compute_other_channels &
(instance%mci_work(instance%i_mci), channel)
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
end if
end subroutine process_instance_compute_other_channels
@ %def process_instance_compute_other_channels
@ If not done otherwise, we flag the kinematics as new for the core state,
such that the routine below will actually compute the matrix element and not
just look it up.
<<Instances: process instance: TBP>>=
procedure :: reset_core_kinematics => process_instance_reset_core_kinematics
<<Instances: procedures>>=
subroutine process_instance_reset_core_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active .and. term%passed) then
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
end if
end associate
end do
end if
end subroutine process_instance_reset_core_kinematics
@ %def process_instance_reset_core_kinematics
@ Sixth step of process evaluation: evaluate the matrix elements, and compute
the trace (summed over quantum numbers) for all terms. Finally, sum up the
terms, iterating over all active process components.
<<Instances: process instance: TBP>>=
procedure :: evaluate_trace => process_instance_evaluate_trace
<<Instances: procedures>>=
subroutine process_instance_evaluate_trace (instance)
class(process_instance_t), intent(inout) :: instance
class(prc_core_t), pointer :: core => null ()
integer :: i, i_real_fin, i_core
real(default) :: alpha_s, alpha_qed
class(prc_core_t), pointer :: core_sub => null ()
class(model_data_t), pointer :: model => null ()
logical :: has_pdfs
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_evaluate_trace")
has_pdfs = instance%process%pcm_contains_pdfs ()
instance%sqme = zero
call instance%reset_matrix_elements ()
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active .and. term%passed) then
core => instance%process%get_core_term (i)
select type (pcm => instance%process%get_pcm_ptr ())
class is (pcm_nlo_t)
i_core = pcm%get_i_core (pcm%i_sub)
core_sub => instance%process%get_core_ptr (i_core)
end select
call term%evaluate_interaction (core)
call term%evaluate_trace ()
i_real_fin = instance%process%get_associated_real_fin (1)
if (instance%process%uses_real_partition ()) &
call term%apply_real_partition (instance%process)
if (term%config%i_component /= i_real_fin) then
if ((term%nlo_type == NLO_REAL .and. term%k_term%emitter < 0) &
.or. term%nlo_type == NLO_MISMATCH &
.or. term%nlo_type == NLO_DGLAP) &
call term%set_born_sqmes (core)
if (term%is_subtraction () .or. &
term%nlo_type == NLO_DGLAP) &
call term%set_sf_factors (has_pdfs)
if (term%nlo_type > BORN) then
if (.not. (term%nlo_type == NLO_REAL .and. term%k_term%emitter >= 0)) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (char (config%settings%nlo_correction_type) == "QCD" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_color_correlations (core_sub)
if (char (config%settings%nlo_correction_type) == "EW" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_charge_correlations (core_sub)
end select
end if
if (term%is_subtraction ()) then
call term%evaluate_spin_correlations (core_sub)
end if
end if
alpha_s = core%get_alpha_s (term%core_state)
alpha_qed = core%get_alpha_qed ()
if (term%nlo_type > BORN) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (alpha_qed == -1 .and. (&
char (config%settings%nlo_correction_type) == "EW" .or. &
char (config%settings%nlo_correction_type) == "Full")) then
call msg_bug("Attempting to compute EW corrections with alpha_qed = -1")
end if
end select
end if
select case (term%nlo_type)
case (NLO_REAL)
call term%apply_fks (alpha_s, alpha_qed)
case (NLO_VIRTUAL)
call term%evaluate_sqme_virt (alpha_s, alpha_qed)
case (NLO_MISMATCH)
call term%evaluate_sqme_mismatch (alpha_s)
case (NLO_DGLAP)
call term%evaluate_sqme_dglap (alpha_s)
end select
end if
end if
core_sub => null ()
instance%sqme = instance%sqme + real (sum (&
term%connected%trace%get_matrix_element () * &
term%weight))
end associate
end do
core => null ()
if (instance%pcm%is_valid ()) then
instance%evaluation_status = STAT_EVALUATED_TRACE
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
else
!!! Failed kinematics or failed cuts: set sqme to zero
instance%sqme = zero
end if
end subroutine process_instance_evaluate_trace
@ %def process_instance_evaluate_trace
<<Instances: term instance: TBP>>=
procedure :: set_born_sqmes => term_instance_set_born_sqmes
<<Instances: procedures>>=
subroutine term_instance_set_born_sqmes (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: i_flv, ii_flv
real(default) :: sqme
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
ii_flv = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
sqme = real (term%connected%trace%get_matrix_element (ii_flv))
select case (term%nlo_type)
case (NLO_REAL)
pcm_instance%real_sub%sqme_born(i_flv) = sqme
case (NLO_MISMATCH)
pcm_instance%soft_mismatch%sqme_born(i_flv) = sqme
case (NLO_DGLAP)
pcm_instance%dglap_remnant%sqme_born(i_flv) = sqme
end select
end do
end select
end subroutine term_instance_set_born_sqmes
@ %def term_instance_set_born_sqmes
@ Calculates and then saves the ratio of the value of the (rescaled) real
structure function chain of each ISR alpha region over the value of the
corresponding underlying born flavor structure.
In the case of emitter 0 we also need the rescaled ratio for emitter 1 and 2
in that region for the (soft-)collinear limits.
Altough this procedure is implying functionality for general structure functions,
it should be reviewed for anything else besides PDFs, as there might be complications
in the details. The general idea of getting the ratio in this way should hold up in
these cases as well, however.
<<Instances: term instance: TBP>>=
procedure :: set_sf_factors => term_instance_set_sf_factors
<<Instances: procedures>>=
subroutine term_instance_set_sf_factors (term, has_pdfs)
class(term_instance_t), intent(inout) :: term
logical, intent(in) :: has_pdfs
type(interaction_t), pointer :: sf_chain_int
real(default) :: factor_born, factor_real
integer :: n_in, alr, em
integer :: i_born, i_real
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (.not. has_pdfs) then
pcm_instance%real_sub%sf_factors = one
return
end if
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
sf_chain_int => term%k_term%sf_chain%get_out_int_ptr ()
associate (reg_data => config%region_data)
n_in = reg_data%get_n_in ()
do alr = 1, reg_data%n_regions
em = reg_data%regions(alr)%emitter
if (em <= n_in) then
i_born = reg_data%regions(alr)%uborn_index
i_real = reg_data%regions(alr)%real_index
factor_born = sf_chain_int%get_matrix_element &
(sf_chain_int%get_sf_qn_index_born (i_born, i_sub = 0))
factor_real = sf_chain_int%get_matrix_element &
(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = em))
call set_factor (pcm_instance, alr, em, factor_born, factor_real)
if (em == 0) then
do em = 1, 2
factor_real = sf_chain_int%get_matrix_element &
(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = em))
call set_factor (pcm_instance, alr, em, factor_born, factor_real)
end do
end if
end if
end do
end associate
end select
end select
contains
subroutine set_factor (pcm_instance, alr, em, factor_born, factor_real)
type(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
integer, intent(in) :: alr, em
real(default), intent(in) :: factor_born, factor_real
real(default) :: factor
if (any (vanishes ([factor_real, factor_born], tiny(1._default), tiny(1._default)))) then
factor = zero
else
factor = factor_real / factor_born
end if
select case (term%nlo_type)
case (NLO_REAL)
pcm_instance%real_sub%sf_factors(alr, em) = factor
case (NLO_DGLAP)
pcm_instance%dglap_remnant%sf_factors(alr, em) = factor
end select
end subroutine
end subroutine term_instance_set_sf_factors
@ %def term_instance_set_sf_factors
@
<<Instances: process instance: TBP>>=
procedure :: apply_real_partition => process_instance_apply_real_partition
<<Instances: procedures>>=
subroutine process_instance_apply_real_partition (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_component, i_term
integer, dimension(:), allocatable :: i_terms
associate (process => instance%process)
i_component = process%get_first_real_component ()
if (process%component_is_selected (i_component) .and. &
process%get_component_nlo_type (i_component) == NLO_REAL) then
allocate (i_terms (size (process%get_component_i_terms (i_component))))
i_terms = process%get_component_i_terms (i_component)
do i_term = 1, size (i_terms)
call instance%term(i_terms(i_term))%apply_real_partition (process)
end do
end if
if (allocated (i_terms)) deallocate (i_terms)
end associate
end subroutine process_instance_apply_real_partition
@ %def process_instance_apply_real_partition
@
<<Instances: process instance: TBP>>=
procedure :: set_i_mci_to_real_component => process_instance_set_i_mci_to_real_component
<<Instances: procedures>>=
subroutine process_instance_set_i_mci_to_real_component (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_mci, i_component
type(process_component_t), pointer :: component => null ()
select type (pcm_instance => instance%pcm)
type is (pcm_instance_nlo_t)
if (allocated (pcm_instance%i_mci_to_real_component)) then
call msg_warning ("i_mci_to_real_component already allocated - replace it")
deallocate (pcm_instance%i_mci_to_real_component)
end if
allocate (pcm_instance%i_mci_to_real_component (size (instance%mci_work)))
do i_mci = 1, size (instance%mci_work)
do i_component = 1, instance%process%get_n_components ()
component => instance%process%get_component_ptr (i_component)
if (component%i_mci /= i_mci) cycle
select case (component%component_type)
case (COMP_MASTER, COMP_REAL)
pcm_instance%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real ()
case (COMP_REAL_FIN)
pcm_instance%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real_fin ()
case (COMP_REAL_SING)
pcm_instance%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real_sing ()
end select
end do
end do
component => null ()
end select
end subroutine process_instance_set_i_mci_to_real_component
@ %def process_instance_set_i_mci_to_real_component
@ Final step of process evaluation: evaluate the matrix elements, and compute
the trace (summed over quantum numbers) for all terms. Finally, sum up the
terms, iterating over all active process components.
If [[weight]] is provided, we already know the kinematical event
weight (the MCI weight which depends on the kinematics sampling
algorithm, but not on the matrix element), so we do not need to take
it from the MCI record.
<<Instances: process instance: TBP>>=
procedure :: evaluate_event_data => process_instance_evaluate_event_data
<<Instances: procedures>>=
subroutine process_instance_evaluate_event_data (instance, weight)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: weight
integer :: i
if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active) then
call term%evaluate_event_data ()
end if
end associate
end do
if (present (weight)) then
instance%weight = weight
else
instance%weight = &
instance%mci_work(instance%i_mci)%mci%get_event_weight ()
instance%excess = &
instance%mci_work(instance%i_mci)%mci%get_event_excess ()
end if
instance%n_dropped = &
instance%mci_work(instance%i_mci)%mci%get_n_event_dropped ()
instance%evaluation_status = STAT_EVENT_COMPLETE
else
!!! failed kinematics etc.: set weight to zero
instance%weight = zero
!!! Maybe we want to process and keep the event nevertheless
if (instance%keep_failed_events ()) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active) then
call term%evaluate_event_data ()
end if
end associate
end do
! do i = 1, size (instance%term)
! instance%term(i)%fac_scale = zero
! end do
instance%evaluation_status = STAT_EVENT_COMPLETE
end if
end if
end subroutine process_instance_evaluate_event_data
@ %def process_instance_evaluate_event_data
@ Computes the real-emission matrix element for externally supplied momenta
for the term instance with index [[i_term]] and a phase space point set with
index [[i_phs]]. In addition, for the real emission, each term instance
corresponds to one emitter. Also, e.g. for Powheg, there is the possibility
to supply an external $\alpha_s$.
<<Instances: process instance: TBP>>=
procedure :: compute_sqme_rad => process_instance_compute_sqme_rad
<<Instances: procedures>>=
subroutine process_instance_compute_sqme_rad &
(instance, i_term, i_phs, is_subtraction, alpha_s_external)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term, i_phs
logical, intent(in) :: is_subtraction
real(default), intent(in), optional :: alpha_s_external
class(prc_core_t), pointer :: core
integer :: i_real_fin
logical :: has_pdfs
has_pdfs = instance%process%pcm_contains_pdfs ()
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_compute_sqme_rad")
select type (pcm => instance%pcm)
type is (pcm_instance_nlo_t)
associate (term => instance%term(i_term))
core => instance%process%get_core_term (i_term)
if (is_subtraction) then
call pcm%set_subtraction_event ()
else
call pcm%set_radiation_event ()
end if
call term%int_hard%set_momenta (pcm%get_momenta &
(i_phs = i_phs, born_phsp = is_subtraction))
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
if (present (alpha_s_external)) &
call term%set_alpha_qcd_forced (alpha_s_external)
call term%compute_eff_kinematics ()
call term%evaluate_expressions ()
call term%evaluate_interaction (core)
call term%evaluate_trace ()
if (term%is_subtraction ()) then
call term%set_sf_factors (has_pdfs)
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (char (config%settings%nlo_correction_type) == "QCD" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_color_correlations (core)
if (char (config%settings%nlo_correction_type) == "EW" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_charge_correlations (core)
end select
call term%evaluate_spin_correlations (core)
end if
i_real_fin = instance%process%get_associated_real_fin (1)
if (term%config%i_component /= i_real_fin) &
call term%apply_fks (core%get_alpha_s (term%core_state), 0._default)
if (instance%process%uses_real_partition ()) &
call instance%apply_real_partition ()
end associate
end select
core => null ()
end subroutine process_instance_compute_sqme_rad
@ %def process_instance_compute_sqme_rad
@ For unweighted event generation, we should reset the reported event
weight to unity (signed) or zero. The latter case is appropriate for
an event which failed for whatever reason.
<<Instances: process instance: TBP>>=
procedure :: normalize_weight => process_instance_normalize_weight
<<Instances: procedures>>=
subroutine process_instance_normalize_weight (instance)
class(process_instance_t), intent(inout) :: instance
if (.not. vanishes (instance%weight)) then
instance%weight = sign (1._default, instance%weight)
end if
end subroutine process_instance_normalize_weight
@ %def process_instance_normalize_weight
@ This is a convenience routine that performs the computations of the
steps 1 to 5 in a single step. The arguments are the input for
[[set_mcpar]]. After this, the evaluation status should be either
[[STAT_FAILED_KINEMATICS]], [[STAT_FAILED_CUTS]] or [[STAT_EVALUATED_TRACE]].
Before calling this, we should call [[choose_mci]].
<<Instances: process instance: TBP>>=
procedure :: evaluate_sqme => process_instance_evaluate_sqme
<<Instances: procedures>>=
subroutine process_instance_evaluate_sqme (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(in) :: x
call instance%reset ()
call instance%set_mcpar (x)
call instance%select_channel (channel)
call instance%compute_seed_kinematics ()
call instance%compute_hard_kinematics ()
call instance%compute_eff_kinematics ()
call instance%evaluate_expressions ()
call instance%compute_other_channels ()
call instance%evaluate_trace ()
end subroutine process_instance_evaluate_sqme
@ %def process_instance_evaluate_sqme
@ This is the inverse. Assuming that the final trace evaluator
contains a valid momentum configuration, recover kinematics
and recalculate the matrix elements and their trace.
To be precise, we first recover kinematics for the given term and
associated component, then recalculate from that all other terms and
active components. The [[channel]] is not really required to obtain
the matrix element, but it allows us to reconstruct the exact MC
parameter set that corresponds to the given phase space point.
Before calling this, we should call [[choose_mci]].
<<Instances: process instance: TBP>>=
procedure :: recover => process_instance_recover
<<Instances: procedures>>=
subroutine process_instance_recover &
(instance, channel, i_term, update_sqme, recover_phs, scale_forced)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
integer, intent(in) :: i_term
logical, intent(in) :: update_sqme
logical, intent(in) :: recover_phs
real(default), intent(in), allocatable, optional :: scale_forced
logical :: skip_phs
call instance%activate ()
instance%evaluation_status = STAT_EFF_KINEMATICS
call instance%recover_hard_kinematics (i_term)
call instance%recover_seed_kinematics (i_term)
call instance%select_channel (channel)
if (recover_phs) then
call instance%recover_mcpar (i_term)
call instance%recover_beam_momenta (i_term)
call instance%compute_seed_kinematics (i_term)
call instance%compute_hard_kinematics (i_term)
call instance%compute_eff_kinematics (i_term)
call instance%compute_other_channels (i_term)
else
call instance%recover_sfchain (i_term)
end if
call instance%evaluate_expressions (scale_forced)
if (update_sqme) then
call instance%reset_core_kinematics ()
call instance%evaluate_trace ()
end if
end subroutine process_instance_recover
@ %def process_instance_recover
@ The [[evaluate]] method is required by the [[sampler_t]] base type of which
the process instance is an extension.
The requirement is that after the process instance is evaluated, the
integrand, the selected channel, the $x$ array, and the $f$ Jacobian array are
exposed by the [[sampler_t]] object.
We allow for the additional [[hook]] to be called, if associated, for outlying
object to access information from the current state of the [[sampler]].
<<Instances: process instance: TBP>>=
procedure :: evaluate => process_instance_evaluate
<<Instances: procedures>>=
subroutine process_instance_evaluate (sampler, c, x_in, val, x, f)
class(process_instance_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%evaluate_sqme (c, x_in)
if (sampler%is_valid ()) then
call sampler%fetch (val, x, f)
end if
call sampler%record_call ()
call sampler%evaluate_after_hook ()
end subroutine process_instance_evaluate
@ %def process_instance_evaluate
@ The phase-space point is valid if the event has valid kinematics and
has passed the cuts.
<<Instances: process instance: TBP>>=
procedure :: is_valid => process_instance_is_valid
<<Instances: procedures>>=
function process_instance_is_valid (sampler) result (valid)
class(process_instance_t), intent(in) :: sampler
logical :: valid
valid = sampler%evaluation_status >= STAT_PASSED_CUTS
end function process_instance_is_valid
@ %def process_instance_is_valid
@ Add a [[process_instance_hook]] object..
<<Instances: process instance: TBP>>=
procedure :: append_after_hook => process_instance_append_after_hook
<<Instances: procedures>>=
subroutine process_instance_append_after_hook (sampler, new_hook)
class(process_instance_t), intent(inout), target :: sampler
class(process_instance_hook_t), intent(inout), target :: new_hook
class(process_instance_hook_t), pointer :: last
if (associated (new_hook%next)) then
call msg_bug ("process_instance_append_after_hook: reuse of SAME hook object is forbidden.")
end if
if (associated (sampler%hook)) then
last => sampler%hook
do while (associated (last%next))
last => last%next
end do
last%next => new_hook
else
sampler%hook => new_hook
end if
end subroutine process_instance_append_after_hook
@ %def process_instance_append_after_evaluate_hook
@ Evaluate the after hook as first in, last out.
<<Instances: process instance: TBP>>=
procedure :: evaluate_after_hook => process_instance_evaluate_after_hook
<<Instances: procedures>>=
subroutine process_instance_evaluate_after_hook (sampler)
class(process_instance_t), intent(in) :: sampler
class(process_instance_hook_t), pointer :: current
current => sampler%hook
do while (associated(current))
call current%evaluate (sampler)
current => current%next
end do
end subroutine process_instance_evaluate_after_hook
@ %def process_instance_evaluate_after_hook
@ The [[rebuild]] method should rebuild the kinematics section out of
the [[x_in]] parameter set. The integrand value [[val]] should not be
computed, but is provided as input.
<<Instances: process instance: TBP>>=
procedure :: rebuild => process_instance_rebuild
<<Instances: procedures>>=
subroutine process_instance_rebuild (sampler, c, x_in, val, x, f)
class(process_instance_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 msg_bug ("process_instance_rebuild not implemented yet")
x = 0
f = 0
end subroutine process_instance_rebuild
@ %def process_instance_rebuild
@ This is another method required by the [[sampler_t]] base type:
fetch the data that are relevant for the MCI record.
<<Instances: process instance: TBP>>=
procedure :: fetch => process_instance_fetch
<<Instances: procedures>>=
subroutine process_instance_fetch (sampler, val, x, f)
class(process_instance_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
integer, dimension(:), allocatable :: i_terms
integer :: i, i_term_base, cc
integer :: n_channel
val = 0
associate (process => sampler%process)
FIND_COMPONENT: do i = 1, process%get_n_components ()
if (sampler%process%component_is_selected (i)) then
allocate (i_terms (size (process%get_component_i_terms (i))))
i_terms = process%get_component_i_terms (i)
i_term_base = i_terms(1)
associate (k => sampler%term(i_term_base)%k_term)
n_channel = k%n_channel
do cc = 1, n_channel
call k%get_mcpar (cc, x(:,cc))
end do
f = k%f
val = sampler%sqme * k%phs_factor
end associate
if (allocated (i_terms)) deallocate (i_terms)
exit FIND_COMPONENT
end if
end do FIND_COMPONENT
end associate
end subroutine process_instance_fetch
@ %def process_instance_fetch
@ Initialize and finalize event generation for the specified MCI
entry.
<<Instances: process instance: TBP>>=
procedure :: init_simulation => process_instance_init_simulation
procedure :: final_simulation => process_instance_final_simulation
<<Instances: procedures>>=
subroutine process_instance_init_simulation (instance, i_mci, &
safety_factor, keep_failed_events)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
call instance%mci_work(i_mci)%init_simulation (safety_factor, keep_failed_events)
end subroutine process_instance_init_simulation
subroutine process_instance_final_simulation (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
call instance%mci_work(i_mci)%final_simulation ()
end subroutine process_instance_final_simulation
@ %def process_instance_init_simulation
@ %def process_instance_final_simulation
@
\subsubsection{Accessing the process instance}
Once the seed kinematics is complete, we can retrieve the MC input parameters
for all channels, not just the seed channel.
Note: We choose the first active component. This makes sense only if the seed
kinematics is identical for all active components.
<<Instances: process instance: TBP>>=
procedure :: get_mcpar => process_instance_get_mcpar
<<Instances: procedures>>=
subroutine process_instance_get_mcpar (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(out) :: x
integer :: i
if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%term(i)%k_term%get_mcpar (channel, x)
return
end if
end do
call msg_bug ("Process instance: get_mcpar: no active channels")
else
call msg_bug ("Process instance: get_mcpar: no seed kinematics")
end if
end subroutine process_instance_get_mcpar
@ %def process_instance_get_mcpar
@ Return true if the [[sqme]] value is known. This also implies that the
event is kinematically valid and has passed all cuts.
<<Instances: process instance: TBP>>=
procedure :: has_evaluated_trace => process_instance_has_evaluated_trace
<<Instances: procedures>>=
function process_instance_has_evaluated_trace (instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
flag = instance%evaluation_status >= STAT_EVALUATED_TRACE
end function process_instance_has_evaluated_trace
@ %def process_instance_has_evaluated_trace
@ Return true if the event is complete. In particular, the event must
be kinematically valid, passed all cuts, and the event data have been
computed.
<<Instances: process instance: TBP>>=
procedure :: is_complete_event => process_instance_is_complete_event
<<Instances: procedures>>=
function process_instance_is_complete_event (instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
flag = instance%evaluation_status >= STAT_EVENT_COMPLETE
end function process_instance_is_complete_event
@ %def process_instance_is_complete_event
@ Select the term for the process instance that will provide the basic
event record (used in [[evt_trivial_make_particle_set]]). It might be
necessary to write out additional events corresponding to other terms
(done in [[evt_nlo]]).
<<Instances: process instance: TBP>>=
procedure :: select_i_term => process_instance_select_i_term
<<Instances: procedures>>=
function process_instance_select_i_term (instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
integer :: i_mci
i_mci = instance%i_mci
i_term = instance%process%select_i_term (i_mci)
end function process_instance_select_i_term
@ %def process_instance_select_i_term
@ Return pointer to the master beam interaction.
<<Instances: process instance: TBP>>=
procedure :: get_beam_int_ptr => process_instance_get_beam_int_ptr
<<Instances: procedures>>=
function process_instance_get_beam_int_ptr (instance) result (ptr)
class(process_instance_t), intent(in), target :: instance
type(interaction_t), pointer :: ptr
ptr => instance%sf_chain%get_beam_int_ptr ()
end function process_instance_get_beam_int_ptr
@ %def process_instance_get_beam_int_ptr
@ Return pointers to the matrix and flows interactions, given a term index.
<<Instances: process instance: TBP>>=
procedure :: get_trace_int_ptr => process_instance_get_trace_int_ptr
procedure :: get_matrix_int_ptr => process_instance_get_matrix_int_ptr
procedure :: get_flows_int_ptr => process_instance_get_flows_int_ptr
<<Instances: procedures>>=
function process_instance_get_trace_int_ptr (instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_trace_int_ptr ()
end function process_instance_get_trace_int_ptr
function process_instance_get_matrix_int_ptr (instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_matrix_int_ptr ()
end function process_instance_get_matrix_int_ptr
function process_instance_get_flows_int_ptr (instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_flows_int_ptr ()
end function process_instance_get_flows_int_ptr
@ %def process_instance_get_trace_int_ptr
@ %def process_instance_get_matrix_int_ptr
@ %def process_instance_get_flows_int_ptr
@ Return the complete account of flavor combinations in the underlying
interaction object, including beams, radiation, and hard interaction.
<<Instances: process instance: TBP>>=
procedure :: get_state_flv => process_instance_get_state_flv
<<Instances: procedures>>=
function process_instance_get_state_flv (instance, i_term) result (state_flv)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
type(state_flv_content_t) :: state_flv
state_flv = instance%term(i_term)%connected%get_state_flv ()
end function process_instance_get_state_flv
@ %def process_instance_get_state_flv
@ Return pointers to the parton states of a selected term.
<<Instances: process instance: TBP>>=
procedure :: get_isolated_state_ptr => &
process_instance_get_isolated_state_ptr
procedure :: get_connected_state_ptr => &
process_instance_get_connected_state_ptr
<<Instances: procedures>>=
function process_instance_get_isolated_state_ptr (instance, i_term) &
result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(isolated_state_t), pointer :: ptr
ptr => instance%term(i_term)%isolated
end function process_instance_get_isolated_state_ptr
function process_instance_get_connected_state_ptr (instance, i_term) &
result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(connected_state_t), pointer :: ptr
ptr => instance%term(i_term)%connected
end function process_instance_get_connected_state_ptr
@ %def process_instance_get_isolated_state_ptr
@ %def process_instance_get_connected_state_ptr
@ Return the indices of the beam particles and incoming partons within the
currently active state matrix, respectively.
<<Instances: process instance: TBP>>=
procedure :: get_beam_index => process_instance_get_beam_index
procedure :: get_in_index => process_instance_get_in_index
<<Instances: procedures>>=
subroutine process_instance_get_beam_index (instance, i_term, i_beam)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_beam
call instance%term(i_term)%connected%get_beam_index (i_beam)
end subroutine process_instance_get_beam_index
subroutine process_instance_get_in_index (instance, i_term, i_in)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_in
call instance%term(i_term)%connected%get_in_index (i_in)
end subroutine process_instance_get_in_index
@ %def process_instance_get_beam_index
@ %def process_instance_get_in_index
@ Return squared matrix element and event weight, and event weight
excess where applicable. [[n_dropped]] is a number that can be
nonzero when a weighted event has been generated, dropping events with
zero weight (failed cuts) on the fly.
<<Instances: process instance: TBP>>=
procedure :: get_sqme => process_instance_get_sqme
procedure :: get_weight => process_instance_get_weight
procedure :: get_excess => process_instance_get_excess
procedure :: get_n_dropped => process_instance_get_n_dropped
<<Instances: procedures>>=
function process_instance_get_sqme (instance, i_term) result (sqme)
real(default) :: sqme
class(process_instance_t), intent(in) :: instance
integer, intent(in), optional :: i_term
if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
if (present (i_term)) then
sqme = instance%term(i_term)%connected%trace%get_matrix_element (1)
else
sqme = instance%sqme
end if
else
sqme = 0
end if
end function process_instance_get_sqme
function process_instance_get_weight (instance) result (weight)
real(default) :: weight
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
weight = instance%weight
else
weight = 0
end if
end function process_instance_get_weight
function process_instance_get_excess (instance) result (excess)
real(default) :: excess
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
excess = instance%excess
else
excess = 0
end if
end function process_instance_get_excess
function process_instance_get_n_dropped (instance) result (n_dropped)
integer :: n_dropped
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
n_dropped = instance%n_dropped
else
n_dropped = 0
end if
end function process_instance_get_n_dropped
@ %def process_instance_get_sqme
@ %def process_instance_get_weight
@ %def process_instance_get_excess
@ %def process_instance_get_n_dropped
@ Return the currently selected MCI channel.
<<Instances: process instance: TBP>>=
procedure :: get_channel => process_instance_get_channel
<<Instances: procedures>>=
function process_instance_get_channel (instance) result (channel)
integer :: channel
class(process_instance_t), intent(in) :: instance
channel = instance%selected_channel
end function process_instance_get_channel
@ %def process_instance_get_channel
@
<<Instances: process instance: TBP>>=
procedure :: set_fac_scale => process_instance_set_fac_scale
<<Instances: procedures>>=
subroutine process_instance_set_fac_scale (instance, fac_scale)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in) :: fac_scale
integer :: i_term
i_term = 1
call instance%term(i_term)%set_fac_scale (fac_scale)
end subroutine process_instance_set_fac_scale
@ %def process_instance_set_fac_scale
@ Return factorization scale and strong coupling. We have to select a
term instance.
<<Instances: process instance: TBP>>=
procedure :: get_fac_scale => process_instance_get_fac_scale
procedure :: get_alpha_s => process_instance_get_alpha_s
<<Instances: procedures>>=
function process_instance_get_fac_scale (instance, i_term) result (fac_scale)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
real(default) :: fac_scale
fac_scale = instance%term(i_term)%get_fac_scale ()
end function process_instance_get_fac_scale
function process_instance_get_alpha_s (instance, i_term) result (alpha_s)
real(default) :: alpha_s
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
class(prc_core_t), pointer :: core => null ()
core => instance%process%get_core_term (i_term)
alpha_s = instance%term(i_term)%get_alpha_s (core)
core => null ()
end function process_instance_get_alpha_s
@ %def process_instance_get_fac_scale
@ %def process_instance_get_alpha_s
@
<<Instances: process instance: TBP>>=
procedure :: get_qcd => process_instance_get_qcd
<<Instances: procedures>>=
function process_instance_get_qcd (process_instance) result (qcd)
type(qcd_t) :: qcd
class(process_instance_t), intent(in) :: process_instance
qcd = process_instance%process%get_qcd ()
end function process_instance_get_qcd
@ %def process_instance_get_qcd
@ Counter.
<<Instances: process instance: TBP>>=
procedure :: reset_counter => process_instance_reset_counter
procedure :: record_call => process_instance_record_call
procedure :: get_counter => process_instance_get_counter
<<Instances: procedures>>=
subroutine process_instance_reset_counter (process_instance)
class(process_instance_t), intent(inout) :: process_instance
call process_instance%mci_work(process_instance%i_mci)%reset_counter ()
end subroutine process_instance_reset_counter
subroutine process_instance_record_call (process_instance)
class(process_instance_t), intent(inout) :: process_instance
call process_instance%mci_work(process_instance%i_mci)%record_call &
(process_instance%evaluation_status)
end subroutine process_instance_record_call
pure function process_instance_get_counter (process_instance) result (counter)
class(process_instance_t), intent(in) :: process_instance
type(process_counter_t) :: counter
counter = process_instance%mci_work(process_instance%i_mci)%get_counter ()
end function process_instance_get_counter
@ %def process_instance_reset_counter
@ %def process_instance_record_call
@ %def process_instance_get_counter
@ Sum up the total number of calls for all MCI records.
<<Instances: process instance: TBP>>=
procedure :: get_actual_calls_total => process_instance_get_actual_calls_total
<<Instances: procedures>>=
pure function process_instance_get_actual_calls_total (process_instance) &
result (n)
class(process_instance_t), intent(in) :: process_instance
integer :: n
integer :: i
type(process_counter_t) :: counter
n = 0
do i = 1, size (process_instance%mci_work)
counter = process_instance%mci_work(i)%get_counter ()
n = n + counter%total
end do
end function process_instance_get_actual_calls_total
@ %def process_instance_get_actual_calls_total
@
<<Instances: process instance: TBP>>=
procedure :: reset_matrix_elements => process_instance_reset_matrix_elements
<<Instances: procedures>>=
subroutine process_instance_reset_matrix_elements (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_term
do i_term = 1, size (instance%term)
call instance%term(i_term)%connected%trace%set_matrix_element (cmplx (0, 0, default))
call instance%term(i_term)%connected%matrix%set_matrix_element (cmplx (0, 0, default))
end do
end subroutine process_instance_reset_matrix_elements
@ %def process_instance_reset_matrix_elements
@
<<Instances: process instance: TBP>>=
procedure :: get_test_phase_space_point &
=> process_instance_get_test_phase_space_point
<<Instances: procedures>>=
subroutine process_instance_get_test_phase_space_point (instance, &
i_component, i_core, p)
type(vector4_t), dimension(:), allocatable, intent(out) :: p
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_component, i_core
real(default), dimension(:), allocatable :: x
logical :: success
integer :: i_term
instance%i_mci = i_component
i_term = instance%process%get_i_term (i_core)
associate (term => instance%term(i_term))
allocate (x (instance%mci_work(i_component)%config%n_par))
x = 0.5_default
call instance%set_mcpar (x, .true.)
call instance%select_channel (1)
call term%compute_seed_kinematics &
(instance%mci_work(i_component), 1, success)
call instance%term(i_term)%evaluate_radiation_kinematics &
(instance%mci_work(instance%i_mci)%get_x_process ())
call instance%term(i_term)%compute_hard_kinematics (success = success)
allocate (p (size (term%p_hard)))
p = term%int_hard%get_momenta ()
end associate
end subroutine process_instance_get_test_phase_space_point
@ %def process_instance_get_test_phase_space_point
@
<<Instances: process instance: TBP>>=
procedure :: get_p_hard => process_instance_get_p_hard
<<Instances: procedures>>=
pure function process_instance_get_p_hard (process_instance, i_term) &
result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(process_instance_t), intent(in) :: process_instance
integer, intent(in) :: i_term
allocate (p_hard (size (process_instance%term(i_term)%get_p_hard ())))
p_hard = process_instance%term(i_term)%get_p_hard ()
end function process_instance_get_p_hard
@ %def process_instance_get_p_hard
@
<<Instances: process instance: TBP>>=
procedure :: get_first_active_i_term => process_instance_get_first_active_i_term
<<Instances: procedures>>=
function process_instance_get_first_active_i_term (instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
integer :: i
i_term = 0
do i = 1, size (instance%term)
if (instance%term(i)%active) then
i_term = i
exit
end if
end do
end function process_instance_get_first_active_i_term
@ %def process_instance_get_first_active_i_term
@
<<Instances: process instance: TBP>>=
procedure :: get_real_of_mci => process_instance_get_real_of_mci
<<Instances: procedures>>=
function process_instance_get_real_of_mci (instance) result (i_real)
integer :: i_real
class(process_instance_t), intent(in) :: instance
select type (pcm => instance%pcm)
type is (pcm_instance_nlo_t)
i_real = pcm%i_mci_to_real_component (instance%i_mci)
end select
end function process_instance_get_real_of_mci
@ %def process_instance_get_real_of_mci
@
<<Instances: process instance: TBP>>=
procedure :: get_connected_states => process_instance_get_connected_states
<<Instances: procedures>>=
function process_instance_get_connected_states (instance, i_component) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_component
connected = instance%process%get_connected_states (i_component, &
instance%term(:)%connected)
end function process_instance_get_connected_states
@ %def process_instance_get_connected_states
@ Get the hadronic center-of-mass energy
<<Instances: process instance: TBP>>=
procedure :: get_sqrts => process_instance_get_sqrts
<<Instances: procedures>>=
function process_instance_get_sqrts (instance) result (sqrts)
class(process_instance_t), intent(in) :: instance
real(default) :: sqrts
sqrts = instance%process%get_sqrts ()
end function process_instance_get_sqrts
@ %def process_instance_get_sqrts
@ Get the polarizations
<<Instances: process instance: TBP>>=
procedure :: get_polarization => process_instance_get_polarization
<<Instances: procedures>>=
function process_instance_get_polarization (instance) result (pol)
class(process_instance_t), intent(in) :: instance
real(default), dimension(2) :: pol
pol = instance%process%get_polarization ()
end function process_instance_get_polarization
@ %def process_instance_get_polarization
@ Get the beam spectrum
<<Instances: process instance: TBP>>=
procedure :: get_beam_file => process_instance_get_beam_file
<<Instances: procedures>>=
function process_instance_get_beam_file (instance) result (file)
class(process_instance_t), intent(in) :: instance
type(string_t) :: file
file = instance%process%get_beam_file ()
end function process_instance_get_beam_file
@ %def process_instance_get_beam_file
@ Get the process name
<<Instances: process instance: TBP>>=
procedure :: get_process_name => process_instance_get_process_name
<<Instances: procedures>>=
function process_instance_get_process_name (instance) result (name)
class(process_instance_t), intent(in) :: instance
type(string_t) :: name
name = instance%process%get_id ()
end function process_instance_get_process_name
@ %def process_instance_get_process_name
@
\subsubsection{Particle sets}
Here we provide two procedures that convert the process instance
from/to a particle set. The conversion applies to the trace evaluator
which has no quantum-number information, thus it involves only the
momenta and the parent-child relations. We keep virtual particles.
If [[n_incoming]] is provided, the status code of the first
[[n_incoming]] particles will be reset to incoming. Otherwise, they
would be classified as virtual.
Nevertheless, it is possible to reconstruct the complete structure
from a particle set. The reconstruction implies a re-evaluation of
the structure function and matrix-element codes.
The [[i_term]] index is needed for both input and output, to select
among different active trace evaluators.
In both cases, the [[instance]] object must be properly initialized.
NB: The [[recover_beams]] option should be used only when the particle
set originates from an external event file, and the user has asked for
it. It should be switched off when reading from raw event file.
<<Instances: process instance: TBP>>=
procedure :: get_trace => process_instance_get_trace
procedure :: set_trace => process_instance_set_trace
<<Instances: procedures>>=
subroutine process_instance_get_trace (instance, pset, i_term, n_incoming)
class(process_instance_t), intent(in), target :: instance
type(particle_set_t), intent(out) :: pset
integer, intent(in) :: i_term
integer, intent(in), optional :: n_incoming
type(interaction_t), pointer :: int
logical :: ok
int => instance%get_trace_int_ptr (i_term)
call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
[0._default, 0._default], .false., .true., n_incoming)
end subroutine process_instance_get_trace
subroutine process_instance_set_trace &
(instance, pset, i_term, recover_beams, check_match)
class(process_instance_t), intent(inout), target :: instance
type(particle_set_t), intent(in) :: pset
integer, intent(in) :: i_term
logical, intent(in), optional :: recover_beams, check_match
type(interaction_t), pointer :: int
integer :: n_in
int => instance%get_trace_int_ptr (i_term)
n_in = instance%process%get_n_in ()
call pset%fill_interaction (int, n_in, &
recover_beams = recover_beams, &
check_match = check_match, &
state_flv = instance%get_state_flv (i_term))
end subroutine process_instance_set_trace
@ %def process_instance_get_trace
@ %def process_instance_set_trace
@ This procedure allows us to override any QCD setting of the WHIZARD process
and directly set the coupling value that comes together with a particle set.
<<Instances: process instance: TBP>>=
procedure :: set_alpha_qcd_forced => process_instance_set_alpha_qcd_forced
<<Instances: procedures>>=
subroutine process_instance_set_alpha_qcd_forced (instance, i_term, alpha_qcd)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
real(default), intent(in) :: alpha_qcd
call instance%term(i_term)%set_alpha_qcd_forced (alpha_qcd)
end subroutine process_instance_set_alpha_qcd_forced
@ %def process_instance_set_alpha_qcd_forced
@
<<Instances: process instance: TBP>>=
procedure :: has_nlo_component => process_instance_has_nlo_component
<<Instances: procedures>>=
function process_instance_has_nlo_component (instance) result (nlo)
class(process_instance_t), intent(in) :: instance
logical :: nlo
nlo = instance%process%is_nlo_calculation ()
end function process_instance_has_nlo_component
@ %def process_instance_has_nlo_component
@
<<Instances: process instance: TBP>>=
procedure :: keep_failed_events => process_instance_keep_failed_events
<<Instances: procedures>>=
function process_instance_keep_failed_events (instance) result (keep)
logical :: keep
class(process_instance_t), intent(in) :: instance
keep = instance%mci_work(instance%i_mci)%keep_failed_events
end function process_instance_keep_failed_events
@ %def process_instance_keep_failed_events
@
<<Instances: process instance: TBP>>=
procedure :: get_term_indices => process_instance_get_term_indices
<<Instances: procedures>>=
function process_instance_get_term_indices (instance, nlo_type) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_instance_t), intent(in) :: instance
integer :: nlo_type
allocate (i_term (count (instance%term%nlo_type == nlo_type)))
i_term = pack (instance%term%get_i_term_global (), instance%term%nlo_type == nlo_type)
end function process_instance_get_term_indices
@ %def process_instance_get_term_indices
@
<<Instances: process instance: TBP>>=
procedure :: get_boost_to_lab => process_instance_get_boost_to_lab
<<Instances: procedures>>=
function process_instance_get_boost_to_lab (instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lt = instance%term(i_term)%get_boost_to_lab ()
end function process_instance_get_boost_to_lab
@ %def process_instance_get_boost_to_lab
@
<<Instances: process instance: TBP>>=
procedure :: get_boost_to_cms => process_instance_get_boost_to_cms
<<Instances: procedures>>=
function process_instance_get_boost_to_cms (instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lt = instance%term(i_term)%get_boost_to_cms ()
end function process_instance_get_boost_to_cms
@ %def process_instance_get_boost_to_cms
@
<<Instances: process instance: TBP>>=
procedure :: lab_is_cm => process_instance_lab_is_cm
<<Instances: procedures>>=
function process_instance_lab_is_cm (instance, i_term) result (lab_is_cm)
logical :: lab_is_cm
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lab_is_cm = instance%term(i_term)%k_term%phs%lab_is_cm ()
end function process_instance_lab_is_cm
@ %def process_instance_lab_is_cm
@
The [[pacify]] subroutine has the purpose of setting numbers to zero
which are (by comparing with a [[tolerance]] parameter) considered
equivalent with zero. We do this in some unit tests. Here, we a
apply this to the phase space subobject of the process instance.
<<Instances: public>>=
public :: pacify
<<Instances: interfaces>>=
interface pacify
module procedure pacify_process_instance
end interface pacify
<<Instances: procedures>>=
subroutine pacify_process_instance (instance)
type(process_instance_t), intent(inout) :: instance
integer :: i
do i = 1, size (instance%term)
call pacify (instance%term(i)%k_term%phs)
end do
end subroutine pacify_process_instance
@ %def pacify
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[processes_ut.f90]]>>=
<<File header>>
module processes_ut
use unit_tests
use processes_uti
<<Standard module head>>
<<Processes: public test>>
<<Processes: public test auxiliary>>
contains
<<Processes: test driver>>
end module processes_ut
@ %def processes_ut
@
<<[[processes_uti.f90]]>>=
<<File header>>
module processes_uti
<<Use kinds>>
<<Use strings>>
use format_utils, only: write_separator
use constants, only: TWOPI4
use physics_defs, only: CONV
use os_interface
use sm_qcd
use lorentz
use pdg_arrays
use model_data
use models
use var_base, only: vars_t
use variables, only: var_list_t
use model_testbed, only: prepare_model
use particle_specifiers, only: new_prt_spec
use flavors
use interactions, only: reset_interaction_counter
use particles
use rng_base
use mci_base
use mci_none, only: mci_none_t
use mci_midpoint
use sf_mappings
use sf_base
use phs_base
use phs_single
use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
use phs_wood, only: phs_wood_config_t
use resonances, only: resonance_history_set_t
use process_constants
use prc_core_def, only: prc_core_def_t
use prc_core
use prc_test, only: prc_test_create_library
use prc_template_me, only: template_me_def_t
use process_libraries
use prc_test_core
use process_counter
use process_config, only: process_term_t
use process, only: process_t
use instances, only: process_instance_t, process_instance_hook_t
use rng_base_ut, only: rng_test_factory_t
use sf_base_ut, only: sf_test_data_t
use mci_base_ut, only: mci_test_t
use phs_base_ut, only: phs_test_config_t
<<Standard module head>>
<<Processes: public test auxiliary>>
<<Processes: test declarations>>
<<Processes: test types>>
contains
<<Processes: tests>>
<<Processes: test auxiliary>>
end module processes_uti
@ %def processes_uti
@ API: driver for the unit tests below.
<<Processes: public test>>=
public :: processes_test
<<Processes: test driver>>=
subroutine processes_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Processes: execute tests>>
end subroutine processes_test
@ %def processes_test
\subsubsection{Write an empty process object}
The most trivial test is to write an uninitialized process object.
<<Processes: execute tests>>=
call test (processes_1, "processes_1", &
"write an empty process object", &
u, results)
<<Processes: test declarations>>=
public :: processes_1
<<Processes: tests>>=
subroutine processes_1 (u)
integer, intent(in) :: u
type(process_t) :: process
write (u, "(A)") "* Test output: processes_1"
write (u, "(A)") "* Purpose: display an empty process object"
write (u, "(A)")
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_1"
end subroutine processes_1
@ %def processes_1
@
\subsubsection{Initialize a process object}
Initialize a process and display it.
<<Processes: execute tests>>=
call test (processes_2, "processes_2", &
"initialize a simple process object", &
u, results)
<<Processes: test declarations>>=
public :: processes_2
<<Processes: tests>>=
subroutine processes_2 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable :: process
class(mci_t), allocatable :: mci_template
class(phs_config_t), allocatable :: phs_config_template
write (u, "(A)") "* Test output: processes_2"
write (u, "(A)") "* Purpose: initialize a simple process object"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes2"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%set_run_id (var_str ("run_2"))
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
call process%setup_mci (dispatch_mci_empty)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_2"
end subroutine processes_2
@ %def processes_2
@ Trivial for testing: do not allocate the MCI record.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_empty (mci, var_list, process_id, is_nlo)
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
end subroutine dispatch_mci_empty
@ %def dispatch_mci_empty
@
\subsubsection{Compute a trivial matrix element}
Initialize a process, retrieve some information and compute a matrix
element.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Processes: execute tests>>=
call test (processes_3, "processes_3", &
"retrieve a trivial matrix element", &
u, results)
<<Processes: test declarations>>=
public :: processes_3
<<Processes: tests>>=
subroutine processes_3 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_constants_t) :: data
type(vector4_t), dimension(:), allocatable :: p
write (u, "(A)") "* Test output: processes_3"
write (u, "(A)") "* Purpose: create a process &
&and compute a matrix element"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes3"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
call process%setup_mci (dispatch_mci_test3)
write (u, "(A)") "* Return the number of process components"
write (u, "(A)")
write (u, "(A,I0)") "n_components = ", process%get_n_components ()
write (u, "(A)")
write (u, "(A)") "* Return the number of flavor states"
write (u, "(A)")
data = process%get_constants (1)
write (u, "(A,I0)") "n_flv(1) = ", data%n_flv
write (u, "(A)")
write (u, "(A)") "* Return the first flavor state"
write (u, "(A)")
write (u, "(A,4(1x,I0))") "flv_state(1) =", data%flv_state (:,1)
write (u, "(A)")
write (u, "(A)") "* Set up kinematics &
&[arbitrary, the matrix element is constant]"
allocate (p (4))
write (u, "(A)")
write (u, "(A)") "* Retrieve the matrix element"
write (u, "(A)")
write (u, "(A,F5.3,' + ',F5.3,' I')") "me (1, p, 1, 1, 1) = ", &
process%compute_amplitude (1, 1, 1, p, 1, 1, 1)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_3"
end subroutine processes_3
@ %def processes_3
@ MCI record with some contents.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_test3 (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
allocate (mci_test_t :: mci)
select type (mci)
type is (mci_test_t)
call mci%set_dimensions (2, 2)
call mci%set_divisions (100)
end select
end subroutine dispatch_mci_test3
@ %def dispatch_mci_test3
@
\subsubsection{Generate a process instance}
Initialize a process and process instance, choose a sampling point and
fill the process instance.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Processes: execute tests>>=
call test (processes_4, "processes_4", &
"create and fill a process instance (partonic event)", &
u, results)
<<Processes: test declarations>>=
public :: processes_4
<<Processes: tests>>=
subroutine processes_4 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_4"
write (u, "(A)") "* Purpose: create a process &
&and fill a process instance"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a test process"
write (u, "(A)")
libname = "processes4"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_empty)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Inject a set of random numbers"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%set_mcpar ([0._default, 0._default])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set up hard kinematics"
write (u, "(A)")
call process_instance%select_channel (1)
call process_instance%compute_seed_kinematics ()
call process_instance%compute_hard_kinematics ()
call process_instance%compute_eff_kinematics ()
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels ()
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%evaluate_trace ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%activate ()
process_instance%evaluation_status = STAT_EFF_KINEMATICS
call process_instance%recover_hard_kinematics (i_term = 1)
call process_instance%recover_seed_kinematics (i_term = 1)
call process_instance%select_channel (1)
call process_instance%recover_mcpar (i_term = 1)
call process_instance%compute_seed_kinematics (skip_term = 1)
call process_instance%compute_hard_kinematics (skip_term = 1)
call process_instance%compute_eff_kinematics (skip_term = 1)
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels (skip_term = 1)
call process_instance%evaluate_trace ()
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_4"
end subroutine processes_4
@ %def processes_4
@
\subsubsection{Structure function configuration}
Configure structure functions (multi-channel) in a process object.
<<Processes: execute tests>>=
call test (processes_7, "processes_7", &
"process configuration with structure functions", &
u, results)
<<Processes: test declarations>>=
public :: processes_7
<<Processes: tests>>=
subroutine processes_7 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t), dimension(2) :: sf_channel
write (u, "(A)") "* Test output: processes_7"
write (u, "(A)") "* Purpose: initialize a process with &
&structure functions"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes7"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call process%test_allocate_sf_channels (3)
call sf_channel(1)%init (2)
call sf_channel(1)%activate_mapping ([1,2])
call process%set_sf_channel (2, sf_channel(1))
call sf_channel(2)%init (2)
call sf_channel(2)%set_s_mapping ([1,2])
call process%set_sf_channel (3, sf_channel(2))
call process%setup_mci (dispatch_mci_empty)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_7"
end subroutine processes_7
@ %def processes_7
@
\subsubsection{Evaluating a process with structure function}
Configure structure functions (single-channel) in a process object,
create an instance, compute kinematics and evaluate.
Note the order of operations when setting up structure functions and
phase space. The beams are first, they determine the [[sqrts]] value.
We can also set up the chain of structure functions. We then
configure the phase space. From this, we can obtain information about
special configurations (resonances, etc.), which we need for
allocating the possible structure-function channels (parameterizations
and mappings). Finally, we match phase-space channels onto
structure-function channels.
In the current example, this matching is trivial; we only have one
structure-function channel.
<<Processes: execute tests>>=
call test (processes_8, "processes_8", &
"process evaluation with structure functions", &
u, results)
<<Processes: test declarations>>=
public :: processes_8
<<Processes: tests>>=
subroutine processes_8 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t) :: sf_channel
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_8"
write (u, "(A)") "* Purpose: evaluate a process with &
&structure functions"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes8"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call process%configure_phs ()
call process%test_allocate_sf_channels (1)
call sf_channel%init (2)
call sf_channel%activate_mapping ([1,2])
call process%set_sf_channel (1, sf_channel)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_mci (dispatch_mci_empty)
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Set up kinematics and evaluate"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%evaluate_sqme (1, &
[0.8_default, 0.8_default, 0.1_default, 0.2_default])
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
call reset_interaction_counter (2)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover &
(channel = 1, i_term = 1, update_sqme = .true., recover_phs = .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_8"
end subroutine processes_8
@ %def processes_8
@
\subsubsection{Multi-channel phase space and structure function}
This is an extension of the previous example. This time, we have two
distinct structure-function channels which are matched to the two
distinct phase-space channels.
<<Processes: execute tests>>=
call test (processes_9, "processes_9", &
"multichannel kinematics and structure functions", &
u, results)
<<Processes: test declarations>>=
public :: processes_9
<<Processes: tests>>=
subroutine processes_9 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t) :: sf_channel
real(default), dimension(4) :: x_saved
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_9"
write (u, "(A)") "* Purpose: evaluate a process with &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes9"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call process%configure_phs ()
call process%test_allocate_sf_channels (2)
call sf_channel%init (2)
call process%set_sf_channel (1, sf_channel)
call sf_channel%init (2)
call sf_channel%activate_mapping ([1,2])
call process%set_sf_channel (2, sf_channel)
call process%test_set_component_sf_channel ([1, 2])
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_mci (dispatch_mci_empty)
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Set up kinematics in channel 1 and evaluate"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%evaluate_sqme (1, &
[0.8_default, 0.8_default, 0.1_default, 0.2_default])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract MC input parameters"
write (u, "(A)")
write (u, "(A)") "Channel 1:"
call process_instance%get_mcpar (1, x_saved)
write (u, "(2x,9(1x,F7.5))") x_saved
write (u, "(A)") "Channel 2:"
call process_instance%get_mcpar (2, x_saved)
write (u, "(2x,9(1x,F7.5))") x_saved
write (u, "(A)")
write (u, "(A)") "* Set up kinematics in channel 2 and evaluate"
write (u, "(A)")
call process_instance%evaluate_sqme (2, x_saved)
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Recover process instance for channel 2"
write (u, "(A)")
call reset_interaction_counter (2)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover &
(channel = 2, i_term = 1, update_sqme = .true., recover_phs = .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_9"
end subroutine processes_9
@ %def processes_9
@
\subsubsection{Event generation}
Activate the MC integrator for the process object and use it to
generate a single event. Note that the test integrator does not
require integration in preparation for generating events.
<<Processes: execute tests>>=
call test (processes_10, "processes_10", &
"event generation", &
u, results)
<<Processes: test declarations>>=
public :: processes_10
<<Processes: tests>>=
subroutine processes_10 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(mci_t), pointer :: mci
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
write (u, "(A)") "* Test output: processes_10"
write (u, "(A)") "* Purpose: generate events for a process without &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes10"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test10)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Generate weighted event"
write (u, "(A)")
call process%test_get_mci_ptr (mci)
select type (mci)
type is (mci_test_t)
! This ensures that the next 'random' numbers are 0.3, 0.5, 0.7
call mci%rng%init (3)
! Include the constant PHS factor in the stored maximum of the integrand
call mci%set_max_factor (conv * twopi4 &
/ (2 * sqrt (lambda (sqrts **2, 125._default**2, 125._default**2))))
end select
call process_instance%generate_weighted_event (1)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate unweighted event"
write (u, "(A)")
call process_instance%generate_unweighted_event (1)
call process%test_get_mci_ptr (mci)
select type (mci)
type is (mci_test_t)
write (u, "(A,I0)") " Success in try ", mci%tries
write (u, "(A)")
end select
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_10"
end subroutine processes_10
@ %def processes_10
@ MCI record with some contents.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_test10 (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
allocate (mci_test_t :: mci)
select type (mci)
type is (mci_test_t); call mci%set_divisions (100)
end select
end subroutine dispatch_mci_test10
@ %def dispatch_mci_test10
@
\subsubsection{Integration}
Activate the MC integrator for the process object and use it to
integrate over phase space.
<<Processes: execute tests>>=
call test (processes_11, "processes_11", &
"integration", &
u, results)
<<Processes: test declarations>>=
public :: processes_11
<<Processes: tests>>=
subroutine processes_11 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(mci_t), allocatable :: mci_template
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
write (u, "(A)") "* Test output: processes_11"
write (u, "(A)") "* Purpose: integrate a process without &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes11"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test10)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Integrate with default test parameters"
write (u, "(A)")
call process_instance%integrate (1, n_it=1, n_calls=10000)
call process%final_integration (1)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
process%get_integral (1) &
/ process_instance%term(1)%k_term%phs_factor
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_11"
end subroutine processes_11
@ %def processes_11
@
\subsubsection{Complete events}
For the purpose of simplifying further tests, we implement a
convenience routine that initializes a process and prepares a single
event. This is a wrapup of the test [[processes_10]].
The procedure is re-exported by the [[processes_ut]] module.
<<Processes: public test auxiliary>>=
public :: prepare_test_process
<<Processes: test auxiliary>>=
subroutine prepare_test_process &
(process, process_instance, model, var_list, run_id)
type(process_t), intent(out), target :: process
type(process_instance_t), intent(out), target :: process_instance
class(model_data_t), intent(in), target :: model
type(var_list_t), intent(inout), optional :: var_list
type(string_t), intent(in), optional :: run_id
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), allocatable, target :: process_model
class(mci_t), pointer :: mci
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
libname = "processes_test"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
allocate (process_model)
call process_model%init (model%get_name (), &
model%get_n_real (), &
model%get_n_complex (), &
model%get_n_field (), &
model%get_n_vtx ())
call process_model%copy_from (model)
call process%init (procname, lib, os_data, process_model, var_list)
if (present (run_id)) call process%set_run_id (run_id)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test10)
call process%setup_terms ()
call process_instance%init (process)
call process%test_get_mci_ptr (mci)
select type (mci)
type is (mci_test_t)
! This ensures that the next 'random' numbers are 0.3, 0.5, 0.7
call mci%rng%init (3)
! Include the constant PHS factor in the stored maximum of the integrand
call mci%set_max_factor (conv * twopi4 &
/ (2 * sqrt (lambda (sqrts **2, 125._default**2, 125._default**2))))
end select
call process%reset_library_ptr () ! avoid dangling pointer
call process_model%final ()
end subroutine prepare_test_process
@ %def prepare_test_process
@ Here we do the cleanup of the process and process instance emitted
by the previous routine.
<<Processes: public test auxiliary>>=
public :: cleanup_test_process
<<Processes: test auxiliary>>=
subroutine cleanup_test_process (process, process_instance)
type(process_t), intent(inout) :: process
type(process_instance_t), intent(inout) :: process_instance
call process_instance%final ()
call process%final ()
end subroutine cleanup_test_process
@ %def cleanup_test_process
@
This is the actual test. Prepare the test process and event, fill
all evaluators, and display the results. Use a particle set as
temporary storage, read kinematics and recalculate the event.
<<Processes: execute tests>>=
call test (processes_12, "processes_12", &
"event post-processing", &
u, results)
<<Processes: test declarations>>=
public :: processes_12
<<Processes: tests>>=
subroutine processes_12 (u)
integer, intent(in) :: u
type(process_t), allocatable, target :: process
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
type(model_data_t), target :: model
write (u, "(A)") "* Test output: processes_12"
write (u, "(A)") "* Purpose: generate a complete partonic event"
write (u, "(A)")
call model%init_test ()
write (u, "(A)") "* Build and initialize process and process instance &
&and generate event"
write (u, "(A)")
allocate (process)
allocate (process_instance)
call prepare_test_process (process, process_instance, model, &
run_id = var_str ("run_12"))
call process_instance%setup_event_data (i_core = 1)
call process%prepare_simulation (1)
call process_instance%init_simulation (1)
call process_instance%generate_weighted_event (1)
call process_instance%evaluate_event_data ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final_simulation (1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Recover kinematics and recalculate"
write (u, "(A)")
call reset_interaction_counter (2)
allocate (process_instance)
call process_instance%init (process)
call process_instance%setup_event_data ()
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover &
(channel = 1, i_term = 1, update_sqme = .true., recover_phs = .true.)
call process_instance%recover_event ()
call process_instance%evaluate_event_data ()
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call cleanup_test_process (process, process_instance)
deallocate (process_instance)
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_12"
end subroutine processes_12
@ %def processes_12
@
\subsubsection{Colored interaction}
This test specifically checks the transformation of process data
(flavor, helicity, and color) into an interaction in a process term.
We use the [[test_t]] process core (which has no nontrivial
particles), but call only the [[is_allowed]] method, which always
returns true.
<<Processes: execute tests>>=
call test (processes_13, "processes_13", &
"colored interaction", &
u, results)
<<Processes: test declarations>>=
public :: processes_13
<<Processes: tests>>=
subroutine processes_13 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(process_term_t) :: term
class(prc_core_t), allocatable :: core
write (u, "(A)") "* Test output: processes_13"
write (u, "(A)") "* Purpose: initialized a colored interaction"
write (u, "(A)")
write (u, "(A)") "* Set up a process constants block"
write (u, "(A)")
call os_data%init ()
call model%init_sm_test ()
allocate (test_t :: core)
associate (data => term%data)
data%n_in = 2
data%n_out = 3
data%n_flv = 2
data%n_hel = 2
data%n_col = 2
data%n_cin = 2
allocate (data%flv_state (5, 2))
data%flv_state (:,1) = [ 1, 21, 1, 21, 21]
data%flv_state (:,2) = [ 2, 21, 2, 21, 21]
allocate (data%hel_state (5, 2))
data%hel_state (:,1) = [1, 1, 1, 1, 0]
data%hel_state (:,2) = [1,-1, 1,-1, 0]
allocate (data%col_state (2, 5, 2))
data%col_state (:,:,1) = &
reshape ([[1, 0], [2,-1], [3, 0], [2,-3], [0,0]], [2,5])
data%col_state (:,:,2) = &
reshape ([[1, 0], [2,-3], [3, 0], [2,-1], [0,0]], [2,5])
allocate (data%ghost_flag (5, 2))
data%ghost_flag(1:4,:) = .false.
data%ghost_flag(5,:) = .true.
end associate
write (u, "(A)") "* Set up the interaction"
write (u, "(A)")
call reset_interaction_counter ()
call term%setup_interaction (core, model)
call term%int%basic_write (u)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_13"
end subroutine processes_13
@ %def processes_13
@
\subsubsection{MD5 sums}
Configure a process with structure functions (multi-channel) and
compute MD5 sums
<<Processes: execute tests>>=
call test (processes_14, "processes_14", &
"process configuration and MD5 sum", &
u, results)
<<Processes: test declarations>>=
public :: processes_14
<<Processes: tests>>=
subroutine processes_14 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t), dimension(3) :: sf_channel
write (u, "(A)") "* Test output: processes_14"
write (u, "(A)") "* Purpose: initialize a process with &
&structure functions"
write (u, "(A)") "* and compute MD5 sum"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes7"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call lib%compute_md5sum ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
call process%test_allocate_sf_channels (3)
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call sf_channel(1)%init (2)
call process%set_sf_channel (1, sf_channel(1))
call sf_channel(2)%init (2)
call sf_channel(2)%activate_mapping ([1,2])
call process%set_sf_channel (2, sf_channel(2))
call sf_channel(3)%init (2)
call sf_channel(3)%set_s_mapping ([1,2])
call process%set_sf_channel (3, sf_channel(3))
call process%setup_mci (dispatch_mci_empty)
call process%compute_md5sum ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_14"
end subroutine processes_14
@ %def processes_14
@
\subsubsection{Decay Process Evaluation}
Initialize an evaluate a decay process.
<<Processes: execute tests>>=
call test (processes_15, "processes_15", &
"decay process", &
u, results)
<<Processes: test declarations>>=
public :: processes_15
<<Processes: tests>>=
subroutine processes_15 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_15"
write (u, "(A)") "* Purpose: initialize a decay process object"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes15"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
call process%setup_beams_decay (i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_empty)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Inject a set of random numbers"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%set_mcpar ([0._default, 0._default])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set up hard kinematics"
write (u, "(A)")
call process_instance%select_channel (1)
call process_instance%compute_seed_kinematics ()
call process_instance%compute_hard_kinematics ()
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%compute_eff_kinematics ()
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels ()
call process_instance%evaluate_trace ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover (1, 1, .true., .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_15"
end subroutine processes_15
@ %def processes_15
@
\subsubsection{Integration: decay}
Activate the MC integrator for the decay object and use it to
integrate over phase space.
<<Processes: execute tests>>=
call test (processes_16, "processes_16", &
"decay integration", &
u, results)
<<Processes: test declarations>>=
public :: processes_16
<<Processes: tests>>=
subroutine processes_16 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_instance_t), allocatable, target :: process_instance
write (u, "(A)") "* Test output: processes_16"
write (u, "(A)") "* Purpose: integrate a process without &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes16"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
call reset_interaction_counter ()
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
call process%setup_beams_decay (i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test_midpoint)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Integrate with default test parameters"
write (u, "(A)")
call process_instance%integrate (1, n_it=1, n_calls=10000)
call process%final_integration (1)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
process%get_integral (1) &
/ process_instance%term(1)%k_term%phs_factor
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_16"
end subroutine processes_16
@ %def processes_16
@ MCI record prepared for midpoint integrator.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_test_midpoint (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
allocate (mci_midpoint_t :: mci)
end subroutine dispatch_mci_test_midpoint
@ %def dispatch_mci_test_midpoint
@
\subsubsection{Decay Process Evaluation}
Initialize an evaluate a decay process for a moving particle.
<<Processes: execute tests>>=
call test (processes_17, "processes_17", &
"decay of moving particle", &
u, results)
<<Processes: test declarations>>=
public :: processes_17
<<Processes: tests>>=
subroutine processes_17 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
type(flavor_t) :: flv_beam
real(default) :: m, p, E
write (u, "(A)") "* Test output: processes_17"
write (u, "(A)") "* Purpose: initialize a decay process object"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes17"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
call process%setup_beams_decay (rest_frame = .false., i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_empty)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set parent momentum and random numbers"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%set_mcpar ([0._default, 0._default])
call flv_beam%init (25, process%get_model_ptr ())
m = flv_beam%get_mass ()
p = 3 * m / 4
E = sqrt (m**2 + p**2)
call process_instance%set_beam_momenta ([vector4_moving (E, p, 3)])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set up hard kinematics"
write (u, "(A)")
call process_instance%select_channel (1)
call process_instance%compute_seed_kinematics ()
call process_instance%compute_hard_kinematics ()
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%compute_eff_kinematics ()
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels ()
call process_instance%evaluate_trace ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover (1, 1, .true., .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_17"
end subroutine processes_17
@ %def processes_17
@
\subsubsection{Resonances in Phase Space}
This test demonstrates the extraction of the resonance-history set from the
generated phase space. We need a nontrivial process, but no matrix element.
This is provided by the [[prc_template]] method, using the [[SM]] model. We
also need the [[phs_wood]] method, otherwise we would not have resonances in
the phase space configuration.
<<Processes: execute tests>>=
call test (processes_18, "processes_18", &
"extract resonance history set", &
u, results)
<<Processes: test declarations>>=
public :: processes_18
<<Processes: tests>>=
subroutine processes_18 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: model_name
type(os_data_t) :: os_data
class(model_data_t), pointer :: model
class(vars_t), pointer :: vars
type(process_t), pointer :: process
type(resonance_history_set_t) :: res_set
integer :: i
write (u, "(A)") "* Test output: processes_18"
write (u, "(A)") "* Purpose: extra resonance histories"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes_18_lib"
procname = "processes_18_p"
call os_data%init ()
call syntax_phs_forest_init ()
model_name = "SM"
model => null ()
call prepare_model (model, model_name, vars)
write (u, "(A)") "* Initialize a process library with one process"
write (u, "(A)")
select type (model)
class is (model_t)
call prepare_resonance_test_library (lib, libname, procname, model, os_data, u)
end select
write (u, "(A)")
write (u, "(A)") "* Initialize a process object with phase space"
allocate (process)
select type (model)
class is (model_t)
call prepare_resonance_test_process (process, lib, procname, model, os_data)
end select
write (u, "(A)")
write (u, "(A)") "* Extract resonance history set"
write (u, "(A)")
call process%extract_resonance_history_set (res_set)
call res_set%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
deallocate (model)
call syntax_phs_forest_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_18"
end subroutine processes_18
@ %def processes_18
@ Auxiliary subroutine that constructs the process library for the above test.
<<Processes: test auxiliary>>=
subroutine prepare_resonance_test_library &
(lib, libname, procname, model, os_data, u)
type(process_library_t), target, intent(out) :: lib
type(string_t), intent(in) :: libname
type(string_t), intent(in) :: procname
type(model_t), intent(in), target :: model
type(os_data_t), intent(in) :: os_data
integer, intent(in) :: u
type(string_t), dimension(:), allocatable :: prt_in, prt_out
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
call lib%init (libname)
allocate (prt_in (2), prt_out (3))
prt_in = [var_str ("e+"), var_str ("e-")]
prt_out = [var_str ("d"), var_str ("ubar"), var_str ("W+")]
allocate (template_me_def_t :: def)
select type (def)
type is (template_me_def_t)
call def%init (model, prt_in, prt_out, unity = .false.)
end select
allocate (entry)
call entry%init (procname, &
model_name = model%get_name (), &
n_in = 2, n_components = 1)
call entry%import_component (1, n_out = size (prt_out), &
prt_in = new_prt_spec (prt_in), &
prt_out = new_prt_spec (prt_out), &
method = var_str ("template"), &
variant = def)
call entry%write (u)
call lib%append (entry)
call lib%configure (os_data)
call lib%write_makefile (os_data, force = .true., verbose = .false.)
call lib%clean (os_data, distclean = .false.)
call lib%write_driver (force = .true.)
call lib%load (os_data)
end subroutine prepare_resonance_test_library
@ %def prepare_resonance_test_library
@ We want a test process which has been initialized up to the point where we
can evaluate the matrix element. This is in fact rather complicated. We copy
the steps from [[integration_setup_process]] in the [[integrate]] module,
which is not available at this point.
<<Processes: test auxiliary>>=
subroutine prepare_resonance_test_process &
(process, lib, procname, model, os_data)
class(process_t), intent(out), target :: process
type(process_library_t), intent(in), target :: lib
type(string_t), intent(in) :: procname
type(model_t), intent(in), target :: model
type(os_data_t), intent(in) :: os_data
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
call process%init (procname, lib, os_data, model)
allocate (phs_wood_config_t :: phs_config_template)
call process%init_components (phs_config_template)
call process%setup_test_cores (type_string = var_str ("template"))
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_none)
call process%setup_terms ()
end subroutine prepare_resonance_test_process
@ %def prepare_resonance_test_process
@ MCI record prepared for the none (dummy) integrator.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_none (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
allocate (mci_none_t :: mci)
end subroutine dispatch_mci_none
@ %def dispatch_mci_none
@
\subsubsection{Add after evaluate hook(s)}
Initialize a process and process instance, add a trivial process hook,
choose a sampling point and fill the process instance.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Processes: test types>>=
type, extends(process_instance_hook_t) :: process_instance_hook_test_t
integer :: unit
character(len=15) :: name
contains
procedure :: init => process_instance_hook_test_init
procedure :: final => process_instance_hook_test_final
procedure :: evaluate => process_instance_hook_test_evaluate
end type process_instance_hook_test_t
@
<<Processes: test auxiliary>>=
subroutine process_instance_hook_test_init (hook, var_list, instance)
class(process_instance_hook_test_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
end subroutine process_instance_hook_test_init
subroutine process_instance_hook_test_final (hook)
class(process_instance_hook_test_t), intent(inout) :: hook
end subroutine process_instance_hook_test_final
subroutine process_instance_hook_test_evaluate (hook, instance)
class(process_instance_hook_test_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
write (hook%unit, "(A)") "Execute hook:"
write (hook%unit, "(2X,A,1X,A,I0,A)") hook%name, "(", len (trim (hook%name)), ")"
end subroutine process_instance_hook_test_evaluate
@
<<Processes: execute tests>>=
call test (processes_19, "processes_19", &
"add trivial hooks to a process instance ", &
u, results)
<<Processes: test declarations>>=
public :: processes_19
<<Processes: tests>>=
subroutine processes_19 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
class(model_data_t), pointer :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t) :: process_instance
class(process_instance_hook_t), allocatable, target :: process_instance_hook, process_instance_hook2
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_19"
write (u, "(A)") "* Purpose: allocate process instance &
&and add an after evaluate hook"
write (u, "(A)")
write (u, "(A)")
write (u, "(A)") "* Allocate a process instance"
write (u, "(A)")
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Allocate hook and add to process instance"
write (u, "(A)")
allocate (process_instance_hook_test_t :: process_instance_hook)
call process_instance%append_after_hook (process_instance_hook)
allocate (process_instance_hook_test_t :: process_instance_hook2)
call process_instance%append_after_hook (process_instance_hook2)
select type (process_instance_hook)
type is (process_instance_hook_test_t)
process_instance_hook%unit = u
process_instance_hook%name = "Hook 1"
end select
select type (process_instance_hook2)
type is (process_instance_hook_test_t)
process_instance_hook2%unit = u
process_instance_hook2%name = "Hook 2"
end select
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%evaluate_after_hook ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance_hook%final ()
deallocate (process_instance_hook)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_19"
end subroutine processes_19
@ %def processes_19
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process Stacks}
For storing and handling multiple processes, we define process stacks.
These are ordinary stacks where new process entries are pushed onto
the top. We allow for multiple entries with identical process ID, but
distinct run ID.
The implementation is essentially identical to the [[prclib_stacks]] module
above. Unfortunately, Fortran supports no generic programming, so we do not
make use of this fact.
When searching for a specific process ID, we will get (a pointer to)
the topmost process entry with that ID on the stack, which was entered
last. Usually, this is the best version of the process (in terms of
integral, etc.) Thus the stack terminology makes sense.
<<[[process_stacks.f90]]>>=
<<File header>>
module process_stacks
<<Use kinds>>
<<Use strings>>
use io_units
use format_utils, only: write_separator
use diagnostics
use os_interface
use sm_qcd
use model_data
use rng_base
use variables
use observables
use process_libraries
use process
<<Standard module head>>
<<Process stacks: public>>
<<Process stacks: types>>
contains
<<Process stacks: procedures>>
end module process_stacks
@ %def process_stacks
@
\subsection{The process entry type}
A process entry is a process object, augmented by a pointer to the
next entry. We do not need specific methods, all relevant methods are
inherited.
On higher level, processes should be prepared as process entry objects.
<<Process stacks: public>>=
public :: process_entry_t
<<Process stacks: types>>=
type, extends (process_t) :: process_entry_t
type(process_entry_t), pointer :: next => null ()
end type process_entry_t
@ %def process_entry_t
@
\subsection{The process stack type}
For easy conversion and lookup it is useful to store the filling
number in the object. The content is stored as a linked list.
The [[var_list]] component stores process-specific results, so they
can be retrieved as (pseudo) variables.
The process stack can be linked to another one. This allows us to
work with stacks of local scope.
<<Process stacks: public>>=
public :: process_stack_t
<<Process stacks: types>>=
type :: process_stack_t
integer :: n = 0
type(process_entry_t), pointer :: first => null ()
type(var_list_t), pointer :: var_list => null ()
type(process_stack_t), pointer :: next => null ()
contains
<<Process stacks: process stack: TBP>>
end type process_stack_t
@ %def process_stack_t
@ Finalize partly: deallocate the process stack and variable list
entries, but keep the variable list as an empty object. This way, the
variable list links are kept.
<<Process stacks: process stack: TBP>>=
procedure :: clear => process_stack_clear
<<Process stacks: procedures>>=
subroutine process_stack_clear (stack)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), pointer :: process
if (associated (stack%var_list)) then
call stack%var_list%final ()
end if
do while (associated (stack%first))
process => stack%first
stack%first => process%next
call process%final ()
deallocate (process)
end do
stack%n = 0
end subroutine process_stack_clear
@ %def process_stack_clear
@ Finalizer. Clear and deallocate the variable list.
<<Process stacks: process stack: TBP>>=
procedure :: final => process_stack_final
<<Process stacks: procedures>>=
subroutine process_stack_final (object)
class(process_stack_t), intent(inout) :: object
call object%clear ()
if (associated (object%var_list)) then
deallocate (object%var_list)
end if
end subroutine process_stack_final
@ %def process_stack_final
@ Output. The processes on the stack will be ordered LIFO, i.e.,
backwards.
<<Process stacks: process stack: TBP>>=
procedure :: write => process_stack_write
<<Process stacks: procedures>>=
recursive subroutine process_stack_write (object, unit, pacify)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
type(process_entry_t), pointer :: process
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
select case (object%n)
case (0)
write (u, "(1x,A)") "Process stack: [empty]"
call write_separator (u, 2)
case default
write (u, "(1x,A)") "Process stack:"
process => object%first
do while (associated (process))
call process%write (.false., u, pacify = pacify)
process => process%next
end do
end select
if (associated (object%next)) then
write (u, "(1x,A)") "[Processes from context environment:]"
call object%next%write (u, pacify)
end if
end subroutine process_stack_write
@ %def process_stack_write
@ The variable list is printed by a separate routine, since
it should be linked to the global variable list, anyway.
<<Process stacks: process stack: TBP>>=
procedure :: write_var_list => process_stack_write_var_list
<<Process stacks: procedures>>=
subroutine process_stack_write_var_list (object, unit)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
if (associated (object%var_list)) then
call var_list_write (object%var_list, unit)
end if
end subroutine process_stack_write_var_list
@ %def process_stack_write_var_list
@ Short output.
Since this is a stack, the default output ordering for each stack will be
last-in, first-out. To enable first-in, first-out, which is more likely to be
requested, there is an optional [[fifo]] argument.
<<Process stacks: process stack: TBP>>=
procedure :: show => process_stack_show
<<Process stacks: procedures>>=
recursive subroutine process_stack_show (object, unit, fifo)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: fifo
type(process_entry_t), pointer :: process
logical :: reverse
integer :: u, i, j
u = given_output_unit (unit)
reverse = .false.; if (present (fifo)) reverse = fifo
select case (object%n)
case (0)
case default
if (.not. reverse) then
process => object%first
do while (associated (process))
call process%show (u, verbose=.false.)
process => process%next
end do
else
do i = 1, object%n
process => object%first
do j = 1, object%n - i
process => process%next
end do
call process%show (u, verbose=.false.)
end do
end if
end select
if (associated (object%next)) call object%next%show ()
end subroutine process_stack_show
@ %def process_stack_show
@
\subsection{Link}
Link the current process stack to a global one.
<<Process stacks: process stack: TBP>>=
procedure :: link => process_stack_link
<<Process stacks: procedures>>=
subroutine process_stack_link (local_stack, global_stack)
class(process_stack_t), intent(inout) :: local_stack
type(process_stack_t), intent(in), target :: global_stack
local_stack%next => global_stack
end subroutine process_stack_link
@ %def process_stack_link
@ Initialize the process variable list and link the main variable list
to it.
<<Process stacks: process stack: TBP>>=
procedure :: init_var_list => process_stack_init_var_list
<<Process stacks: procedures>>=
subroutine process_stack_init_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(inout), optional :: var_list
allocate (stack%var_list)
if (present (var_list)) call var_list%link (stack%var_list)
end subroutine process_stack_init_var_list
@ %def process_stack_init_var_list
@ Link the process variable list to a global
variable list.
<<Process stacks: process stack: TBP>>=
procedure :: link_var_list => process_stack_link_var_list
<<Process stacks: procedures>>=
subroutine process_stack_link_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(in), target :: var_list
call stack%var_list%link (var_list)
end subroutine process_stack_link_var_list
@ %def process_stack_link_var_list
@
\subsection{Push}
We take a process pointer and push it onto the stack. The previous
pointer is nullified. Subsequently, the process is `owned' by the
stack and will be finalized when the stack is deleted.
<<Process stacks: process stack: TBP>>=
procedure :: push => process_stack_push
<<Process stacks: procedures>>=
subroutine process_stack_push (stack, process)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), intent(inout), pointer :: process
process%next => stack%first
stack%first => process
process => null ()
stack%n = stack%n + 1
end subroutine process_stack_push
@ %def process_stack_push
@ Inverse: Remove the last process pointer in the list and return it.
<<Process stacks: process stack: TBP>>=
procedure :: pop_last => process_stack_pop_last
<<Process stacks: procedures>>=
subroutine process_stack_pop_last (stack, process)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), intent(inout), pointer :: process
type(process_entry_t), pointer :: previous
integer :: i
select case (stack%n)
case (:0)
process => null ()
case (1)
process => stack%first
stack%first => null ()
stack%n = 0
case (2:)
process => stack%first
do i = 2, stack%n
previous => process
process => process%next
end do
previous%next => null ()
stack%n = stack%n - 1
end select
end subroutine process_stack_pop_last
@ %def process_stack_pop_last
@ Initialize process variables for a given process ID, without setting
values.
<<Process stacks: process stack: TBP>>=
procedure :: init_result_vars => process_stack_init_result_vars
<<Process stacks: procedures>>=
subroutine process_stack_init_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
call var_list_init_num_id (stack%var_list, id)
call var_list_init_process_results (stack%var_list, id)
end subroutine process_stack_init_result_vars
@ %def process_stack_init_result_vars
@ Fill process variables with values. This is executed after the
integration pass.
Note: We set only integral and error. With multiple MCI records
possible, the results for [[n_calls]], [[chi2]] etc. are not
necessarily unique. (We might set the efficiency, though.)
<<Process stacks: process stack: TBP>>=
procedure :: fill_result_vars => process_stack_fill_result_vars
<<Process stacks: procedures>>=
subroutine process_stack_fill_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
type(process_t), pointer :: process
process => stack%get_process_ptr (id)
if (associated (process)) then
call var_list_init_num_id (stack%var_list, id, process%get_num_id ())
if (process%has_integral ()) then
call var_list_init_process_results (stack%var_list, id, &
integral = process%get_integral (), &
error = process%get_error ())
end if
else
call msg_bug ("process_stack_fill_result_vars: unknown process ID")
end if
end subroutine process_stack_fill_result_vars
@ %def process_stack_fill_result_vars
@ If one of the result variables has a local image in [[var_list_local]],
update the value there as well.
<<Process stacks: process stack: TBP>>=
procedure :: update_result_vars => process_stack_update_result_vars
<<Process stacks: procedures>>=
subroutine process_stack_update_result_vars (stack, id, var_list_local)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
type(var_list_t), intent(inout) :: var_list_local
call update ("integral(" // id // ")")
call update ("error(" // id // ")")
contains
subroutine update (var_name)
type(string_t), intent(in) :: var_name
real(default) :: value
if (var_list_local%contains (var_name, follow_link = .false.)) then
value = stack%var_list%get_rval (var_name)
call var_list_local%set_real (var_name, value, is_known = .true.)
end if
end subroutine update
end subroutine process_stack_update_result_vars
@ %def process_stack_update_result_vars
@
\subsection{Data Access}
Tell if a process exists.
<<Process stacks: process stack: TBP>>=
procedure :: exists => process_stack_exists
<<Process stacks: procedures>>=
function process_stack_exists (stack, id) result (flag)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
logical :: flag
type(process_t), pointer :: process
process => stack%get_process_ptr (id)
flag = associated (process)
end function process_stack_exists
@ %def process_stack_exists
@ Return a pointer to a process with specific ID. Look also at a
linked stack, if necessary.
<<Process stacks: process stack: TBP>>=
procedure :: get_process_ptr => process_stack_get_process_ptr
<<Process stacks: procedures>>=
recursive function process_stack_get_process_ptr (stack, id) result (ptr)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
type(process_t), pointer :: ptr
type(process_entry_t), pointer :: entry
ptr => null ()
entry => stack%first
do while (associated (entry))
if (entry%get_id () == id) then
ptr => entry%process_t
return
end if
entry => entry%next
end do
if (associated (stack%next)) ptr => stack%next%get_process_ptr (id)
end function process_stack_get_process_ptr
@ %def process_stack_get_process_ptr
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[process_stacks_ut.f90]]>>=
<<File header>>
module process_stacks_ut
use unit_tests
use process_stacks_uti
<<Standard module head>>
<<Process stacks: public test>>
contains
<<Process stacks: test driver>>
end module process_stacks_ut
@ %def process_stacks_ut
@
<<[[process_stacks_uti.f90]]>>=
<<File header>>
module process_stacks_uti
<<Use strings>>
use os_interface
use sm_qcd
use models
use model_data
use variables, only: var_list_t
use process_libraries
use rng_base
use prc_test, only: prc_test_create_library
use process, only: process_t
use instances, only: process_instance_t
use processes_ut, only: prepare_test_process
use process_stacks
use rng_base_ut, only: rng_test_factory_t
<<Standard module head>>
<<Process stacks: test declarations>>
contains
<<Process stacks: tests>>
end module process_stacks_uti
@ %def process_stacks_uti
@ API: driver for the unit tests below.
<<Process stacks: public test>>=
public :: process_stacks_test
<<Process stacks: test driver>>=
subroutine process_stacks_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Process stacks: execute tests>>
end subroutine process_stacks_test
@ %def process_stacks_test
@
\subsubsection{Write an empty process stack}
The most trivial test is to write an uninitialized process stack.
<<Process stacks: execute tests>>=
call test (process_stacks_1, "process_stacks_1", &
"write an empty process stack", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_1
<<Process stacks: tests>>=
subroutine process_stacks_1 (u)
integer, intent(in) :: u
type(process_stack_t) :: stack
write (u, "(A)") "* Test output: process_stacks_1"
write (u, "(A)") "* Purpose: display an empty process stack"
write (u, "(A)")
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_1"
end subroutine process_stacks_1
@ %def process_stacks_1
@
\subsubsection{Fill a process stack}
Fill a process stack with two (identical) processes.
<<Process stacks: execute tests>>=
call test (process_stacks_2, "process_stacks_2", &
"fill a process stack", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_2
<<Process stacks: tests>>=
subroutine process_stacks_2 (u)
integer, intent(in) :: u
type(process_stack_t) :: stack
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(var_list_t) :: var_list
type(process_entry_t), pointer :: process => null ()
write (u, "(A)") "* Test output: process_stacks_2"
write (u, "(A)") "* Purpose: fill a process stack"
write (u, "(A)")
write (u, "(A)") "* Build, initialize and store two test processes"
write (u, "(A)")
libname = "process_stacks2"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call model%init_test ()
call var_list%append_string (var_str ("$run_id"))
call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
call var_list%append_int (var_str ("seed"), 0)
allocate (process)
call var_list%set_string &
(var_str ("$run_id"), var_str ("run1"), is_known=.true.)
call process%init (procname, lib, os_data, model, var_list)
call stack%push (process)
allocate (process)
call var_list%set_string &
(var_str ("$run_id"), var_str ("run2"), is_known=.true.)
call process%init (procname, lib, os_data, model, var_list)
call stack%push (process)
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_2"
end subroutine process_stacks_2
@ %def process_stacks_2
@
\subsubsection{Fill a process stack}
Fill a process stack with two (identical) processes.
<<Process stacks: execute tests>>=
call test (process_stacks_3, "process_stacks_3", &
"process variables", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_3
<<Process stacks: tests>>=
subroutine process_stacks_3 (u)
integer, intent(in) :: u
type(process_stack_t) :: stack
type(model_t), target :: model
type(string_t) :: procname
type(process_entry_t), pointer :: process => null ()
type(process_instance_t), target :: process_instance
write (u, "(A)") "* Test output: process_stacks_3"
write (u, "(A)") "* Purpose: setup process variables"
write (u, "(A)")
write (u, "(A)") "* Initialize process variables"
write (u, "(A)")
procname = "processes_test"
call model%init_test ()
write (u, "(A)") "* Initialize process variables"
write (u, "(A)")
call stack%init_var_list ()
call stack%init_result_vars (procname)
call stack%write_var_list (u)
write (u, "(A)")
write (u, "(A)") "* Build and integrate a test process"
write (u, "(A)")
allocate (process)
call prepare_test_process (process%process_t, process_instance, model)
call process_instance%integrate (1, 1, 1000)
call process_instance%final ()
call process%final_integration (1)
call stack%push (process)
write (u, "(A)") "* Fill process variables"
write (u, "(A)")
call stack%fill_result_vars (procname)
call stack%write_var_list (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_3"
end subroutine process_stacks_3
@ %def process_stacks_3
@
\subsubsection{Linked a process stack}
Fill two process stack, linked to each other.
<<Process stacks: execute tests>>=
call test (process_stacks_4, "process_stacks_4", &
"linked stacks", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_4
<<Process stacks: tests>>=
subroutine process_stacks_4 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(process_stack_t), target :: stack1, stack2
type(model_t), target :: model
type(string_t) :: libname
type(string_t) :: procname1, procname2
type(os_data_t) :: os_data
type(process_entry_t), pointer :: process => null ()
write (u, "(A)") "* Test output: process_stacks_4"
write (u, "(A)") "* Purpose: link process stacks"
write (u, "(A)")
write (u, "(A)") "* Initialize process variables"
write (u, "(A)")
libname = "process_stacks_4_lib"
procname1 = "process_stacks_4a"
procname2 = "process_stacks_4b"
call os_data%init ()
write (u, "(A)") "* Initialize first process"
write (u, "(A)")
call prc_test_create_library (procname1, lib)
call model%init_test ()
allocate (process)
call process%init (procname1, lib, os_data, model)
call stack1%push (process)
write (u, "(A)") "* Initialize second process"
write (u, "(A)")
call stack2%link (stack1)
call prc_test_create_library (procname2, lib)
allocate (process)
call process%init (procname2, lib, os_data, model)
call stack2%push (process)
write (u, "(A)") "* Show linked stacks"
write (u, "(A)")
call stack2%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack2%final ()
call stack1%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_4"
end subroutine process_stacks_4
@ %def process_stacks_4
@