Index: trunk/src/variables/variables.nw =================================================================== --- trunk/src/variables/variables.nw (revision 8449) +++ trunk/src/variables/variables.nw (revision 8450) @@ -1,6848 +1,6849 @@ % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*- % WHIZARD code as NOWEB source: variables for processes %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Variables for Processes} \includemodulegraph{variables} This part introduces variables as user-controlled objects that influence the behavior of objects and calculations. Variables contain objects of intrinsic type or of a type as introced above. \begin{description} \item[variables] Store values of various kind, used by expressions and accessed by the command interface. This provides an implementation of the [[vars_t]] abstract type. \item[observables] Concrete implementation of observables (functions in the variable tree), applicable for \whizard. abstract type. \end{description} \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Variables: Implementation} The user interface deals with variables that are handled similarly to full-flegded programming languages. The system will add a lot of predefined variables (model parameters, flags, etc.) that are accessible to the user by the same methods. Variables can be of various type: logical (boolean/flag), integer, real (default precision), subevents (used in cut expressions), arrays of PDG codes (aliases for particles), strings. Furthermore, in cut expressions we have unary and binary observables, which are used like real parameters but behave like functions. <<[[variables.f90]]>>= <> module variables <> <> use io_units use format_utils, only: pac_fmt use format_defs, only: FMT_12, FMT_19 use constants, only: eps0, tiny_07 use os_interface, only: paths_t use physics_defs, only: LAMBDA_QCD_REF use system_dependencies use fastjet !NODEP! use diagnostics use pdg_arrays use subevents use var_base <> <> <> <> <> contains <> end module variables @ %def variables @ \subsection{Variable list entries} Variable (and constant) values can be of one of the following types: <>= integer, parameter, public :: V_NONE = 0, V_LOG = 1, V_INT = 2, V_REAL = 3 integer, parameter, public :: V_CMPLX = 4, V_SEV = 5, V_PDG = 6, V_STR = 7 integer, parameter, public :: V_OBS1_INT = 11, V_OBS2_INT = 12 integer, parameter, public :: V_OBS1_REAL = 21, V_OBS2_REAL = 22 integer, parameter, public :: V_UOBS1_INT = 31, V_UOBS2_INT = 32 integer, parameter, public :: V_UOBS1_REAL = 41, V_UOBS2_REAL = 42 @ %def V_NONE V_LOG V_INT V_REAL V_CMPLX V_PRT V_SEV V_PDG @ %def V_OBS1_INT V_OBS2_INT V_OBS1_REAL V_OBS2_REAL @ %def V_UOBS1_INT V_UOBS2_INT V_UOBS1_REAL V_UOBS2_REAL @ \subsubsection{The type} This is an entry in the variable list. It can be of any type; in each case only one value is allocated. It may be physically allocated upon creation, in which case [[is_allocated]] is true, or it may contain just a pointer to a value somewhere else, in which case [[is_allocated]] is false. The flag [[is_defined]] is set when the variable is given a value, even the undefined value. (Therefore it is distinct from [[is_known]].) This matters for variable declaration in the SINDARIN language. The variable is set up in the compilation step and initially marked as defined, but after compilation all variables are set undefined. Each variable becomes defined when it is explicitly set. The difference matters in loops. [[is_locked]] means that it cannot be given a value using the interface routines [[var_list_set_XXX]] below. It can only be initialized, or change automatically due to a side effect. [[is_copy]] means that this is a local copy of a global variable. The copy has a pointer to the original, which can be used to restore a previous value. [[is_intrinsic]] means that this variable is defined by the program, not by the user. Intrinsic variables cannot be (re)declared, but their values can be reset unless they are locked. [[is_user_var]] means that the variable has been declared by the user. It could be a new variable, or a local copy of an intrinsic variable. The flag [[is_known]] is a pointer which parallels the use of the value pointer. For pointer variables, it is set if the value should point to a known value. For ordinary variables, it should be true. The value is implemented as a set of alternative type-specific pointers. This emulates polymorphism, and it allows for actual pointer variables. Observable-type variables have function pointers as values, so they behave like macros. The functions make use of the particle objects accessible via the pointers [[prt1]] and [[prt2]]. Finally, the [[next]] pointer indicates that we are making lists of variables. A more efficient implementation might switch to hashes or similar; the current implementation has $O(N)$ lookup. <>= public :: var_entry_t <>= type :: var_entry_t private integer :: type = V_NONE type(string_t) :: name logical :: is_allocated = .false. logical :: is_defined = .false. logical :: is_locked = .false. logical :: is_intrinsic = .false. logical :: is_user_var = .false. logical, pointer :: is_known => null () logical, pointer :: lval => null () integer, pointer :: ival => null () real(default), pointer :: rval => null () complex(default), pointer :: cval => null () type(subevt_t), pointer :: pval => null () type(pdg_array_t), pointer :: aval => null () type(string_t), pointer :: sval => null () procedure(obs_unary_int), nopass, pointer :: obs1_int => null () procedure(obs_unary_real), nopass, pointer :: obs1_real => null () procedure(obs_binary_int), nopass, pointer :: obs2_int => null () procedure(obs_binary_real), nopass, pointer :: obs2_real => null () type(prt_t), pointer :: prt1 => null () type(prt_t), pointer :: prt2 => null () type(var_entry_t), pointer :: next => null () type(var_entry_t), pointer :: previous => null () type(string_t) :: description end type var_entry_t @ %def var_entry_t @ \subsubsection{Interfaces for the observable functions} <>= public :: obs_unary_int public :: obs_unary_real public :: obs_binary_int public :: obs_binary_real <>= abstract interface function obs_unary_int (prt1) result (ival) import integer :: ival type(prt_t), intent(in) :: prt1 end function obs_unary_int end interface abstract interface function obs_unary_real (prt1) result (rval) import real(default) :: rval type(prt_t), intent(in) :: prt1 end function obs_unary_real end interface abstract interface function obs_binary_int (prt1, prt2) result (ival) import integer :: ival type(prt_t), intent(in) :: prt1, prt2 end function obs_binary_int end interface abstract interface function obs_binary_real (prt1, prt2) result (rval) import real(default) :: rval type(prt_t), intent(in) :: prt1, prt2 end function obs_binary_real end interface @ %def obs_unary_int obs_unary_real obs_binary_real @ \subsubsection{Initialization} Initialize an entry, optionally with a physical value. We also allocate the [[is_known]] flag and set it if the value is set. <>= public :: var_entry_init_int <>= subroutine var_entry_init_log (var, name, lval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name logical, intent(in), optional :: lval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_LOG allocate (var%lval, var%is_known) if (present (lval)) then var%lval = lval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_log subroutine var_entry_init_int (var, name, ival, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name integer, intent(in), optional :: ival logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_INT allocate (var%ival, var%is_known) if (present (ival)) then var%ival = ival var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_int subroutine var_entry_init_real (var, name, rval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name real(default), intent(in), optional :: rval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_REAL allocate (var%rval, var%is_known) if (present (rval)) then var%rval = rval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_real subroutine var_entry_init_cmplx (var, name, cval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name complex(default), intent(in), optional :: cval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_CMPLX allocate (var%cval, var%is_known) if (present (cval)) then var%cval = cval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_cmplx subroutine var_entry_init_subevt (var, name, pval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(subevt_t), intent(in), optional :: pval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_SEV allocate (var%pval, var%is_known) if (present (pval)) then var%pval = pval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_subevt subroutine var_entry_init_pdg_array (var, name, aval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(pdg_array_t), intent(in), optional :: aval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_PDG allocate (var%aval, var%is_known) if (present (aval)) then var%aval = aval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_pdg_array subroutine var_entry_init_string (var, name, sval, intrinsic, user) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(string_t), intent(in), optional :: sval logical, intent(in), optional :: intrinsic, user var%name = name var%type = V_STR allocate (var%sval, var%is_known) if (present (sval)) then var%sval = sval var%is_defined = .true. var%is_known = .true. else var%is_known = .false. end if if (present (intrinsic)) var%is_intrinsic = intrinsic if (present (user)) var%is_user_var = user var%is_allocated = .true. end subroutine var_entry_init_string @ %def var_entry_init_log @ %def var_entry_init_int @ %def var_entry_init_real @ %def var_entry_init_cmplx @ %def var_entry_init_subevt @ %def var_entry_init_pdg_array @ %def var_entry_init_string @ Initialize an entry with a pointer to the value and, for numeric/logical values, a pointer to the [[is_known]] flag. <>= subroutine var_entry_init_log_ptr (var, name, lval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name logical, intent(in), target :: lval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_LOG var%lval => lval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_log_ptr subroutine var_entry_init_int_ptr (var, name, ival, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name integer, intent(in), target :: ival logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_INT var%ival => ival var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_int_ptr subroutine var_entry_init_real_ptr (var, name, rval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name real(default), intent(in), target :: rval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_REAL var%rval => rval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_real_ptr subroutine var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name complex(default), intent(in), target :: cval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_CMPLX var%cval => cval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_cmplx_ptr subroutine var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(pdg_array_t), intent(in), target :: aval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_PDG var%aval => aval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_pdg_array_ptr subroutine var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(subevt_t), intent(in), target :: pval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_SEV var%pval => pval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_subevt_ptr subroutine var_entry_init_string_ptr (var, name, sval, is_known, intrinsic) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name type(string_t), intent(in), target :: sval logical, intent(in), target :: is_known logical, intent(in), optional :: intrinsic var%name = name var%type = V_STR var%sval => sval var%is_known => is_known if (present (intrinsic)) var%is_intrinsic = intrinsic var%is_defined = .true. end subroutine var_entry_init_string_ptr @ %def var_entry_init_log_ptr @ %def var_entry_init_int_ptr @ %def var_entry_init_real_ptr @ %def var_entry_init_cmplx_ptr @ %def var_entry_init_pdg_array_ptr @ %def var_entry_init_subevt_ptr @ %def var_entry_init_string_ptr @ Initialize an entry with an observable. The procedure pointer is not yet set. <>= subroutine var_entry_init_obs (var, name, type, prt1, prt2) type(var_entry_t), intent(out) :: var type(string_t), intent(in) :: name integer, intent(in) :: type type(prt_t), intent(in), target :: prt1 type(prt_t), intent(in), optional, target :: prt2 var%type = type var%name = name var%prt1 => prt1 if (present (prt2)) var%prt2 => prt2 var%is_intrinsic = .true. var%is_defined = .true. end subroutine var_entry_init_obs @ %def var_entry_init_obs @ Mark an entry as undefined it it is a user-defined variable object, so force re-initialization. <>= subroutine var_entry_undefine (var) type(var_entry_t), intent(inout) :: var var%is_defined = .not. var%is_user_var var%is_known = var%is_defined .and. var%is_known end subroutine var_entry_undefine @ %def var_entry_undefine @ Clear an entry: mark it as unknown. <>= subroutine var_entry_clear (var) type(var_entry_t), intent(inout) :: var var%is_known = .false. end subroutine var_entry_clear @ %def var_entry_clear @ Lock an entry: forbid resetting the entry after initialization. <>= subroutine var_entry_lock (var, locked) type(var_entry_t), intent(inout) :: var logical, intent(in), optional :: locked if (present (locked)) then var%is_locked = locked else var%is_locked = .true. end if end subroutine var_entry_lock @ %def var_entry_lock @ \subsubsection{Finalizer} <>= subroutine var_entry_final (var) type(var_entry_t), intent(inout) :: var if (var%is_allocated) then select case (var%type) case (V_LOG); deallocate (var%lval) case (V_INT); deallocate (var%ival) case (V_REAL);deallocate (var%rval) case (V_CMPLX);deallocate (var%cval) case (V_SEV); deallocate (var%pval) case (V_PDG); deallocate (var%aval) case (V_STR); deallocate (var%sval) end select deallocate (var%is_known) var%is_allocated = .false. var%is_defined = .false. end if end subroutine var_entry_final @ %def var_entry_final @ \subsubsection{Output} <>= recursive subroutine var_entry_write (var, unit, model_name, & intrinsic, pacified, descriptions, ascii_output) type(var_entry_t), intent(in) :: var integer, intent(in), optional :: unit type(string_t), intent(in), optional :: model_name logical, intent(in), optional :: intrinsic logical, intent(in), optional :: pacified logical, intent(in), optional :: descriptions logical, intent(in), optional :: ascii_output type(string_t) :: col_string logical :: show_desc, ao integer :: u u = given_output_unit (unit); if (u < 0) return show_desc = .false.; if (present (descriptions)) show_desc = descriptions ao = .false.; if (present (ascii_output)) ao = ascii_output if (show_desc) then if (ao) then col_string = create_col_string (COL_BLUE) if (var%is_locked) then write (u, "(A)", advance="no") char (achar(27) // col_string) // & char (var%name) // achar(27) // "[0m" //" fixed-value=" else write (u, "(A)", advance="no") char (achar(27) // col_string) // & char (var%name) // achar(27) // "[0m" //" default=" end if col_string = create_col_string (COL_RED) write (u, "(A)", advance="no") char (achar(27) // col_string) call var_write_val (var, u, "no", pacified=.true.) write (u, "(A)") achar(27) // "[0m" write (u, "(A)") char (var%description) return else write (u, "(A)") "\item" write (u, "(A)", advance="no") "\ttt{" // char ( & replace (replace (var%name, "_", "\_", every=.true.), "$", "\$" )) // & "} " if (var%is_known) then if (var%is_locked) then write (u, "(A)", advance="no") "\qquad (fixed value: \ttt{" else write (u, "(A)", advance="no") "\qquad (default: \ttt{" end if call var_write_val (var, u, "no", pacified=.true., escape_tex=.true.) write (u, "(A)", advance="no") "})" end if write (u, "(A)") " \newline" write (u, "(A)") char (var%description) write (u, "(A)") "%%%%%" return end if end if if (present (intrinsic)) then if (var%is_intrinsic .neqv. intrinsic) return end if if (.not. var%is_defined) then write (u, "(A,1x)", advance="no") "[undefined]" end if if (.not. var%is_intrinsic) then write (u, "(A,1x)", advance="no") "[user variable]" end if if (present (model_name)) then write (u, "(A,A)", advance="no") char(model_name), "." end if write (u, "(A)", advance="no") char (var%name) if (var%is_locked) write (u, "(A)", advance="no") "*" if (var%is_allocated) then write (u, "(A)", advance="no") " = " else if (var%type /= V_NONE) then write (u, "(A)", advance="no") " => " end if call var_write_val (var, u, "yes", pacified) end subroutine var_entry_write @ %def var_entry_write @ <>= subroutine var_write_val (var, u, advance, pacified, escape_tex) type(var_entry_t), intent(in) :: var integer, intent(in) :: u character(*), intent(in) :: advance logical, intent(in), optional :: pacified, escape_tex logical :: num_pac, et real(default) :: rval complex(default) :: cval character(len=7) :: fmt call pac_fmt (fmt, FMT_19, FMT_12, pacified) num_pac = .false.; if (present (pacified)) num_pac = pacified et = .false.; if (present (escape_tex)) et = escape_tex select case (var%type) case (V_NONE); write (u, '()', advance=advance) case (V_LOG) if (var%is_known) then if (var%lval) then write (u, "(A)", advance=advance) "true" else write (u, "(A)", advance=advance) "false" end if else write (u, "(A)", advance=advance) "[unknown logical]" end if case (V_INT) if (var%is_known) then write (u, "(I0)", advance=advance) var%ival else write (u, "(A)", advance=advance) "[unknown integer]" end if case (V_REAL) if (var%is_known) then rval = var%rval if (num_pac) then call pacify (rval, 10 * eps0) end if write (u, "(" // fmt // ")", advance=advance) rval else write (u, "(A)", advance=advance) "[unknown real]" end if case (V_CMPLX) if (var%is_known) then cval = var%cval if (num_pac) then call pacify (cval, 10 * eps0) end if write (u, "('('," // fmt // ",','," // fmt // ",')')", advance=advance) cval else write (u, "(A)", advance=advance) "[unknown complex]" end if case (V_SEV) if (var%is_known) then call subevt_write (var%pval, u, prefix=" ", & pacified = pacified) else write (u, "(A)", advance=advance) "[unknown subevent]" end if case (V_PDG) if (var%is_known) then call pdg_array_write (var%aval, u); write (u, *) else write (u, "(A)", advance=advance) "[unknown PDG array]" end if case (V_STR) if (var%is_known) then if (et) then write (u, "(A)", advance=advance) '"' // char (replace ( & replace (var%sval, "_", "\_", every=.true.), "$", "\$" )) // '"' else write (u, "(A)", advance=advance) '"' // char (var%sval) // '"' end if else write (u, "(A)", advance=advance) "[unknown string]" end if case (V_OBS1_INT); write (u, "(A)", advance=advance) "[int] = unary observable" case (V_OBS2_INT); write (u, "(A)", advance=advance) "[int] = binary observable" case (V_OBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary observable" case (V_OBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary observable" case (V_UOBS1_INT); write (u, "(A)", advance=advance) "[int] = unary user observable" case (V_UOBS2_INT); write (u, "(A)", advance=advance) "[int] = binary user observable" case (V_UOBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary user observable" case (V_UOBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary user observable" end select end subroutine var_write_val @ %def procedure @ \subsubsection{Accessing contents} <>= function var_entry_get_name (var) result (name) type(string_t) :: name type(var_entry_t), intent(in) :: var name = var%name end function var_entry_get_name function var_entry_get_type (var) result (type) integer :: type type(var_entry_t), intent(in) :: var type = var%type end function var_entry_get_type @ %def var_entry_get_name var_entry_get_type @ Return true if the variable is defined. This the case if it is allocated and known, or if it is a pointer. <>= function var_entry_is_defined (var) result (defined) logical :: defined type(var_entry_t), intent(in) :: var defined = var%is_defined end function var_entry_is_defined @ %def var_entry_is_defined @ Return true if the variable is locked. If [[force]] is active, always return false. <>= function var_entry_is_locked (var, force) result (locked) logical :: locked type(var_entry_t), intent(in) :: var logical, intent(in), optional :: force if (present (force)) then if (force) then locked = .false.; return end if end if locked = var%is_locked end function var_entry_is_locked @ %def var_entry_is_locked @ Return true if the variable is intrinsic <>= function var_entry_is_intrinsic (var) result (flag) logical :: flag type(var_entry_t), intent(in) :: var flag = var%is_intrinsic end function var_entry_is_intrinsic @ %def var_entry_is_intrinsic @ Return components <>= function var_entry_is_known (var) result (flag) logical :: flag type(var_entry_t), intent(in) :: var flag = var%is_known end function var_entry_is_known function var_entry_get_lval (var) result (lval) logical :: lval type(var_entry_t), intent(in) :: var lval = var%lval end function var_entry_get_lval function var_entry_get_ival (var) result (ival) integer :: ival type(var_entry_t), intent(in) :: var ival = var%ival end function var_entry_get_ival function var_entry_get_rval (var) result (rval) real(default) :: rval type(var_entry_t), intent(in) :: var rval = var%rval end function var_entry_get_rval function var_entry_get_cval (var) result (cval) complex(default) :: cval type(var_entry_t), intent(in) :: var cval = var%cval end function var_entry_get_cval function var_entry_get_aval (var) result (aval) type(pdg_array_t) :: aval type(var_entry_t), intent(in) :: var aval = var%aval end function var_entry_get_aval function var_entry_get_pval (var) result (pval) type(subevt_t) :: pval type(var_entry_t), intent(in) :: var pval = var%pval end function var_entry_get_pval function var_entry_get_sval (var) result (sval) type(string_t) :: sval type(var_entry_t), intent(in) :: var sval = var%sval end function var_entry_get_sval @ %def var_entry_get_lval @ %def var_entry_get_ival @ %def var_entry_get_rval @ %def var_entry_get_cval @ %def var_entry_get_aval @ %def var_entry_get_pval @ %def var_entry_get_sval @ Return pointers to components. <>= function var_entry_get_known_ptr (var) result (ptr) logical, pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%is_known end function var_entry_get_known_ptr function var_entry_get_lval_ptr (var) result (ptr) logical, pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%lval end function var_entry_get_lval_ptr function var_entry_get_ival_ptr (var) result (ptr) integer, pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%ival end function var_entry_get_ival_ptr function var_entry_get_rval_ptr (var) result (ptr) real(default), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%rval end function var_entry_get_rval_ptr function var_entry_get_cval_ptr (var) result (ptr) complex(default), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%cval end function var_entry_get_cval_ptr function var_entry_get_pval_ptr (var) result (ptr) type(subevt_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%pval end function var_entry_get_pval_ptr function var_entry_get_aval_ptr (var) result (ptr) type(pdg_array_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%aval end function var_entry_get_aval_ptr function var_entry_get_sval_ptr (var) result (ptr) type(string_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%sval end function var_entry_get_sval_ptr @ %def var_entry_get_known_ptr @ %def var_entry_get_lval_ptr var_entry_get_ival_ptr var_entry_get_rval_ptr @ %def var_entry_get_cval_ptr var_entry_get_aval_ptr var_entry_get_pval_ptr @ %def var_entry_get_sval_ptr @ Furthermore, <>= function var_entry_get_prt1_ptr (var) result (ptr) type(prt_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%prt1 end function var_entry_get_prt1_ptr function var_entry_get_prt2_ptr (var) result (ptr) type(prt_t), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%prt2 end function var_entry_get_prt2_ptr @ %def var_entry_get_prt1_ptr @ %def var_entry_get_prt2_ptr @ Subroutines might be safer than functions for procedure pointer transfer. <>= subroutine var_entry_assign_obs1_int_ptr (ptr, var) procedure(obs_unary_int), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs1_int end subroutine var_entry_assign_obs1_int_ptr subroutine var_entry_assign_obs1_real_ptr (ptr, var) procedure(obs_unary_real), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs1_real end subroutine var_entry_assign_obs1_real_ptr subroutine var_entry_assign_obs2_int_ptr (ptr, var) procedure(obs_binary_int), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs2_int end subroutine var_entry_assign_obs2_int_ptr subroutine var_entry_assign_obs2_real_ptr (ptr, var) procedure(obs_binary_real), pointer :: ptr type(var_entry_t), intent(in), target :: var ptr => var%obs2_real end subroutine var_entry_assign_obs2_real_ptr @ %def var_entry_assign_obs1_int_ptr var_entry_assign_obs1_real_ptr @ %def var_entry_assign_obs2_int_ptr var_entry_assign_obs2_real_ptr @ \subsection{Setting values} Undefine the value. <>= subroutine var_entry_clear_value (var) type(var_entry_t), intent(inout) :: var var%is_known = .false. end subroutine var_entry_clear_value @ %def var_entry_clear_value <>= recursive subroutine var_entry_set_log & (var, lval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var logical, intent(in) :: lval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%lval = lval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_log recursive subroutine var_entry_set_int & (var, ival, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var integer, intent(in) :: ival logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%ival = ival var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_int recursive subroutine var_entry_set_real & (var, rval, is_known, verbose, model_name, pacified) type(var_entry_t), intent(inout) :: var real(default), intent(in) :: rval logical, intent(in) :: is_known logical, intent(in), optional :: verbose, pacified type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%rval = rval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write & (var, model_name=model_name, pacified = pacified) call var_entry_write & (var, model_name=model_name, unit=u, pacified = pacified) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_real recursive subroutine var_entry_set_cmplx & (var, cval, is_known, verbose, model_name, pacified) type(var_entry_t), intent(inout) :: var complex(default), intent(in) :: cval logical, intent(in) :: is_known logical, intent(in), optional :: verbose, pacified type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%cval = cval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write & (var, model_name=model_name, pacified = pacified) call var_entry_write & (var, model_name=model_name, unit=u, pacified = pacified) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_cmplx recursive subroutine var_entry_set_pdg_array & (var, aval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var type(pdg_array_t), intent(in) :: aval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%aval = aval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_pdg_array recursive subroutine var_entry_set_subevt & (var, pval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var type(subevt_t), intent(in) :: pval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%pval = pval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_subevt recursive subroutine var_entry_set_string & (var, sval, is_known, verbose, model_name) type(var_entry_t), intent(inout) :: var type(string_t), intent(in) :: sval logical, intent(in) :: is_known logical, intent(in), optional :: verbose type(string_t), intent(in), optional :: model_name integer :: u u = logfile_unit () var%sval = sval var%is_known = is_known var%is_defined = .true. if (present (verbose)) then if (verbose) then call var_entry_write (var, model_name=model_name) call var_entry_write (var, model_name=model_name, unit=u) if (u >= 0) flush (u) end if end if end subroutine var_entry_set_string @ %def var_entry_set_log @ %def var_entry_set_int @ %def var_entry_set_real @ %def var_entry_set_cmplx @ %def var_entry_set_pdg_array @ %def var_entry_set_subevt @ %def var_entry_set_string @ <>= public :: var_entry_set_description <>= pure subroutine var_entry_set_description (var_entry, description) type(var_entry_t), intent(inout) :: var_entry type(string_t), intent(in) :: description var_entry%description = description end subroutine var_entry_set_description @ %def var_entry_set_description @ \subsection{Copies and pointer variables} Initialize an entry with a copy of an existing variable entry. The copy is physically allocated with the same type as the original. <>= subroutine var_entry_init_copy (var, original, user) type(var_entry_t), intent(out) :: var type(var_entry_t), intent(in), target :: original logical, intent(in), optional :: user type(string_t) :: name logical :: intrinsic name = var_entry_get_name (original) intrinsic = original%is_intrinsic select case (original%type) case (V_LOG) call var_entry_init_log (var, name, intrinsic=intrinsic, user=user) case (V_INT) call var_entry_init_int (var, name, intrinsic=intrinsic, user=user) case (V_REAL) call var_entry_init_real (var, name, intrinsic=intrinsic, user=user) case (V_CMPLX) call var_entry_init_cmplx (var, name, intrinsic=intrinsic, user=user) case (V_SEV) call var_entry_init_subevt (var, name, intrinsic=intrinsic, user=user) case (V_PDG) call var_entry_init_pdg_array (var, name, intrinsic=intrinsic, user=user) case (V_STR) call var_entry_init_string (var, name, intrinsic=intrinsic, user=user) end select end subroutine var_entry_init_copy @ %def var_entry_init_copy @ Copy the value of an entry. The target variable entry must be initialized correctly. <>= subroutine var_entry_copy_value (var, original) type(var_entry_t), intent(inout) :: var type(var_entry_t), intent(in), target :: original if (var_entry_is_known (original)) then select case (original%type) case (V_LOG) call var_entry_set_log (var, var_entry_get_lval (original), .true.) case (V_INT) call var_entry_set_int (var, var_entry_get_ival (original), .true.) case (V_REAL) call var_entry_set_real (var, var_entry_get_rval (original), .true.) case (V_CMPLX) call var_entry_set_cmplx (var, var_entry_get_cval (original), .true.) case (V_SEV) call var_entry_set_subevt (var, var_entry_get_pval (original), .true.) case (V_PDG) call var_entry_set_pdg_array (var, var_entry_get_aval (original), .true.) case (V_STR) call var_entry_set_string (var, var_entry_get_sval (original), .true.) end select else call var_entry_clear (var) end if end subroutine var_entry_copy_value @ %def var_entry_copy_value @ \subsection{Variable lists} \subsubsection{The type} Variable lists can be linked together. No initializer needed. They are deleted separately. <>= public :: var_list_t <>= type, extends (vars_t) :: var_list_t private type(var_entry_t), pointer :: first => null () type(var_entry_t), pointer :: last => null () type(var_list_t), pointer :: next => null () contains <> end type var_list_t @ %def var_list_t @ \subsubsection{Constructors} Implementation of the [[link]] deferred method. The implementation restricts itself to var lists of the same type. We might need to relax this constraint. <>= procedure :: link => var_list_link <>= subroutine var_list_link (vars, target_vars) class(var_list_t), intent(inout) :: vars class(vars_t), intent(in), target :: target_vars select type (target_vars) type is (var_list_t) vars%next => target_vars class default call msg_bug ("var_list_link: unsupported target type") end select end subroutine var_list_link @ %def var_list_link @ Append a new entry to an existing list. <>= subroutine var_list_append (var_list, var, verbose) type(var_list_t), intent(inout), target :: var_list type(var_entry_t), intent(inout), target :: var logical, intent(in), optional :: verbose if (associated (var_list%last)) then var%previous => var_list%last var_list%last%next => var else var%previous => null () var_list%first => var end if var_list%last => var if (present (verbose)) then if (verbose) call var_entry_write (var) end if end subroutine var_list_append @ %def var_list_append @ Sort a list. <>= procedure :: sort => var_list_sort <>= subroutine var_list_sort (var_list) class(var_list_t), intent(inout) :: var_list type(var_entry_t), pointer :: var, previous if (associated (var_list%first)) then var => var_list%first do while (associated (var)) previous => var%previous do while (associated (previous)) if (larger_var (previous, var)) then call var_list%swap_with_next (previous) end if previous => previous%previous end do var => var%next end do end if end subroutine var_list_sort @ %def var_list_sort @ <>= pure function larger_var (var1, var2) result (larger) logical :: larger type(var_entry_t), intent(in) :: var1, var2 type(string_t) :: str1, str2 str1 = replace (var1%name, "?", "") str1 = replace (str1, "$", "") str2 = replace (var2%name, "?", "") str2 = replace (str2, "$", "") larger = str1 > str2 end function larger_var @ %def larger_var @ <>= procedure :: get_previous => var_list_get_previous <>= function var_list_get_previous (var_list, var_entry) result (previous) type(var_entry_t), pointer :: previous class(var_list_t), intent(in) :: var_list type(var_entry_t), intent(in) :: var_entry previous => var_list%first if (previous%name == var_entry%name) then previous => null () else do while (associated (previous)) if (previous%next%name == var_entry%name) exit previous => previous%next end do end if end function var_list_get_previous @ %def var_list_get_previous @ <>= procedure :: swap_with_next => var_list_swap_with_next <>= subroutine var_list_swap_with_next (var_list, var_entry) class(var_list_t), intent(inout) :: var_list type(var_entry_t), intent(in) :: var_entry type(var_entry_t), pointer :: previous, this, next, next_next previous => var_list%get_previous (var_entry) if (.not. associated (previous)) then this => var_list%first else this => previous%next end if next => this%next next_next => next%next if (associated (previous)) then previous%next => next next%previous => previous else var_list%first => next next%previous => null () end if this%next => next_next if (associated (next_next)) then next_next%previous => this end if next%next => this this%previous => next if (.not. associated (next%next)) then var_list%last => next end if end subroutine var_list_swap_with_next @ %def var_list_swap_with_next @ Public methods for expanding the variable list (as subroutines) <>= generic :: append_log => var_list_append_log_s, var_list_append_log_c procedure, private :: var_list_append_log_s procedure, private :: var_list_append_log_c generic :: append_int => var_list_append_int_s, var_list_append_int_c procedure, private :: var_list_append_int_s procedure, private :: var_list_append_int_c generic :: append_real => var_list_append_real_s, var_list_append_real_c procedure, private :: var_list_append_real_s procedure, private :: var_list_append_real_c generic :: append_cmplx => var_list_append_cmplx_s, var_list_append_cmplx_c procedure, private :: var_list_append_cmplx_s procedure, private :: var_list_append_cmplx_c generic :: append_subevt => var_list_append_subevt_s, var_list_append_subevt_c procedure, private :: var_list_append_subevt_s procedure, private :: var_list_append_subevt_c generic :: append_pdg_array => var_list_append_pdg_array_s, var_list_append_pdg_array_c procedure, private :: var_list_append_pdg_array_s procedure, private :: var_list_append_pdg_array_c generic :: append_string => var_list_append_string_s, var_list_append_string_c procedure, private :: var_list_append_string_s procedure, private :: var_list_append_string_c <>= public :: var_list_append_log public :: var_list_append_int public :: var_list_append_real public :: var_list_append_cmplx public :: var_list_append_subevt public :: var_list_append_pdg_array public :: var_list_append_string <>= interface var_list_append_log module procedure var_list_append_log_s module procedure var_list_append_log_c end interface interface var_list_append_int module procedure var_list_append_int_s module procedure var_list_append_int_c end interface interface var_list_append_real module procedure var_list_append_real_s module procedure var_list_append_real_c end interface interface var_list_append_cmplx module procedure var_list_append_cmplx_s module procedure var_list_append_cmplx_c end interface interface var_list_append_subevt module procedure var_list_append_subevt_s module procedure var_list_append_subevt_c end interface interface var_list_append_pdg_array module procedure var_list_append_pdg_array_s module procedure var_list_append_pdg_array_c end interface interface var_list_append_string module procedure var_list_append_string_s module procedure var_list_append_string_c end interface <>= subroutine var_list_append_log_s & (var_list, name, lval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name logical, intent(in), optional :: lval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_log (var, name, lval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_log_s subroutine var_list_append_int_s & (var_list, name, ival, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name integer, intent(in), optional :: ival logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_int (var, name, ival, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_int_s subroutine var_list_append_real_s & (var_list, name, rval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name real(default), intent(in), optional :: rval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_real (var, name, rval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_real_s subroutine var_list_append_cmplx_s & (var_list, name, cval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name complex(default), intent(in), optional :: cval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_cmplx (var, name, cval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_cmplx_s subroutine var_list_append_subevt_s & (var_list, name, pval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(subevt_t), intent(in), optional :: pval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_subevt (var, name, pval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_subevt_s subroutine var_list_append_pdg_array_s & (var_list, name, aval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(pdg_array_t), intent(in), optional :: aval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_pdg_array (var, name, aval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_pdg_array_s subroutine var_list_append_string_s & (var_list, name, sval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(string_t), intent(in), optional :: sval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_string (var, name, sval, intrinsic, user) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_string_s subroutine var_list_append_log_c & (var_list, name, lval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name logical, intent(in), optional :: lval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_log_s & (var_list, var_str (name), lval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_log_c subroutine var_list_append_int_c & (var_list, name, ival, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name integer, intent(in), optional :: ival logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_int_s & (var_list, var_str (name), ival, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_int_c subroutine var_list_append_real_c & (var_list, name, rval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name real(default), intent(in), optional :: rval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_real_s & (var_list, var_str (name), rval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_real_c subroutine var_list_append_cmplx_c & (var_list, name, cval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name complex(default), intent(in), optional :: cval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_cmplx_s & (var_list, var_str (name), cval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_cmplx_c subroutine var_list_append_subevt_c & (var_list, name, pval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name type(subevt_t), intent(in), optional :: pval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_subevt_s & (var_list, var_str (name), pval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_subevt_c subroutine var_list_append_pdg_array_c & (var_list, name, aval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name type(pdg_array_t), intent(in), optional :: aval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description call var_list_append_pdg_array_s & (var_list, var_str (name), aval, locked, verbose, & intrinsic, user, description) end subroutine var_list_append_pdg_array_c subroutine var_list_append_string_c & (var_list, name, sval, locked, verbose, intrinsic, user, description) class(var_list_t), intent(inout) :: var_list character(*), intent(in) :: name character(*), intent(in), optional :: sval logical, intent(in), optional :: locked, verbose, intrinsic, user type(string_t), intent(in), optional :: description if (present (sval)) then call var_list_append_string_s & (var_list, var_str (name), var_str (sval), & locked, verbose, intrinsic, user, description) else call var_list_append_string_s & (var_list, var_str (name), & locked=locked, verbose=verbose, intrinsic=intrinsic, & user=user, description=description) end if end subroutine var_list_append_string_c @ %def var_list_append_log @ %def var_list_append_int @ %def var_list_append_real @ %def var_list_append_cmplx @ %def var_list_append_subevt @ %def var_list_append_pdg_array @ %def var_list_append_string <>= public :: var_list_append_log_ptr public :: var_list_append_int_ptr public :: var_list_append_real_ptr public :: var_list_append_cmplx_ptr public :: var_list_append_pdg_array_ptr public :: var_list_append_subevt_ptr public :: var_list_append_string_ptr <>= procedure :: append_log_ptr => var_list_append_log_ptr procedure :: append_int_ptr => var_list_append_int_ptr procedure :: append_real_ptr => var_list_append_real_ptr procedure :: append_cmplx_ptr => var_list_append_cmplx_ptr procedure :: append_pdg_array_ptr => var_list_append_pdg_array_ptr procedure :: append_subevt_ptr => var_list_append_subevt_ptr procedure :: append_string_ptr => var_list_append_string_ptr <>= subroutine var_list_append_log_ptr & (var_list, name, lval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name logical, intent(in), target :: lval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_log_ptr (var, name, lval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_log_ptr subroutine var_list_append_int_ptr & (var_list, name, ival, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name integer, intent(in), target :: ival logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_int_ptr (var, name, ival, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_int_ptr subroutine var_list_append_real_ptr & (var_list, name, rval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name real(default), intent(in), target :: rval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_real_ptr (var, name, rval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_real_ptr subroutine var_list_append_cmplx_ptr & (var_list, name, cval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name complex(default), intent(in), target :: cval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_cmplx_ptr subroutine var_list_append_pdg_array_ptr & (var_list, name, aval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(pdg_array_t), intent(in), target :: aval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_pdg_array_ptr subroutine var_list_append_subevt_ptr & (var_list, name, pval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(subevt_t), intent(in), target :: pval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_subevt_ptr subroutine var_list_append_string_ptr & (var_list, name, sval, is_known, locked, verbose, intrinsic, description) class(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(string_t), intent(in), target :: sval logical, intent(in), target :: is_known logical, intent(in), optional :: locked, verbose, intrinsic type(string_t), intent(in), optional :: description type(var_entry_t), pointer :: var allocate (var) call var_entry_init_string_ptr (var, name, sval, is_known, intrinsic) if (present (description)) call var_entry_set_description (var, description) if (present (locked)) call var_entry_lock (var, locked) call var_list_append (var_list, var, verbose) end subroutine var_list_append_string_ptr @ %def var_list_append_log_ptr @ %def var_list_append_int_ptr @ %def var_list_append_real_ptr @ %def var_list_append_cmplx_ptr @ %def var_list_append_pdg_array_ptr @ %def var_list_append_subevt_ptr @ \subsubsection{Finalizer} Finalize, delete the list entry by entry. The link itself is kept intact. Follow link and delete recursively only if requested explicitly. <>= procedure :: final => var_list_final <>= recursive subroutine var_list_final (vars, follow_link) class(var_list_t), intent(inout) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var vars%last => null () do while (associated (vars%first)) var => vars%first vars%first => var%next call var_entry_final (var) deallocate (var) end do if (present (follow_link)) then if (follow_link) then if (associated (vars%next)) then call vars%next%final (follow_link) deallocate (vars%next) end if end if end if end subroutine var_list_final @ %def var_list_final @ \subsubsection{Output} Show variable list with precise control over options. E.g., show only variables of a certain type. Many options, thus not an ordinary [[write]] method. <>= public :: var_list_write <>= procedure :: write => var_list_write <>= recursive subroutine var_list_write & (var_list, unit, follow_link, only_type, prefix, model_name, & intrinsic, pacified, descriptions, ascii_output) class(var_list_t), intent(in), target :: var_list integer, intent(in), optional :: unit logical, intent(in), optional :: follow_link integer, intent(in), optional :: only_type character(*), intent(in), optional :: prefix type(string_t), intent(in), optional :: model_name logical, intent(in), optional :: intrinsic logical, intent(in), optional :: pacified logical, intent(in), optional :: descriptions logical, intent(in), optional :: ascii_output type(var_entry_t), pointer :: var integer :: u, length logical :: write_this, write_next u = given_output_unit (unit); if (u < 0) return if (present (prefix)) length = len (prefix) var => var_list%first if (associated (var)) then do while (associated (var)) if (present (only_type)) then write_this = only_type == var%type else write_this = .true. end if if (write_this .and. present (prefix)) then if (prefix /= extract (var%name, 1, length)) & write_this = .false. end if if (write_this) then call var_entry_write & (var, unit, model_name=model_name, & intrinsic=intrinsic, pacified=pacified, & descriptions=descriptions, ascii_output=ascii_output) end if var => var%next end do end if if (present (follow_link)) then write_next = follow_link .and. associated (var_list%next) else write_next = associated (var_list%next) end if if (write_next) then call var_list_write (var_list%next, & unit, follow_link, only_type, prefix, model_name, & intrinsic, pacified) end if end subroutine var_list_write @ %def var_list_write @ Write only a certain variable. <>= public :: var_list_write_var <>= procedure :: write_var => var_list_write_var <>= recursive subroutine var_list_write_var & (var_list, name, unit, type, follow_link, & model_name, pacified, defined, descriptions, ascii_output) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(in), optional :: unit integer, intent(in), optional :: type logical, intent(in), optional :: follow_link type(string_t), intent(in), optional :: model_name logical, intent(in), optional :: pacified logical, intent(in), optional :: defined logical, intent(in), optional :: descriptions logical, intent(in), optional :: ascii_output type(var_entry_t), pointer :: var integer :: u u = given_output_unit (unit); if (u < 0) return var => var_list_get_var_ptr & (var_list, name, type, follow_link=follow_link, defined=defined) if (associated (var)) then call var_entry_write & (var, unit, model_name = model_name, & pacified = pacified, & descriptions=descriptions, ascii_output=ascii_output) else write (u, "(A)") char (name) // " = [undefined]" end if end subroutine var_list_write_var @ %def var_list_write_var @ \subsection{Tools} Return a pointer to the variable list linked to by the current one. <>= function var_list_get_next_ptr (var_list) result (next_ptr) type(var_list_t), pointer :: next_ptr type(var_list_t), intent(in) :: var_list next_ptr => var_list%next end function var_list_get_next_ptr @ %def var_list_get_next_ptr @ Used by [[eval_trees]]: Return a pointer to the variable with the requested name. If no such name exists, return a null pointer. In that case, try the next list if present, unless [[follow_link]] is unset. If [[defined]] is set, ignore entries that exist but are undefined. <>= public :: var_list_get_var_ptr <>= recursive function var_list_get_var_ptr & (var_list, name, type, follow_link, defined) result (var) type(var_entry_t), pointer :: var type(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(in), optional :: type logical, intent(in), optional :: follow_link, defined logical :: ignore_undef, search_next ignore_undef = .true.; if (present (defined)) ignore_undef = .not. defined var => var_list%first if (present (type)) then do while (associated (var)) if (var%type == type) then if (var%name == name) then if (ignore_undef .or. var%is_defined) return end if end if var => var%next end do else do while (associated (var)) if (var%name == name) then if (ignore_undef .or. var%is_defined) return end if var => var%next end do end if search_next = associated (var_list%next) if (present (follow_link)) & search_next = search_next .and. follow_link if (search_next) & var => var_list_get_var_ptr & (var_list%next, name, type, defined=defined) end function var_list_get_var_ptr @ %def var_list_get_var_ptr @ Return the variable type <>= procedure :: get_type => var_list_get_type <>= function var_list_get_type (var_list, name, follow_link) result (type) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name logical, intent(in), optional :: follow_link integer :: type type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, follow_link=follow_link) if (associated (var)) then type = var%type else type = V_NONE end if end function var_list_get_type @ %def var_list_get_type @ Return true if the variable exists in the current list. <>= procedure :: contains => var_list_exists <>= function var_list_exists (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) lval = associated (var) end function var_list_exists @ %def var_list_exists @ Return true if the variable is declared as intrinsic. (This is not a property of the abstract [[vars_t]] type, and therefore the method is not inherited.) <>= procedure :: is_intrinsic => var_list_is_intrinsic <>= function var_list_is_intrinsic (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then lval = var%is_intrinsic else lval = .false. end if end function var_list_is_intrinsic @ %def var_list_is_intrinsic @ Return true if the value is known. <>= procedure :: is_known => var_list_is_known <>= function var_list_is_known (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then lval = var%is_known else lval = .false. end if end function var_list_is_known @ %def var_list_is_known @ Return true if the value is locked. (This is not a property of the abstract [[vars_t]] type, and therefore the method is not inherited.) <>= procedure :: is_locked => var_list_is_locked <>= function var_list_is_locked (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then lval = var_entry_is_locked (var) else lval = .false. end if end function var_list_is_locked @ %def var_list_is_locked @ Return several properties at once. <>= procedure :: get_var_properties => var_list_get_var_properties <>= subroutine var_list_get_var_properties (vars, name, req_type, follow_link, & type, is_defined, is_known, is_locked) class(var_list_t), intent(in) :: vars type(string_t), intent(in) :: name integer, intent(in), optional :: req_type logical, intent(in), optional :: follow_link integer, intent(out), optional :: type logical, intent(out), optional :: is_defined, is_known, is_locked type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, type=req_type, follow_link=follow_link) if (associated (var)) then if (present (type)) type = var_entry_get_type (var) if (present (is_defined)) is_defined = var_entry_is_defined (var) if (present (is_known)) is_known = var_entry_is_known (var) if (present (is_locked)) is_locked = var_entry_is_locked (var) else if (present (type)) type = V_NONE if (present (is_defined)) is_defined = .false. if (present (is_known)) is_known = .false. if (present (is_locked)) is_locked = .false. end if end subroutine var_list_get_var_properties @ %def var_list_get_var_properties @ Return the value, assuming that the type is correct. We consider only variable entries that have been [[defined]]. For convenience, allow both variable and fixed-length (literal) strings. <>= procedure :: get_lval => var_list_get_lval procedure :: get_ival => var_list_get_ival procedure :: get_rval => var_list_get_rval procedure :: get_cval => var_list_get_cval procedure :: get_pval => var_list_get_pval procedure :: get_aval => var_list_get_aval procedure :: get_sval => var_list_get_sval <>= function var_list_get_lval (vars, name, follow_link) result (lval) logical :: lval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_LOG, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then lval = var%lval else lval = .false. end if else lval = .false. end if end function var_list_get_lval function var_list_get_ival (vars, name, follow_link) result (ival) integer :: ival type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_INT, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then ival = var%ival else ival = 0 end if else ival = 0 end if end function var_list_get_ival function var_list_get_rval (vars, name, follow_link) result (rval) real(default) :: rval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_REAL, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then rval = var%rval else rval = 0 end if else rval = 0 end if end function var_list_get_rval function var_list_get_cval (vars, name, follow_link) result (cval) complex(default) :: cval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_CMPLX, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then cval = var%cval else cval = 0 end if else cval = 0 end if end function var_list_get_cval function var_list_get_aval (vars, name, follow_link) result (aval) type(pdg_array_t) :: aval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_PDG, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then aval = var%aval end if end if end function var_list_get_aval function var_list_get_pval (vars, name, follow_link) result (pval) type(subevt_t) :: pval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_SEV, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then pval = var%pval end if end if end function var_list_get_pval function var_list_get_sval (vars, name, follow_link) result (sval) type(string_t) :: sval type(string_t), intent(in) :: name class(var_list_t), intent(in) :: vars logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr & (vars, name, V_STR, follow_link, defined=.true.) if (associated (var)) then if (var_has_value (var)) then sval = var%sval else sval = "" end if else sval = "" end if end function var_list_get_sval @ %def var_list_get_lval @ %def var_list_get_ival @ %def var_list_get_rval @ %def var_list_get_cval @ %def var_list_get_pval @ %def var_list_get_aval @ %def var_list_get_sval @ Check for a valid value, given a pointer. Issue error messages if invalid. <>= function var_has_value (var) result (valid) logical :: valid type(var_entry_t), pointer :: var if (associated (var)) then if (var%is_known) then valid = .true. else call msg_error ("The value of variable '" // char (var%name) & // "' is unknown but must be known at this point.") valid = .false. end if else call msg_error ("Variable '" // char (var%name) & // "' is undefined but must have a known value at this point.") valid = .false. end if end function var_has_value @ %def var_has_value @ Return pointers instead of values, including a pointer to the [[known]] entry. <>= procedure :: get_lptr => var_list_get_lptr procedure :: get_iptr => var_list_get_iptr procedure :: get_rptr => var_list_get_rptr procedure :: get_cptr => var_list_get_cptr procedure :: get_aptr => var_list_get_aptr procedure :: get_pptr => var_list_get_pptr procedure :: get_sptr => var_list_get_sptr <>= subroutine var_list_get_lptr (var_list, name, lptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name logical, pointer, intent(out) :: lptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_LOG) if (associated (var)) then lptr => var_entry_get_lval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else lptr => null () if (present (known)) known => null () end if end subroutine var_list_get_lptr subroutine var_list_get_iptr (var_list, name, iptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name integer, pointer, intent(out) :: iptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_INT) if (associated (var)) then iptr => var_entry_get_ival_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else iptr => null () if (present (known)) known => null () end if end subroutine var_list_get_iptr subroutine var_list_get_rptr (var_list, name, rptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name real(default), pointer, intent(out) :: rptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_REAL) if (associated (var)) then rptr => var_entry_get_rval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else rptr => null () if (present (known)) known => null () end if end subroutine var_list_get_rptr subroutine var_list_get_cptr (var_list, name, cptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name complex(default), pointer, intent(out) :: cptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_CMPLX) if (associated (var)) then cptr => var_entry_get_cval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else cptr => null () if (present (known)) known => null () end if end subroutine var_list_get_cptr subroutine var_list_get_aptr (var_list, name, aptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name type(pdg_array_t), pointer, intent(out) :: aptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_PDG) if (associated (var)) then aptr => var_entry_get_aval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else aptr => null () if (present (known)) known => null () end if end subroutine var_list_get_aptr subroutine var_list_get_pptr (var_list, name, pptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name type(subevt_t), pointer, intent(out) :: pptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_SEV) if (associated (var)) then pptr => var_entry_get_pval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else pptr => null () if (present (known)) known => null () end if end subroutine var_list_get_pptr subroutine var_list_get_sptr (var_list, name, sptr, known) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name type(string_t), pointer, intent(out) :: sptr logical, pointer, intent(out), optional :: known type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_STR) if (associated (var)) then sptr => var_entry_get_sval_ptr (var) if (present (known)) known => var_entry_get_known_ptr (var) else sptr => null () if (present (known)) known => null () end if end subroutine var_list_get_sptr @ %def var_list_get_lptr @ %def var_list_get_iptr @ %def var_list_get_rptr @ %def var_list_get_cptr @ %def var_list_get_aptr @ %def var_list_get_pptr @ %def var_list_get_sptr @ This bunch of methods handles the procedure-pointer cases. <>= procedure :: get_obs1_iptr => var_list_get_obs1_iptr procedure :: get_obs2_iptr => var_list_get_obs2_iptr procedure :: get_obs1_rptr => var_list_get_obs1_rptr procedure :: get_obs2_rptr => var_list_get_obs2_rptr <>= subroutine var_list_get_obs1_iptr (var_list, name, obs1_iptr, p1) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_int), pointer, intent(out) :: obs1_iptr type(prt_t), pointer, intent(out) :: p1 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS1_INT) if (associated (var)) then call var_entry_assign_obs1_int_ptr (obs1_iptr, var) p1 => var_entry_get_prt1_ptr (var) else obs1_iptr => null () p1 => null () end if end subroutine var_list_get_obs1_iptr subroutine var_list_get_obs2_iptr (var_list, name, obs2_iptr, p1, p2) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_int), pointer, intent(out) :: obs2_iptr type(prt_t), pointer, intent(out) :: p1, p2 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS2_INT) if (associated (var)) then call var_entry_assign_obs2_int_ptr (obs2_iptr, var) p1 => var_entry_get_prt1_ptr (var) p2 => var_entry_get_prt2_ptr (var) else obs2_iptr => null () p1 => null () p2 => null () end if end subroutine var_list_get_obs2_iptr subroutine var_list_get_obs1_rptr (var_list, name, obs1_rptr, p1) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_real), pointer, intent(out) :: obs1_rptr type(prt_t), pointer, intent(out) :: p1 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS1_REAL) if (associated (var)) then call var_entry_assign_obs1_real_ptr (obs1_rptr, var) p1 => var_entry_get_prt1_ptr (var) else obs1_rptr => null () p1 => null () end if end subroutine var_list_get_obs1_rptr subroutine var_list_get_obs2_rptr (var_list, name, obs2_rptr, p1, p2) class(var_list_t), intent(in) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_real), pointer, intent(out) :: obs2_rptr type(prt_t), pointer, intent(out) :: p1, p2 type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_OBS2_REAL) if (associated (var)) then call var_entry_assign_obs2_real_ptr (obs2_rptr, var) p1 => var_entry_get_prt1_ptr (var) p2 => var_entry_get_prt2_ptr (var) else obs2_rptr => null () p1 => null () p2 => null () end if end subroutine var_list_get_obs2_rptr @ %def var_list_get_obs1_iptr @ %def var_list_get_obs2_iptr @ %def var_list_get_obs1_rptr @ %def var_list_get_obs2_rptr @ \subsection{Process Result Variables} These variables are associated to process (integration) runs and their results. Their names contain brackets (so they look like function evaluations), therefore we need to special-case them. <>= public :: var_list_set_procvar_int public :: var_list_set_procvar_real <>= subroutine var_list_set_procvar_int (var_list, proc_id, name, ival) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id type(string_t), intent(in) :: name integer, intent(in), optional :: ival type(string_t) :: var_name type(var_entry_t), pointer :: var var_name = name // "(" // proc_id // ")" var => var_list_get_var_ptr (var_list, var_name) if (.not. associated (var)) then call var_list%append_int (var_name, ival, intrinsic=.true.) else if (present (ival)) then call var_list%set_int (var_name, ival, is_known=.true.) end if end subroutine var_list_set_procvar_int subroutine var_list_set_procvar_real (var_list, proc_id, name, rval) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id type(string_t), intent(in) :: name real(default), intent(in), optional :: rval type(string_t) :: var_name type(var_entry_t), pointer :: var var_name = name // "(" // proc_id // ")" var => var_list_get_var_ptr (var_list, var_name) if (.not. associated (var)) then call var_list%append_real (var_name, rval, intrinsic=.true.) else if (present (rval)) then call var_list%set_real (var_name, rval, is_known=.true.) end if end subroutine var_list_set_procvar_real @ %def var_list_set_procvar_int @ %def var_list_set_procvar_real @ \subsection{Observable initialization} Observables are formally treated as variables, which however are evaluated each time the observable is used. The arguments (pointers) to evaluate and the function are part of the variable-list entry. <>= public :: var_list_append_obs1_iptr public :: var_list_append_obs2_iptr public :: var_list_append_obs1_rptr public :: var_list_append_obs2_rptr <>= subroutine var_list_append_obs1_iptr (var_list, name, obs1_iptr, p1) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_int) :: obs1_iptr type(prt_t), intent(in), target :: p1 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS1_INT, p1) var%obs1_int => obs1_iptr call var_list_append (var_list, var) end subroutine var_list_append_obs1_iptr subroutine var_list_append_obs2_iptr (var_list, name, obs2_iptr, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_int) :: obs2_iptr type(prt_t), intent(in), target :: p1, p2 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS2_INT, p1, p2) var%obs2_int => obs2_iptr call var_list_append (var_list, var) end subroutine var_list_append_obs2_iptr subroutine var_list_append_obs1_rptr (var_list, name, obs1_rptr, p1) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_unary_real) :: obs1_rptr type(prt_t), intent(in), target :: p1 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS1_REAL, p1) var%obs1_real => obs1_rptr call var_list_append (var_list, var) end subroutine var_list_append_obs1_rptr subroutine var_list_append_obs2_rptr (var_list, name, obs2_rptr, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name procedure(obs_binary_real) :: obs2_rptr type(prt_t), intent(in), target :: p1, p2 type(var_entry_t), pointer :: var allocate (var) call var_entry_init_obs (var, name, V_OBS2_REAL, p1, p2) var%obs2_real => obs2_rptr call var_list_append (var_list, var) end subroutine var_list_append_obs2_rptr @ %def var_list_append_obs1_iptr @ %def var_list_append_obs2_iptr @ %def var_list_append_obs1_rptr @ %def var_list_append_obs2_rptr @ User observables: no pointer needs to be stored. <>= public :: var_list_append_uobs_int public :: var_list_append_uobs_real <>= subroutine var_list_append_uobs_int (var_list, name, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(prt_t), intent(in), target :: p1 type(prt_t), intent(in), target, optional :: p2 type(var_entry_t), pointer :: var allocate (var) if (present (p2)) then call var_entry_init_obs (var, name, V_UOBS2_INT, p1, p2) else call var_entry_init_obs (var, name, V_UOBS1_INT, p1) end if call var_list_append (var_list, var) end subroutine var_list_append_uobs_int subroutine var_list_append_uobs_real (var_list, name, p1, p2) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: name type(prt_t), intent(in), target :: p1 type(prt_t), intent(in), target, optional :: p2 type(var_entry_t), pointer :: var allocate (var) if (present (p2)) then call var_entry_init_obs (var, name, V_UOBS2_REAL, p1, p2) else call var_entry_init_obs (var, name, V_UOBS1_REAL, p1) end if call var_list_append (var_list, var) end subroutine var_list_append_uobs_real @ %def var_list_append_uobs_int @ %def var_list_append_uobs_real @ \subsection{API for variable lists} Set a new value. If the variable holds a pointer, this pointer is followed, e.g., a model parameter is actually set. If [[ignore]] is set, do nothing if the variable does not exist. If [[verbose]] is set, echo the new value. Clear a variable (all variables), i.e., undefine the value. <>= procedure :: unset => var_list_clear <>= subroutine var_list_clear (vars, name, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_clear (var) end if end subroutine var_list_clear @ %def var_list_clear @ Setting the value, concise specific versions (implementing deferred TBP): <>= procedure :: set_ival => var_list_set_ival procedure :: set_rval => var_list_set_rval procedure :: set_cval => var_list_set_cval procedure :: set_lval => var_list_set_lval procedure :: set_sval => var_list_set_sval <>= subroutine var_list_set_ival (vars, name, ival, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name integer, intent(in) :: ival logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_int (var, ival, is_known=.true.) end if end subroutine var_list_set_ival subroutine var_list_set_rval (vars, name, rval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name real(default), intent(in) :: rval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_real (var, rval, is_known=.true.) end if end subroutine var_list_set_rval subroutine var_list_set_cval (vars, name, cval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name complex(default), intent(in) :: cval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_cmplx (var, cval, is_known=.true.) end if end subroutine var_list_set_cval subroutine var_list_set_lval (vars, name, lval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name logical, intent(in) :: lval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_log (var, lval, is_known=.true.) end if end subroutine var_list_set_lval subroutine var_list_set_sval (vars, name, sval, follow_link) class(var_list_t), intent(inout) :: vars type(string_t), intent(in) :: name type(string_t), intent(in) :: sval logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var var => var_list_get_var_ptr (vars, name, follow_link=follow_link) if (associated (var)) then call var_entry_set_string (var, sval, is_known=.true.) end if end subroutine var_list_set_sval @ %def var_list_set_ival @ %def var_list_set_rval @ %def var_list_set_cval @ %def var_list_set_lval @ %def var_list_set_sval @ Setting the value, verbose specific versions (as subroutines): <>= procedure :: set_log => var_list_set_log procedure :: set_int => var_list_set_int procedure :: set_real => var_list_set_real procedure :: set_cmplx => var_list_set_cmplx procedure :: set_subevt => var_list_set_subevt procedure :: set_pdg_array => var_list_set_pdg_array procedure :: set_string => var_list_set_string <>= subroutine var_list_set_log & (var_list, name, lval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name logical, intent(in) :: lval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_LOG) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_LOG) call var_entry_set_log (var, lval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_log subroutine var_list_set_int & (var_list, name, ival, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name integer, intent(in) :: ival logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_INT) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_INT) call var_entry_set_int (var, ival, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_int subroutine var_list_set_real & (var_list, name, rval, is_known, ignore, force, & verbose, model_name, pacified) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name real(default), intent(in) :: rval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose, pacified type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_REAL) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_REAL) call var_entry_set_real & (var, rval, is_known, verbose, model_name, pacified) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_real subroutine var_list_set_cmplx & (var_list, name, cval, is_known, ignore, force, & verbose, model_name, pacified) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name complex(default), intent(in) :: cval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose, pacified type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_CMPLX) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_CMPLX) call var_entry_set_cmplx & (var, cval, is_known, verbose, model_name, pacified) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_cmplx subroutine var_list_set_pdg_array & (var_list, name, aval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name type(pdg_array_t), intent(in) :: aval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_PDG) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_PDG) call var_entry_set_pdg_array & (var, aval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_pdg_array subroutine var_list_set_subevt & (var_list, name, pval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name type(subevt_t), intent(in) :: pval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_SEV) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_SEV) call var_entry_set_subevt & (var, pval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_subevt subroutine var_list_set_string & (var_list, name, sval, is_known, ignore, force, verbose, model_name) class(var_list_t), intent(inout), target :: var_list type(string_t), intent(in) :: name type(string_t), intent(in) :: sval logical, intent(in) :: is_known logical, intent(in), optional :: ignore, force, verbose type(string_t), intent(in), optional :: model_name type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name, V_STR) if (associated (var)) then if (.not. var_entry_is_locked (var, force)) then select case (var%type) case (V_STR) call var_entry_set_string & (var, sval, is_known, verbose, model_name) case default call var_mismatch_error (name) end select else call var_locked_error (name) end if else call var_missing_error (name, ignore) end if end subroutine var_list_set_string subroutine var_mismatch_error (name) type(string_t), intent(in) :: name call msg_fatal ("Type mismatch for variable '" // char (name) // "'") end subroutine var_mismatch_error subroutine var_locked_error (name) type(string_t), intent(in) :: name call msg_error ("Variable '" // char (name) // "' is not user-definable") end subroutine var_locked_error subroutine var_missing_error (name, ignore) type(string_t), intent(in) :: name logical, intent(in), optional :: ignore logical :: error if (present (ignore)) then error = .not. ignore else error = .true. end if if (error) then call msg_fatal ("Variable '" // char (name) // "' has not been declared") end if end subroutine var_missing_error @ %def var_list_set_log @ %def var_list_set_int @ %def var_list_set_real @ %def var_list_set_cmplx @ %def var_list_set_subevt @ %def var_list_set_pdg_array @ %def var_list_set_string @ %def var_mismatch_error @ %def var_missing_error @ Import values for the current variable list from another list. <>= public :: var_list_import <>= procedure :: import => var_list_import <>= subroutine var_list_import (var_list, src_list) class(var_list_t), intent(inout) :: var_list type(var_list_t), intent(in) :: src_list type(var_entry_t), pointer :: var, src var => var_list%first do while (associated (var)) src => var_list_get_var_ptr (src_list, var%name) if (associated (src)) then call var_entry_copy_value (var, src) end if var => var%next end do end subroutine var_list_import @ %def var_list_import @ Mark all entries in the current variable list as undefined. This is done when a local variable list is discarded. If the local list is used again (by a loop), the entries will be re-initialized. <>= public :: var_list_undefine <>= procedure :: undefine => var_list_undefine <>= recursive subroutine var_list_undefine (var_list, follow_link) class(var_list_t), intent(inout) :: var_list logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var logical :: rec rec = .true.; if (present (follow_link)) rec = follow_link var => var_list%first do while (associated (var)) call var_entry_undefine (var) var => var%next end do if (rec .and. associated (var_list%next)) then call var_list_undefine (var_list%next, follow_link=follow_link) end if end subroutine var_list_undefine @ %def var_list_undefine @ Make a deep copy of a variable list. <>= public :: var_list_init_snapshot <>= procedure :: init_snapshot => var_list_init_snapshot <>= recursive subroutine var_list_init_snapshot (var_list, vars_in, follow_link) class(var_list_t), intent(out) :: var_list type(var_list_t), intent(in) :: vars_in logical, intent(in), optional :: follow_link type(var_entry_t), pointer :: var, var_in type(var_list_t), pointer :: var_list_next logical :: rec rec = .true.; if (present (follow_link)) rec = follow_link var_in => vars_in%first do while (associated (var_in)) allocate (var) call var_entry_init_copy (var, var_in) call var_entry_copy_value (var, var_in) call var_list_append (var_list, var) var_in => var_in%next end do if (rec .and. associated (vars_in%next)) then allocate (var_list_next) call var_list_init_snapshot (var_list_next, vars_in%next) call var_list%link (var_list_next) end if end subroutine var_list_init_snapshot @ %def var_list_init_snapshot @ Check if a user variable can be set. The [[new]] flag is set if the user variable has an explicit declaration. If an error occurs, return [[V_NONE]] as variable type. Also determine the actual type of generic numerical variables, which enter the procedure with type [[V_NONE]]. <>= public :: var_list_check_user_var <>= procedure :: check_user_var => var_list_check_user_var <>= subroutine var_list_check_user_var (var_list, name, type, new) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(inout) :: type logical, intent(in) :: new type(var_entry_t), pointer :: var var => var_list_get_var_ptr (var_list, name) if (associated (var)) then if (type == V_NONE) then type = var_entry_get_type (var) end if if (var_entry_is_locked (var)) then call msg_fatal ("Variable '" // char (name) & // "' is not user-definable") type = V_NONE return else if (new) then if (var_entry_is_intrinsic (var)) then call msg_fatal ("Intrinsic variable '" & // char (name) // "' redeclared") type = V_NONE return end if if (var_entry_get_type (var) /= type) then call msg_fatal ("Variable '" // char (name) // "' " & // "redeclared with different type") type = V_NONE return end if end if end if end subroutine var_list_check_user_var @ %def var_list_check_user_var @ \subsection{Default values for global var list} <>= procedure :: init_defaults => var_list_init_defaults <>= subroutine var_list_init_defaults (var_list, seed, paths) class(var_list_t), intent(out) :: var_list integer, intent(in) :: seed type(paths_t), intent(in), optional :: paths call var_list%set_beams_defaults (paths) call var_list%set_core_defaults (seed) call var_list%set_integration_defaults () call var_list%set_phase_space_defaults () call var_list%set_gamelan_defaults () call var_list%set_clustering_defaults () call var_list%set_isolation_defaults () call var_list%set_eio_defaults () call var_list%set_shower_defaults () call var_list%set_hadronization_defaults () call var_list%set_tauola_defaults () call var_list%set_mlm_matching_defaults () call var_list%set_powheg_matching_defaults () call var_list%append_log (var_str ("?ckkw_matching"), .false., & intrinsic=.true., description=var_str ('Master flag that switches ' // & 'on the CKKW(-L) (LO) matching between hard scattering matrix ' // & 'elements and QCD parton showers. Note that this is not yet ' // & '(completely) implemented in \whizard. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})')) call var_list%set_openmp_defaults () call var_list%set_mpi_defaults () call var_list%set_nlo_defaults () end subroutine var_list_init_defaults @ %def var_list_init_defaults @ <>= procedure :: set_beams_defaults => var_list_set_beams_defaults <>= subroutine var_list_set_beams_defaults (var_list, paths) type(paths_t), intent(in), optional :: paths class(var_list_t), intent(inout) :: var_list call var_list%append_real (var_str ("sqrts"), & intrinsic=.true., & description=var_str ('Real variable in order to set the center-of-mass ' // & 'energy for the collisions (collider energy $\sqrt{s}$, not ' // & 'hard interaction energy $\sqrt{\hat{s}}$): \ttt{sqrts = {\em ' // & '} [ {\em } ]}. The physical unit can be one ' // & 'of the following \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV}, ' // & 'and \ttt{TeV}. If absent, \whizard\ takes \ttt{GeV} as its ' // & 'standard unit. Note that this variable is absolutely mandatory ' // & 'for integration and simulation of scattering processes.')) call var_list%append_real (var_str ("luminosity"), 0._default, & intrinsic=.true., & description=var_str ('This specifier \ttt{luminosity = {\em ' // & '}} sets the integrated luminosity (in inverse femtobarns, ' // & 'fb${}^{-1}$) for the event generation of the processes in the ' // & '\sindarin\ input files. Note that WHIZARD itself chooses the ' // & 'number from the \ttt{luminosity} or from the \ttt{n\_events} ' // & 'specifier, whichever would give the larger number of events. ' // & 'As this depends on the cross section under consideration, it ' // & 'might be different for different processes in the process list. ' // & '(cf. \ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format}, \ttt{?unweighted})')) call var_list%append_log (var_str ("?sf_trace"), .false., & intrinsic=.true., & description=var_str ('Debug flag that writes out detailed information ' // & 'about the structure function setup into the file \ttt{{\em ' // & '}\_sftrace.dat}. This file name can be changed ' // & 'with ($\to$) \ttt{\$sf\_trace\_file}.')) call var_list%append_string (var_str ("$sf_trace_file"), var_str (""), & intrinsic=.true., & description=var_str ('\ttt{\$sf\_trace\_file = "{\em }"} ' // & 'allows to change the detailed structure function information ' // & 'switched on by the debug flag ($\to$) \ttt{?sf\_trace} into ' // & 'a different file \ttt{{\em }} than the default ' // & '\ttt{{\em }\_sftrace.dat}.')) call var_list%append_log (var_str ("?sf_allow_s_mapping"), .true., & intrinsic=.true., & description=var_str ('Flag that determines whether special mappings ' // & 'for processes with structure functions and $s$-channel resonances ' // & 'are applied, e.g. Drell-Yan at hadron colliders, or $Z$ production ' // & 'at linear colliders with beamstrahlung and ISR.')) if (present (paths)) then call var_list%append_string (var_str ("$lhapdf_dir"), paths%lhapdfdir, & intrinsic=.true., & description=var_str ('String variable that tells the path ' // & 'where the \lhapdf\ library and PDF sets can be found. When ' // & 'the library has been correctly recognized during configuration, ' // & 'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // & '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // & '\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})')) else call var_list%append_string (var_str ("$lhapdf_dir"), var_str(""), & intrinsic=.true., & description=var_str ('String variable that tells the path ' // & 'where the \lhapdf\ library and PDF sets can be found. When ' // & 'the library has been correctly recognized during configuration, ' // & 'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // & '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // & '\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})')) end if call var_list%append_string (var_str ("$lhapdf_file"), var_str (""), & intrinsic=.true., & description=var_str ('This string variable \ttt{\$lhapdf\_file ' // & '= "{\em }"} allows to specify the PDF set \ttt{{\em ' // & '}} from the external \lhapdf\ library. It must match ' // & 'the exact name of the PDF set from the \lhapdf\ library. The ' // & 'default is empty, and the default set from \lhapdf\ is taken. ' // & 'Only one argument is possible, the PDF set must be identical ' // & 'for both beams, unless there are fundamentally different beam ' // & 'particles like proton and photon. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // & '\ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_photon\_scheme}, ' // & '\ttt{lhapdf\_member})')) call var_list%append_string (var_str ("$lhapdf_photon_file"), var_str (""), & intrinsic=.true., & description=var_str ('String variable \ttt{\$lhapdf\_photon\_file ' // & '= "{\em }"} analagous to ($\to$) \ttt{\$lhapdf\_file} ' // & 'for photon PDF structure functions from the external \lhapdf\ ' // & 'library. The name must exactly match the one of the set from ' // & '\lhapdf. (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // & '\ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member}, ' // & '\ttt{lhapdf\_photon\_scheme})')) call var_list%append_int (var_str ("lhapdf_member"), 0, & intrinsic=.true., & description=var_str ('Integer variable that specifies the number ' // & 'of the corresponding PDF set chosen via the command ($\to$) ' // & '\ttt{\$lhapdf\_file} or ($\to$) \ttt{\$lhapdf\_photon\_file} ' // & 'from the external \lhapdf\ library. E.g. error PDF sets can ' // & 'be chosen by this. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // & '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // & '\ttt{lhapdf\_photon\_scheme})')) call var_list%append_int (var_str ("lhapdf_photon_scheme"), 0, & intrinsic=.true., & description=var_str ('Integer parameter that controls the different ' // & 'available schemes for photon PDFs inside the external \lhapdf\ ' // & 'library. For more details see the \lhapdf\ manual. (cf. also ' // & '\ttt{lhapdf}, \ttt{\$lhapdf\_dir}, \ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, ' // & '\ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member})')) call var_list%append_string (var_str ("$pdf_builtin_set"), var_str ("CTEQ6L"), & intrinsic=.true., & description=var_str ("For \whizard's internal PDF structure functions " // & 'for hadron colliders, this string variable allows to set the ' // & 'particular PDF set. (cf. also \ttt{pdf\_builtin}, \ttt{pdf\_builtin\_photon})')) call var_list%append_log (var_str ("?hoppet_b_matching"), .false., & intrinsic=.true., & description=var_str ('Flag that switches on the matching between ' // & '4- and 5-flavor schemes for hadron collider $b$-parton initiated ' // & 'processes. Works either with builtin PDFs or with the external ' // & '\lhapdf\ interface. Needs the external \ttt{HOPPET} library ' // & 'to be linked. (cf. \ttt{beams}, \ttt{pdf\_builtin}, \ttt{lhapdf})')) call var_list%append_real (var_str ("isr_alpha"), 0._default, & intrinsic=.true., & description=var_str ('For lepton collider initial-state QED ' // & 'radiation (ISR), this real parameter sets the value of $\alpha_{em}$ ' // & 'used in the structure function. If not set, it is taken from ' // & 'the parameter set of the physics model in use (cf. also \ttt{isr}, ' // & '\ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // & '\ttt{?isr\_keep\_energy})')) call var_list%append_real (var_str ("isr_q_max"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set the ' // & 'scale of the initial-state QED radiation (ISR) structure function. ' // & 'If not set, it is taken internally to be $\sqrt{s}$. (cf. ' // & 'also \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // & '\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})')) call var_list%append_real (var_str ("isr_mass"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set by hand ' // & 'the mass of the incoming particle for lepton collider initial-state ' // & 'QED radiation (ISR). If not set, the mass for the initial beam ' // & 'particle is taken from the model in use. (cf. also \ttt{isr}, ' // & '\ttt{isr\_q\_max}, \ttt{isr\_alpha}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // & '\ttt{?isr\_keep\_energy})')) call var_list%append_int (var_str ("isr_order"), 3, & intrinsic=.true., & description=var_str ('For lepton collider initial-state QED ' // & 'radiation (ISR), this integer parameter allows to set the order ' // & 'up to which hard-collinear radiation is taken into account. ' // & 'Default is the highest available, namely third order. (cf. ' // & 'also \ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_alpha}, ' // & '\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})')) call var_list%append_log (var_str ("?isr_recoil"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // & '$p_T$-kick for the lepton collider initial-state QED radiation ' // & '(ISR). (cf. also \ttt{isr}, \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, ' // & '\ttt{isr\_order}, \ttt{isr\_q\_max})')) call var_list%append_log (var_str ("?isr_keep_energy"), .false., & intrinsic=.true., & description=var_str ('As the splitting kinematics for the ISR ' // & 'structure function violates Lorentz invariance when the recoil ' // & 'is switched on, this flag forces energy conservation when set ' // & 'to true, otherwise violating energy conservation. (cf. also ' // & '\ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // & '\ttt{?isr\_recoil}, \ttt{?isr\_alpha})')) call var_list%append_log (var_str ("?isr_handler"), .false., & intrinsic=.true., & description=var_str ('Activate ISR ' // & 'handler for event generation (no effect on integration). ' // & 'Requires \ttt{isr\_recoil = false}')) call var_list%append_string (var_str ("$isr_handler_mode"), & var_str ("trivial"), & intrinsic=.true., & description=var_str ('Operation mode for the ISR ' // & 'event handler. Allowed values: \ttt{trivial} (no effect), ' // & '\ttt{recoil} (recoil kinematics with two photons)')) call var_list%append_log (var_str ("?isr_handler_keep_mass"), .true., & intrinsic=.true., & description=var_str ('If \ttt{true} (default), force the incoming ' // & 'partons of the hard process (after radiation) on their mass ' // & 'shell. Otherwise, insert massless on-shell momenta. This ' // & 'applies only for event generation (no effect on integration, ' // & 'cf.\ also \ttt{?isr\_handler})')) call var_list%append_string (var_str ("$epa_mode"), & var_str ("default"), intrinsic=.true., & description=var_str ('For the equivalent photon approximation ' // & '(EPA), this string variable defines the mode, i.e. the explicit ' // & 'formula for the EPA distribution. For more details cf. the manual. ' // & 'Possible are \ttt{default} (\ttt{Budnev\_617}), \ttt{Budnev\_616e}, ' // & '\ttt{log\_power}, \ttt{log\_simple}, and \ttt{log}. ' // & '(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, ' // & '\ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, ' // & '\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_real (var_str ("epa_alpha"), 0._default, & intrinsic=.true., & description=var_str ('For the equivalent photon approximation ' // & '(EPA), this real parameter sets the value of $\alpha_{em}$ ' // & 'used in the structure function. If not set, it is taken from ' // & 'the parameter set of the physics model in use (cf. also \ttt{epa}, ' // & '\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, \ttt{epa\_q\_min}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}, ' // & '\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_real (var_str ("epa_x_min"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the lower cutoff ' // & 'for the energy fraction in the splitting for the equivalent-photon ' // & 'approximation (EPA). This parameter has to be set by the user ' // & 'to a non-zero value smaller than one. (cf. also \ttt{epa}, ' // & '\ttt{epa\_e\_max}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}, ' // & '\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_real (var_str ("epa_q_min"), 0._default, & intrinsic=.true., & description=var_str ('In the equivalent-photon approximation ' // & '(EPA), this real parameters sets the minimal value for the ' // & 'transferred momentum. Either this parameter or the mass of ' // & 'the beam particle has to be non-zero. (cf. also \ttt{epa}, ' // & '\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_max}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}, ' // & '\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_real (var_str ("epa_q_max"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set the ' // & 'upper energy cutoff for the equivalent-photon approximation ' // & '(EPA). If not set, \whizard\ simply takes the collider energy, ' // & '$\sqrt{s}$. (cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, ' // & '\ttt{epa\_alpha}, \ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{\$epa\_mode}, ' // & '\ttt{?epa\_keep\_energy}, \ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_real (var_str ("epa_mass"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set by hand ' // & 'the mass of the incoming particle for the equivalent-photon ' // & 'approximation (EPA). If not set, the mass for the initial beam ' // & 'particle is taken from the model in use. (cf. also \ttt{epa}, ' // & '\ttt{epa\_x\_min}, \ttt{epa\_e\_max}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // & '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}. ' // & '\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_log (var_str ("?epa_recoil"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // & '$p_T$-kick for the equivalent-photon approximation (EPA). ' // & '(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // & '\ttt{epa\_e\_max}, \ttt{epa\_q\_min}, \ttt{?epa\_keep\_energy}, ' // & '\ttt{\$epa\_mode}, \ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_log (var_str ("?epa_keep_energy"), .false., & intrinsic=.true., & description=var_str ('As the splitting kinematics for the EPA ' // & 'structure function violates Lorentz invariance when the recoil ' // & 'is switched on, this flag forces energy conservation when set ' // & 'to true, otherwise violating energy conservation. (cf. also ' // & '\ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // & '\ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{\$epa\_mode}, ' // & '\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})')) call var_list%append_log (var_str ("?epa_handler"), .false., & intrinsic=.true., & description=var_str ('Activate EPA ' // & 'handler for event generation (no effect on integration). ' // & 'Requires \ttt{epa\_recoil = false}')) call var_list%append_string (var_str ("$epa_handler_mode"), & var_str ("trivial"), & intrinsic=.true., & description=var_str ('Operation mode for the EPA ' // & 'event handler. Allowed values: \ttt{trivial} (no effect), ' // & '\ttt{recoil} (recoil kinematics with two beams)')) call var_list%append_real (var_str ("ewa_x_min"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the lower cutoff ' // & 'for the energy fraction in the splitting for the equivalent ' // & '$W$ approximation (EWA). This parameter has to be set by the ' // & 'user to a non-zero value smaller than one. (cf. also \ttt{ewa}, ' // & '\ttt{ewa\_pt\_max}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // & '\ttt{?ewa\_recoil})')) call var_list%append_real (var_str ("ewa_pt_max"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set the ' // & 'upper $p_T$ cutoff for the equivalent $W$ approximation (EWA). ' // & 'If not set, \whizard\ simply takes the collider energy, $\sqrt{s}$. ' // & '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // & '\ttt{?ewa\_recoil})')) call var_list%append_real (var_str ("ewa_mass"), 0._default, & intrinsic=.true., & description=var_str ('This real parameter allows to set by hand ' // & 'the mass of the incoming particle for the equivalent $W$ approximation ' // & '(EWA). If not set, the mass for the initial beam particle is ' // & 'taken from the model in use. (cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, ' // & '\ttt{ewa\_pt\_max}, \ttt{?ewa\_keep\_energy}, \ttt{?ewa\_recoil})')) call var_list%append_log (var_str ("?ewa_recoil"), .false., & intrinsic=.true., & description=var_str ('For the equivalent $W$ approximation (EWA), ' // & 'this flag switches on recoil, i.e. non-collinear splitting. ' // & '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // & '\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy})')) call var_list%append_log (var_str ("?ewa_keep_energy"), .false., & intrinsic=.true., & description=var_str ('As the splitting kinematics for the equivalent ' // & '$W$ approximation (EWA) violates Lorentz invariance when the ' // & 'recoil is switched on, this flag forces energy conservation ' // & 'when set to true, otherwise violating energy conservation. ' // & '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // & '\ttt{ewa\_mass}, \ttt{?ewa\_recoil})')) call var_list%append_log (var_str ("?circe1_photon1"), .false., & intrinsic=.true., & description=var_str ('Flag to tell \whizard\ to use the photon ' // & 'of the \circeone\ beamstrahlung structure function as initiator ' // & 'for the hard scattering process in the first beam. (cf. also ' // & '\ttt{circe1}, \ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_photon2"), .false., & intrinsic=.true., & description=var_str ('Flag to tell \whizard\ to use the photon ' // & 'of the \circeone\ beamstrahlung structure function as initiator ' // & 'for the hard scattering process in the second beam. (cf. also ' // & '\ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{circe1\_sqrts}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // & '\newline\ttt{?circe1\_with\_radiation})')) call var_list%append_real (var_str ("circe1_sqrts"), & intrinsic=.true., & description=var_str ('Real parameter that allows to set the ' // & 'value of the collider energy for the lepton collider beamstrahlung ' // & 'structure function \circeone. If not set, $\sqrt{s}$ is taken. ' // & '(cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_generate"), .true., & intrinsic=.true., & description=var_str ('Flag that determines whether the \circeone\ ' // & 'structure function for lepton collider beamstrahlung uses the ' // & 'generator mode for the spectrum, or a pre-defined (semi-)analytical ' // & 'parameterization. Default is the generator mode. (cf. also ' // & '\ttt{circe1}, \ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_map}, \ttt{circe1\_mapping\_slope}, ' // & '\ttt{circe1\_eps}, \newline \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // & '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_map"), .true., & intrinsic=.true., & description=var_str ('Flag that determines whether the \circeone\ ' // & 'structure function for lepton collider beamstrahlung uses special ' // & 'mappings for $s$-channel resonances. (cf. also \ttt{circe1}, ' // & '\ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // & '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_eps}, \newline ' // & '\ttt{circe1\_ver}, \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, ' // & '\ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_real (var_str ("circe1_mapping_slope"), 2._default, & intrinsic=.true., & description=var_str ('Real parameter that allows to vary the ' // & 'slope of the mapping function for the \circeone\ structure ' // & 'function for lepton collider beamstrahlung from the default ' // & 'value \ttt{2.}. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // & '\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // & '\ttt{?circe1\_map}, \ttt{circe1\_eps}, \ttt{circe1\_ver}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_real (var_str ("circe1_eps"), 1e-5_default, & intrinsic=.true., & description=var_str ('Real parameter, that takes care of the ' // & 'mapping of the peak in the lepton collider beamstrahlung structure ' // & 'function spectrum of \circeone. (cf. also \ttt{circe1}, \ttt{?circe1\_photons}, ' // & '\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // & '\ttt{?circe1\_map}, \ttt{circe1\_eps}, \newline ' // & '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // & '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline\ttt{?circe1\_with\_radiation})')) call var_list%append_int (var_str ("circe1_ver"), 0, intrinsic=.true., & description=var_str ('Integer parameter that sets the internal ' // & 'versioning number of the \circeone\ structure function for lepton-collider ' // & 'beamstrahlung. It has to be set by the user explicitly, it takes ' // & 'values from one to ten. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // & '\ttt{?circe1\_photon2}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, ' // & '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // & '\ttt{?circe1\_with\_radiation})')) call var_list%append_int (var_str ("circe1_rev"), 0, intrinsic=.true., & description=var_str ('Integer parameter that sets the internal ' // & 'revision number of the \circeone\ structure function for lepton-collider ' // & 'beamstrahlung. The default \ttt{0} translates always into the ' // & 'most recent version; older versions have to be accessed through ' // & 'the explicit revision date. For more details cf.~the \circeone ' // & 'manual. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // & '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // & '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, \ttt{circe1\_ver}, ' // & '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_string (var_str ("$circe1_acc"), var_str ("SBAND"), & intrinsic=.true., & description=var_str ('String variable that specifies the accelerator ' // & 'type for the \circeone\ structure function for lepton-collider ' // & 'beamstrahlung. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\newline \ttt{circe1\_rev}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})')) call var_list%append_int (var_str ("circe1_chat"), 0, intrinsic=.true., & description=var_str ('Chattiness of the \circeone\ structure ' // & 'function for lepton-collider beamstrahlung. The higher the integer ' // & 'value, the more information will be given out by the \circeone\ ' // & 'package. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{?circe1\_with\_radiation})')) call var_list%append_log (var_str ("?circe1_with_radiation"), .false., & intrinsic=.true., & description=var_str ('This logical decides whether the additional photon ' // & 'or electron ("beam remnant") will be considered in the event record or ' // & 'not. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // & '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // & '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // & '\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc})')) call var_list%append_log (var_str ("?circe2_polarized"), .true., & intrinsic=.true., & description=var_str ('Flag whether the photon spectra from the ' // & '\circetwo\ structure function for lepton colliders should be ' // & 'treated polarized. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, ' // & '\ttt{\$circe2\_design})')) call var_list%append_string (var_str ("$circe2_file"), & intrinsic=.true., & description=var_str ('String variable by which the corresponding ' // & 'photon collider spectrum for the \circetwo\ structure function ' // & 'can be selected. (cf. also \ttt{circe2}, \ttt{?circe2\_polarized}, ' // & '\ttt{\$circe2\_design})')) call var_list%append_string (var_str ("$circe2_design"), var_str ("*"), & intrinsic=.true., & description=var_str ('String variable that sets the collider ' // & 'design for the \circetwo\ structure function for photon collider ' // & 'spectra. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, \ttt{?circe2\_polarized})')) call var_list%append_real (var_str ("gaussian_spread1"), 0._default, & intrinsic=.true., & description=var_str ('Parameter that sets the energy spread ' // & '($\sigma$ value) of the first beam for a Gaussian spectrum. ' // & '(cf. \ttt{gaussian})')) call var_list%append_real (var_str ("gaussian_spread2"), 0._default, & intrinsic=.true., & description=var_str ('Ditto, for the second beam.')) call var_list%append_string (var_str ("$beam_events_file"), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & "name of the external file from which a beamstrahlung's spectrum " // & 'for lepton colliders as pairs of energy fractions is read in. ' // & '(cf. also \ttt{beam\_events}, \ttt{?beam\_events\_warn\_eof})')) call var_list%append_log (var_str ("?beam_events_warn_eof"), .true., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to ' // & 'issue a warning when in a simulation the end of an external ' // & "file for beamstrahlung's spectra for lepton colliders are reached, " // & 'and energy fractions from the beginning of the file are reused. ' // & '(cf. also \ttt{beam\_events}, \ttt{\$beam\_events\_file})')) call var_list%append_log (var_str ("?energy_scan_normalize"), .false., & intrinsic=.true., & description=var_str ('Normalization flag for the energy scan ' // & 'structure function: if set the total cross section is normalized ' // & 'to unity. (cf. also \ttt{energy\_scan})')) end subroutine var_list_set_beams_defaults @ %def var_list_set_beams_defaults @ <>= procedure :: set_core_defaults => var_list_set_core_defaults <>= subroutine var_list_set_core_defaults (var_list, seed) class(var_list_t), intent(inout) :: var_list integer, intent(in) :: seed logical, target, save :: known = .true. !!! ?????? real(default), parameter :: real_specimen = 1. call var_list_append_log_ptr & (var_list, var_str ("?logging"), logging, known, & intrinsic=.true., & description=var_str ('This logical -- when set to \ttt{false} ' // & '-- suppresses writing out a logfile (default: \ttt{whizard.log}) ' // & 'for the whole \whizard\ run, or when \whizard\ is run with the ' // & '\ttt{--no-logging} option, to suppress parts of the logging ' // & 'when setting it to \ttt{true} again at a later part of the ' // & '\sindarin\ input file. Mainly for debugging purposes. ' // & '(cf. also \ttt{?openmp\_logging}, \ttt{?mpi\_logging})')) call var_list%append_string (var_str ("$job_id"), & intrinsic=.true., & description=var_str ('Arbitrary string that can be used for ' // & 'creating unique names. The variable is initialized with the ' // & 'value of the \ttt{job\_id} option on startup. (cf. also ' // & '\ttt{\$compile\_workspace}, \ttt{\$run\_id})')) call var_list%append_string (var_str ("$compile_workspace"), & intrinsic=.true., & description=var_str ('If set, create process source code ' // & 'and process-driver library code in a subdirectory with this ' // & 'name. If non-existent, the directory will be created. (cf. ' // & 'also \ttt{\$job\_id}, \ttt{\$run\_id}, \ttt{\$integrate\_workspace})')) call var_list%append_int (var_str ("seed"), seed, & intrinsic=.true., & description=var_str ('Integer variable \ttt{seed = {\em }} ' // & 'that allows to set a specific random seed \ttt{num}. If not ' // & 'set, \whizard\ takes the time from the system clock to determine ' // & 'the random seed.')) call var_list%append_string (var_str ("$model_name"), & intrinsic=.true., & description=var_str ('This variable makes the locally used physics ' // & 'model available as a string, e.g. as \ttt{show (\$model\_name)}. ' // & 'However, the user is not able to change the current model by ' // & 'setting this variable to a different string. (cf. also \ttt{model}, ' // & '\ttt{\$library\_name}, \ttt{printf}, \ttt{show})')) call var_list%append_int (var_str ("process_num_id"), & intrinsic=.true., & description=var_str ('Using the integer \ttt{process\_num\_id ' // & '= {\em }} one can set a numerical identifier for processes ' // & 'within a process library. This can be set either just before ' // & 'the corresponding \ttt{process} definition or as an optional ' // & 'local argument of the latter. (cf. also \ttt{process}, ' // & '\ttt{?proc\_as\_run\_id}, \ttt{lcio\_run\_id})')) call var_list%append_log (var_str ("?proc_as_run_id"), .true., & intrinsic=.true., & description=var_str ('Normally, for LCIO the process ID (cf. ' // & '\ttt{process\_num\_id}) is used as run ID, unless this flag is ' // & 'set to \ttt{false}, cf. also \ttt{process}, \ttt{lcio\_run\_id}.')) call var_list%append_int (var_str ("lcio_run_id"), 0, & intrinsic=.true., & description=var_str ('Allows to set an integer run ID for the LCIO ' // & 'event format. Normally, the process ID is taken as run ID, unless ' // & 'the flag (cf.) \ttt{?proc\_as\_run\_id} is set to \ttt{false}, ' // & 'cf. also \ttt{process}.')) call var_list%append_string (var_str ("$method"), var_str ("omega"), & intrinsic=.true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation. The default ' // & "is the intrinsic \oMega\ matrix element generator " // & '(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // & '\ttt{"template\_unity"}, \ttt{"threshold"}. For processes defined ' // & '\ttt{"template"}, with \ttt{nlo\_calculation = ...}, please refer to ' // & '\ttt{\$born\_me\_method}, \ttt{\$real\_tree\_me\_method}, ' // & '\ttt{\$loop\_me\_method} and \ttt{\$correlation\_me\_method}.')) call var_list%append_log (var_str ("?report_progress"), .true., & intrinsic=.true., & description=var_str ('Flag for the \oMega\ matrix element generator ' // & 'whether to print out status messages about progress during ' // & 'matrix element generation. (cf. also \ttt{\$method}, \ttt{\$omega\_flags})')) call var_list%append_log (var_str ("?me_verbose"), .false., & description=var_str ("Flag determining whether " // & "the makefile command for generating and compiling the \oMega\ matrix " // & "element code is silent or verbose. Default is silent.")) call var_list%append_string (var_str ("$restrictions"), var_str (""), & intrinsic=.true., & description=var_str ('This is an optional argument for process ' // & 'definitions for the matrix element method \ttt{"omega"}. Using ' // & 'the following construction, it defines a string variable, \ttt{process ' // & '\newline {\em } = {\em }, {\em } ' // & '=> {\em }, {\em }, ... \{ \$restrictions ' // & '= "{\em }" \}}. The string argument \ttt{{\em ' // & '}} is directly transferred during the code ' // & 'generation to the ME generator \oMega. It has to be of the form ' // & '\ttt{n1 + n2 + ... \url{~} {\em }}, where ' // & '\ttt{n1} and so on are the numbers of the particles above in ' // & 'the process definition. The tilde specifies a certain intermediate ' // & 'state to be equal to the particle(s) in \ttt{particle (list)}. ' // & 'An example is \ttt{process eemm\_z = e1, E1 => e2, E2 ' // & '\{ \$restrictions = "1+2 \url{~} Z" \} } restricts the code ' // & 'to be generated for the process $e^- e^+ \to \mu^- \mu^+$ to ' // & 'the $s$-channel $Z$-boson exchange. For more details see Sec.~\ref{sec:omega_me} ' // & '(cf. also \ttt{process})')) call var_list%append_log (var_str ("?omega_write_phs_output"), .false., & intrinsic=.true., & description=var_str ('This flag decides whether a the phase-space ' // & 'output is produced by the \oMega\ matrix element generator. This ' // & 'output is written to file(s) and contains the Feynman diagrams ' // & 'which belong to the process(es) under consideration. The file is ' // & 'mandatory whenever the variable \ttt{\$phs\_method} has the value ' // & '\ttt{fast\_wood}, i.e. if the phase-space file is provided by ' // & 'cascades2.')) call var_list%append_string (var_str ("$omega_flags"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass flags ' // & 'to the \oMega\ matrix element generator. Normally, \whizard\ ' // & 'takes care of all flags automatically. Note that for restrictions ' // & 'of intermediate states, there is a special string variable: ' // & '(cf. $\to$) \ttt{\$restrictions}.')) call var_list%append_log (var_str ("?read_color_factors"), .true., & intrinsic=.true., & description=var_str ('This flag decides whether to read QCD ' // & 'color factors from the matrix element provided by each method, ' // & 'or to try and calculate the color factors in \whizard\ internally.')) call var_list%append_log (var_str ("?slha_read_input"), .true., & intrinsic=.true., & description=var_str ('Flag which decides whether \whizard\ reads ' // & 'in the SM and parameter information from the \ttt{SMINPUTS} ' // & 'and \ttt{MINPAR} common blocks of the SUSY Les Houches Accord ' // & 'files. (cf. also \ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, ' // & '\ttt{?slha\_read\_decays})')) call var_list%append_log (var_str ("?slha_read_spectrum"), .true., & intrinsic=.true., & description=var_str ('Flag which decides whether \whizard\ reads ' // & 'in the whole spectrum and mixing angle information from the ' // & 'common blocks of the SUSY Les Houches Accord files. (cf. also ' // & '\ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_decays}, ' // & '\ttt{?slha\_read\_input})')) call var_list%append_log (var_str ("?slha_read_decays"), .false., & intrinsic=.true., & description=var_str ('Flag which decides whether \whizard\ reads ' // & 'in the widths and branching ratios from the \ttt{DCINFO} common ' // & 'block of the SUSY Les Houches Accord files. (cf. also \ttt{read\_slha}, ' // & '\ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, \ttt{?slha\_read\_input})')) call var_list%append_string (var_str ("$library_name"), & intrinsic=.true., & description=var_str ('Similar to \ttt{\$model\_name}, this string ' // & 'variable is used solely to access the name of the active process ' // & 'library, e.g. in \ttt{printf} statements. (cf. \ttt{compile}, ' // & '\ttt{library}, \ttt{printf}, \ttt{show}, \ttt{\$model\_name})')) call var_list%append_log (var_str ("?alphas_is_fixed"), .true., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use a non-running ' // & '$\alpha_s$. Note that this has to be set explicitly to $\ttt{false}$ ' // & 'if the user wants to use one of the running $\alpha_s$ options. ' // & '(cf. also \ttt{alphas\_order}, \ttt{?alphas\_from\_lhapdf}, ' // & '\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // & '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_lhapdf"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use a running ' // & '$\alpha_s$ from the \lhapdf\ library (which has to be correctly ' // & 'linked). Note that \ttt{?alphas\_is\_fixed} has to be set ' // & 'explicitly to $\ttt{false}$. (cf. also \ttt{alphas\_order}, ' // & '\ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // & '\ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_pdf_builtin"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use a running ' // & '$\alpha_s$ from the internal PDFs. Note that in that case \ttt{?alphas\_is\_fixed} ' // & 'has to be set explicitly to $\ttt{false}$. (cf. also ' // & '\ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // & '\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \newline \ttt{?alphas\_from\_lambda\_qcd}, ' // & '\ttt{lambda\_qcd})')) call var_list%append_int (var_str ("alphas_order"), 0, & intrinsic=.true., & description=var_str ('Integer parameter that sets the order ' // & 'of the internal evolution for running $\alpha_s$ in \whizard: ' // & 'the default, \ttt{0}, is LO running, \ttt{1} is NLO, \ttt{2} ' // & 'is NNLO. (cf. also \ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // & '\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // & '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_int (var_str ("alphas_nf"), 5, & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of active quark flavors for the internal evolution for running ' // & '$\alpha_s$ in \whizard: the default is \ttt{5}. (cf. also ' // & '\ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\ttt{alphas\_order}, \ttt{?alphas\_from\_mz}, \newline ' // & '\ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_mz"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use its internal ' // & 'running $\alpha_s$ from $\alpha_s(M_Z)$. Note that in that ' // & 'case \ttt{?alphas\_is\_fixed} has to be set explicitly to ' // & '$\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // & '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})')) call var_list%append_log (var_str ("?alphas_from_lambda_qcd"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to use its internal ' // & 'running $\alpha_s$ from $\alpha_s(\Lambda_{QCD})$. Note that ' // & 'in that case \ttt{?alphas\_is\_fixed} has to be set explicitly ' // & 'to $\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // & '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\newline \ttt{?alphas\_from\_mz}, \ttt{lambda\_qcd})')) call var_list%append_real (var_str ("lambda_qcd"), 200.e-3_default, & intrinsic=.true., & description=var_str ('Real parameter that sets the value for ' // & '$\Lambda_{QCD}$ used in the internal evolution for running ' // & '$\alpha_s$ in \whizard. (cf. also \ttt{alphas\_is\_fixed}, ' // & '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, ' // & '\newline \ttt{?alphas\_from\_pdf\_builtin}, ' // & '\ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // & '\ttt{alphas\_order})')) call var_list%append_log (var_str ("?fatal_beam_decay"), .true., & intrinsic=.true., & description=var_str ('Logical variable that let the user decide ' // & 'whether the possibility of a beam decay is treated as a fatal ' // & 'error or only as a warning. An example is a process $b t \to ' // & 'X$, where the bottom quark as an inital state particle appears ' // & 'as a possible decay product of the second incoming particle, ' // & 'the top quark. This might trigger inconsistencies or instabilities ' // & 'in the phase space set-up.')) call var_list%append_log (var_str ("?helicity_selection_active"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether \whizard\ uses ' // & 'a numerical selection rule for vanishing helicities: if active, ' // & 'then, if a certain helicity combination yields an absolute ' // & '(\oMega) matrix element smaller than a certain threshold ($\to$ ' // & '\ttt{helicity\_selection\_threshold}) more often than a certain ' // & 'cutoff ($\to$ \ttt{helicity\_selection\_cutoff}), it will be dropped.')) call var_list%append_real (var_str ("helicity_selection_threshold"), & 1E10_default, & intrinsic=.true., & description=var_str ('Real parameter that gives the threshold ' // & 'for the absolute value of a certain helicity combination of ' // & 'an (\oMega) amplitude. If a certain number ($\to$ ' // & '\ttt{helicity\_selection\_cutoff}) of calls stays below this ' // & 'threshold, that combination will be dropped from then on. (cf. ' // & 'also \ttt{?helicity\_selection\_active})')) call var_list%append_int (var_str ("helicity_selection_cutoff"), 1000, & intrinsic=.true., & description=var_str ('Integer parameter that gives the number ' // & "a certain helicity combination of an (\oMega) amplitude has " // & 'to be below a certain threshold ($\to$ \ttt{helicity\_selection\_threshold}) ' // & 'in order to be dropped from then on. (cf. also \ttt{?helicity\_selection\_active})')) call var_list%append_string (var_str ("$rng_method"), var_str ("tao"), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'method for the random number generation. Default is Donald ' // & "Knuth' RNG method \ttt{TAO}.")) call var_list%append_log (var_str ("?vis_diags"), .false., & intrinsic=.true., & description=var_str ('Logical variable that allows to give out ' // & "a Postscript or PDF file for the Feynman diagrams for a \oMega\ " // & 'process. (cf. \ttt{?vis\_diags\_color}).')) call var_list%append_log (var_str ("?vis_diags_color"), .false., & intrinsic=.true., & description=var_str ('Same as \ttt{?vis\_diags}, but switches ' // & 'on color flow instead of Feynman diagram generation. (cf. \ttt{?vis\_diags}).')) call var_list%append_log (var_str ("?check_event_file"), .true., & intrinsic=.true., & description=var_str ('Setting this to false turns off all sanity ' // & 'checks when reading a raw event file with previously generated ' // & 'events. Use this at your own risk; the program may return ' // & 'wrong results or crash if data do not match. (cf. also \ttt{?check\_grid\_file}, ' // & '\ttt{?check\_phs\_file})')) call var_list%append_string (var_str ("$event_file_version"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'format version of the \whizard\ internal binary event format.')) call var_list%append_int (var_str ("n_events"), 0, & intrinsic=.true., & description=var_str ('This specifier \ttt{n\_events = {\em }} ' // & 'sets the number of events for the event generation of the processes ' // & 'in the \sindarin\ input files. Note that WHIZARD itself chooses ' // & 'the number from the \ttt{n\_events} or from the \ttt{luminosity} ' // & 'specifier, whichever would give the larger number of events. ' // & 'As this depends on the cross section under consideration, it ' // & 'might be different for different processes in the process list. ' // & '(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?unweighted}, \ttt{event\_index\_offset})')) call var_list%append_int (var_str ("event_index_offset"), 0, & intrinsic=.true., & description=var_str ('The value ' // & '\ttt{event\_index\_offset = {\em }} ' // & 'initializes the event counter for a subsequent ' // & 'event sample. By default (value 0), the first event ' // & 'gets index value 1, incrementing by one for each generated event ' // & 'within a sample. The event counter is initialized again ' // & 'for each new sample (i.e., \ttt{integrate} command). ' // & 'If events are read from file, and the ' // & 'event file format supports event numbering, the event numbers ' // & 'will be taken from file instead, and the value of ' // & '\ttt{event\_index\_offset} has no effect. ' // & '(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?unweighted}, \ttt{n\_events})')) call var_list%append_log (var_str ("?unweighted"), .true., & intrinsic=.true., & description=var_str ('Flag that distinguishes between unweighted ' // & 'and weighted event generation. (cf. also \ttt{simulate}, \ttt{n\_events}, ' // & '\ttt{luminosity}, \ttt{event\_index\_offset})')) call var_list%append_real (var_str ("safety_factor"), 1._default, & intrinsic=.true., & description=var_str ('This real variable \ttt{safety\_factor ' // & '= {\em }} reduces the acceptance probability for unweighting. ' // & 'If greater than one, excess events become less likely, but ' // & 'the reweighting efficiency also drops. (cf. \ttt{simulate}, \ttt{?unweighted})')) call var_list%append_log (var_str ("?negative_weights"), .false., & intrinsic=.true., & description=var_str ('Flag that tells \whizard\ to allow negative ' // & 'weights in integration and simulation. (cf. also \ttt{simulate}, ' // & '\ttt{?unweighted})')) call var_list%append_log (var_str ("?resonance_history"), .false., & intrinsic=.true., & description=var_str ( & 'The logical variable \texttt{?resonance\_history ' // & '= true/false} specifies whether during a simulation pass, ' // & 'the event generator should try to reconstruct intermediate ' // & 'resonances. If activated, appropriate resonant subprocess ' // & 'matrix element code will be automatically generated. ')) call var_list%append_real (var_str ("resonance_on_shell_limit"), & 4._default, & intrinsic=.true., & description=var_str ( & 'The real variable \texttt{resonance\_on\_shell\_limit ' // & '= {\em }} specifies the maximum relative distance from a ' // & 'resonance peak, such that the kinematical configuration ' // & 'can still be considered on-shell. This is relevant only if ' // & '\texttt{?resonance\_history = true}.')) call var_list%append_real (var_str ("resonance_on_shell_turnoff"), & 0._default, & intrinsic=.true., & description=var_str ( & 'The real variable \texttt{resonance\_on\_shell\_turnoff ' // & '= {\em }}, if positive, ' // & 'controls the smooth transition from resonance-like ' // & 'to background-like events. The relative strength of a ' // & 'resonance is reduced by a Gaussian with width given by this ' // & 'variable. In any case, events are treated as background-like ' // & 'when the off-shellness is greater than ' // & '\texttt{resonance\_on\_shell\_limit}. All of this applies ' // & 'only if \texttt{?resonance\_history = true}.')) call var_list%append_real (var_str ("resonance_background_factor"), & 1._default, & intrinsic=.true., & description=var_str ( & 'The real variable \texttt{resonance\_background\_factor} ' // & 'controls resonance insertion if a resonance ' // & 'history applies to a particular event. In determining '// & 'whether event kinematics qualifies as resonant or non-resonant, ' //& 'the non-resonant probability is multiplied by this factor ' // & 'Setting the factor to zero removes the background ' // & 'configuration as long as the kinematics qualifies as on-shell ' // & 'as qualified by \texttt{resonance\_on\_shell\_limit}.')) call var_list%append_log (var_str ("?keep_beams"), .false., & intrinsic=.true., & description=var_str ('The logical variable \ttt{?keep\_beams ' // & '= true/false} specifies whether beam particles and beam remnants ' // & 'are included when writing event files. For example, in order ' // & 'to read Les Houches accord event files into \pythia, no beam ' // & 'particles are allowed.')) call var_list%append_log (var_str ("?keep_remnants"), .true., & intrinsic=.true., & description=var_str ('The logical variable \ttt{?keep\_beams ' // & '= true/false} is respected only if \ttt{?keep\_beams} is set. ' // & 'If \ttt{true}, beam remnants are tagged as outgoing particles ' // & 'if they have been neither showered nor hadronized, i.e., have ' // & 'no children. If \ttt{false}, beam remnants are also included ' // & 'in the event record, but tagged as unphysical. Note that for ' // & 'ISR and/or beamstrahlung spectra, the radiated photons are ' // & 'considered as beam remnants.')) call var_list%append_log (var_str ("?recover_beams"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether the beam particles ' // & 'should be reconstructed when reading event/rescanning files ' // & 'into \whizard. (cf. \ttt{rescan}, \ttt{?update\_event}, \ttt{?update\_sqme}, ' // & '\newline \ttt{?update\_weight})')) call var_list%append_log (var_str ("?update_event"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the events in ' // & 'an event file should be rebuilt from the hard process when ' // & 'reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // & '\ttt{?recover\_beams}, \ttt{?update\_sqme}, \ttt{?update\_weight})')) call var_list%append_log (var_str ("?update_sqme"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whehter the squared ' // & 'matrix element in an event file should be updated/recalculated ' // & 'when reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // & '\newline \ttt{?recover\_beams}, \ttt{?update\_event}, \ttt{?update\_weight})')) call var_list%append_log (var_str ("?update_weight"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the weights ' // & 'in an event file should be updated/recalculated when reading ' // & 'event/rescanning files into \whizard. (cf. \ttt{rescan}, \ttt{?recover\_beams}, ' // & '\newline \ttt{?update\_event}, \ttt{?update\_sqme})')) call var_list%append_log (var_str ("?use_alphas_from_file"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the current ' // & '$\alpha_s$ definition should be used when recalculating matrix ' // & 'elements for events read from file, or the value that is stored ' // & 'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // & '\ttt{?use\_scale\_from\_file})')) call var_list%append_log (var_str ("?use_scale_from_file"), .false., & intrinsic=.true., & description=var_str ('Flag that decides whether the current ' // & 'energy-scale expression should be used when recalculating matrix ' // & 'elements for events read from file, or the value that is stored ' // & 'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // & '\ttt{?use\_alphas\_from\_file})')) call var_list%append_log (var_str ("?allow_decays"), .true., & intrinsic=.true., & description=var_str ('Master flag to switch on cascade decays ' // & 'for final state particles as an event transform. As a default, ' // & 'it is switched on. (cf. also \ttt{?auto\_decays}, ' // & '\ttt{auto\_decays\_multiplicity}, \ttt{?auto\_decays\_radiative}, ' // & '\ttt{?decay\_rest\_frame})')) call var_list%append_log (var_str ("?auto_decays"), .false., & intrinsic=.true., & description=var_str ('Flag, particularly as optional argument of the ($\to$) ' // & '\ttt{unstable} command, that tells \whizard\ to automatically ' // & 'determine the decays of that particle up to the final state ' // & 'multplicity ($\to$) \ttt{auto\_decays\_multiplicity}. Depending ' // & 'on the flag ($\to$) \ttt{?auto\_decays\_radiative}, radiative ' // & 'decays will be taken into account or not. (cf. also \ttt{unstable}, ' // & '\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay})')) call var_list%append_int (var_str ("auto_decays_multiplicity"), 2, & intrinsic=.true., & description=var_str ('Integer parameter, that sets -- ' // & 'for the ($\to$) \ttt{?auto\_decays} option to let \whizard\ ' // & 'automatically determine the decays of a particle set as ($\to$) ' // & '\ttt{unstable} -- the maximal final state multiplicity that ' // & 'is taken into account. The default is \ttt{2}. The flag \ttt{?auto\_decays\_radiative} ' // & 'decides whether radiative decays are taken into account. (cf.\ ' // & 'also \ttt{unstable}, \ttt{?auto\_decays})')) call var_list%append_log (var_str ("?auto_decays_radiative"), .false., & intrinsic=.true., & description=var_str ("If \whizard's automatic detection " // & 'of decay channels are switched on ($\to$ \ttt{?auto\_decays} ' // & 'for the ($\to$) \ttt{unstable} command, this flags decides ' // & 'whether radiative decays (e.g. containing additional photon(s)/gluon(s)) ' // & 'are taken into account or not. (cf. also \ttt{unstable}, \ttt{auto\_decays\_multiplicity})')) call var_list%append_log (var_str ("?decay_rest_frame"), .false., & intrinsic=.true., & description=var_str ('Flag that allows to force a particle decay ' // & 'to be simulated in its rest frame. This simplifies the calculation ' // & 'for decays as stand-alone processes, but makes the process ' // & 'unsuitable for use in a decay chain.')) call var_list%append_log (var_str ("?isotropic_decay"), .false., & intrinsic=.true., & description=var_str ('Flag that -- in case of using factorized ' // & 'production and decays using the ($\to$) \ttt{unstable} command ' // & '-- tells \whizard\ to switch off spin correlations completely ' // & '(isotropic decay). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // & '\ttt{decay\_helicity}, \ttt{?diagonal\_decay})')) call var_list%append_log (var_str ("?diagonal_decay"), .false., & intrinsic=.true., & description=var_str ('Flag that -- in case of using factorized ' // & 'production and decays using the ($\to$) \ttt{unstable} command ' // & '-- tells \whizard\ instead of full spin correlations to take ' // & 'only the diagonal entries in the spin-density matrix (i.e. ' // & 'classical spin correlations). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // & '\ttt{decay\_helicity}, \ttt{?isotropic\_decay})')) call var_list%append_int (var_str ("decay_helicity"), & intrinsic=.true., & description=var_str ('If this parameter is given an integer ' // & 'value, any particle decay triggered by a subsequent \ttt{unstable} ' // & 'declaration will receive a projection on the given helicity ' // & 'state for the unstable particle. (cf. also \ttt{unstable}, ' // & '\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay}. The latter ' // & 'parameters, if true, take precdence over any \ttt{?decay\_helicity} setting.)')) call var_list%append_log (var_str ("?polarized_events"), .false., & intrinsic=.true., & description=var_str ('Flag that allows to select certain helicity ' // & 'combinations in final state particles in the event files, ' // & 'and perform analysis on polarized event samples. (cf. also ' // & '\ttt{simulate}, \ttt{polarized}, \ttt{unpolarized})')) call var_list%append_string (var_str ("$polarization_mode"), & var_str ("helicity"), & intrinsic=.true., & description=var_str ('String variable that specifies the mode in ' // & 'which the polarization of particles is handled when polarized events ' // & 'are written out. Possible options are \ttt{"ignore"}, \ttt{"helicity"}, ' // & '\ttt{"factorized"}, and \ttt{"correlated"}. For more details cf. the ' // & 'detailed section.')) call var_list%append_log (var_str ("?colorize_subevt"), .false., & intrinsic=.true., & description=var_str ('Flag that enables color-index tracking ' // & 'in the subevent (\ttt{subevt}) objects that are used for ' // & 'internal event analysis.')) call var_list%append_real (var_str ("tolerance"), 0._default, & intrinsic=.true., & description=var_str ('Real variable that defines the absolute ' // & 'tolerance with which the (logical) function \ttt{expect} accepts ' // & 'equality or inequality: \ttt{tolerance = {\em }}. This ' // & 'can e.g. be used for cross-section tests and backwards compatibility ' // & 'checks. (cf. also \ttt{expect})')) call var_list%append_int (var_str ("checkpoint"), 0, & intrinsic = .true., & description=var_str ('Setting this integer variable to a positive ' // & 'integer $n$ instructs simulate to print out a progress summary ' // & 'every $n$ events.')) call var_list%append_int (var_str ("event_callback_interval"), 0, & intrinsic = .true., & description=var_str ('Setting this integer variable to a positive ' // & 'integer $n$ instructs simulate to print out a progress summary ' // & 'every $n$ events.')) call var_list%append_log (var_str ("?pacify"), .false., & intrinsic=.true., & description=var_str ('Flag that allows to suppress numerical ' // & 'noise and give screen and log file output with a lower number ' // & 'of significant digits. Mainly for debugging purposes. (cf. also ' // & '\ttt{?sample\_pacify})')) call var_list%append_string (var_str ("$out_file"), var_str (""), & intrinsic=.true., & description=var_str ('This character variable allows to specify ' // & 'the name of the data file to which the histogram and plot data ' // & 'are written (cf. also \ttt{write\_analysis}, \ttt{open\_out}, ' // & '\ttt{close\_out})')) call var_list%append_log (var_str ("?out_advance"), .true., & intrinsic=.true., & description=var_str ('Flag that sets advancing in the \ttt{printf} ' // & 'output commands, i.e. continuous printing with no line feed ' // & 'etc. (cf. also \ttt{printf})')) !!! JRR: WK please check (#542) ! call var_list%append_log (var_str ("?out_custom"), .false., & ! intrinsic=.true.) ! call var_list%append_string (var_str ("$out_comment"), var_str ("# "), & ! intrinsic=.true.) ! call var_list%append_log (var_str ("?out_header"), .true., & ! intrinsic=.true.) ! call var_list%append_log (var_str ("?out_yerr"), .true., & ! intrinsic=.true.) ! call var_list%append_log (var_str ("?out_xerr"), .true., & ! intrinsic=.true.) call var_list%append_int (var_str ("real_range"), & range (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This integer gives the decimal exponent ' // & 'range of the numeric model for the real float type in use. It cannot ' // & 'be set by the user. (cf. also \ttt{real\_precision}, ' // & '\ttt{real\_epsilon}, \ttt{real\_tiny}).')) call var_list%append_int (var_str ("real_precision"), & precision (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This integer gives the precision of ' // & 'the numeric model for the real float type in use. It cannot ' // & 'be set by the user. (cf. also \ttt{real\_range}, ' // & '\ttt{real\_epsilon}, \ttt{real\_tiny}).')) call var_list%append_real (var_str ("real_epsilon"), & epsilon (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This gives the smallest number $E$ ' // & 'of the same kind as the float type for which $1 + E > 1$. ' // & 'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // & '\ttt{real\_tiny}, \ttt{real\_precision}).')) call var_list%append_real (var_str ("real_tiny"), & tiny (real_specimen), intrinsic = .true., locked = .true., & description=var_str ('This gives the smallest positive (non-zero) ' // & 'number in the numeric model for the real float type in use. ' // & 'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // & '\ttt{real\_epsilon}, \ttt{real\_precision}).')) end subroutine var_list_set_core_defaults @ %def var_list_set_core_defaults @ <>= procedure :: set_integration_defaults => var_list_set_integration_defaults <>= subroutine var_list_set_integration_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$integration_method"), var_str ("vamp"), & intrinsic=.true., & description=var_str ('This string variable specifies the method ' // & 'for performing the multi-dimensional phase-space integration. ' // & 'The default is the \vamp\ algorithm (\ttt{"vamp"}), other options ' // & 'are via the numerical midpoint rule (\ttt{"midpoint"}) or an ' // & 'alternate \vamptwo\ implementation that is MPI-parallelizable ' // & '(\ttt{"vamp2"}).')) call var_list%append_int (var_str ("threshold_calls"), 10, & intrinsic=.true., & description=var_str ('This integer variable gives a limit for ' // & 'the number of calls in a given channel which acts as a lower ' // & 'threshold for the channel weight. If the number of calls in ' // & 'that channel falls below this threshold, the weight is not ' // & 'lowered further but kept at this threshold. (cf. also ' // & '\ttt{channel\_weights\_power})')) call var_list%append_int (var_str ("min_calls_per_channel"), 10, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the minimal " // & 'number every channel must be called. If the number of calls ' // & 'from the iterations is too small, \whizard\ will automatically ' // & 'increase the number of calls. (cf. \ttt{iterations}, \ttt{min\_calls\_per\_bin}, ' // & '\ttt{min\_bins}, \ttt{max\_bins})')) call var_list%append_int (var_str ("min_calls_per_bin"), 10, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the minimal " // & 'number every bin in an integration dimension must be called. ' // & 'If the number of calls from the iterations is too small, \whizard\ ' // & 'will automatically increase the number of calls. (cf. \ttt{iterations}, ' // & '\ttt{min\_calls\_per\_channel}, \ttt{min\_bins}, \ttt{max\_bins})')) call var_list%append_int (var_str ("min_bins"), 3, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the minimal " // & 'number of bins per integration dimension. (cf. \ttt{iterations}, ' // & '\ttt{max\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})')) call var_list%append_int (var_str ("max_bins"), 20, & intrinsic=.true., & description=var_str ('Integer parameter that modifies the settings ' // & "of the \vamp\ integrator's grid parameters. It sets the maximal " // & 'number of bins per integration dimension. (cf. \ttt{iterations}, ' // & '\ttt{min\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})')) call var_list%append_log (var_str ("?stratified"), .true., & intrinsic=.true., & description=var_str ('Flag that switches between stratified ' // & 'and importance sampling for the \vamp\ integration method.')) call var_list%append_log (var_str ("?use_vamp_equivalences"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether equivalence ' // & 'relations (symmetries) between different integration channels ' // & 'are used by the \vamp\ integrator.')) call var_list%append_log (var_str ("?vamp_verbose"), .false., & intrinsic=.true., & description=var_str ('Flag that sets the chattiness of the \vamp\ ' // & 'integrator. If set, not only errors, but also all warnings and ' // & 'messages will be written out (not the default). (cf. also \newline ' // & '\ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_global\_verbose}, ' // & '\ttt{?vamp\_history\_channels}, \newline \ttt{?vamp\_history\_channels\_verbose})')) call var_list%append_log (var_str ("?vamp_history_global"), & .true., intrinsic=.true., & description=var_str ('Flag that decides whether the global history ' // & 'of the grid adaptation of the \vamp\ integrator are written ' // & 'into the process logfiles. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // & '\ttt{?vamp\_history\_channels}, \ttt{?vamp\_history\_channels\_verbose}, ' // & '\ttt{?vamp\_verbose})')) call var_list%append_log (var_str ("?vamp_history_global_verbose"), & .false., intrinsic=.true., & description=var_str ('Flag that decides whether the global history ' // & 'of the grid adaptation of the \vamp\ integrator are written ' // & 'into the process logfiles in an extended version. Only for debugging ' // & 'purposes. (cf. also \ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_channels}, ' // & '\ttt{?vamp\_verbose}, \ttt{?vamp\_history\_channels\_verbose})')) call var_list%append_log (var_str ("?vamp_history_channels"), & .false., intrinsic=.true., & description=var_str ('Flag that decides whether the history of ' // & 'the grid adaptation of the \vamp\ integrator for every single ' // & 'channel are written into the process logfiles. Only for debugging ' // & 'purposes. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // & '\ttt{?vamp\_history\_global}, \ttt{?vamp\_verbose}, \newline ' // & '\ttt{?vamp\_history\_channels\_verbose})')) call var_list%append_log (var_str ("?vamp_history_channels_verbose"), & .false., intrinsic=.true., & description=var_str ('Flag that decides whether the history of ' // & 'the grid adaptation of the \vamp\ integrator for every single ' // & 'channel are written into the process logfiles in an extended ' // & 'version. Only for debugging purposes. (cf. also \ttt{?vamp\_history\_global}, ' // & '\ttt{?vamp\_history\_channels}, \ttt{?vamp\_verbose}, \ttt{?vamp\_history\_global\_verbose})')) call var_list%append_string (var_str ("$run_id"), var_str (""), & intrinsic=.true., & description=var_str ('String variable \ttt{\$run\_id = "{\em ' // & '}"} that allows to set a special ID for a particular process ' // & 'run, e.g. in a scan. The run ID is then attached to the process ' // & 'log file: \newline \ttt{{\em }\_{\em }.{\em ' // & '}.log}, the \vamp\ grid file: \newline \ttt{{\em }\_{\em ' // & '}.{\em }.vg}, and the phase space file: \newline ' // & '\ttt{{\em }\_{\em }.{\em }.phs}. ' // & 'The run ID string distinguishes among several runs for the ' // & 'same process. It identifies process instances with respect ' // & 'to adapted integration grids and similar run-specific data. ' // & 'The run ID is kept when copying processes for creating instances, ' // & 'however, so it does not distinguish event samples. (cf.\ also ' // & '\ttt{\$job\_id}, \ttt{\$compile\_workspace}')) call var_list%append_int (var_str ("n_calls_test"), 0, & intrinsic=.true., & description=var_str ('Integer variable that allows to set a ' // & 'certain number of matrix element sampling test calls without ' // & 'actually integrating the process under consideration. (cf. ' // & '\ttt{integrate})')) call var_list%append_log (var_str ("?integration_timer"), .true., & intrinsic=.true., & description=var_str ('This flag switches the integration timer ' // & 'on and off, that gives the estimate for the duration of the ' // & 'generation of 10,000 unweighted events for each integrated ' // & 'process.')) call var_list%append_log (var_str ("?check_grid_file"), .true., & intrinsic=.true., & description=var_str ('Setting this to false turns off all sanity ' // & 'checks when reading a grid file with previous integration data. ' // & 'Use this at your own risk; the program may return wrong results ' // & 'or crash if data do not match. (cf. also \ttt{?check\_event\_file}, \ttt{?check\_phs\_file}) ')) call var_list%append_real (var_str ("accuracy_goal"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that allows the user to ' // & 'set a minimal accuracy that should be achieved in the Monte-Carlo ' // & 'integration of a certain process. If that goal is reached, ' // & 'grid and weight adapation stop, and this result is used for ' // & 'simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // & '\ttt{error\_goal}, \ttt{relative\_error\_goal}, ' // & '\ttt{error\_threshold})')) call var_list%append_real (var_str ("error_goal"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that allows the user to ' // & 'set a minimal absolute error that should be achieved in the ' // & 'Monte-Carlo integration of a certain process. If that goal ' // & 'is reached, grid and weight adapation stop, and this result ' // & 'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // & '\ttt{accuracy\_goal}, \ttt{relative\_error\_goal}, \ttt{error\_threshold})')) call var_list%append_real (var_str ("relative_error_goal"), 0._default, & intrinsic=.true., & description=var_str ('Real parameter that allows the user to ' // & 'set a minimal relative error that should be achieved in the ' // & 'Monte-Carlo integration of a certain process. If that goal ' // & 'is reached, grid and weight adaptation stop, and this result ' // & 'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // & '\ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{error\_threshold})')) call var_list%append_int (var_str ("integration_results_verbosity"), 1, & intrinsic=.true., & description=var_str ('Integer parameter for the verbosity of ' // & 'the integration results in the process-specific logfile.')) call var_list%append_real (var_str ("error_threshold"), & 0._default, intrinsic=.true., & description=var_str ('The real parameter \ttt{error\_threshold ' // & '= {\em }} declares that any error value (in absolute numbers) ' // & 'smaller than \ttt{{\em }} is to be considered zero. The ' // & 'units are \ttt{fb} for scatterings and \ttt{GeV} for decays. ' // & '(cf. also \ttt{integrate}, \ttt{iterations}, \ttt{accuracy\_goal}, ' // & '\ttt{error\_goal}, \ttt{relative\_error\_goal})')) call var_list%append_real (var_str ("channel_weights_power"), 0.25_default, & intrinsic=.true., & description=var_str ('Real parameter that allows to vary the ' // & 'exponent of the channel weights for the \vamp\ integrator.')) call var_list%append_string (var_str ("$integrate_workspace"), & intrinsic=.true., & description=var_str ('Character string that tells \whizard\ ' // & 'the subdirectory where to find the run-specific phase-space ' // & 'configuration and the \vamp\ and \vamptwo\ grid files. ' // & 'If undefined (as per default), \whizard\ creates them and ' // & 'searches for them in the ' // & 'current directory. (cf. also \ttt{\$job\_id}, ' // & '\ttt{\$run\_id}, \ttt{\$compile\_workspace})')) call var_list%append_string (var_str ("$vamp_grid_format"), var_str ("ascii"), & intrinsic=.true., & description=var_str ('Character string that tells \whizard\ ' // & 'the file format for \ttt{vamp2} to use for writing and reading ' // & 'the configuration for the multi-channel integration setup and the ' // & '\vamptwo\ (only) grid data. The values can be \ttt{ascii} for a single ' // & 'human-readable grid file with ending \ttt{.vg2} or \ttt{binary} for two files, ' // & 'a human-readable header file with ending \ttt{.vg2} and binary file with ending ' // & '\ttt{.vgx2} storing the grid data.' // & 'The main purpose of the binary format is to perform faster I/O, e.g. for HPC runs.' // & '\whizard\ can convert between the different file formats automatically.')) end subroutine var_list_set_integration_defaults @ %def var_list_set_integration_defaults @ <>= procedure :: set_phase_space_defaults => var_list_set_phase_space_defaults <>= subroutine var_list_set_phase_space_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$phs_method"), var_str ("default"), & intrinsic=.true., & description=var_str ('String variable that allows to choose ' // & 'the phase-space parameterization method. The default is the ' // & '\ttt{"wood"} method that takes into account electroweak/BSM ' // & 'resonances. Note that this might not be the best choice for ' // & '(pure) QCD amplitudes. (cf. also \ttt{\$phs\_file})')) call var_list%append_log (var_str ("?vis_channels"), .false., & intrinsic=.true., & description=var_str ('Optional logical argument for the \ttt{integrate} ' // & 'command that demands \whizard\ to generate a PDF or postscript ' // & 'output showing the classification of the found phase space ' // & 'channels (if the phase space method \ttt{wood} has been used) ' // & 'according to their properties: \ttt{integrate (foo) \{ iterations=3:10000 ' // & '?vis\_channels = true \}}. The default is \ttt{false}. (cf. ' // & 'also \ttt{integrate}, \ttt{?vis\_history})')) call var_list%append_log (var_str ("?check_phs_file"), .true., & intrinsic=.true., & description=var_str ('Setting this to false turns off all sanity ' // & 'checks when reading a previously generated phase-space configuration ' // & 'file. Use this at your own risk; the program may return wrong ' // & 'results or crash if data do not match. (cf. also \ttt{?check\_event\_file}, ' // & '\ttt{?check\_grid\_file})')) call var_list%append_string (var_str ("$phs_file"), var_str (""), & intrinsic=.true., & description=var_str ('This string variable allows the user to ' // & 'set an individual file name for the phase space parameterization ' // & 'for a particular process: \ttt{\$phs\_file = "{\em }"}. ' // & 'If not set, the default is \ttt{{\em }\_{\em }.{\em ' // & '}.phs}. (cf. also \ttt{\$phs\_method})')) call var_list%append_log (var_str ("?phs_only"), .false., & intrinsic=.true., & description=var_str ('Flag (particularly as optional argument ' // & 'of the $\to$ \ttt{integrate} command) that allows to only generate ' // & 'the phase space file, but not perform the integration. (cf. ' // & 'also \ttt{\$phs\_method}, \ttt{\$phs\_file})')) call var_list%append_real (var_str ("phs_threshold_s"), 50._default, & intrinsic=.true., & description=var_str ('For the phase space method \ttt{wood}, ' // & 'this real parameter sets the threshold below which particles ' // & 'are assumed to be massless in the $s$-channel like kinematic ' // & 'regions. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_off\_shell}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // & '\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_threshold_t"), 100._default, & intrinsic=.true., & description=var_str ('For the phase space method \ttt{wood}, ' // & 'this real parameter sets the threshold below which particles ' // & 'are assumed to be massless in the $t$-channel like kinematic ' // & 'regions. (cf. also \ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // & '\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})')) call var_list%append_int (var_str ("phs_off_shell"), 2, & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of off-shell (not $t$-channel-like, non-resonant) lines that ' // & 'are taken into account to find a valid phase-space setup in ' // & 'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // & '\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // & '\ttt{?phs\_s\_mapping})')) call var_list%append_int (var_str ("phs_t_channel"), 6, & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of $t$-channel propagators in multi-peripheral diagrams that ' // & 'are taken into account to find a valid phase-space setup in ' // & 'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // & '\ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // & '\ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_e_scale"), 10._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the energy scale ' // & 'that acts as a cutoff for parameterizing radiation-like kinematics ' // & 'in the \ttt{wood} phase space method. \whizard\ takes the maximum ' // & 'of this value and the width of the propagating particle as ' // & 'a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // & '\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_m_scale"), 10._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the mass scale ' // & 'that acts as a cutoff for parameterizing collinear and infrared ' // & 'kinematics in the \ttt{wood} phase space method. \whizard\ ' // & 'takes the maximum of this value and the mass of the propagating ' // & 'particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // & '\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})')) call var_list%append_real (var_str ("phs_q_scale"), 10._default, & intrinsic=.true., & description=var_str ('Real parameter that sets the momentum ' // & 'transfer scale that acts as a cutoff for parameterizing $t$- ' // & 'and $u$-channel like kinematics in the \ttt{wood} phase space ' // & 'method. \whizard\ takes the maximum of this value and the mass ' // & 'of the propagating particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, ' // & '\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, ' // & '\ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp}, ' // & '\newline \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_keep_nonresonant"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether the \ttt{wood} ' // & 'phase space method takes into account also non-resonant contributions. ' // & '(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // & '\ttt{phs\_q\_scale}, \ttt{phs\_e\_scale}, \ttt{?phs\_step\_mapping}, ' // & '\newline \ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_step_mapping"), .true., & intrinsic=.true., & description=var_str ('Flag that switches on (or off) a particular ' // & 'phase space mapping for resonances, where the mass and width ' // & 'of the resonance are explicitly set as channel cutoffs. (cf. ' // & 'also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, ' // & '\ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, \newline \ttt{phs\_m\_scale}, ' // & '\ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, \ttt{?phs\_step\_mapping\_exp}, ' // & '\newline \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_step_mapping_exp"), .true., & intrinsic=.true., & description=var_str ('Flag that switches on (or off) a particular ' // & 'phase space mapping for resonances, where the mass and width ' // & 'of the resonance are explicitly set as channel cutoffs. This ' // & 'is an exponential mapping in contrast to ($\to$) \ttt{?phs\_step\_mapping}. ' // & '(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \newline \ttt{?phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // & '\ttt{?phs\_step\_mapping}, \ttt{?phs\_s\_mapping})')) call var_list%append_log (var_str ("?phs_s_mapping"), .true., & intrinsic=.true., & description=var_str ('Flag that allows special mapping for $s$-channel ' // & 'resonances. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // & '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // & '\ttt{phs\_m\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, ' // & '\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp})')) call var_list%append_log (var_str ("?vis_history"), .false., & intrinsic=.true., & description=var_str ('Optional logical argument for the \ttt{integrate} ' // & 'command that demands \whizard\ to generate a PDF or postscript ' // & 'output showing the adaptation history of the Monte-Carlo integration ' // & 'of the process under consideration. (cf. also \ttt{integrate}, ' // & '\ttt{?vis\_channels})')) end subroutine var_list_set_phase_space_defaults @ %def var_list_set_phase_space_defaults @ <>= procedure :: set_gamelan_defaults => var_list_set_gamelan_defaults <>= subroutine var_list_set_gamelan_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_int (& var_str ("n_bins"), 20, & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: integer value that sets the number of bins in histograms. ' // & '(cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // & '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // & '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, ' // & '\ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (& var_str ("?normalize_bins"), .false., & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that determines whether the weights shall be normalized ' // & 'to the bin width or not. (cf. also \ttt{n\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\newline \ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \newline ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options})')) call var_list%append_string (var_str ("$obs_label"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: this is a string variable \ttt{\$obs\_label = "{\em ' // & '}"} that allows to attach a label to a plotted ' // & 'or histogrammed observable. (cf. also \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$obs_unit"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: this is a string variable \ttt{\$obs\_unit = "{\em ' // & '}"} that allows to attach a \LaTeX\ physical unit ' // & 'to a plotted or histogrammed observable. (cf. also \ttt{n\_bins}, ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$title"), var_str (""), & intrinsic=.true., & description=var_str ('This string variable sets the title of ' // & 'a plot in a \whizard\ analysis setup, e.g. a histogram or an ' // & 'observable. The syntax is \ttt{\$title = "{\em }"}. ' // & 'This title appears as a section header in the analysis file, ' // & 'but not in the screen output of the analysis. (cf. also \ttt{n\_bins}, ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \newline \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$description"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to specify ' // & 'a description text for the analysis, \ttt{\$description = "{\em ' // & '}"}. This line appears below the title ' // & 'of a corresponding analysis, on top of the respective plot. ' // & '(cf. also \ttt{analysis}, \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_unit}, \ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, ' // & '\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$x_label"), var_str (""), & intrinsic=.true., & description=var_str ('String variable, \ttt{\$x\_label = "{\em ' // & '}"}, that sets the $x$ axis label in a plot or ' // & 'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // & '\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$y\_label}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_string (var_str ("$y_label"), var_str (""), & intrinsic=.true., & description=var_str ('String variable, \ttt{\$y\_label = "{\em ' // & '}"}, that sets the $y$ axis label in a plot or ' // & 'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // & '\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{?y\_log}, ' // & '\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // & '\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})')) call var_list%append_int (var_str ("graph_width_mm"), 130, & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: integer value that sets the width of a graph or histogram ' // & 'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // & '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_int (var_str ("graph_height_mm"), 90, & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: integer value that sets the height of a graph or histogram ' // & 'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // & '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?y_log"), .false., & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that makes the $y$ axis logarithmic. (cf. also ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // & '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // & '\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (var_str ("?x_log"), .false., & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that makes the $x$ axis logarithmic. (cf. also ' // & '\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // & '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // & '\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // & '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // & '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_real (var_str ("x_min"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the lower limit of the $x$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_real (var_str ("x_max"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the upper limit of the $x$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_min}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_real (var_str ("y_min"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the lower limit of the $y$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_max}, \ttt{y\_max}, \ttt{x\_min}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_real (var_str ("y_max"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: real parameter that sets the upper limit of the $y$ ' // & 'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // & '\ttt{x\_max}, \ttt{x\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$gmlcode_bg"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: string variable that allows to define a background ' // & 'for plots and histograms (i.e. it is overwritten by the plot/histogram), ' // & 'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // & 'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$gmlcode_fg"), var_str (""), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: string variable that allows to define a foreground ' // & 'for plots and histograms (i.e. it overwrites the plot/histogram), ' // & 'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // & 'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_histogram"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to either plot data as a ' // & 'histogram or as a continuous line (if $\to$ \ttt{?draw\_curve} ' // & 'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_base"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to insert a \ttt{base} statement ' // & 'in the analysis code to calculate the plot data from a data ' // & 'set. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{\$symbol}, \newline \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\newline \ttt{\$err\_options})')) call var_list%append_log (var_str ("?draw_piecewise"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to data from a data set piecewise, ' // & 'i.e. histogram style. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, ' // & '\ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_base}, \ttt{?fill\_curve}, ' // & '\ttt{\$symbol}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options})')) call var_list%append_log (var_str ("?fill_curve"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to fill data curves (e.g. ' // & 'as a histogram). The style can be set with $\to$ \ttt{\$fill\_options ' // & '= "{\em }"}. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_curve"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that tells \whizard\ to either plot data as a ' // & 'continuous line or as a histogram (if $\to$ \ttt{?draw\_histogram} ' // & 'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\ttt{?draw\_histogram}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // & '\ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_errors"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that determines whether error bars should be drawn ' // & 'or not. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\newline \ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_log (var_str ("?draw_symbols"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: flag that determines whether particular symbols (specified ' // & 'by $\to$ \ttt{\$symbol = "{\em }"}) should be ' // & 'used for plotting data points (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\ttt{?fill\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_curve}, ' // & '\ttt{?draw\_errors}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // & '\newline \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$fill_options"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$fill\_options = "{\em }"} is a ' // & 'string variable that allows to set fill options when plotting ' // & 'data as filled curves with the $\to$ \ttt{?fill\_curve} flag. ' // & 'For more details see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // & '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // & '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // & '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // & '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // & '\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // & '\newline \ttt{?draw\_symbols}, \ttt{?fill\_curve}, \ttt{\$draw\_options}, ' // & '\ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$draw_options"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$draw\_options = "{\em }"} is a ' // & 'string variable that allows to set specific drawing options ' // & 'for plots and histograms. For more details see the \gamelan\ ' // & 'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // & '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // & '\ttt{?draw\_histogram}, \ttt{\$err\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$err_options"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$err\_options = "{\em }"} is a string ' // & 'variable that allows to set specific drawing options for errors ' // & 'in plots and histograms. For more details see the \gamelan\ ' // & 'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // & '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // & '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // & '\ttt{?draw\_histogram}, \ttt{\$draw\_options}, \ttt{\$symbol})')) call var_list%append_string (var_str ("$symbol"), & intrinsic=.true., & description=var_str ("Settings for \whizard's internal graphics " // & 'output: \ttt{\$symbol = "{\em }"} is a string ' // & 'variable for the symbols that should be used for plotting data ' // & 'points. (cf. also \ttt{\$obs\_label}, \ttt{?normalize\_bins}, ' // & '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // & '\ttt{\$y\_label}, \newline \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // & '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // & '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // & '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // & '\newline \ttt{?draw\_histogram}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // & '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \newline \ttt{\$err\_options}, ' // & '\ttt{?draw\_symbols})')) call var_list%append_log (& var_str ("?analysis_file_only"), .false., & intrinsic=.true., & description=var_str ('Allows to specify that only \LaTeX\ files ' // & "for \whizard's graphical analysis are written out, but not processed. " // & '(cf. \ttt{compile\_analysis}, \ttt{write\_analysis})')) end subroutine var_list_set_gamelan_defaults @ %def var_list_set_gamelan_defaults @ FastJet parameters and friends <>= procedure :: set_clustering_defaults => var_list_set_clustering_defaults <>= subroutine var_list_set_clustering_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_int (& var_str ("kt_algorithm"), & kt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the ' // & 'interfaced external \fastjet\ package. (cf. also ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, ' // & '\ttt{plugin\_algorithm}, ' // & '\newline\ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})')) call var_list%append_int (& var_str ("cambridge_algorithm"), & cambridge_algorithm, intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("antikt_algorithm"), & antikt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("genkt_algorithm"), & genkt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_for\_passive\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r}), \ttt{jet\_p}')) call var_list%append_int (& var_str ("cambridge_for_passive_algorithm"), & cambridge_for_passive_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_algorithm}, \ttt{plugin\_algorithm}, \newline ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("genkt_for_passive_algorithm"), & genkt_for_passive_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})')) call var_list%append_int (& var_str ("ee_kt_algorithm"), & ee_kt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_genkt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("ee_genkt_algorithm"), & ee_genkt_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_kt\_algorithm}, ' // & '\ttt{jet\_r}), \ttt{jet\_p})')) call var_list%append_int (& var_str ("plugin_algorithm"), & plugin_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('Specifies a jet algorithm for the ($\to$) ' // & '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // & 'subevent function. At the moment only available for the interfaced ' // & 'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r})')) call var_list%append_int (& var_str ("undefined_jet_algorithm"), & undefined_jet_algorithm, & intrinsic = .true., locked = .true., & description=var_str ('This is just a place holder for any kind of jet ' // & 'jet algorithm that is not further specified. (cf. also \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // & '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // & '\ttt{jet\_r}, \ttt{plugin\_algorithm})')) call var_list%append_int (& var_str ("jet_algorithm"), undefined_jet_algorithm, & intrinsic = .true., & description=var_str ('Variable that allows to set the type of ' // & 'jet algorithm when using the external \fastjet\ library. It ' // & 'accepts one of the following algorithms: ($\to$) \ttt{kt\_algorithm}, ' // & '\newline ($\to$) \ttt{cambridge\_[for\_passive\_]algorithm}, ' // & '($\to$) \ttt{antikt\_algorithm}, ($\to$) \ttt{plugin\_algorithm}, ' // & '($\to$) \ttt{genkt\_[for\_passive\_]algorithm}, ($\to$) ' // & '\ttt{ee\_[gen]kt\_algorithm}). (cf. also \ttt{cluster}, ' // & '\ttt{jet\_p}, \ttt{jet\_r}, \ttt{jet\_ycut})')) call var_list%append_real (& var_str ("jet_r"), 0._default, & intrinsic = .true., & description=var_str ('Value for the distance measure $R$ used in ' // & 'some algorithms that are available via the interface ' // & 'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // & '\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // & '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_ycut})')) call var_list%append_real (& var_str ("jet_p"), 0._default, & intrinsic = .true., & description=var_str ('Value for the exponent of the distance measure $R$ in ' // & 'the generalized $k_T$ algorithms that are available via the interface ' // & 'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // & '\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // & '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r}, \newline\ttt{jet\_ycut})')) call var_list%append_real (& var_str ("jet_ycut"), 0._default, & intrinsic = .true., & description=var_str ('Value for the $y$ separation measure used in ' // & 'the Cambridge-Aachen algorithms that are available via the interface ' // & 'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // & '\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // & '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})')) call var_list%append_real (& var_str ("jet_dcut"), 0._default, & intrinsic = .true., & description=var_str ('Value for the $d_{ij}$ separation measure used in ' // & 'the $e^+e^- k_T$ algorithms that are available via the interface ' // & 'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // & '\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // & '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // & '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // & '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})')) call var_list%append_log (& var_str ("?keep_flavors_when_clustering"), .false., & intrinsic = .true., & description=var_str ('The logical variable \ttt{?keep\_flavors\_when\_clustering ' // & '= true/false} specifies whether the flavor of a jet should be ' // & 'kept during \ttt{cluster} when a jet consists of one quark and ' // & 'zero or more gluons. Especially useful for cuts on b-tagged ' // & 'jets (cf. also \ttt{cluster}).')) end subroutine var_list_set_clustering_defaults @ %def var_list_set_clustering_defaults @ Frixione isolation parameters and all that: <>= procedure :: set_isolation_defaults => var_list_set_isolation_defaults <>= subroutine var_list_set_isolation_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_real (var_str ("photon_iso_eps"), 1._default, & intrinsic=.true., & description=var_str ('Photon isolation parameter $\epsilon_\gamma$ ' // & '(energy fraction) from hep-ph/9801442 (cf. also ' // & '\ttt{photon\_iso\_n}, \ttt{photon\_iso\_r0})')) call var_list%append_real (var_str ("photon_iso_n"), 1._default, & intrinsic=.true., & description=var_str ('Photon isolation parameter $n$ ' // & '(cone function exponent) from hep-ph/9801442 (cf. also ' // & '\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_r0})')) call var_list%append_real (var_str ("photon_iso_r0"), 0.4_default, & intrinsic=.true., & description=var_str ('Photon isolation parameter $R_0^\gamma$ ' // & '(isolation cone radius) from hep-ph/9801442 (cf. also ' // & '\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_n})')) end subroutine var_list_set_isolation_defaults @ %def var_list_set_isolation_defaults <>= procedure :: set_eio_defaults => var_list_set_eio_defaults <>= subroutine var_list_set_eio_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$sample"), var_str (""), & intrinsic=.true., & description=var_str ('String variable to set the (base) name ' // & 'of the event output format, e.g. \ttt{\$sample = "foo"} will ' // & 'result in an intrinsic binary format event file \ttt{foo.evx}. ' // & '(cf. also \ttt{sample\_format}, \ttt{simulate}, \ttt{hepevt}, ' // & '\ttt{ascii}, \ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, ' // & '\ttt{hepmc}, \ttt{lhef}, \ttt{lha}, \ttt{stdhep}, \ttt{stdhep\_up}, ' // & '\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, \ttt{sample\_max\_tries})')) call var_list%append_string (var_str ("$sample_normalization"), var_str ("auto"),& intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'normalization of generated events. There are four options: ' // & 'option \ttt{"1"} (events normalized to one), \ttt{"1/n"} (sum ' // & 'of all events in a sample normalized to one), \ttt{"sigma"} ' // & '(events normalized to the cross section of the process), and ' // & '\ttt{"sigma/n"} (sum of all events normalized to the cross ' // & 'section). The default is \ttt{"auto"} where unweighted events ' // & 'are normalized to one, and weighted ones to the cross section. ' // & '(cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?sample\_pacify}, \ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // & '\ttt{sample\_split\_n\_kbytes})')) call var_list%append_log (var_str ("?sample_pacify"), .false., & intrinsic=.true., & description=var_str ('Flag, mainly for debugging purposes: suppresses ' // & 'numerical noise in the output of a simulation. (cf. also \ttt{simulate}, ' // & '\ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}, ' // & '\ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // & '\ttt{sample\_split\_n\_kbytes})')) call var_list%append_log (var_str ("?sample_select"), .true., & intrinsic=.true., & description=var_str ('Logical that determines whether a selection should ' // & 'be applied to the output event format or not. If set to \ttt{false} a ' // & 'selection is only considered for the evaluation of observables. (cf. ' // & '\ttt{select}, \ttt{selection}, \ttt{analysis})')) call var_list%append_int (var_str ("sample_max_tries"), 10000, & intrinsic = .true., & description=var_str ('Integer variable that sets the maximal ' // & 'number of tries for generating a single event. The event might ' // & 'be vetoed because of a very low unweighting efficiency, errors ' // & 'in the event transforms like decays, shower, matching, hadronization ' // & 'etc. (cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{?sample\_pacify}, \ttt{\$sample\_normalization}, ' // & '\ttt{sample\_split\_n\_evt}, \newline\ttt{sample\_split\_n\_kbytes})')) call var_list%append_int (var_str ("sample_split_n_evt"), 0, & intrinsic = .true., & description=var_str ('When generating events, this integer parameter ' // & '\ttt{sample\_split\_n\_evt = {\em }} gives the number \ttt{{\em ' // & '}} of breakpoints in the event files, i.e. it splits the ' // & 'event files into \ttt{{\em } + 1} parts. The parts are ' // & 'denoted by \ttt{{\em }.{\em }.{\em ' // & '}}. Here, \ttt{{\em }} is an integer ' // & 'running from \ttt{0} to \ttt{{\em }}. The start can be ' // & 'reset by ($\to$) \ttt{sample\_split\_index}. (cf. also \ttt{simulate}, ' // & '\ttt{\$sample}, \ttt{sample\_format}, \ttt{sample\_max\_tries}, ' // & '\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, ' // & '\ttt{sample\_split\_n\_kbytes})')) call var_list%append_int (var_str ("sample_split_n_kbytes"), 0, & intrinsic = .true., & description=var_str ('When generating events, this integer parameter ' // & '\ttt{sample\_split\_n\_kbytes = {\em }} limits the file ' // & 'size of event files. Whenever an event file has exceeded this ' // & 'size, counted in kilobytes, the following events will be written ' // & 'to a new file. The naming conventions are the same as for ' // & '\ttt{sample\_split\_n\_evt}. (cf. also \ttt{simulate}, \ttt{\$sample}, ' // & '\ttt{sample\_format}, \ttt{sample\_max\_tries}, \ttt{\$sample\_normalization}, ' // & '\ttt{?sample\_pacify})')) call var_list%append_int (var_str ("sample_split_index"), 0, & intrinsic = .true., & description=var_str ('Integer number that gives the starting ' // & 'index \ttt{sample\_split\_index = {\em }} for ' // & 'the numbering of event samples \ttt{{\em }.{\em ' // & '}.{\em }} split by the \ttt{sample\_split\_n\_evt ' // & '= {\em }}. The index runs from \ttt{{\em }} ' // & 'to \newline \ttt{{\em } + {\em }}. (cf. also \ttt{simulate}, ' // & '\ttt{\$sample}, \ttt{sample\_format}, \newline\ttt{\$sample\_normalization}, ' // & '\ttt{sample\_max\_tries}, \ttt{?sample\_pacify})')) call var_list%append_string (var_str ("$rescan_input_format"), var_str ("raw"), & intrinsic=.true., & description=var_str ('String variable that allows to set the ' // & 'event format of the event file that is to be rescanned by the ' // & '($\to$) \ttt{rescan} command.')) call var_list%append_log (var_str ("?read_raw"), .true., & intrinsic=.true., & description=var_str ('This flag demands \whizard\ to (try to) ' // & 'read events (from the internal binary format) first before ' // & 'generating new ones. (cf. \ttt{simulate}, \ttt{?write\_raw}, ' // & '\ttt{\$sample}, \ttt{sample\_format})')) call var_list%append_log (var_str ("?write_raw"), .true., & intrinsic=.true., & description=var_str ("Flag to write out events in \whizard's " // & 'internal binary format. (cf. \ttt{simulate}, \ttt{?read\_raw}, ' // & '\ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_raw"), var_str ("evx"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_raw ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & "to which events in \whizard's internal format are written. If " // & 'not set, the default file name and suffix is \ttt{{\em }.evx}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_default"), var_str ("evt"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_default ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in a the standard \whizard\ verbose ASCII format ' // & 'are written. If not set, the default file name and suffix is ' // & '\ttt{{\em }.evt}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) call var_list%append_string (var_str ("$debug_extension"), var_str ("debug"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$debug\_extension ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in a long verbose format with debugging information ' // & 'are written. If not set, the default file name and suffix is ' // & '\ttt{{\em }.debug}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{?debug\_process}, \ttt{?debug\_transforms}, ' // & '\ttt{?debug\_decay}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_process"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether process information ' // & 'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // & '\ttt{?debug\_decay}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_transforms"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether information ' // & 'about event transforms will be displayed in the ASCII debug ' // & 'event format ($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{?debug\_decay}, \ttt{\$debug\_extension}, ' // & '\ttt{?debug\_process}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_decay"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether decay information ' // & 'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // & '\ttt{?debug\_process}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})')) call var_list%append_log (var_str ("?debug_verbose"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether extensive verbose ' // & 'information will be included in the ASCII debug event format ' // & '($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, \ttt{\$sample}, ' // & '\ttt{\$debug\_extension}, \ttt{?debug\_decay}, \ttt{?debug\_transforms}, ' // & '\ttt{?debug\_process})')) call var_list%append_string (var_str ("$dump_extension"), var_str ("pset.dat"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$dump\_extension ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & "to which events in \whizard's internal particle set format " // & 'are written. If not set, the default file name and suffix is ' // & '\ttt{{\em }.pset.dat}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?dump_compressed"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, issues ' // & 'a very compressed and clear version of the \ttt{dump} ($\to$) ' // & 'event format. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{\$dump\_extension}, ' // & '\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?dump_weights"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, includes ' // & 'cross sections, weights and excess in the \ttt{dump} ($\to$) ' // & 'event format. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_summary})')) call var_list%append_log (var_str ("?dump_summary"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, includes ' // & 'a summary with momentum sums for incoming and outgoing particles ' // & 'as well as for beam remnants in the \ttt{dump} ($\to$) ' // & 'event format. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?dump_screen"), .false., & intrinsic=.true., & description=var_str ('Flag that, if set to \ttt{true}, outputs ' // & 'events for the \ttt{dump} ($\to$) event format on screen ' // & ' instead of to a file. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // & '\ttt{\$dump\_extension}, \ttt{?dump\_summary}, \ttt{?dump\_weights})')) call var_list%append_log (var_str ("?hepevt_ensure_order"), .false., & intrinsic=.true., & description=var_str ('Flag to ensure that the particle set confirms ' // & 'the HEPEVT standard. This involves some copying and reordering ' // & 'to guarantee that mothers and daughters are always next to ' // & 'each other. Usually this is not necessary.')) call var_list%append_string (var_str ("$extension_hepevt"), var_str ("hepevt"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_hepevt ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the \whizard\ version 1 style HEPEVT ASCII ' // & 'format are written. If not set, the default file name and suffix ' // & 'is \ttt{{\em }.hepevt}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) call var_list%append_string (var_str ("$extension_ascii_short"), & var_str ("short.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_short ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the so called short variant of the \whizard\ ' // & 'version 1 style HEPEVT ASCII format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.short.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_ascii_long"), & var_str ("long.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_long ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the so called long variant of the \whizard\ ' // & 'version 1 style HEPEVT ASCII format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.long.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_athena"), & var_str ("athena.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_athena ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the ATHENA file format are written. If not ' // & 'set, the default file name and suffix is \ttt{{\em }.athena.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_mokka"), & var_str ("mokka.evt"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_mokka ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the MOKKA format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.mokka.evt}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$lhef_version"), var_str ("2.0"), & intrinsic = .true., & description=var_str ('Specifier for the Les Houches Accord (LHEF) ' // & 'event format files with XML headers to discriminate among different ' // & 'versions of this format. (cf. also \ttt{\$sample}, \ttt{sample\_format}, ' // & '\ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // & '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref}, ' // & '\ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_string (var_str ("$lhef_extension"), var_str ("lhe"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$lhef\_extension ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the LHEF format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.lhe}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{lhef}, ' // & '\ttt{\$lhef\_extension}, \ttt{\$lhef\_version}, \ttt{?lhef\_write\_sqme\_prc}, ' // & '\ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_log (var_str ("?lhef_write_sqme_prc"), .true., & intrinsic = .true., & description=var_str ('Flag that decides whether in the ($\to$) ' // & '\ttt{lhef} event format the weights of the squared matrix element ' // & 'of the corresponding process shall be written in the LHE file. ' // & '(cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{lhef}, ' // & '\ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_ref}, ' // & '\newline \ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_log (var_str ("?lhef_write_sqme_ref"), .false., & intrinsic = .true., & description=var_str ('Flag that decides whether in the ($\to$) ' // & '\ttt{lhef} event format reference weights of the squared matrix ' // & 'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // & '\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // & '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_alt})')) call var_list%append_log (var_str ("?lhef_write_sqme_alt"), .true., & intrinsic = .true., & description=var_str ('Flag that decides whether in the ($\to$) ' // & '\ttt{lhef} event format alternative weights of the squared matrix ' // & 'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // & '\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // & '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref})')) call var_list%append_string (var_str ("$extension_lha"), var_str ("lha"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_lha ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the (deprecated) LHA format are written. ' // & 'If not set, the default file name and suffix is \ttt{{\em }.lha}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_hepmc"), var_str ("hepmc"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_hepmc ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the HepMC format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.hepmc}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_log (var_str ("?hepmc_output_cross_section"), .false., & intrinsic = .true., & description=var_str ('Flag for the HepMC event format that allows ' // & 'to write out the cross section (and error) from the integration ' // & 'together with each HepMC event. This can be used by programs ' // & 'like Rivet to scale histograms according to the cross section. ' // & '(cf. also \ttt{hepmc})')) call var_list%append_string (var_str ("$hepmc3_mode"), var_str ("HepMC3"), & intrinsic = .true., & description=var_str ('This specifies the writer mode for HepMC3. ' // & 'Possible values are \ttt{HepMC2}, \ttt{HepMC3} (default), ' // & '\ttt{HepEVT}, \ttt{Root}. and \ttt{RootTree} (cf. also \ttt{hepmc})')) call var_list%append_string (var_str ("$extension_lcio"), var_str ("slcio"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_lcio ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the LCIO format are written. If not set, ' // & 'the default file name and suffix is \ttt{{\em }.slcio}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_stdhep"), var_str ("hep"), & intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_stdhep ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the StdHEP format via the HEPEVT common ' // & 'block are written. If not set, the default file name and suffix ' // & 'is \ttt{{\em }.hep}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) call var_list%append_string (var_str ("$extension_stdhep_up"), & var_str ("up.hep"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_up ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the StdHEP format via the HEPRUP/HEPEUP ' // & 'common blocks are written. \ttt{{\em }.up.hep} ' // & 'is the default file name and suffix, if this variable not set. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_stdhep_ev4"), & var_str ("ev4.hep"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_ev4 ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the StdHEP format via the HEPEVT/HEPEV4 ' // & 'common blocks are written. \ttt{{\em }.up.hep} ' // & 'is the default file name and suffix, if this variable not set. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_hepevt_verb"), & var_str ("hepevt.verb"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_hepevt\_verb ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the \whizard\ version 1 style extended or ' // & 'verbose HEPEVT ASCII format are written. If not set, the default ' // & 'file name and suffix is \ttt{{\em }.hepevt.verb}. ' // & '(cf. also \ttt{sample\_format}, \ttt{\$sample})')) call var_list%append_string (var_str ("$extension_lha_verb"), & var_str ("lha.verb"), intrinsic=.true., & description=var_str ('String variable that allows via \ttt{\$extension\_lha\_verb ' // & '= "{\em }"} to specify the suffix for the file \ttt{name.suffix} ' // & 'to which events in the (deprecated) extended or verbose LHA ' // & 'format are written. If not set, the default file name and suffix ' // & 'is \ttt{{\em }.lha.verb}. (cf. also \ttt{sample\_format}, ' // & '\ttt{\$sample})')) end subroutine var_list_set_eio_defaults @ %def var_list_set_eio_defaults @ <>= procedure :: set_shower_defaults => var_list_set_shower_defaults <>= subroutine var_list_set_shower_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?allow_shower"), .true., & intrinsic=.true., & description=var_str ('Master flag to switch on (initial and ' // & 'final state) parton shower, matching/merging as an event ' // & 'transform. As a default, it is switched on. (cf. also \ttt{?ps\_ ' // & '....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_fsr_active"), .false., & intrinsic=.true., & description=var_str ('Flag that switches final-state QCD radiation ' // & '(FSR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_active"), .false., & intrinsic=.true., & description=var_str ('Flag that switches initial-state QCD ' // & 'radiation (ISR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_taudec_active"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on $\tau$ decays, at ' // & 'the moment only via the included external package \ttt{TAUOLA} ' // & 'and \ttt{PHOTOS}. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?muli_active"), .false., & intrinsic=.true., & description=var_str ("Master flag that switches on \whizard's " // & 'module for multiple interaction with interleaved QCD parton ' // & 'showers for hadron colliders. Note that this feature is still ' // & 'experimental. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})')) call var_list%append_string (var_str ("$shower_method"), var_str ("WHIZARD"), & intrinsic=.true., & description=var_str ('String variable that allows to specify ' // & 'which parton shower is being used, the default, \ttt{"WHIZARD"}, ' // & 'is one of the in-house showers of \whizard. Other possibilities ' // & 'at the moment are only \ttt{"PYTHIA6"}.')) call var_list%append_log (var_str ("?shower_verbose"), .false., & intrinsic=.true., & description=var_str ('Flag to switch on verbose messages when ' // & 'using shower and/or hadronization. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...},')) call var_list%append_string (var_str ("$ps_PYTHIA_PYGIVE"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass options ' // & 'for tunes etc. to the attached \pythia\ parton shower or hadronization, ' // & 'e.g.: \ttt{\$ps\_PYTHIA\_PYGIVE = "MSTJ(41)=1"}. (cf. also ' // & '\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_string (var_str ("$ps_PYTHIA8_config"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass options ' // & 'for tunes etc. to the attached \pythia\ttt{8} parton shower or hadronization, ' // & 'e.g.: \ttt{\$ps\_PYTHIA8\_config = "PartonLevel:MPI = off"}. (cf. also ' // & '\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_string (var_str ("$ps_PYTHIA8_config_file"), var_str (""), & intrinsic=.true., & description=var_str ('String variable that allows to pass a filename to a ' // & '\pythia\ttt{8} configuration file.')) call var_list%append_real (& var_str ("ps_mass_cutoff"), 1._default, intrinsic = .true., & description=var_str ('Real value that sets the QCD parton shower ' // & 'lower cutoff scale, where hadronization sets in. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (& var_str ("ps_fsr_lambda"), 0.29_default, intrinsic = .true., & description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // & 'used in running $\alpha_s$ for time-like showers is set (except ' // & 'for showers in the decay of a resonance). (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (& var_str ("ps_isr_lambda"), 0.29_default, intrinsic = .true., & description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // & 'used in running $\alpha_s$ for space-like showers is set. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_int (& var_str ("ps_max_n_flavors"), 5, intrinsic = .true., & description=var_str ('This integer parameter sets the maxmimum ' // & 'number of flavors that can be produced in a QCD shower $g\to ' // & 'q\bar q$. It is also used as the maximal number of active flavors ' // & 'for the running of $\alpha_s$ in the shower (with a minimum ' // & 'of 3). (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_alphas_running"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether a running ' // & '$\alpha_s$ is taken in space-like QCD parton showers. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_fsr_alphas_running"), .true., & intrinsic=.true., & description=var_str ('Flag that decides whether a running ' // & '$\alpha_s$ is taken in time-like QCD parton showers. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str ("ps_fixed_alphas"), & 0._default, intrinsic = .true., & description=var_str ('This real parameter sets the value of $\alpha_s$ ' // & 'if it is (cf. $\to$ \ttt{?ps\_isr\_alphas\_running}, \newline ' // & '\ttt{?ps\_fsr\_alphas\_running}) not running in initial and/or ' // & 'final-state QCD showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_pt_ordered"), .false., & intrinsic=.true., & description=var_str ('By this flag, it can be switched between ' // & 'the analytic QCD ISR shower (\ttt{false}, default) and the ' // & '$p_T$ ISR QCD shower (\ttt{true}). (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str ("?ps_isr_angular_ordered"), .true., & intrinsic=.true., & description=var_str ('If switched one, this flag forces opening ' // & 'angles of emitted partons in the QCD ISR shower to be strictly ' // & 'ordered, i.e. increasing towards the hard interaction. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_primordial_kt_width"), 0._default, intrinsic = .true., & description=var_str ('This real parameter sets the width $\sigma ' // & '= \braket{k_T^2}$ for the Gaussian primordial $k_T$ distribution ' // & 'inside the hadron, given by: $\exp[-k_T^2/\sigma^2] k_T dk_T$. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_primordial_kt_cutoff"), 5._default, intrinsic = .true., & description=var_str ('Real parameter that sets the upper cutoff ' // & 'for the primordial $k_T$ distribution inside a hadron. (cf. ' // & 'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // & '\ttt{?hadronization\_active}, \ttt{?mlm\_ ...})')) call var_list%append_real (var_str & ("ps_isr_z_cutoff"), 0.999_default, intrinsic = .true., & description=var_str ('This real parameter allows to set the upper ' // & 'cutoff on the splitting variable $z$ in space-like QCD parton ' // & 'showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_minenergy"), 1._default, intrinsic = .true., & description=var_str ('By this real parameter, the minimal effective ' // & 'energy (in the c.m. frame) of a time-like or on-shell-emitted ' // & 'parton in a space-like QCD shower is set. For a hard subprocess ' // & 'that is not in the rest frame, this number is roughly reduced ' // & 'by a boost factor $1/\gamma$ to the rest frame of the hard scattering ' // & 'process. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("ps_isr_tscalefactor"), 1._default, intrinsic = .true., & description=var_str ('The $Q^2$ scale of the hard scattering ' // & 'process is multiplied by this real factor to define the maximum ' // & 'parton virtuality allowed in time-like QCD showers. This does ' // & 'only apply to $t$- and $u$-channels, while for $s$-channel resonances ' // & 'the maximum virtuality is set by $m^2$. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_log (var_str & ("?ps_isr_only_onshell_emitted_partons"), .false., intrinsic=.true., & description=var_str ('This flag if set true sets all emitted ' // & 'partons off space-like showers on-shell, i.e. it would not allow ' // & 'associated time-like showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})')) end subroutine var_list_set_shower_defaults @ %def var_list_set_shower_defaults @ <>= procedure :: set_hadronization_defaults => var_list_set_hadronization_defaults <>= subroutine var_list_set_hadronization_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log & (var_str ("?allow_hadronization"), .true., intrinsic=.true., & description=var_str ('Master flag to switch on hadronization ' // & 'as an event transform. As a default, it is switched on. (cf. ' // & 'also \ttt{?ps\_ ....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, ' // & '\ttt{?hadronization\_active})')) call var_list%append_log & (var_str ("?hadronization_active"), .false., intrinsic=.true., & description=var_str ('Master flag to switch hadronization (through ' // & 'the attached \pythia\ package) on or off. As a default, it is ' // & 'off. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...})')) call var_list%append_string & (var_str ("$hadronization_method"), var_str ("PYTHIA6"), intrinsic = .true., & description=var_str ("Determines whether \whizard's own " // & "hadronization or the (internally included) \pythiasix\ should be used.")) call var_list%append_real & (var_str ("hadron_enhanced_fraction"), 0.01_default, intrinsic = .true., & description=var_str ('Fraction of Lund strings that break with enhanced ' // & 'width. [not yet active]')) call var_list%append_real & (var_str ("hadron_enhanced_width"), 2.0_default, intrinsic = .true., & description=var_str ('Enhancement factor for the width of breaking ' // & 'Lund strings. [not yet active]')) end subroutine var_list_set_hadronization_defaults @ %def var_list_set_hadronization_defaults @ <>= procedure :: set_tauola_defaults => var_list_set_tauola_defaults <>= subroutine var_list_set_tauola_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (& var_str ("?ps_tauola_photos"), .false., intrinsic=.true., & description=var_str ('Flag to switch on \ttt{PHOTOS} for photon ' // & 'showering inside the \ttt{TAUOLA} package. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_log (& var_str ("?ps_tauola_transverse"), .false., intrinsic=.true., & description=var_str ('Flag to switch transverse $\tau$ polarization ' // & 'on or off for Higgs decays into $\tau$ leptons. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_log (& var_str ("?ps_tauola_dec_rad_cor"), .true., intrinsic=.true., & description=var_str ('Flag to switch radiative corrections for ' // & '$\tau$ decays in \ttt{TAUOLA} on or off. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_int (& var_str ("ps_tauola_dec_mode1"), 0, intrinsic = .true., & description=var_str ('Integer code to request a specific $\tau$ ' // & 'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // & 'in correlated decays -- for the second $\tau$. For more information ' // & 'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_int (& var_str ("ps_tauola_dec_mode2"), 0, intrinsic = .true., & description=var_str ('Integer code to request a specific $\tau$ ' // & 'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // & 'in correlated decays -- for the second $\tau$. For more information ' // & 'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_real (& var_str ("ps_tauola_mh"), 125._default, intrinsic = .true., & description=var_str ('Real option to set the Higgs mass for Higgs ' // & 'decays into $\tau$ leptons in the interface to \ttt{TAUOLA}. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_real (& var_str ("ps_tauola_mix_angle"), 90._default, intrinsic = .true., & description=var_str ('Option to set the mixing angle between ' // & 'scalar and pseudoscalar Higgs bosons for Higgs decays into $\tau$ ' // & 'leptons in the interface to \ttt{TAUOLA}. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) call var_list%append_log (& var_str ("?ps_tauola_pol_vector"), .false., intrinsic = .true., & description=var_str ('Flag to decide whether for transverse $\tau$ ' // & 'polarization, polarization information should be taken from ' // & '\ttt{TAUOLA} or not. The default is just based on random numbers. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})')) end subroutine var_list_set_tauola_defaults @ %def var_list_set_tauola_defaults @ <>= procedure :: set_mlm_matching_defaults => var_list_set_mlm_matching_defaults <>= subroutine var_list_set_mlm_matching_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?mlm_matching"), .false., & intrinsic=.true., & description=var_str ('Master flag to switch on MLM (LO) jet ' // & 'matching between hard matrix elements and the QCD parton ' // & 'shower. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // & '\ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Qcut_ME"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that in the MLM jet matching ' // & 'between hard matrix elements and QCD parton shower sets a possible ' // & 'virtuality cut on jets from the hard matrix element. (cf. also ' // & '\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // & '...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Qcut_PS"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that in the MLM jet matching ' // & 'between hard matrix elements and QCD parton shower sets a possible ' // & 'virtuality cut on jets from the parton shower. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_ptmin"), 0._default, intrinsic = .true., & description=var_str ('This real parameter sets a minimal $p_T$ ' // & 'that enters the $y_{cut}$ jet clustering measure in the MLM ' // & 'jet matching between hard matrix elements and QCD parton showers. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_etamax"), 0._default, intrinsic = .true., & description=var_str ('This real parameter sets a maximal pseudorapidity ' // & 'that enters the MLM jet matching between hard matrix elements ' // & 'and QCD parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Rmin"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that sets a minimal $R$ ' // & 'distance value that enters the $y_{cut}$ jet clustering measure ' // & 'in the MLM jet matching between hard matrix elements and QCD ' // & 'parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // & '...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Emin"), 0._default, intrinsic = .true., & description=var_str ('Real parameter that sets a minimal energy ' // & '$E_{min}$ value as an infrared cutoff in the MLM jet matching ' // & 'between hard matrix elements and QCD parton showers. (cf. also ' // & '\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // & '...}, \ttt{?hadronization\_active})')) call var_list%append_int (var_str & ("mlm_nmaxMEjets"), 0, intrinsic = .true., & description=var_str ('This integer sets the maximal number of ' // & 'jets that are available from hard matrix elements in the MLM ' // & 'jet matching between hard matrix elements and QCD parton shower. ' // & '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // & '...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_ETclusfactor"), 0.2_default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_ETclusminE"), 5._default, intrinsic = .true., & description=var_str ('This real parameter is a minimal energy ' // & 'that enters the calculation of the $y_{cut}$ measure for jet ' // & 'clustering after the parton shower in the MLM jet matching between ' // & 'hard matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_etaclusfactor"), 1._default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Rclusfactor"), 1._default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) call var_list%append_real (var_str & ("mlm_Eclusfactor"), 1._default, intrinsic = .true., & description=var_str ('This real parameter is a factor that enters ' // & 'the calculation of the $y_{cut}$ measure for jet clustering ' // & 'after the parton shower in the MLM jet matching between hard ' // & 'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // & '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})')) end subroutine var_list_set_mlm_matching_defaults @ %def var_list_set_mlm_matching_defaults @ <>= procedure :: set_powheg_matching_defaults => & var_list_set_powheg_matching_defaults <>= subroutine var_list_set_powheg_matching_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?powheg_matching"), & .false., intrinsic = .true., & description=var_str ('Activates Powheg matching. Needs to be ' // & 'combined with the \ttt{?combined\_nlo\_integration}-method.')) call var_list%append_log (var_str ("?powheg_use_singular_jacobian"), & .false., intrinsic = .true., & description=var_str ('This allows to give a different ' // & 'normalization of the Jacobian, resulting in an alternative ' // & 'POWHEG damping in the singular regions.')) call var_list%append_int (var_str ("powheg_grid_size_xi"), & 5, intrinsic = .true., & description=var_str ('Number of $\xi$ points in the POWHEG grid.')) call var_list%append_int (var_str ("powheg_grid_size_y"), & 5, intrinsic = .true., & description=var_str ('Number of $y$ points in the POWHEG grid.')) call var_list%append_int (var_str ("powheg_grid_sampling_points"), & 500000, intrinsic = .true., & description=var_str ('Number of calls used to initialize the ' // & 'POWHEG grid.')) call var_list%append_real (var_str ("powheg_pt_min"), & 1._default, intrinsic = .true., & description=var_str ('Lower $p_T$-cut-off for the POWHEG ' // & 'hardest emission.')) call var_list%append_real (var_str ("powheg_lambda"), & LAMBDA_QCD_REF, intrinsic = .true., & description=var_str ('Reference scale of the $\alpha_s$ evolution ' // & 'in the POWHEG matching algorithm.')) call var_list%append_log (var_str ("?powheg_test_sudakov"), & .false., intrinsic = .true., & description=var_str ('Performs an internal consistency check ' // & 'on the POWHEG event generation.')) call var_list%append_log (var_str ("?powheg_disable_sudakov"), & .false., intrinsic = .true., & description=var_str ('This flag allows to set the Sudakov form ' // & 'factor to one. This effectively results in a version of ' // & 'the matrix-element method (MEM) at NLO.')) end subroutine var_list_set_powheg_matching_defaults @ %def var_list_set_powheg_matching_defaults @ <>= procedure :: set_openmp_defaults => var_list_set_openmp_defaults <>= subroutine var_list_set_openmp_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?omega_openmp"), & openmp_is_active (), & intrinsic=.true., & description=var_str ('Flag to switch on or off OpenMP multi-threading ' // & "for \oMega\ matrix elements. (cf. also \ttt{\$method}, \ttt{\$omega\_flag})")) call var_list%append_log (var_str ("?openmp_is_active"), & openmp_is_active (), & locked=.true., intrinsic=.true., & description=var_str ('Flag to switch on or off OpenMP multi-threading ' // & 'for \whizard. (cf. also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, ' // & '\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})')) call var_list%append_int (var_str ("openmp_num_threads_default"), & openmp_get_default_max_threads (), & locked=.true., intrinsic=.true., & description=var_str ('Integer parameter that shows the number ' // & 'of default OpenMP threads for multi-threading. Note that this ' // & 'parameter can only be accessed, but not reset by the user. (cf. ' // & 'also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, \ttt{?omega\_openmp})')) call var_list%append_int (var_str ("openmp_num_threads"), & openmp_get_max_threads (), & intrinsic=.true., & description=var_str ('Integer parameter that sets the number ' // & 'of OpenMP threads for multi-threading. (cf. also \ttt{?openmp\_logging}, ' // & '\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})')) call var_list%append_log (var_str ("?openmp_logging"), & .true., intrinsic=.true., & description=var_str ('This logical -- when set to \ttt{false} ' // & '-- suppresses writing out messages about OpenMP parallelization ' // & '(number of used threads etc.) on screen and into the logfile ' // & '(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // & 'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // & '\ttt{?mpi\_logging})')) end subroutine var_list_set_openmp_defaults @ %def var_list_set_openmp_defaults @ <>= procedure :: set_mpi_defaults => var_list_set_mpi_defaults <>= subroutine var_list_set_mpi_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_log (var_str ("?mpi_logging"), & .false., intrinsic=.true., & description=var_str('This logical -- when set to \ttt{false} ' // & '-- suppresses writing out messages about MPI parallelization ' // & '(number of used workers etc.) on screen and into the logfile ' // & '(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // & 'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // & '\ttt{?openmp\_logging})')) end subroutine var_list_set_mpi_defaults @ %def var_list_set_mpi_defaults @ <>= procedure :: set_nlo_defaults => var_list_set_nlo_defaults <>= subroutine var_list_set_nlo_defaults (var_list) class(var_list_t), intent(inout) :: var_list call var_list%append_string (var_str ("$born_me_method"), & var_str (""), intrinsic = .true., & description=var_str ("This string variable specifies the method " // & "for the matrix elements to be used in the evaluation of the " // & "Born part of the NLO computation. The default is the empty string, " // & "i.e. the \ttt{\$method} being the intrinsic \oMega\ matrix element " // & 'generator (\ttt{"omega"}), other options ' // & 'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, ' // & '\ttt{"template\_unity"}, \ttt{"threshold"}, \ttt{"gosam"}, ' // & '\ttt{"openloops"}. Note that this option is inoperative if ' // & 'no NLO calculation is specified in the process definition. ' // & 'If you want ot use different matrix element methods in a LO ' // & 'computation, use the usual \ttt{method} command. (cf. also ' // & '\ttt{\$correlation\_me\_method}, ' // & '\ttt{\$dglap\_me\_method}, \ttt{\$loop\_me\_method} and ' // & '\ttt{\$real\_tree\_me\_method}.)')) call var_list%append_string (var_str ("$loop_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation of the ' // & 'virtual part of the NLO computation. The default is the empty string, ' // & 'i.e. the same as \ttt{\$method}. Working options are: ' // & '\ttt{"threshold"}, \ttt{"openloops"}, \ttt{"recola"}, \ttt{"gosam"}. ' // & '(cf. also \ttt{\$real\_tree\_me\_method}, \ttt{\$correlation\_me\_method} ' // & 'and \ttt{\$born\_me\_method}.)')) call var_list%append_string (var_str ("$correlation_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies ' // & 'the method for the matrix elements to be used in the evaluation ' // & 'of the color (and helicity) correlated part of the NLO computation. ' // & "The default is the same as the \ttt{\$method}, i.e. the intrinsic " // & "\oMega\ matrix element generator " // & '(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // & '\ttt{"template"}, \ttt{"template\_unity"}, \ttt{"threshold"}, ' // & '\ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // & '\ttt{\$born\_me\_method}, \ttt{\$dglap\_me\_method}, ' // & '\ttt{\$loop\_me\_method} and \newline' // & '\ttt{\$real\_tree\_me\_method}.)')) call var_list%append_string (var_str ("$real_tree_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation of the ' // & 'real part of the NLO computation. The default is the same as ' // & 'the \ttt{\$method}, i.e. the intrinsic ' // & "\oMega\ matrix element generator " // & '(\ttt{"omega"}), other options ' // & 'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // & '\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // & '\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // & '\ttt{\$dglap\_me\_method} and \ttt{\$loop\_me\_method}.)')) call var_list%append_string (var_str ("$dglap_me_method"), & var_str (""), intrinsic = .true., & description=var_str ('This string variable specifies the method ' // & 'for the matrix elements to be used in the evaluation of the ' // & 'DGLAP remnants of the NLO computation. The default is the same as ' // & "\ttt{\$method}, i.e. the \oMega\ matrix element generator " // & '(\ttt{"omega"}), other options ' // & 'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // & '\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also \newline' // & '\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // & '\ttt{\$loop\_me\_method} and \ttt{\$real\_tree\_me\_method}.)')) call var_list%append_log (& var_str ("?test_soft_limit"), .false., intrinsic = .true., & description=var_str ('Sets the fixed values $\tilde{\xi} = 0.00001$ ' // & 'and $y = 0.5$ as radiation variables. This way, only soft, ' // & 'but non-collinear phase space points are generated, which allows ' // & 'for testing subtraction in this region.')) call var_list%append_log (& var_str ("?test_coll_limit"), .false., intrinsic = .true., & description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // & 'and $y = 0.9999999$ as radiation variables. This way, only collinear, ' // & 'but non-soft phase space points are generated, which allows ' // & 'for testing subtraction in this region. Can be combined with ' // & '\ttt{?test\_soft\_limit} to probe soft-collinear regions.')) call var_list%append_log (& var_str ("?test_anti_coll_limit"), .false., intrinsic = .true., & description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // & 'and $y = -0.9999999$ as radiation variables. This way, only anti-collinear, ' // & 'but non-soft phase space points are generated, which allows ' // & 'for testing subtraction in this region. Can be combined with ' // & '\ttt{?test\_soft\_limit} to probe soft-collinear regions.')) call var_list%append_string (var_str ("$select_alpha_regions"), & var_str (""), intrinsic = .true., & description=var_str ('Fixes the $\alpha_r$ in the real ' // & ' subtraction component. Allows for testing in one individual ' // & 'singular region.')) call var_list%append_string (var_str ("$virtual_selection"), & var_str ("Full"), intrinsic = .true., & description=var_str ('String variable to select either the full ' // & 'or only parts of the virtual components of an NLO calculation. ' // & 'Possible modes are \ttt{"Full"}, \ttt{"OLP"} and ' // & '\ttt{"Subtraction."}. Mainly for debugging purposes.')) call var_list%append_log (var_str ("?virtual_collinear_resonance_aware"), & .true., intrinsic = .true., & description=var_str ('This flag allows to switch between two ' // & 'different implementations of the collinear subtraction in the ' // & 'resonance-aware FKS setup.')) call var_list%append_real (& var_str ("blha_top_yukawa"), -1._default, intrinsic = .true., & description=var_str ('If this value is set, the given value will ' // & 'be used as the top Yukawa coupling instead of the top mass. ' // & 'Note that having different values for $y_t$ and $m_t$ must be ' // & 'supported by your OLP-library and yield errors if this is not the case.')) call var_list%append_string (var_str ("$blha_ew_scheme"), & var_str ("alpha_internal"), intrinsic = .true., & description=var_str ('String variable that transfers the electroweak ' // & 'renormalization scheme via BLHA to the one-loop provider. Possible ' // & 'values are \ttt{GF} or \ttt{Gmu} for the $G_\mu$ scheme, ' // & '\ttt{alpha\_internal} (default, $G_\mu$ scheme, but value of ' // & '$\alpha_S$ calculated internally by \whizard), \ttt{alpha\_mz} ' // & 'and \ttt{alpha\_0} (or \ttt{alpha\_thompson}) for different schemes ' // & 'with $\alpha$ as input.')) call var_list%append_int (var_str ("openloops_verbosity"), 1, & intrinsic = .true., & description=var_str ('Decides how much \openloops\ output is printed. ' // & 'Can have values 0, 1 and 2, where 2 is the highest verbosity level.')) call var_list%append_log (var_str ("?openloops_use_cms"), & .true., intrinsic = .true., & description=var_str ('Activates the complex mass scheme in ' // & '\openloops. (cf. also ' // & '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // & '\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // & '\ttt{openloops\_stability\_log}, \newline' // & '\ttt{\$openloops\_extra\_cmd})')) call var_list%append_int (var_str ("openloops_phs_tolerance"), 7, & intrinsic = .true., & description=var_str ('This integer parameter gives via ' // & '\ttt{openloops\_phs\_tolerance = } the relative numerical ' // & 'tolerance $10^{-n}$ for the momentum conservation of the ' // & 'external particles within \openloops. (cf. also ' // & '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // & '\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // & '\newline\ttt{openloops\_stability\_log}, ' // & '\ttt{\$openloops\_extra\_cmd})')) call var_list%append_int (var_str ("openloops_stability_log"), 0, & intrinsic = .true., & description=var_str ('Creates the directory \ttt{stability\_log} ' // & 'containing information about the performance of the \openloops ' // & 'matrix elements. Possible values are 0 (No output), 1 (On ' // & '\ttt{finish()}-call), 2 (Adaptive) and 3 (Always).')) call var_list%append_log (var_str ("?openloops_switch_off_muon_yukawa"), & .false., intrinsic = .true., & description=var_str ('Sets the Yukawa coupling of muons for ' // & '\openloops\ to zero. (cf. also ' // & '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // & '\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // & '\ttt{\$openloops\_extra\_cmd})')) call var_list%append_string (var_str ("$openloops_extra_cmd"), & var_str (""), intrinsic = .true., & description=var_str ('String variable to transfer customized ' // & 'special commands to \openloops. The three supported examples ' // & '\ttt{\$openloops\_extra\_command = "extra approx top/stop/not"} ' // & 'are for selection of subdiagrams in top production. (cf. also ' // & '\ttt{\$method}, \ttt{openloos\_verbosity}, ' // & '\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // & '\ttt{?openloops\_switch\_off\_muon\_yukawa})')) call var_list%append_real (var_str ("ellis_sexton_scale"), & -1._default, intrinsic = .true., & description = var_str ('Real positive paramter for the Ellis-Sexton scale' // & '$\mathcal{Q}$ used both in the finite one-loop contribution provided by' // & 'the OLP and in the virtual counter terms. The NLO cross section is' // & - 'independend of $\mathcal{Q}$. Therefore, this allows for debugging of' // & + 'independent of $\mathcal{Q}$. Therefore, this allows for debugging of' // & 'the implemention of the virtual counter terms. As the default' // & '$\mathcal{Q} = \mu_{\rm{R}}$ is chosen. So far, setting this parameter' // & 'only works for OpenLoops2, otherwise the default behaviour is invoked.')) call var_list%append_log (var_str ("?disable_subtraction"), & .false., intrinsic = .true., & description=var_str ('Disables the subtraction of soft and collinear ' // & 'divergences from the real matrix element.')) call var_list%append_real (var_str ("fks_dij_exp1"), & 1._default, intrinsic = .true., & description=var_str ('Fine-tuning parameters of the FKS ' // & 'final state partition functions. The exact meaning depends ' // & 'on the mapping implementation. (cf. also \ttt{fks\_dij\_exp2}, ' // & '\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})')) call var_list%append_real (var_str ("fks_dij_exp2"), & 1._default, intrinsic = .true., & description=var_str ('Fine-tuning parameters of the FKS ' // & 'initial state partition functions. The exact meaning depends ' // & 'on the mapping implementation. (cf. also \ttt{fks\_dij\_exp1}, ' // & '\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})')) call var_list%append_real (var_str ("fks_xi_min"), & 0._default, intrinsic = .true., & description=var_str ('Real parameter for the FKS ' // & 'phase space that sets the numerical lower value of the $\xi$ ' // & 'variable. Valid for the value range $[\texttt{tiny\_07},1]$, where ' // & 'value inputs out of bounds will take the value of the closest bound. ' // & 'Here, $\texttt{tiny\_07} = \texttt{1E0\_default * epsilon (0.\_default)}$, where ' // & '\ttt{epsilon} is an intrinsic Fortran function. (cf. also \ttt{fks\_dij\_exp1}, ' // & '\ttt{fks\_dij\_exp2}, \ttt{\$fks\_mapping\_type}, \ttt{fks\_y\_max})')) call var_list%append_real (var_str ("fks_y_max"), & 1._default, intrinsic = .true., & description=var_str ('Real parameter for the FKS ' // & 'phase space that sets the numerical upper value of the $\left|y\right|$ ' // & 'variable. Valid for ranges $[0,1]$, where value inputs out of bounds will take ' // & 'the value of the closest bound.(cf. also \ttt{fks\_dij\_exp1}, ' // & '\ttt{\$fks\_mapping\_type}, \ttt{fks\_dij\_exp2}, \ttt{fks\_y\_max})')) call var_list%append_log (var_str ("?vis_fks_regions"), & .false., intrinsic = .true., & description=var_str ('Logical variable that, if set to ' // & '\ttt{true}, generates \LaTeX\ code and executes it into a PDF ' // & ' to produce a table of all singular FKS regions and their ' // & ' flavor structures. The default is \ttt{false}.')) call var_list%append_real (var_str ("fks_xi_cut"), & 1.0_default, intrinsic = .true., & - description = var_str ('Real paramter for the FKS ' // & + description = var_str ('(Experimental) Real paramter for the FKS ' // & 'phase space that applies a cut to $\xi$ variable with $0 < \xi_{\text{cut}}' // & '\leq \xi_{\text{max}}$. The dependence on the parameter vanishes between ' // & - 'real subtraction and integrated subtraction term.')) + 'real subtraction and integrated subtraction term. Could thus be used for debugging. ' // & + 'This is not implemented properly, use at your own risk!')) call var_list%append_real (var_str ("fks_delta_o"), & 2._default, intrinsic = .true., & description = var_str ('Real paramter for the FKS ' // & 'phase space that applies a cut to the $y$ variable with $0 < \delta_o \leq 2$. ' // & 'The dependence on the parameter vanishes between real subtraction and integrated ' // & - 'subtraction term.')) + 'subtraction term. For debugging purposes.')) call var_list%append_real (var_str ("fks_delta_i"), & 2._default, intrinsic = .true., & description = var_str ('Real paramter for the FKS ' // & 'phase space that applies a cut to the $y$ variable with ' // & '$0 < \delta_{\mathrm{I}} \leq 2$ '// & 'for initial state singularities only. ' // & 'The dependence on the parameter vanishes between real subtraction and integrated ' // & - 'subtraction term.')) + 'subtraction term. For debugging purposes.')) call var_list%append_string (var_str ("$fks_mapping_type"), & var_str ("default"), intrinsic = .true., & description=var_str ('Sets the FKS mapping type. Possible values ' // & 'are \ttt{"default"} and \ttt{"resonances"}. The latter option ' // & 'activates the resonance-aware subtraction mode and induces the ' // & 'generation of a soft mismatch component. (cf. also ' // & '\ttt{fks\_dij\_exp1}, \ttt{fks\_dij\_exp2}, \ttt{fks\_xi\_min}, ' // & '\ttt{fks\_y\_max})')) call var_list%append_string (var_str ("$resonances_exclude_particles"), & var_str ("default"), intrinsic = .true., & description=var_str ('Accepts a string of particle names. These ' // & 'particles will be ignored when the resonance histories are generated. ' // & 'If \ttt{\$fks\_mapping\_type} is not \ttt{"resonances"}, this ' // & 'option does nothing.')) call var_list%append_int (var_str ("alpha_power"), & 2, intrinsic = .true., & description=var_str ('Fixes the electroweak coupling ' // & 'powers used by BLHA matrix element generators. Setting these ' // & 'values is necessary for the correct generation of OLP-files. ' // & 'Having inconsistent values yields to error messages by the corresponding ' // & 'OLP-providers.')) call var_list%append_int (var_str ("alphas_power"), & 0, intrinsic = .true., & description=var_str ('Fixes the strong coupling ' // & 'powers used by BLHA matrix element generators. Setting these ' // & 'values is necessary for the correct generation of OLP-files. ' // & 'Having inconsistent values yields to error messages by the corresponding ' // & 'OLP-providers.')) call var_list%append_log (var_str ("?combined_nlo_integration"), & .false., intrinsic = .true., & description=var_str ('When this option is set to \ttt{true}, ' // & 'the NLO integration will not be performed in the separate components, ' // & 'but instead the sum of all components will be integrated directly. ' // & 'When fixed-order NLO events are requested, this integration ' // & 'mode is possible, but not necessary. However, it is necessary ' // & 'for POWHEG events.')) call var_list%append_log (var_str ("?fixed_order_nlo_events"), & .false., intrinsic = .true., & description=var_str ('Induces the generation of fixed-order ' // & 'NLO events.')) call var_list%append_log (var_str ("?check_event_weights_against_xsection"), & .false., intrinsic = .true., & description=var_str ('Activates an internal recording of event ' // & 'weights when unweighted events are generated. At the end of ' // & 'the simulation, the mean value of the weights and its standard ' // & 'deviation are displayed. This allows to cross-check event generation ' // & 'and integration, because the value displayed must be equal to ' // & 'the integration result.')) call var_list%append_log (var_str ("?keep_failed_events"), & .false., intrinsic = .true., & description=var_str ('In the context of weighted event generation, ' // & 'if set to \ttt{true}, events with failed kinematics will be ' // & 'written to the event output with an associated weight of zero. ' // & 'This way, the total cross section can be reconstructed from the event output.')) call var_list%append_int (var_str ("gks_multiplicity"), & 0, intrinsic = .true., & description=var_str ('Jet multiplicity for the GKS merging scheme.')) call var_list%append_string (var_str ("$gosam_filter_lo"), & var_str (""), intrinsic = .true., & description=var_str ('The filter string given to \gosam\ in order to ' // & 'filter out tree-level diagrams. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // & '\ttt{\$gosam\_symmetries})')) call var_list%append_string (var_str ("$gosam_filter_nlo"), & var_str (""), intrinsic = .true., & description=var_str ('The same as \ttt{\$gosam\_filter\_lo}, but for ' // & 'loop matrix elements. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // & '\ttt{\$gosam\_symmetries})')) call var_list%append_string (var_str ("$gosam_symmetries"), & var_str ("family,generation"), intrinsic = .true., & description=var_str ('String variable that is transferred to \gosam\ ' // & 'configuration file to determine whether certain helicity configurations ' // & 'are considered to be equal. Possible values are \ttt{flavour}, ' // & '\ttt{family} etc. For more info see the \gosam\ manual.')) call var_list%append_int (var_str ("form_threads"), & 2, intrinsic = .true., & description=var_str ('The number of threads used by \gosam\ when ' // & 'matrix elements are evaluated using \ttt{FORM}')) call var_list%append_int (var_str ("form_workspace"), & 1000, intrinsic = .true., & description=var_str ('The size of the workspace \gosam\ requires ' // & 'from \ttt{FORM}. Inside \ttt{FORM}, it corresponds to the heap ' // & 'size used by the algebra processor.')) call var_list%append_string (var_str ("$gosam_fc"), & var_str (""), intrinsic = .true., & description=var_str ('The Fortran compiler used by \gosam.')) call var_list%append_real (& var_str ("mult_call_real"), 1._default, & intrinsic = .true., & description=var_str ('(Real-valued) multiplier for the number ' // & 'of calls used in the integration of the real subtraction ' // & 'NLO component. This way, a higher accuracy can be achieved for ' // & 'the real component, while simultaneously avoiding redundant ' // & 'integration calls for the other components. (cf. also ' // & '\ttt{mult\_call\_dglap}, \ttt{mult\_call\_virt})')) call var_list%append_real (& var_str ("mult_call_virt"), 1._default, & intrinsic = .true., & description=var_str ('(Real-valued) multiplier for the number ' // & 'of calls used in the integration of the virtual NLO ' // & 'component. This way, a higher accuracy can be achieved for ' // & 'this component, while simultaneously avoiding redundant ' // & 'integration calls for the other components. (cf. also ' // & '\ttt{mult\_call\_dglap}, \ttt{mult\_call\_real})')) call var_list%append_real (& var_str ("mult_call_dglap"), 1._default, & intrinsic = .true., & description=var_str ('(Real-valued) multiplier for the number ' // & 'of calls used in the integration of the DGLAP remnant NLO ' // & 'component. This way, a higher accuracy can be achieved for ' // & 'this component, while simultaneously avoiding redundant ' // & 'integration calls for the other components. (cf. also ' // & '\ttt{mult\_call\_real}, \ttt{mult\_call\_virt})')) call var_list%append_string (var_str ("$dalitz_plot"), & var_str (''), intrinsic = .true., & description=var_str ('This string variable has two purposes: ' // & 'when different from the empty string, it switches on generation ' // & 'of the Dalitz plot file (ASCII tables) for the real emitters. ' // & 'The string variable itself provides the file name.')) call var_list%append_string (var_str ("$nlo_correction_type"), & var_str ("QCD"), intrinsic = .true., & description=var_str ('String variable which sets the NLO correction ' // & 'type via \ttt{nlo\_correction\_type = "{\em }"} to either ' // & '\ttt{"QCD"}, \ttt{"EW"}, or to all with \ttt{\em{}} ' // & 'set to \ttt{"Full"}. Must be set before the \texttt{process} statement.')) call var_list%append_string (var_str ("$exclude_gauge_splittings"), & var_str ("c:b:t:e2:e3"), intrinsic = .true., & description=var_str ('String variable that allows via ' // & '\ttt{\$exclude\_gauge\_splittings = "{\em ::\dots}"} ' // & 'to exclude fermion flavors from gluon/photon splitting into ' // & 'fermion pairs beyond LO. For example \ttt{\$exclude\_gauge\_splittings ' // & '= "c:s:b:t"} would lead to \ttt{gl => u U} and \ttt{gl => d ' // & 'D} as possible splittings in QCD. It is important to keep in ' // & 'mind that only the particles listed in the string are excluded! ' // & 'In QED this string would additionally allow for all splittings into ' // & 'lepton pairs \ttt{A => l L}. Therefore, once set the variable ' // & 'acts as a replacement of the default value, not as an addition! ' // & 'Note: \ttt{"\em "} can be both particle or antiparticle. It ' // & 'will always exclude the corresponding fermion pair. An empty ' // & 'string allows for all fermion flavors to take part in the splitting! ' // & 'Also, particles included in an \ttt{alias} are not excluded by ' // & '\ttt{\$exclude\_gauge\_splittings}!')) call var_list%append_log (var_str ("?nlo_use_born_scale"), & .false., intrinsic = .true., & description=var_str ('Flag that decides whether a scale expression ' // & 'defined for the Born component of an NLO process shall be applied ' // & 'to all other components as well or not. ' // & '(cf. also \ttt{?nlo\_cut\_all\_real\_sqmes})')) call var_list%append_log (var_str ("?nlo_cut_all_real_sqmes"), & .false., intrinsic = .true., & description=var_str ('Flag that decides whether in the case that ' // & 'the real component does not pass a cut, its subtraction term ' // & 'shall be discarded for that phase space point as well or not. ' // & '(cf. also \ttt{?nlo\_use\_born\_scale})')) call var_list%append_log (var_str ("?nlo_use_real_partition"), & .false., intrinsic = .true., & description=var_str (' If set to \ttt{true}, the real matrix ' // & 'element is split into a finite and a singular part using a ' // & 'partition function $f$, such that $\mathcal{R} ' // & '= [1-f(p_T^2)]\mathcal{R} + f(p_T^2)\mathcal{R} = ' // & '\mathcal{R}_{\text{fin}} ' // & '+ \mathcal{R}_{\text{sing}}$. The emission ' // & 'generation is then performed using $\mathcal{R}_{\text{sing}}$, ' // & 'whereas $\mathcal{R}_{\text{fin}}$ is treated separately. ' // & '(cf. also \ttt{real\_partition\_scale})')) call var_list%append_real (var_str ("real_partition_scale"), & 10._default, intrinsic = .true., & description=var_str ('This real variable sets the invariant mass ' // & 'of the FKS pair used as a separator between the singular and the ' // & 'finite part of the real subtraction terms in an NLO calculation, ' // & 'e.g. in $e^+e^- \to ' // & 't\bar tj$. (cf. also \ttt{?nlo\_use\_real\_partition})')) call var_list%append_log (var_str ("?nlo_reuse_amplitudes_fks"), & .false., intrinsic = .true., & description=var_str ('Only compute real and virtual amplitudes for' // & 'subprocesses that give a different amplitude and reuse the result ' // & 'for equivalent subprocesses.' // & 'Might give a speed-up for some processes. Might' // & 'break others, especially in cases where resonance histories are needed. ' // & 'Experimental feature, use at your own risk!')) end subroutine var_list_set_nlo_defaults @ %def var_list_set_nlo_defaults @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Observables} In this module we define concrete variables and operators (observables) that we want to support in expressions. <<[[observables.f90]]>>= <> module observables <> <> use io_units use diagnostics use lorentz use subevents use variables <> <> contains <> end module observables @ %def observables @ \subsection{Process-specific variables} We allow the user to set a numeric process ID for each declared process. <>= public :: var_list_init_num_id <>= subroutine var_list_init_num_id (var_list, proc_id, num_id) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id integer, intent(in), optional :: num_id call var_list_set_procvar_int (var_list, proc_id, & var_str ("num_id"), num_id) end subroutine var_list_init_num_id @ %def var_list_init_num_id @ Integration results are stored in special variables. They are initialized by this subroutine. The values may or may not already known. Note: the values which are accessible are those that are unique for a process with multiple MCI records. The rest has been discarded. <>= public :: var_list_init_process_results <>= subroutine var_list_init_process_results (var_list, proc_id, & n_calls, integral, error, accuracy, chi2, efficiency) type(var_list_t), intent(inout) :: var_list type(string_t), intent(in) :: proc_id integer, intent(in), optional :: n_calls real(default), intent(in), optional :: integral, error, accuracy real(default), intent(in), optional :: chi2, efficiency call var_list_set_procvar_real (var_list, proc_id, & var_str ("integral"), integral) call var_list_set_procvar_real (var_list, proc_id, & var_str ("error"), error) end subroutine var_list_init_process_results @ %def var_list_init_process_results @ \subsection{Observables as Pseudo-Variables} Unary and binary observables are different. Most unary observables can be equally well evaluated for particle pairs. Binary observables cannot be evaluated for single particles. <>= public :: var_list_set_observables_unary public :: var_list_set_observables_binary <>= subroutine var_list_set_observables_unary (var_list, prt1) type(var_list_t), intent(inout) :: var_list type(prt_t), intent(in), target :: prt1 call var_list_append_obs1_iptr & (var_list, var_str ("PDG"), obs_pdg1, prt1) call var_list_append_obs1_iptr & (var_list, var_str ("Hel"), obs_helicity1, prt1) call var_list_append_obs1_iptr & (var_list, var_str ("Ncol"), obs_n_col1, prt1) call var_list_append_obs1_iptr & (var_list, var_str ("Nacl"), obs_n_acl1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("M"), obs_signed_mass1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("M2"), obs_mass_squared1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("E"), obs_energy1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Px"), obs_px1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Py"), obs_py1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Pz"), obs_pz1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("P"), obs_p1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Pl"), obs_pl1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Pt"), obs_pt1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Theta"), obs_theta1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Phi"), obs_phi1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Rap"), obs_rap1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Eta"), obs_eta1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Theta_star"), obs_theta_star1, prt1) call var_list_append_obs1_rptr & (var_list, var_str ("Dist"), obs_dist1, prt1) call var_list_append_uobs_real & (var_list, var_str ("_User_obs_real"), prt1) call var_list_append_uobs_int & (var_list, var_str ("_User_obs_int"), prt1) end subroutine var_list_set_observables_unary subroutine var_list_set_observables_binary (var_list, prt1, prt2) type(var_list_t), intent(inout) :: var_list type(prt_t), intent(in), target :: prt1 type(prt_t), intent(in), optional, target :: prt2 call var_list_append_obs2_iptr & (var_list, var_str ("PDG"), obs_pdg2, prt1, prt2) call var_list_append_obs2_iptr & (var_list, var_str ("Hel"), obs_helicity2, prt1, prt2) call var_list_append_obs2_iptr & (var_list, var_str ("Ncol"), obs_n_col2, prt1, prt2) call var_list_append_obs2_iptr & (var_list, var_str ("Nacl"), obs_n_acl2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("M"), obs_signed_mass2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("M2"), obs_mass_squared2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("E"), obs_energy2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Px"), obs_px2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Py"), obs_py2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Pz"), obs_pz2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("P"), obs_p2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Pl"), obs_pl2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Pt"), obs_pt2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Theta"), obs_theta2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Phi"), obs_phi2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Rap"), obs_rap2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Eta"), obs_eta2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Theta_star"), obs_theta_star2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("Dist"), obs_dist2, prt1, prt2) call var_list_append_obs2_rptr & (var_list, var_str ("kT"), obs_ktmeasure, prt1, prt2) call var_list_append_uobs_real & (var_list, var_str ("_User_obs_real"), prt1, prt2) call var_list_append_uobs_int & (var_list, var_str ("_User_obs_int"), prt1, prt2) end subroutine var_list_set_observables_binary @ %def var_list_set_observables_unary var_list_set_observables_binary @ \subsection{Checks} <>= public :: var_list_check_observable <>= subroutine var_list_check_observable (var_list, name, type) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(inout) :: type if (string_is_observable_id (name)) then call msg_fatal ("Variable name '" // char (name) & // "' is reserved for an observable") type = V_NONE return end if end subroutine var_list_check_observable @ %def var_list_check_observable @ Check if a variable name is defined as an observable: <>= function string_is_observable_id (string) result (flag) logical :: flag type(string_t), intent(in) :: string select case (char (string)) case ("PDG", "Hel", "Ncol", & "M", "M2", "E", "Px", "Py", "Pz", "P", "Pl", "Pt", & "Theta", "Phi", "Rap", "Eta", "Theta_star", "Dist", "kT") flag = .true. case default flag = .false. end select end function string_is_observable_id @ %def string_is_observable_id @ Check for result and process variables. <>= public :: var_list_check_result_var <>= subroutine var_list_check_result_var (var_list, name, type) class(var_list_t), intent(in), target :: var_list type(string_t), intent(in) :: name integer, intent(inout) :: type if (string_is_integer_result_var (name)) type = V_INT if (.not. var_list%contains (name)) then if (string_is_result_var (name)) then call msg_fatal ("Result variable '" // char (name) // "' " & // "set without prior integration") type = V_NONE return else if (string_is_num_id (name)) then call msg_fatal ("Numeric process ID '" // char (name) // "' " & // "set without process declaration") type = V_NONE return end if end if end subroutine var_list_check_result_var @ %def var_list_check_result_var @ Check if a variable name is a result variable of integer type: <>= function string_is_integer_result_var (string) result (flag) logical :: flag type(string_t), intent(in) :: string type(string_t) :: buffer, name, separator buffer = string call split (buffer, name, "(", separator=separator) ! ")" if (separator == "(") then select case (char (name)) case ("num_id", "n_calls") flag = .true. case default flag = .false. end select else flag = .false. end if end function string_is_integer_result_var @ %def string_is_integer_result_var @ Check if a variable name is an integration-result variable: <>= function string_is_result_var (string) result (flag) logical :: flag type(string_t), intent(in) :: string type(string_t) :: buffer, name, separator buffer = string call split (buffer, name, "(", separator=separator) ! ")" if (separator == "(") then select case (char (name)) case ("integral", "error") flag = .true. case default flag = .false. end select else flag = .false. end if end function string_is_result_var @ %def string_is_result_var @ Check if a variable name is a numeric process ID: <>= function string_is_num_id (string) result (flag) logical :: flag type(string_t), intent(in) :: string type(string_t) :: buffer, name, separator buffer = string call split (buffer, name, "(", separator=separator) ! ")" if (separator == "(") then select case (char (name)) case ("num_id") flag = .true. case default flag = .false. end select else flag = .false. end if end function string_is_num_id @ %def string_is_num_id @ \subsection{Observables} These are analogous to the unary and binary numeric functions listed above. An observable takes the [[pval]] component(s) of its one or two argument nodes and produces an integer or real value. \subsubsection{Integer-valued unary observables} The PDG code <>= integer function obs_pdg1 (prt1) result (pdg) type(prt_t), intent(in) :: prt1 pdg = prt_get_pdg (prt1) end function obs_pdg1 @ %def obs_pdg @ The helicity. The return value is meaningful only if the particle is polarized, otherwise an invalid value is returned (-9). <>= integer function obs_helicity1 (prt1) result (h) type(prt_t), intent(in) :: prt1 if (prt_is_polarized (prt1)) then h = prt_get_helicity (prt1) else h = -9 end if end function obs_helicity1 @ %def obs_helicity1 @ The number of open color (anticolor) lines. The return value is meaningful only if the particle is colorized (i.e., the subevent has been given color information), otherwise the function returns zero. <>= integer function obs_n_col1 (prt1) result (n) type(prt_t), intent(in) :: prt1 if (prt_is_colorized (prt1)) then n = prt_get_n_col (prt1) else n = 0 end if end function obs_n_col1 integer function obs_n_acl1 (prt1) result (n) type(prt_t), intent(in) :: prt1 if (prt_is_colorized (prt1)) then n = prt_get_n_acl (prt1) else n = 0 end if end function obs_n_acl1 @ %def obs_n_col1 @ %def obs_n_acl1 @ \subsubsection{Real-valued unary observables} The invariant mass squared, obtained from the separately stored value. <>= real(default) function obs_mass_squared1 (prt1) result (p2) type(prt_t), intent(in) :: prt1 p2 = prt_get_msq (prt1) end function obs_mass_squared1 @ %def obs_mass_squared1 @ The signed invariant mass, which is the signed square root of the previous observable. <>= real(default) function obs_signed_mass1 (prt1) result (m) type(prt_t), intent(in) :: prt1 real(default) :: msq msq = prt_get_msq (prt1) m = sign (sqrt (abs (msq)), msq) end function obs_signed_mass1 @ %def obs_signed_mass1 @ The particle energy <>= real(default) function obs_energy1 (prt1) result (e) type(prt_t), intent(in) :: prt1 e = energy (prt_get_momentum (prt1)) end function obs_energy1 @ %def obs_energy1 @ Particle momentum (components) <>= real(default) function obs_px1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = vector4_get_component (prt_get_momentum (prt1), 1) end function obs_px1 real(default) function obs_py1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = vector4_get_component (prt_get_momentum (prt1), 2) end function obs_py1 real(default) function obs_pz1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = vector4_get_component (prt_get_momentum (prt1), 3) end function obs_pz1 real(default) function obs_p1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = space_part_norm (prt_get_momentum (prt1)) end function obs_p1 real(default) function obs_pl1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = longitudinal_part (prt_get_momentum (prt1)) end function obs_pl1 real(default) function obs_pt1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = transverse_part (prt_get_momentum (prt1)) end function obs_pt1 @ %def obs_px1 obs_py1 obs_pz1 @ %def obs_p1 obs_pl1 obs_pt1 @ Polar and azimuthal angle (lab frame). <>= real(default) function obs_theta1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = polar_angle (prt_get_momentum (prt1)) end function obs_theta1 real(default) function obs_phi1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = azimuthal_angle (prt_get_momentum (prt1)) end function obs_phi1 @ %def obs_theta1 obs_phi1 @ Rapidity and pseudorapidity <>= real(default) function obs_rap1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = rapidity (prt_get_momentum (prt1)) end function obs_rap1 real(default) function obs_eta1 (prt1) result (p) type(prt_t), intent(in) :: prt1 p = pseudorapidity (prt_get_momentum (prt1)) end function obs_eta1 @ %def obs_rap1 obs_eta1 @ Meaningless: Polar angle in the rest frame of the two arguments combined. <>= real(default) function obs_theta_star1 (prt1) result (dist) type(prt_t), intent(in) :: prt1 call msg_fatal (" 'Theta_star' is undefined as unary observable") dist = 0 end function obs_theta_star1 @ %def obs_theta_star1 @ [Obsolete] Meaningless: Polar angle in the rest frame of the 2nd argument. <>= real(default) function obs_theta_rf1 (prt1) result (dist) type(prt_t), intent(in) :: prt1 call msg_fatal (" 'Theta_RF' is undefined as unary observable") dist = 0 end function obs_theta_rf1 @ %def obs_theta_rf1 @ Meaningless: Distance on the $\eta$-$\phi$ cylinder. <>= real(default) function obs_dist1 (prt1) result (dist) type(prt_t), intent(in) :: prt1 call msg_fatal (" 'Dist' is undefined as unary observable") dist = 0 end function obs_dist1 @ %def obs_dist1 @ \subsubsection{Integer-valued binary observables} These observables are meaningless as binary functions. <>= integer function obs_pdg2 (prt1, prt2) result (pdg) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" PDG_Code is undefined as binary observable") pdg = 0 end function obs_pdg2 integer function obs_helicity2 (prt1, prt2) result (h) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" Helicity is undefined as binary observable") h = 0 end function obs_helicity2 integer function obs_n_col2 (prt1, prt2) result (n) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" Ncol is undefined as binary observable") n = 0 end function obs_n_col2 integer function obs_n_acl2 (prt1, prt2) result (n) type(prt_t), intent(in) :: prt1, prt2 call msg_fatal (" Nacl is undefined as binary observable") n = 0 end function obs_n_acl2 @ %def obs_pdg2 @ %def obs_helicity2 @ %def obs_n_col2 @ %def obs_n_acl2 @ \subsubsection{Real-valued binary observables} The invariant mass squared, obtained from the separately stored value. <>= real(default) function obs_mass_squared2 (prt1, prt2) result (p2) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p2 = prt_get_msq (prt) end function obs_mass_squared2 @ %def obs_mass_squared2 @ The signed invariant mass, which is the signed square root of the previous observable. <>= real(default) function obs_signed_mass2 (prt1, prt2) result (m) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt real(default) :: msq call prt_init_combine (prt, prt1, prt2) msq = prt_get_msq (prt) m = sign (sqrt (abs (msq)), msq) end function obs_signed_mass2 @ %def obs_signed_mass2 @ The particle energy <>= real(default) function obs_energy2 (prt1, prt2) result (e) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) e = energy (prt_get_momentum (prt)) end function obs_energy2 @ %def obs_energy2 @ Particle momentum (components) <>= real(default) function obs_px2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = vector4_get_component (prt_get_momentum (prt), 1) end function obs_px2 real(default) function obs_py2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = vector4_get_component (prt_get_momentum (prt), 2) end function obs_py2 real(default) function obs_pz2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = vector4_get_component (prt_get_momentum (prt), 3) end function obs_pz2 real(default) function obs_p2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = space_part_norm (prt_get_momentum (prt)) end function obs_p2 real(default) function obs_pl2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = longitudinal_part (prt_get_momentum (prt)) end function obs_pl2 real(default) function obs_pt2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = transverse_part (prt_get_momentum (prt)) end function obs_pt2 @ %def obs_px2 obs_py2 obs_pz2 @ %def obs_p2 obs_pl2 obs_pt2 @ Enclosed angle and azimuthal distance (lab frame). <>= real(default) function obs_theta2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 p = enclosed_angle (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_theta2 real(default) function obs_phi2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = azimuthal_distance (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_phi2 @ %def obs_theta2 obs_phi2 @ Rapidity and pseudorapidity distance <>= real(default) function obs_rap2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 p = rapidity_distance & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_rap2 real(default) function obs_eta2 (prt1, prt2) result (p) type(prt_t), intent(in) :: prt1, prt2 type(prt_t) :: prt call prt_init_combine (prt, prt1, prt2) p = pseudorapidity_distance & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_eta2 @ %def obs_rap2 obs_eta2 @ [This doesn't work! The principle of no common particle for momentum combination prohibits us from combining a decay particle with the momentum of its parent.] Polar angle in the rest frame of the 2nd argument. <>= real(default) function obs_theta_rf2 (prt1, prt2) result (theta) type(prt_t), intent(in) :: prt1, prt2 theta = enclosed_angle_rest_frame & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_theta_rf2 @ %def obs_theta_rf2 @ Polar angle of the first particle in the rest frame of the two particles combined. <>= real(default) function obs_theta_star2 (prt1, prt2) result (theta) type(prt_t), intent(in) :: prt1, prt2 theta = enclosed_angle_rest_frame & (prt_get_momentum (prt1), & prt_get_momentum (prt1) + prt_get_momentum (prt2)) end function obs_theta_star2 @ %def obs_theta_star2 @ Distance on the $\eta$-$\phi$ cylinder. <>= real(default) function obs_dist2 (prt1, prt2) result (dist) type(prt_t), intent(in) :: prt1, prt2 dist = eta_phi_distance & (prt_get_momentum (prt1), prt_get_momentum (prt2)) end function obs_dist2 @ %def obs_dist2 @ Durham kT measure. <>= real(default) function obs_ktmeasure (prt1, prt2) result (kt) type(prt_t), intent(in) :: prt1, prt2 real (default) :: q2, e1, e2 ! Normalized scale to one for now! (#67) q2 = 1 e1 = energy (prt_get_momentum (prt1)) e2 = energy (prt_get_momentum (prt2)) kt = (2/q2) * min(e1**2,e2**2) * & (1 - enclosed_angle_ct(prt_get_momentum (prt1), & prt_get_momentum (prt2))) end function obs_ktmeasure @ %def obs_ktmeasure Index: trunk/src/fks/fks.nw =================================================================== --- trunk/src/fks/fks.nw (revision 8449) +++ trunk/src/fks/fks.nw (revision 8450) @@ -1,9862 +1,9868 @@ % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*- % WHIZARD code as NOWEB source: matrix elements and process libraries %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{FKS Subtraction Scheme} \includemodulegraph{fks} The code in this chapter implements the FKS subtraction scheme for use with \whizard. These are the modules: \begin{description} \item[fks\_regions] Given a process definition, identify singular regions in the associated phase space. \item[virtual] Handle the virtual correction matrix element. \item[real\_subtraction] Handle the real-subtraction matrix element. \item[nlo\_data] Manage the subtraction objects. \end{description} This chapter deals with next-to-leading order contributions to cross sections. Basically, there are three major issues to be adressed: The creation of the $N+1$-particle flavor structure, the construction of the $N+1$-particle phase space and the actual calculation of the real- and virtual-subtracted matrix elements. The first is dealt with using the [[auto_components]] class, and it will be shown that the second and third issue are connected in FKS subtraction. \section{Brief outline of FKS subtraction} {\em In the current state, this discussion is only concerned with lepton collisions. For hadron collisions, renormalization of parton distributions has to be taken into account. Further, for QCD corrections, initial-state radiation is necessarily present.} The aim is to calculate the next-to-leading order cross section according to \begin{equation*} d\sigma_{\rm{NLO}} = \mathcal{B} + \mathcal{V} + \mathcal{R}d\Phi_{\rm{rad}}. \end{equation*} Analytically, the divergences, in terms of poles in the complex quantity $\varepsilon = 2-d/2$, cancel. However, this is in general only valid in an arbitrary, complex number of dimensions. This is, roughly, the content of the KLN-theorem. \whizard, as any other numerical program, is confined to four dimensions. We will assume that the KLN-theorem is valid and that there exist subtraction terms $\mathcal{C}$ such that \begin{equation*} d\sigma_{\rm{NLO}} = \mathcal{B} + \underbrace{\mathcal{V} + \mathcal{C}}_{\text{finite}} + \underbrace{\mathcal{R} - \mathcal{C}}_{\text{finite}}, \end{equation*} i.e. the subtraction terms correspond to the divergent limits of the real and virtual matrix element. Because $\mathcal{C}$ subtracts the divergences of $\mathcal{R}$ as well as those of $\mathcal{V}$, it suffices to consider one of them, so we focus on $\mathcal{R}$. For this purpose, $\mathcal{R}$ is rewritten as \begin{equation*} \mathcal{R} = \frac{1}{\xi^2}\frac{1}{1-y} \left(\xi^2 (1-y)\mathcal{R}\right) = \frac{1}{\xi^2}\frac{1}{1-y}\tilde{\mathcal{R}}, \end{equation*} with $\xi = \left(2k_{\rm{rad}}^0\right)/\sqrt{s}$ and $y = \cos\theta$, where $k_{\rm{rad}}^0$ denotes the energy of the radiated parton and $\theta$ is the angle between emitter and radiated parton. $\tilde{\mathcal{R}}$ is finite, therefore the whole singularity structure is contained in the prefactor $\xi^{-2}(1-y)^{-1}$. Combined with the $d$-dimensional phase space element, \begin{equation*} \frac{d^{d-1}k}{2k^0(2\pi)^{d-1}} = \frac{s^{1-\varepsilon}}{(4\pi)^{d-1}}\xi^{1-2\varepsilon}\left(1-y^2\right)^{-\varepsilon} d\xi dy d\Omega^{d-2}, \end{equation*} this yields \begin{equation*} d\Phi_{\rm{rad}} \mathcal{R} = dy (1-y)^{-1-\varepsilon} d\xi \xi^{-1-2\varepsilon} \tilde{R}. \end{equation*} This can further be rewritten in terms of plus-distributions, \begin{align*} \xi^{-1-2\varepsilon} &= -\frac{1}{2\varepsilon}\delta(\xi) + \left(\frac{1}{\xi}\right)_+ - 2\varepsilon\left(\frac{\log\xi}{\xi}\right)_+ + \mathcal{O}(\varepsilon^2),\\ (1-y)^{-1-\varepsilon} &= -\frac{2^{-\varepsilon}}{\varepsilon} \delta(1-y) + \left(\frac{1}{1-y}\right)_+ - \varepsilon \left(\frac{1}{1-y}\right)_+\log(1-y) + \mathcal{O}(\varepsilon^2), \end{align*} (imagine that all this is written inside of integrals, which are spared for ease of notation) such that \begin{align*} d\Phi_{\rm{rad}} \mathcal{R} &= -\frac{1}{2\varepsilon} dy (1-y)^{-1-\varepsilon}\tilde{R} (0,y) - d\xi\left[\frac{2^{-\varepsilon}}{\varepsilon}\left(\frac{1}{\xi}\right)_+ - 2\left(\frac{\log\xi}{\xi}\right)_+\right] \tilde{R}(\xi,1) \\ &+ dy d\xi \left(\frac{1}{\xi}\right)_+ \left(\frac{1}{1-y}\right)_+ \tilde{R}(\xi, y) + \mathcal{O}(\varepsilon).\\ \end{align*} The summand in the second line is of order $\mathcal{O}(1)$ and is the only one to reproduce $\mathcal{R}(\xi,y)$. It thus constitutes the sum of the real matrix element and the corresponding counterterms. The first summand consequently consists of the subtraction terms to the virtual matrix elements. Above formula thus allows to calculate all quantities to render the matrix elements finite. \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Identifying singular regions} In the FKS subtraction scheme, the phase space is decomposed into disjoint singular regions, such that \begin{equation} \label{eq:S_complete} \sum_i \mathcal{S}_i + \sum_{ij}\mathcal{S}_{ij} = 1. \end{equation} The quantities $\mathcal{S}_i$ and $\mathcal{S}_{ij}$ are functions of phase space corresponding to a pair of particles indices which can make up a divergent phase space region. We call such an index pair a fundamental tuple. For example, the process $e^+ \, e^- \rightarrow u \, \bar{u} \, g$ has two singular regions, $(3,5)$ and $(4,5)$, indicating that the gluon can be soft or collinear with respect to either the quark or the anti-quark. Therefore, the functions $S_{ij}$ have to be chosen in such a way that their contribution makes up most of \eqref{eq:S_complete} in phase-space configurations where (final-state) particle $j$ is collinear to particle $i$ or/and particle $j$ is soft. The functions $S_i$ is the corresponding quantity for initial-state divergences. As a singular region we understand the collection of real flavor structures associated with an emitter and a list of all possible fundamental tuples. As an example, consider the process $e^+ \, e^- \rightarrow u \, \bar{u} \, g$. At next-to-leading order, processes with an additionally radiated particle have to be considered. In this case, these are $e^+ \, e^- \rightarrow u \, \bar{u}, \, g \, g$, and $e^+ \, e^- \rightarrow u \, \bar{u} \, u \, \bar{u}$ (or the same process with any other quark). Table \ref{table:singular regions} sums up all possible singular regions for this problem. \begin{table} \begin{tabular}{|c|c|c|c|} \hline \texttt{alr} & \texttt{flst\_alr} & \texttt{emitter} & \texttt{ftuple\_list}\\ \hline 1 & [-11,11,2,-2,21,21] & 3 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline 2 & [-11,11,2,-2,21,21] & 4 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline 3 & [-11,11,2,-2,21,21] & 5 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline 4 & [-11,11,2,-2,2,-2] & 5 & {(3,4), (3,6), (4,5), (5,6)} \\ \hline \end{tabular} \caption{List of singular regions. The particles are represented by their PDG codes. The third column contains the emitter for the specific singular region. For the process involving an additional gluon, the gluon can either be emitted from one of the quarks or from the first gluon. Each emitter yields the same list of fundamental tuples, five in total. The last singular region corresponds to the process where the gluon splits up into two quarks. As the matrix element for this process has no information on which quarks originate from a gluon splitting, there are ftuples for all the quark pairs and not just those involving the emitter.} \label{table:singular regions} \end{table} \\ \begin{table} \begin{tabular}{|c|c|c|c|} \hline \texttt{alr} & \texttt{ftuple} & \texttt{emitter} & \texttt{flst\_alr} \\ \hline 1 & $(3,5)$ & 5 & [-11,11,-2,21,2,21] \\ \hline 2 & $(4,5)$ & 5 & [-11,11,2,21,-2,21] \\ \hline 3 & $(3,6)$ & 5 & [-11,11,-2,21,2,21] \\ \hline 4 & $(4,6)$ & 5 & [-11,11,2,21,-2,21] \\ \hline 5 & $(5,6)$ & 5 & [-11,11,2,-2,21,21] \\ \hline 6 & $(5,6)$ & 5 & [-11,11,2,-2,2,-2] \\ \hline \end{tabular} \caption{Initial list of singular regions} \label{table:ftuples and flavors} \end{table} Thus, during the preparation of a NLO-calculation, the possible singular regions have to be identified. [[fks_regions.f90]] deals with this issue. \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{FKS Regions} <<[[fks_regions.f90]]>>= <> module fks_regions <> use format_utils, only: write_separator use numeric_utils use string_utils, only: str use io_units use os_interface <> <> use constants use permutations use diagnostics use flavors use process_constants use lorentz use pdg_arrays use models use physics_defs use resonances, only: resonance_contributors_t, resonance_history_t use phs_fks, only: phs_identifier_t, check_for_phs_identifier use nlo_data <> <> <> <> <> contains <> end module fks_regions @ %def fks_regions @ There are three fundamental splitting types: $q \rightarrow qg$, $g \rightarrow gg$ and $g \rightarrow qq$ for FSR and additionally $q \rightarrow gq$ for ISR which is different from $q \rightarrow qg$ by which particle enters the hard process. <>= integer, parameter :: UNDEFINED_SPLITTING = 0 integer, parameter :: F_TO_FV = 1 integer, parameter :: V_TO_VV = 2 integer, parameter :: V_TO_FF = 3 integer, parameter :: F_TO_VF = 4 @ @ We group the indices of the emitting and the radiated particle in the [[ftuple]]-object. <>= public :: ftuple_t <>= type :: ftuple_t integer, dimension(2) :: ireg = [-1,-1] integer :: i_res = 0 integer :: splitting_type logical :: pseudo_isr = .false. contains <> end type ftuple_t @ %def ftuple_t @ <>= interface assignment(=) module procedure ftuple_assign end interface interface operator(==) module procedure ftuple_equal end interface interface operator(>) module procedure ftuple_greater end interface interface operator(<) module procedure ftuple_less end interface <>= pure subroutine ftuple_assign (ftuple_out, ftuple_in) type(ftuple_t), intent(out) :: ftuple_out type(ftuple_t), intent(in) :: ftuple_in ftuple_out%ireg = ftuple_in%ireg ftuple_out%i_res = ftuple_in%i_res ftuple_out%splitting_type = ftuple_in%splitting_type ftuple_out%pseudo_isr = ftuple_in%pseudo_isr end subroutine ftuple_assign @ %def ftuple_assign @ <>= elemental function ftuple_equal (f1, f2) result (value) logical :: value type(ftuple_t), intent(in) :: f1, f2 value = all (f1%ireg == f2%ireg) .and. f1%i_res == f2%i_res & .and. f1%splitting_type == f2%splitting_type & .and. (f1%pseudo_isr .eqv. f2%pseudo_isr) end function ftuple_equal @ %def ftuple_equal @ <>= elemental function ftuple_equal_ireg (f1, f2) result (value) logical :: value type(ftuple_t), intent(in) :: f1, f2 value = all (f1%ireg == f2%ireg) end function ftuple_equal_ireg @ %def ftuple_equal_ireg @ <>= elemental function ftuple_greater (f1, f2) result (greater) logical :: greater type(ftuple_t), intent(in) :: f1, f2 if (f1%ireg(1) == f2%ireg(1)) then greater = f1%ireg(2) > f2%ireg(2) else greater = f1%ireg(1) > f2%ireg(1) end if end function ftuple_greater @ %def ftuple_greater @ <>= elemental function ftuple_less (f1, f2) result (less) logical :: less type(ftuple_t), intent(in) :: f1, f2 if (f1%ireg(1) == f2%ireg(1)) then less = f1%ireg(2) < f2%ireg(2) else less = f1%ireg(1) < f2%ireg(1) end if end function ftuple_less @ %def ftuple_less <>= subroutine ftuple_sort_array (ftuple_array, equivalences) type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuple_array logical, intent(inout), dimension(:,:), allocatable :: equivalences type(ftuple_t) :: ftuple_tmp logical, dimension(:), allocatable :: eq_tmp integer :: i1, i2, n n = size (ftuple_array) allocate (eq_tmp (n)) do i1 = 2, n i2 = i1 do while (ftuple_array(i2 - 1) > ftuple_array(i2)) ftuple_tmp = ftuple_array(i2 - 1) eq_tmp = equivalences(i2, :) ftuple_array(i2 - 1) = ftuple_array(i2) ftuple_array(i2) = ftuple_tmp equivalences(i2 - 1, :) = equivalences(i2, :) equivalences(i2, :) = eq_tmp i2 = i2 - 1 if (i2 == 1) exit end do end do end subroutine ftuple_sort_array @ %def ftuple_sort_array @ <>= procedure :: write => ftuple_write <>= subroutine ftuple_write (ftuple, unit, newline) class(ftuple_t), intent(in) :: ftuple integer, intent(in), optional :: unit logical, intent(in), optional :: newline integer :: u logical :: nl u = given_output_unit (unit); if (u < 0) return nl = .true.; if (present(newline)) nl = newline if (all (ftuple%ireg > -1)) then if (ftuple%i_res > 0) then if (nl) then write (u, "(A1,I1,A1,I1,A1,I1,A1)") & '(', ftuple%ireg(1), ',', ftuple%ireg(2), ';', ftuple%i_res, ')' else write (u, "(A1,I1,A1,I1,A1,I1,A1)", advance = "no") & '(', ftuple%ireg(1), ',', ftuple%ireg(2), ';', ftuple%i_res, ')' end if else if (nl) then write (u, "(A1,I1,A1,I1,A1)") & '(', ftuple%ireg(1), ',', ftuple%ireg(2), ')' else write (u, "(A1,I1,A1,I1,A1)", advance = "no") & '(', ftuple%ireg(1), ',', ftuple%ireg(2), ')' end if end if else write (u, "(A)") "(Empty)" end if end subroutine ftuple_write @ %def ftuple_write @ <>= function ftuple_string (ftuples, latex) type(string_t) :: ftuple_string type(ftuple_t), intent(in), dimension(:) :: ftuples logical, intent(in) :: latex integer :: i, nreg if (latex) then ftuple_string = var_str ("$\left\{") else ftuple_string = var_str ("{") end if nreg = size(ftuples) do i = 1, nreg if (ftuples(i)%i_res == 0) then ftuple_string = ftuple_string // var_str ("(") // & str (ftuples(i)%ireg(1)) // var_str (",") // & str (ftuples(i)%ireg(2)) // var_str (")") else ftuple_string = ftuple_string // var_str ("(") // & str (ftuples(i)%ireg(1)) // var_str (",") // & str (ftuples(i)%ireg(2)) // var_str (";") // & str (ftuples(i)%i_res) // var_str (")") end if if (ftuples(i)%pseudo_isr) ftuple_string = ftuple_string // var_str ("*") if (i < nreg) ftuple_string = ftuple_string // var_str (",") end do if (latex) then ftuple_string = ftuple_string // var_str ("\right\}$") else ftuple_string = ftuple_string // var_str ("}") end if end function ftuple_string @ %def ftuple_string @ <>= procedure :: get => ftuple_get <>= subroutine ftuple_get (ftuple, pos1, pos2) class(ftuple_t), intent(in) :: ftuple integer, intent(out) :: pos1, pos2 pos1 = ftuple%ireg(1) pos2 = ftuple%ireg(2) end subroutine ftuple_get @ %def ftuple_get @ <>= procedure :: set => ftuple_set <>= subroutine ftuple_set (ftuple, pos1, pos2) class(ftuple_t), intent(inout) :: ftuple integer, intent(in) :: pos1, pos2 ftuple%ireg(1) = pos1 ftuple%ireg(2) = pos2 end subroutine ftuple_set @ %def ftuple_set @ Determines the splitting type for FSR. There are three different types of splittings relevant here: $g \to gg$ tagged [[V_TO_VV]], $g \to qq$ tagged [[V_TO_FF]] and $q \to qg$ tagged [[F_TO_FV]]. For FSR, there is no need to differentiate between $q \to qg$ and $q \to gq$ splittings. <>= procedure :: determine_splitting_type_fsr => ftuple_determine_splitting_type_fsr <>= subroutine ftuple_determine_splitting_type_fsr (ftuple, flv, i, j) class(ftuple_t), intent(inout) :: ftuple type(flv_structure_t), intent(in) :: flv integer, intent(in) :: i, j associate (flst => flv%flst) if (is_vector (flst(i)) .and. is_vector (flst(j))) then ftuple%splitting_type = V_TO_VV else if (flst(i)+flst(j) == 0 & .and. is_fermion (flst(i))) then ftuple%splitting_type = V_TO_FF else if (is_fermion(flst(i)) .and. is_massless_vector (flst(j)) & .or. is_fermion(flst(j)) .and. is_massless_vector (flst(i))) then ftuple%splitting_type = F_TO_FV else ftuple%splitting_type = UNDEFINED_SPLITTING end if end associate end subroutine ftuple_determine_splitting_type_fsr @ %def ftuple_determine_splitting_type_fsr @ Determines the splitting type for ISR. There are four different types of splittings relevant here: $g \to gg$ tagged [[V_TO_VV]], $g \to qq$ tagged [[V_TO_FF]], $q \to qg$ tagged [[F_TO_FV]] and $q \to gq$ tagged [[F_TO_VF]]. The latter two need to be considered separately for ISR as they differ with respect to which particle enters the hard process. A splitting [[F_TO_FV]] may lead to soft divergences while [[F_TO_VF]] does not.\\ We also want to emphasize that the splitting type naming convention for ISR names the splittings considering backwards evolution. So in the splitting [[V_TO_FF]], it is the \textit{gluon} that enteres the hard process!\\ Special treatment here is required if emitter $0$ is assigned. This is the case only when a gluon was radiated from any of the IS particles. In this case, both splittings are soft divergent so we can equivalently choose $1$ or $2$ as the emitter here even if both have different flavors. <>= procedure :: determine_splitting_type_isr => ftuple_determine_splitting_type_isr <>= subroutine ftuple_determine_splitting_type_isr (ftuple, flv, i, j) class(ftuple_t), intent(inout) :: ftuple type(flv_structure_t), intent(in) :: flv integer, intent(in) :: i, j integer :: em em = i; if (i == 0) em = 1 associate (flst => flv%flst) if (is_vector (flst(em)) .and. is_vector (flst(j))) then ftuple%splitting_type = V_TO_VV else if (is_massless_vector(flst(em)) .and. is_fermion(flst(j))) then ftuple%splitting_type = F_TO_VF else if (is_fermion(flst(em)) .and. is_massless_vector(flst(j))) then ftuple%splitting_type = F_TO_FV else if (is_fermion(flst(em)) .and. is_fermion(flst(j))) then ftuple%splitting_type = V_TO_FF else ftuple%splitting_type = UNDEFINED_SPLITTING end if end associate end subroutine ftuple_determine_splitting_type_isr @ %def ftuple_determine_splitting_type_isr @ Two debug functions to check the consistency of [[ftuples]] <>= procedure :: has_negative_elements => ftuple_has_negative_elements procedure :: has_identical_elements => ftuple_has_identical_elements <>= elemental function ftuple_has_negative_elements (ftuple) result (value) logical :: value class(ftuple_t), intent(in) :: ftuple value = any (ftuple%ireg < 0) end function ftuple_has_negative_elements elemental function ftuple_has_identical_elements (ftuple) result (value) logical :: value class(ftuple_t), intent(in) :: ftuple value = ftuple%ireg(1) == ftuple%ireg(2) end function ftuple_has_identical_elements @ %def ftuple_has_negative_elements, ftuple_has_identical_elements @ Each singular region can have a different number of emitter-radiation pairs. This is coped with using the linked list [[ftuple_list]]. <>= type :: ftuple_list_t integer :: index = 0 type(ftuple_t) :: ftuple type(ftuple_list_t), pointer :: next => null () type(ftuple_list_t), pointer :: prev => null () type(ftuple_list_t), pointer :: equiv => null () contains <> end type ftuple_list_t @ %def ftuple_list_t @ <>= procedure :: write => ftuple_list_write <>= subroutine ftuple_list_write (list, unit, verbose) class(ftuple_list_t), intent(in), target :: list integer, intent(in), optional :: unit logical, intent(in), optional :: verbose type(ftuple_list_t), pointer :: current logical :: verb integer :: u u = given_output_unit (unit); if (u < 0) return verb = .false.; if (present (verbose)) verb = verbose select type (list) type is (ftuple_list_t) current => list do call current%ftuple%write (unit = u, newline = .false.) if (verb .and. associated (current%equiv)) write (u, '(A)', advance = "no") "'" if (associated (current%next)) then current => current%next else exit end if end do write (u, *) "" end select end subroutine ftuple_list_write @ %def ftuple_list_write @ <>= procedure :: append => ftuple_list_append <>= subroutine ftuple_list_append (list, ftuple) class(ftuple_list_t), intent(inout), target :: list type(ftuple_t), intent(in) :: ftuple type(ftuple_list_t), pointer :: current select type (list) type is (ftuple_list_t) if (list%index == 0) then nullify (list%next) list%index = 1 list%ftuple = ftuple else current => list do if (associated (current%next)) then current => current%next else allocate (current%next) nullify (current%next%next) nullify (current%next%equiv) current%next%prev => current current%next%index = current%index + 1 current%next%ftuple = ftuple exit end if end do end if end select end subroutine ftuple_list_append @ %def ftuple_list_append @ <>= procedure :: get_n_tuples => ftuple_list_get_n_tuples <>= impure elemental function ftuple_list_get_n_tuples (list) result(n_tuples) integer :: n_tuples class(ftuple_list_t), intent(in), target :: list type(ftuple_list_t), pointer :: current n_tuples = 0 select type (list) type is (ftuple_list_t) current => list if (current%index > 0) then n_tuples = 1 do if (associated (current%next)) then current => current%next n_tuples = n_tuples + 1 else exit end if end do end if end select end function ftuple_list_get_n_tuples @ %def ftuple_list_get_n_tuples @ <>= procedure :: get_entry => ftuple_list_get_entry <>= function ftuple_list_get_entry (list, index) result (entry) type(ftuple_list_t), pointer :: entry class(ftuple_list_t), intent(in), target :: list integer, intent(in) :: index type(ftuple_list_t), pointer :: current integer :: i entry => null() select type (list) type is (ftuple_list_t) current => list if (index == 1) then entry => current else do i = 1, index - 1 current => current%next end do entry => current end if end select end function ftuple_list_get_entry @ %def ftuple_list_get_entry @ <>= procedure :: get_ftuple => ftuple_list_get_ftuple <>= function ftuple_list_get_ftuple (list, index) result (ftuple) type(ftuple_t) :: ftuple class(ftuple_list_t), intent(in), target :: list integer, intent(in) :: index type(ftuple_list_t), pointer :: entry entry => list%get_entry (index) ftuple = entry%ftuple end function ftuple_list_get_ftuple @ %def ftuple_list_get_ftuple @ <>= procedure :: set_equiv => ftuple_list_set_equiv <>= subroutine ftuple_list_set_equiv (list, i1, i2) class(ftuple_list_t), intent(in) :: list integer, intent(in) :: i1, i2 type(ftuple_list_t), pointer :: list1, list2 => null () select type (list) type is (ftuple_list_t) if (list%get_ftuple (i1) > list%get_ftuple (i2)) then list1 => list%get_entry (i2) list2 => list%get_entry (i1) else list1 => list%get_entry (i1) list2 => list%get_entry (i2) end if do if (associated (list1%equiv)) then list1 => list1%equiv else exit end if end do list1%equiv => list2 end select end subroutine ftuple_list_set_equiv @ %def ftuple_list_set_equiv @ <>= procedure :: check_equiv => ftuple_list_check_equiv <>= function ftuple_list_check_equiv(list, i1, i2) result(eq) class(ftuple_list_t), intent(in) :: list integer, intent(in) :: i1, i2 logical :: eq type(ftuple_list_t), pointer :: current eq = .false. select type (list) type is (ftuple_list_t) current => list%get_entry (i1) do if (associated (current%equiv)) then current => current%equiv if (current%index == i2) then eq = .true. exit end if else exit end if end do end select end function ftuple_list_check_equiv @ %def ftuple_list_sort @ <>= procedure :: to_array => ftuple_list_to_array <>= subroutine ftuple_list_to_array (ftuple_list, ftuple_array, equivalences, ordered) class(ftuple_list_t), intent(in), target :: ftuple_list type(ftuple_t), intent(out), dimension(:), allocatable :: ftuple_array logical, intent(out), dimension(:,:), allocatable :: equivalences logical, intent(in) :: ordered integer :: i_tuple, n type(ftuple_list_t), pointer :: current => null () integer :: i1, i2 type(ftuple_t) :: ftuple_tmp logical, dimension(:), allocatable :: eq_tmp n = ftuple_list%get_n_tuples () allocate (ftuple_array (n), equivalences (n, n)) equivalences = .false. select type (ftuple_list) type is (ftuple_list_t) current => ftuple_list i_tuple = 1 do ftuple_array(i_tuple) = current%ftuple if (associated (current%equiv)) then i1 = current%index i2 = current%equiv%index equivalences (i1, i2) = .true. end if if (associated (current%next)) then current => current%next i_tuple = i_tuple + 1 else exit end if end do end select if (ordered) call ftuple_sort_array (ftuple_array, equivalences) end subroutine ftuple_list_to_array @ %def ftuple_list_to_array @ <>= subroutine print_equivalence_matrix (ftuple_array, equivalences) type(ftuple_t), intent(in), dimension(:) :: ftuple_array logical, intent(in), dimension(:,:) :: equivalences integer :: i, i1, i2 print *, 'Equivalence matrix: ' do i = 1, size (ftuple_array) call ftuple_array(i)%get(i1,i2) print *, 'i: ', i, '(', i1, i2, '): ', equivalences(i,:) end do end subroutine print_equivalence_matrix @ %def print_equivalence_matrix @ Class for working with the flavor specification arrays. <>= public :: flv_structure_t <>= type :: flv_structure_t integer, dimension(:), allocatable :: flst integer, dimension(:), allocatable :: tag integer :: nlegs = 0 integer :: n_in = 0 logical, dimension(:), allocatable :: massive logical, dimension(:), allocatable :: colored real(default), dimension(:), allocatable :: charge real(default) :: prt_symm_fs = 1._default integer :: eqv_index = 0 contains <> end type flv_structure_t @ %def flv_structure_t @ Returns \texttt{true} if the two particles at position \texttt{i} and \texttt{j} in the flavor array can originate from the same splitting. For this purpose, the function first checks whether the splitting is allowed at all. If this is the case, the emitter is removed from the flavor array. If the resulting array is equivalent to the Born flavor structure \texttt{flv\_born}, the pair is accepted as a valid splitting. We first check whether the splitting is possible. The array [[flv_orig]] contains all particles which share a vertex with the particles at position [[i]] and [[j]]. If any of these particles belongs to the initial state, a PDG-ID flip is necessary to correctly recognize the vertex. If its size is equal to zero, no splitting is possible and the subroutine is exited. Otherwise, we loop over all possible underlying Born flavor structures and check if any of them equals the actual underlying Born flavor structure. For a quark emitting a gluon, [[flv_orig]] contains the PDG code of the anti-quark. To be on the safe side, a second array is created, which contains both the positively and negatively signed PDG codes. Then, the origial tuple $(i,j)$ is removed from the real flavor structure and the particles in [[flv_orig2]] are inserted. If the resulting Born configuration is equal to the underlying Born configuration, up to a permutation of final-state particles, the tuple $(i,j)$ is accepted as valid. <>= procedure :: valid_pair => flv_structure_valid_pair <>= function flv_structure_valid_pair & (flv, i, j, flv_ref, model) result (valid) logical :: valid class(flv_structure_t), intent(in) :: flv integer, intent(in) :: i,j type(flv_structure_t), intent(in) :: flv_ref type(model_t), intent(in) :: model integer :: k, n_orig type(flv_structure_t) :: flv_test integer, dimension(:), allocatable :: flv_orig valid = .false. if (all ([i, j] <= flv%n_in)) return if (i <= flv%n_in .and. is_fermion(flv%flst(i))) then call model%match_vertex (-flv%flst(i), flv%flst(j), flv_orig) else if (j <= flv%n_in .and. is_fermion(flv%flst(j))) then call model%match_vertex (flv%flst(i), -flv%flst(j), flv_orig) else call model%match_vertex (flv%flst(i), flv%flst(j), flv_orig) end if n_orig = size (flv_orig) if (n_orig == 0) then return else do k = 1, n_orig if (any ([i, j] <= flv%n_in)) then flv_test = flv%insert_particle_isr (i, j, flv_orig(k)) else flv_test = flv%insert_particle_fsr (i, j, flv_orig(k)) end if valid = flv_ref .equiv. flv_test call flv_test%final () if (valid) return end do end if deallocate (flv_orig) end function flv_structure_valid_pair @ %def flv_structure_valid_pair @ This function checks whether two flavor arrays are the same up to a permutation of the final-state particles <>= function flv_structure_equivalent (flv1, flv2, with_tag) result(equiv) logical :: equiv type(flv_structure_t), intent(in) :: flv1, flv2 logical, intent(in) :: with_tag type(flavor_permutation_t) :: perm integer :: n n = size (flv1%flst) equiv = .true. if (n /= size (flv2%flst)) then call msg_fatal & ('flv_structure_equivalent: flavor arrays do not have equal lengths') else if (flv1%n_in /= flv2%n_in) then call msg_fatal & ('flv_structure_equivalent: flavor arrays do not have equal n_in') else call perm%init (flv1, flv2, flv1%n_in, flv1%nlegs, with_tag) equiv = perm%test (flv2, flv1, with_tag) call perm%final () end if end function flv_structure_equivalent @ %def flv_structure_equivalent @ <>= function flv_structure_equivalent_no_tag (flv1, flv2) result(equiv) logical :: equiv type(flv_structure_t), intent(in) :: flv1, flv2 equiv = flv_structure_equivalent (flv1, flv2, .false.) end function flv_structure_equivalent_no_tag function flv_structure_equivalent_with_tag (flv1, flv2) result(equiv) logical :: equiv type(flv_structure_t), intent(in) :: flv1, flv2 equiv = flv_structure_equivalent (flv1, flv2, .true.) end function flv_structure_equivalent_with_tag @ %def flv_structure_equivalent_no_tag, flv_structure_equivalent_with_tag @ <>= pure subroutine flv_structure_assign_flv (flv_out, flv_in) type(flv_structure_t), intent(out) :: flv_out type(flv_structure_t), intent(in) :: flv_in flv_out%nlegs = flv_in%nlegs flv_out%n_in = flv_in%n_in flv_out%prt_symm_fs = flv_in%prt_symm_fs if (allocated (flv_in%flst)) then allocate (flv_out%flst (size (flv_in%flst))) flv_out%flst = flv_in%flst end if if (allocated (flv_in%tag)) then allocate (flv_out%tag (size (flv_in%tag))) flv_out%tag = flv_in%tag end if if (allocated (flv_in%massive)) then allocate (flv_out%massive (size (flv_in%massive))) flv_out%massive = flv_in%massive end if if (allocated (flv_in%colored)) then allocate (flv_out%colored (size (flv_in%colored))) flv_out%colored = flv_in%colored end if end subroutine flv_structure_assign_flv @ %def flv_structure_assign_flv @ <>= pure subroutine flv_structure_assign_integer (flv_out, iarray) type(flv_structure_t), intent(out) :: flv_out integer, intent(in), dimension(:) :: iarray integer :: i flv_out%nlegs = size (iarray) allocate (flv_out%flst (flv_out%nlegs)) allocate (flv_out%tag (flv_out%nlegs)) flv_out%flst = iarray flv_out%tag = [(i, i = 1, flv_out%nlegs)] end subroutine flv_structure_assign_integer @ %def flv_structure_assign_integer @ Returs a new flavor array with the particle at position \texttt{index} removed. <>= procedure :: remove_particle => flv_structure_remove_particle <>= function flv_structure_remove_particle (flv, index) result(flv_new) type(flv_structure_t) :: flv_new class(flv_structure_t), intent(in) :: flv integer, intent(in) :: index integer :: n1, n2 integer :: i, removed_tag n1 = size (flv%flst); n2 = n1 - 1 allocate (flv_new%flst (n2), flv_new%tag (n2)) flv_new%nlegs = n2 flv_new%n_in = flv%n_in removed_tag = flv%tag(index) if (index == 1) then flv_new%flst(1 : n2) = flv%flst(2 : n1) flv_new%tag(1 : n2) = flv%tag(2 : n1) else if (index == n1) then flv_new%flst(1 : n2) = flv%flst(1 : n2) flv_new%tag(1 : n2) = flv%tag(1 : n2) else flv_new%flst(1 : index - 1) = flv%flst(1 : index - 1) flv_new%flst(index : n2) = flv%flst(index + 1 : n1) flv_new%tag(1 : index - 1) = flv%tag(1 : index - 1) flv_new%tag(index : n2) = flv%tag(index + 1 : n1) end if do i = 1, n2 if (flv_new%tag(i) > removed_tag) & flv_new%tag(i) = flv_new%tag(i) - 1 end do call flv_new%compute_prt_symm_fs (flv_new%n_in) end function flv_structure_remove_particle @ %def flv_structure_remove_particle @ Removes the particles at position i1 and i2 and inserts a new particle of matching flavor at position i1. <>= procedure :: insert_particle_fsr => flv_structure_insert_particle_fsr <>= function flv_structure_insert_particle_fsr (flv, i1, i2, flv_add) result (flv_new) type(flv_structure_t) :: flv_new class(flv_structure_t), intent(in) :: flv integer, intent(in) :: i1, i2, flv_add if (flv%flst(i1) + flv_add == 0 .or. flv%flst(i2) + flv_add == 0) then flv_new = flv%insert_particle (i1, i2, -flv_add) else flv_new = flv%insert_particle (i1, i2, flv_add) end if end function flv_structure_insert_particle_fsr @ %def flv_structure_insert_particle_fsr @ Same as [[insert_particle_fsr]] but for ISR, the two particles are not exchangable. <>= procedure :: insert_particle_isr => flv_structure_insert_particle_isr <>= function flv_structure_insert_particle_isr (flv, i_in, i_out, flv_add) result (flv_new) type(flv_structure_t) :: flv_new class(flv_structure_t), intent(in) :: flv integer, intent(in) :: i_in, i_out, flv_add if (flv%flst(i_in) + flv_add == 0) then flv_new = flv%insert_particle (i_in, i_out, -flv_add) else flv_new = flv%insert_particle (i_in, i_out, flv_add) end if end function flv_structure_insert_particle_isr @ %def flv_structure_insert_particle_isr @ Removes the particles at position i1 and i2 and inserts a new particle at position i1. <>= procedure :: insert_particle => flv_structure_insert_particle <>= function flv_structure_insert_particle (flv, i1, i2, particle) result (flv_new) type(flv_structure_t) :: flv_new class(flv_structure_t), intent(in) :: flv integer, intent(in) :: i1, i2, particle type(flv_structure_t) :: flv_tmp integer :: n1, n2 integer :: new_tag n1 = size (flv%flst); n2 = n1 - 1 allocate (flv_new%flst (n2), flv_new%tag (n2)) flv_new%nlegs = n2 flv_new%n_in = flv%n_in new_tag = maxval(flv%tag) + 1 if (i1 < i2) then flv_tmp = flv%remove_particle (i1) flv_tmp = flv_tmp%remove_particle (i2 - 1) else if(i2 < i1) then flv_tmp = flv%remove_particle(i2) flv_tmp = flv_tmp%remove_particle(i1 - 1) else call msg_fatal ("flv_structure_insert_particle: Indices are identical!") end if if (i1 == 1) then flv_new%flst(1) = particle flv_new%flst(2 : n2) = flv_tmp%flst(1 : n2 - 1) flv_new%tag(1) = new_tag flv_new%tag(2 : n2) = flv_tmp%tag(1 : n2 - 1) else if (i1 == n1 .or. i1 == n2) then flv_new%flst(1 : n2 - 1) = flv_tmp%flst(1 : n2 - 1) flv_new%flst(n2) = particle flv_new%tag(1 : n2 - 1) = flv_tmp%tag(1 : n2 - 1) flv_new%tag(n2) = new_tag else flv_new%flst(1 : i1 - 1) = flv_tmp%flst(1 : i1 - 1) flv_new%flst(i1) = particle flv_new%flst(i1 + 1 : n2) = flv_tmp%flst(i1 : n2 - 1) flv_new%tag(1 : i1 - 1) = flv_tmp%tag(1 : i1 - 1) flv_new%tag(i1) = new_tag flv_new%tag(i1 + 1 : n2) = flv_tmp%tag(i1 : n2 - 1) end if call flv_new%compute_prt_symm_fs (flv_new%n_in) end function flv_structure_insert_particle @ %def flv_structure_insert_particle @ Counts the number of occurances of a particle in a flavor array <>= procedure :: count_particle => flv_structure_count_particle <>= function flv_structure_count_particle (flv, part) result (n) class(flv_structure_t), intent(in) :: flv integer, intent(in) :: part integer :: n n = count (flv%flst == part) end function flv_structure_count_particle @ %def flv_structure_count_particle @ Initializer for flavor structures <>= procedure :: init => flv_structure_init <>= subroutine flv_structure_init (flv, aval, n_in, tags) class(flv_structure_t), intent(inout) :: flv integer, intent(in), dimension(:) :: aval integer, intent(in) :: n_in integer, intent(in), dimension(:), optional :: tags integer :: i, n integer, dimension(:), allocatable :: aval_unique integer, dimension(:), allocatable :: mult n = size (aval) allocate (flv%flst (n), flv%tag (n)) flv%flst = aval if (present (tags)) then flv%tag = tags else do i = 1, n flv%tag(i) = i end do end if flv%nlegs = n flv%n_in = n_in call flv%compute_prt_symm_fs (flv%n_in) end subroutine flv_structure_init @ %def flv_structure_init @ <>= procedure :: compute_prt_symm_fs => flv_structure_compute_prt_symm_fs <>= subroutine flv_structure_compute_prt_symm_fs (flv, n_in) class(flv_structure_t), intent(inout) :: flv integer, intent(in) :: n_in integer, dimension(:), allocatable :: flst_unique integer, dimension(:), allocatable :: mult integer :: i flst_unique = remove_duplicates_from_int_array (flv%flst(n_in + 1 :)) allocate (mult(size (flst_unique))) do i = 1, size (flst_unique) mult(i) = count (flv%flst(n_in + 1 :) == flst_unique(i)) end do flv%prt_symm_fs = one / product (gamma (real (mult + 1, default))) end subroutine flv_structure_compute_prt_symm_fs @ %def flv_structure_compute_prt_symm_fs @ <>= procedure :: write => flv_structure_write <>= subroutine flv_structure_write (flv, unit) class(flv_structure_t), intent(in) :: flv integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, '(A)') char (flv%to_string ()) end subroutine flv_structure_write @ %def flv_structure_write @ <>= procedure :: to_string => flv_structure_to_string <>= function flv_structure_to_string (flv) result (flv_string) type(string_t) :: flv_string class(flv_structure_t), intent(in) :: flv integer :: i, n if (allocated (flv%flst)) then flv_string = var_str ("[") n = size (flv%flst) do i = 1, n - 1 flv_string = flv_string // str (flv%flst(i)) // var_str(",") end do flv_string = flv_string // str (flv%flst(n)) // var_str("]") else flv_string = var_str ("[not allocated]") end if end function flv_structure_to_string @ %def flv_structure_to_string @ Creates the underlying Born flavor structure for a given real flavor structure if the particle at position \texttt{emitter} is removed <>= procedure :: create_uborn => flv_structure_create_uborn <>= function flv_structure_create_uborn (flv, emitter, nlo_correction_type) result(flv_uborn) type(flv_structure_t) :: flv_uborn class(flv_structure_t), intent(in) :: flv type(string_t), intent(in) :: nlo_correction_type integer, intent(in) :: emitter integer n_legs integer :: f1, f2 integer :: gauge_boson n_legs = size(flv%flst) allocate (flv_uborn%flst (n_legs - 1), flv_uborn%tag (n_legs - 1)) gauge_boson = determine_gauge_boson_to_be_inserted () if (emitter > flv%n_in) then f1 = flv%flst(n_legs); f2 = flv%flst(n_legs - 1) if (is_massless_vector (f1)) then !!! Emitted particle is a gluon or photon => just remove it flv_uborn = flv%remove_particle(n_legs) else if (is_fermion (f1) .and. is_fermion (f2) .and. f1 + f2 == 0) then !!! Emission type is a gauge boson splitting into two fermions flv_uborn = flv%insert_particle(n_legs - 1, n_legs, gauge_boson) else call msg_error ("Create underlying Born: Unsupported splitting type.") call msg_error (char (str (flv%flst))) call msg_fatal ("FKS - FAIL") end if else if (emitter > 0) then f1 = flv%flst(n_legs); f2 = flv%flst(emitter) if (is_massless_vector (f1)) then flv_uborn = flv%remove_particle(n_legs) else if (is_fermion (f1) .and. is_massless_vector (f2)) then flv_uborn = flv%insert_particle (emitter, n_legs, -f1) else if (is_fermion (f1) .and. is_fermion (f2) .and. f1 == f2) then flv_uborn = flv%insert_particle(emitter, n_legs, gauge_boson) end if else flv_uborn = flv%remove_particle (n_legs) end if contains integer function determine_gauge_boson_to_be_inserted () select case (char (nlo_correction_type)) case ("QCD") determine_gauge_boson_to_be_inserted = GLUON case ("EW") determine_gauge_boson_to_be_inserted = PHOTON case ("Full") call msg_fatal ("NLO correction type 'Full' not yet implemented!") case default call msg_fatal ("Invalid NLO correction type! Valid inputs are: QCD, EW and Full (default: QCD)") end select end function determine_gauge_boson_to_be_inserted end function flv_structure_create_uborn @ %def flv_structure_create_uborn @ <>= procedure :: init_mass_color_and_charge => flv_structure_init_mass_color_and_charge <>= subroutine flv_structure_init_mass_color_and_charge (flv, model) class(flv_structure_t), intent(inout) :: flv type(model_t), intent(in) :: model integer :: i type(flavor_t) :: flavor allocate (flv%massive (flv%nlegs), flv%colored(flv%nlegs), flv%charge(flv%nlegs)) do i = 1, flv%nlegs call flavor%init (flv%flst(i), model) flv%massive(i) = flavor%get_mass () > 0 flv%colored(i) = & is_quark (flv%flst(i)) .or. is_gluon (flv%flst(i)) if (flavor%is_antiparticle ()) then flv%charge(i) = -flavor%get_charge () else flv%charge(i) = flavor%get_charge () end if end do end subroutine flv_structure_init_mass_color_and_charge @ %def flv_structure_init_mass_color_and_charge @ <>= procedure :: get_last_two => flv_structure_get_last_two <>= function flv_structure_get_last_two (flv, n) result (flst_last) integer, dimension(2) :: flst_last class(flv_structure_t), intent(in) :: flv integer, intent(in) :: n flst_last = [flv%flst(n - 1), flv%flst(n)] end function flv_structure_get_last_two @ %def flv_structure_get_last_two @ <>= procedure :: final => flv_structure_final <>= subroutine flv_structure_final (flv) class(flv_structure_t), intent(inout) :: flv if (allocated (flv%flst)) deallocate (flv%flst) if (allocated (flv%tag)) deallocate (flv%tag) if (allocated (flv%massive)) deallocate (flv%massive) if (allocated (flv%colored)) deallocate (flv%colored) if (allocated (flv%charge)) deallocate (flv%charge) end subroutine flv_structure_final @ %def flv_structure_final @ <>= public :: flavor_permutation_t <>= type :: flavor_permutation_t integer, dimension(:,:), allocatable :: perms contains <> end type flavor_permutation_t @ %def flavor_permutation_t @ <>= procedure :: init => flavor_permutation_init <>= subroutine flavor_permutation_init (perm, flv_in, flv_ref, n_first, n_last, with_tag) class(flavor_permutation_t), intent(out) :: perm type(flv_structure_t), intent(in) :: flv_in, flv_ref integer, intent(in) :: n_first, n_last logical, intent(in) :: with_tag integer :: flv1, flv2, tmp integer :: tag1, tag2 integer :: i, j, j_min, i_perm integer, dimension(:,:), allocatable :: perm_list_tmp type(flv_structure_t) :: flv_copy logical :: condition logical, dimension(:), allocatable :: already_correct flv_copy = flv_in allocate (perm_list_tmp (factorial (n_last - n_first - 1), 2)) allocate (already_correct (flv_in%nlegs)) already_correct = flv_in%flst == flv_ref%flst if (with_tag) & already_correct = already_correct .and. (flv_in%tag == flv_ref%tag) j_min = n_first + 1 i_perm = 0 do i = n_first + 1, n_last flv1 = flv_ref%flst(i) tag1 = flv_ref%tag(i) do j = j_min, n_last if (already_correct(i) .or. already_correct(j)) cycle flv2 = flv_copy%flst(j) tag2 = flv_copy%tag(j) condition = (flv1 == flv2) .and. i /= j if (with_tag) condition = condition .and. (tag1 == tag2) if (condition) then i_perm = i_perm + 1 tmp = flv_copy%flst(i) flv_copy%flst(i) = flv2 flv_copy%flst(j) = tmp tmp = flv_copy%tag(i) flv_copy%tag(i) = tag2 flv_copy%tag(j) = tmp perm_list_tmp (i_perm, 1) = i perm_list_tmp (i_perm, 2) = j exit end if end do j_min = j_min + 1 end do allocate (perm%perms (i_perm, 2)) perm%perms = perm_list_tmp (1 : i_perm, :) deallocate (perm_list_tmp) call flv_copy%final () end subroutine flavor_permutation_init @ %def flavor_permutation_init @ <>= procedure :: write => flavor_permutation_write <>= subroutine flavor_permutation_write (perm, unit) class(flavor_permutation_t), intent(in) :: perm integer, intent(in), optional :: unit integer :: i, n, u u = given_output_unit (unit); if (u < 0) return write (u, "(A)") "Flavor permutation list: " n = size (perm%perms, dim = 1) if (n > 0) then do i = 1, n write (u, "(A1,I1,1X,I1,A1)", advance = "no") "[", perm%perms(i,1), perm%perms(i,2), "]" if (i < n) write (u, "(A4)", advance = "no") " // " end do write (u, "(A)") "" else write (u, "(A)") "[Empty]" end if end subroutine flavor_permutation_write @ %def flavor_permutation_write @ <>= procedure :: reset => flavor_permutation_final procedure :: final => flavor_permutation_final <>= subroutine flavor_permutation_final (perm) class(flavor_permutation_t), intent(inout) :: perm if (allocated (perm%perms)) deallocate (perm%perms) end subroutine flavor_permutation_final @ %def flavor_permutation_final @ <>= generic :: apply => apply_permutation, & apply_flavor, apply_integer, apply_ftuple procedure :: apply_permutation => flavor_permutation_apply_permutation procedure :: apply_flavor => flavor_permutation_apply_flavor procedure :: apply_integer => flavor_permutation_apply_integer procedure :: apply_ftuple => flavor_permutation_apply_ftuple <>= elemental function flavor_permutation_apply_permutation (perm_1, perm_2) & result (perm_out) type(flavor_permutation_t) :: perm_out class(flavor_permutation_t), intent(in) :: perm_1 type(flavor_permutation_t), intent(in) :: perm_2 integer :: n1, n2 n1 = size (perm_1%perms, dim = 1) n2 = size (perm_2%perms, dim = 1) allocate (perm_out%perms (n1 + n2, 2)) perm_out%perms (1 : n1, :) = perm_1%perms perm_out%perms (n1 + 1: n1 + n2, :) = perm_2%perms end function flavor_permutation_apply_permutation @ %def flavor_permutation_apply_permutation @ <>= elemental function flavor_permutation_apply_flavor (perm, flv_in, invert) & result (flv_out) type(flv_structure_t) :: flv_out class(flavor_permutation_t), intent(in) :: perm type(flv_structure_t), intent(in) :: flv_in logical, intent(in), optional :: invert integer :: i, i1, i2 integer :: p1, p2, incr integer :: flv_tmp, tag_tmp logical :: inv inv = .false.; if (present(invert)) inv = invert flv_out = flv_in if (inv) then p1 = 1 p2 = size (perm%perms, dim = 1) incr = 1 else p1 = size (perm%perms, dim = 1) p2 = 1 incr = -1 end if do i = p1, p2, incr i1 = perm%perms(i,1) i2 = perm%perms(i,2) flv_tmp = flv_out%flst(i1) tag_tmp = flv_out%tag(i1) flv_out%flst(i1) = flv_out%flst(i2) flv_out%flst(i2) = flv_tmp flv_out%tag(i1) = flv_out%tag(i2) flv_out%tag(i2) = tag_tmp end do end function flavor_permutation_apply_flavor @ %def flavor_permutation_apply_flavor @ <>= elemental function flavor_permutation_apply_integer (perm, i_in) result (i_out) integer :: i_out class(flavor_permutation_t), intent(in) :: perm integer, intent(in) :: i_in integer :: i, i1, i2 i_out = i_in do i = size (perm%perms(:,1)), 1, -1 i1 = perm%perms(i,1) i2 = perm%perms(i,2) if (i_out == i1) then i_out = i2 else if (i_out == i2) then i_out = i1 end if end do end function flavor_permutation_apply_integer @ %def flavor_permutation_apply_integer @ <>= elemental function flavor_permutation_apply_ftuple (perm, f_in) result (f_out) type(ftuple_t) :: f_out class(flavor_permutation_t), intent(in) :: perm type(ftuple_t), intent(in) :: f_in integer :: i, i1, i2 f_out = f_in do i = size (perm%perms, dim = 1), 1, -1 i1 = perm%perms(i,1) i2 = perm%perms(i,2) if (f_out%ireg(1) == i1) then f_out%ireg(1) = i2 else if (f_out%ireg(1) == i2) then f_out%ireg(1) = i1 end if if (f_out%ireg(2) == i1) then f_out%ireg(2) = i2 else if (f_out%ireg(2) == i2) then f_out%ireg(2) = i1 end if end do if (f_out%ireg(1) > f_out%ireg(2)) f_out%ireg = f_out%ireg([2,1]) end function flavor_permutation_apply_ftuple @ %def flavor_permutation_apply_ftuple @ <>= procedure :: test => flavor_permutation_test <>= function flavor_permutation_test (perm, flv1, flv2, with_tag) result (valid) logical :: valid class(flavor_permutation_t), intent(in) :: perm type(flv_structure_t), intent(in) :: flv1, flv2 logical, intent(in) :: with_tag type(flv_structure_t) :: flv_test flv_test = perm%apply (flv2, invert = .true.) valid = all (flv_test%flst == flv1%flst) if (with_tag) valid = valid .and. all (flv_test%tag == flv1%tag) call flv_test%final () end function flavor_permutation_test @ %def flavor_permutation_test @ A singular region is a partition of phase space which is associated with an individual emitter and, if relevant, resonance. It is associated with an $\alpha_r$- and resonance-index, with a real flavor structure and its underlying Born flavor structure. To compute the FKS weights, it is relevant to know all the other particle indices which can result in a divergenent phase space configuration, which are collected in the [[ftuples]]-array. Some singular regions might behave physically identical. E.g. a real flavor structure associated with three-jet production is $[11,-11,2,-2,21,21]$. Here, there are two possible [[ftuples]] which contribute to the same $u \rightarrow u g$ splitting, namely $(3,5)$ and $(3,6)$. The resulting singular regions will be identical. To avoid this, one singular region is associated with the multiplicity factor [[mult]]. When computing the subtraction terms for each singular region, the result is then simply multiplied by this factor.\\ The [[double_fsr]]-flag indicates whether the singular region should also be supplied by a symmetry factor, explained below. <>= public :: singular_region_t <>= type :: singular_region_t integer :: alr integer :: i_res type(flv_structure_t) :: flst_real type(flv_structure_t) :: flst_uborn integer :: mult integer :: emitter integer :: nregions integer :: real_index type(ftuple_t), dimension(:), allocatable :: ftuples integer :: uborn_index logical :: double_fsr = .false. logical :: soft_divergence = .false. logical :: coll_divergence = .false. type(string_t) :: nlo_correction_type integer, dimension(:), allocatable :: i_reg_to_i_con logical :: pseudo_isr = .false. logical :: sc_required = .false. integer :: eqv_index = 0 contains <> end type singular_region_t @ %def singular_region_t @ <>= procedure :: init => singular_region_init <>= subroutine singular_region_init (sregion, alr, mult, i_res, & flst_real, flst_uborn, flv_born, emitter, ftuples, equivalences, & nlo_correction_type) class(singular_region_t), intent(out) :: sregion integer, intent(in) :: alr, mult, i_res type(flv_structure_t), intent(in) :: flst_real type(flv_structure_t), intent(in) :: flst_uborn type(flv_structure_t), dimension(:), intent(in) :: flv_born integer, intent(in) :: emitter type(ftuple_t), intent(inout), dimension(:) :: ftuples logical, intent(inout), dimension(:,:) :: equivalences type(string_t), intent(in) :: nlo_correction_type integer :: i call debug_input_values () sregion%alr = alr sregion%mult = mult sregion%i_res = i_res sregion%flst_real = flst_real sregion%flst_uborn = flst_uborn sregion%emitter = emitter sregion%nlo_correction_type = nlo_correction_type sregion%nregions = size (ftuples) allocate (sregion%ftuples (sregion%nregions)) sregion%ftuples = ftuples do i = 1, size(flv_born) if (flv_born (i) .equiv. sregion%flst_uborn) then sregion%uborn_index = i exit end if end do sregion%sc_required = any (sregion%flst_uborn%flst == GLUON) .or. & any (sregion%flst_uborn%flst == PHOTON) contains subroutine debug_input_values() if (debug_on) call msg_debug2 (D_SUBTRACTION, "singular_region_init") if (debug2_active (D_SUBTRACTION)) then print *, 'alr = ', alr print *, 'mult = ', mult print *, 'i_res = ', i_res call flst_real%write () call flst_uborn%write () print *, 'emitter = ', emitter call print_equivalence_matrix (ftuples, equivalences) end if end subroutine debug_input_values end subroutine singular_region_init @ %def singular_region_init <>= procedure :: write => singular_region_write <>= subroutine singular_region_write (sregion, unit, maxnregions) class(singular_region_t), intent(in) :: sregion integer, intent(in), optional :: unit integer, intent(in), optional :: maxnregions character(len=7), parameter :: flst_format = "(I3,A1)" character(len=7), parameter :: ireg_space_format = "(7X,A1)" integer :: nreal, nborn, i, u, mr integer :: nleft, nright, nreg, nreg_diff u = given_output_unit (unit); if (u < 0) return mr = sregion%nregions; if (present (maxnregions)) mr = maxnregions nreal = size (sregion%flst_real%flst) nborn = size (sregion%flst_uborn%flst) call write_vline (u) write (u, '(A1)', advance = 'no') '[' do i = 1, nreal - 1 write (u, flst_format, advance = 'no') sregion%flst_real%flst(i), ',' end do write (u, flst_format, advance = 'no') sregion%flst_real%flst(nreal), ']' call write_vline (u) write (u, '(I6)', advance = 'no') sregion%real_index call write_vline (u) write (u, '(I3)', advance = 'no') sregion%emitter call write_vline (u) write (u, '(I3)', advance = 'no') sregion%mult call write_vline (u) write (u, '(I4)', advance = 'no') sregion%nregions call write_vline (u) if (sregion%i_res > 0) then write (u, '(I3)', advance = 'no') sregion%i_res call write_vline (u) end if nreg = sregion%nregions if (nreg == mr) then nleft = 0 nright = 0 else nreg_diff = mr - nreg nleft = nreg_diff / 2 if (mod(nreg_diff , 2) == 0) then nright = nleft else nright = nleft + 1 end if end if if (nleft > 0) then do i = 1, nleft write(u, ireg_space_format, advance='no') ' ' end do end if write (u, '(A)', advance = 'no') char (ftuple_string (sregion%ftuples, .false.)) call write_vline (u) write (u,'(A1)',advance = 'no') '[' do i = 1, nborn - 1 write(u, flst_format, advance = 'no') sregion%flst_uborn%flst(i), ',' end do write (u, flst_format, advance = 'no') sregion%flst_uborn%flst(nborn), ']' call write_vline (u) write (u, '(I7)', advance = 'no') sregion%uborn_index write (u, '(A)') end subroutine singular_region_write @ %def singular_region_write @ <>= procedure :: write_latex => singular_region_write_latex <>= subroutine singular_region_write_latex (region, unit) class(singular_region_t), intent(in) :: region integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(I2,A3,A,A3,I2,A3,I1,A3,I1,A3,A,A3,I2,A3,A,A3)") & region%alr, " & ", char (region%flst_real%to_string ()), & " & ", region%real_index, " & ", region%emitter, " & ", & region%mult, " & ", char (ftuple_string (region%ftuples, .true.)), & " & ", region%uborn_index, " & ", char (region%flst_uborn%to_string ()), & " \\" end subroutine singular_region_write_latex @ %def singular_region_write_latex @ In case of a $g \rightarrow gg$ splitting, the factor \begin{equation*} \frac{2E_{\rm{em}}}{E_{\rm{em}} + E_{\rm{rad}}} \end{equation*} is multiplied to the real matrix element. This way, the symmetry of the splitting is used and only one singular region has to be taken into account. However, the factor ensures that there is only a soft singularity if the radiated parton becomes soft. <>= procedure :: set_splitting_info => singular_region_set_splitting_info <>= subroutine singular_region_set_splitting_info (region, n_in) class(singular_region_t), intent(inout) :: region integer, intent(in) :: n_in integer :: i1, i2 integer :: reg region%double_fsr = .false. region%soft_divergence = .false. associate (ftuple => region%ftuples) do reg = 1, region%nregions call ftuple(reg)%get (i1, i2) if (i1 /= region%emitter .or. i2 /= region%flst_real%nlegs) then cycle else if (ftuple(reg)%splitting_type == V_TO_VV .or. & ftuple(reg)%splitting_type == F_TO_FV ) then region%soft_divergence = .true. end if if (i1 == 0) then region%coll_divergence = .not. all (region%flst_real%massive(1:n_in)) else region%coll_divergence = .not. region%flst_real%massive(i1) end if if (ftuple(reg)%splitting_type == V_TO_VV) then if (all (ftuple(reg)%ireg > n_in)) & region%double_fsr = all (is_gluon (region%flst_real%flst(ftuple(reg)%ireg))) exit else if (ftuple(reg)%splitting_type == UNDEFINED_SPLITTING) then call msg_fatal ("All splittings should be defined!") end if end if end do if (.not. region%soft_divergence .and. .not. region%coll_divergence) & call msg_fatal ("Singular region defined without divergence!") end associate end subroutine singular_region_set_splitting_info @ %def singular_region_set_splitting_info @ <>= procedure :: double_fsr_factor => singular_region_double_fsr_factor <>= function singular_region_double_fsr_factor (region, p) result (val) class(singular_region_t), intent(in) :: region type(vector4_t), intent(in), dimension(:) :: p real(default) :: val real(default) :: E_rad, E_em if (region%double_fsr) then E_em = energy (p(region%emitter)) E_rad = energy (p(region%flst_real%nlegs)) val = two * E_em / (E_em + E_rad) else val = one end if end function singular_region_double_fsr_factor @ %def singular_region_double_fsr_factor @ <>= procedure :: has_soft_divergence => singular_region_has_soft_divergence <>= function singular_region_has_soft_divergence (region) result (div) logical :: div class(singular_region_t), intent(in) :: region div = region%soft_divergence end function singular_region_has_soft_divergence @ %def singular_region_has_soft_divergence @ <>= procedure :: has_collinear_divergence => & singular_region_has_collinear_divergence <>= function singular_region_has_collinear_divergence (region) result (div) logical :: div class(singular_region_t), intent(in) :: region div = region%coll_divergence end function singular_region_has_collinear_divergence @ %def singular_region_has_collinear_divergence @ <>= procedure :: has_identical_ftuples => singular_region_has_identical_ftuples <>= elemental function singular_region_has_identical_ftuples (sregion) result (value) logical :: value class(singular_region_t), intent(in) :: sregion integer :: alr value = .false. do alr = 1, sregion%nregions value = value .or. (count (sregion%ftuples(alr) == sregion%ftuples) > 1) end do end function singular_region_has_identical_ftuples @ %def singular_region_has_identical_ftuples @ <>= interface assignment(=) module procedure singular_region_assign end interface <>= subroutine singular_region_assign (reg_out, reg_in) type(singular_region_t), intent(out) :: reg_out type(singular_region_t), intent(in) :: reg_in reg_out%alr = reg_in%alr reg_out%i_res = reg_in%i_res reg_out%flst_real = reg_in%flst_real reg_out%flst_uborn = reg_in%flst_uborn reg_out%mult = reg_in%mult reg_out%emitter = reg_in%emitter reg_out%nregions = reg_in%nregions reg_out%real_index = reg_in%real_index reg_out%uborn_index = reg_in%uborn_index reg_out%double_fsr = reg_in%double_fsr reg_out%soft_divergence = reg_in%soft_divergence reg_out%coll_divergence = reg_in%coll_divergence reg_out%nlo_correction_type = reg_in%nlo_correction_type if (allocated (reg_in%ftuples)) then allocate (reg_out%ftuples (size (reg_in%ftuples))) reg_out%ftuples = reg_in%ftuples else call msg_bug ("singular_region_assign: Trying to copy a singular region without allocated ftuples!") end if end subroutine singular_region_assign @ %def singular_region_assign @ Two singular regions match if they would produce the same amplitude. For this we have to check that their real and underlying Born flavor structures are equivalent, as determined by the [[prc_core]]. However, since there are more aspects of a singular region that make it unique, we have to check other attributes as well. <>= interface operator(.match.) module procedure singular_region_match end interface <>= function singular_region_match (reg1, reg2) result (match) type(singular_region_t), intent(in) :: reg1, reg2 logical :: match match = all ([reg1%flst_real%eqv_index, reg2%flst_real%eqv_index] > 0) match = match .and. (reg1%flst_real%eqv_index == reg2%flst_real%eqv_index) match = match .and. (reg1%flst_uborn%eqv_index == reg2%flst_uborn%eqv_index) match = match .and. (reg1%mult == reg2%mult) match = match .and. (reg1%emitter == reg2%emitter) match = match .and. (reg1%nregions == reg2%nregions) match = match .and. (reg1%double_fsr .eqv. reg2%double_fsr) match = match .and. (reg1%soft_divergence .eqv. reg2%soft_divergence) match = match .and. (reg1%coll_divergence .eqv. reg2%coll_divergence) match = match .and. (char (reg1%nlo_correction_type) == char (reg2%nlo_correction_type)) if (match) match = match .and. (all (reg1%ftuples == reg2%ftuples)) end function singular_region_match @ %def singular_region_match @ <>= type :: resonance_mapping_t type(resonance_history_t), dimension(:), allocatable :: res_histories integer, dimension(:), allocatable :: alr_to_i_res integer, dimension(:,:), allocatable :: i_res_to_alr type(vector4_t), dimension(:), allocatable :: p_res contains <> end type resonance_mapping_t @ %def resonance_mapping_t @ Testing: Init resonance mapping for $\mu \mu b b$ final state. <>= procedure :: init => resonance_mapping_init <>= subroutine resonance_mapping_init (res_map, res_hist) class(resonance_mapping_t), intent(inout) :: res_map type(resonance_history_t), intent(in), dimension(:) :: res_hist integer :: n_hist, i_hist1, i_hist2, n_contributors n_contributors = 0 n_hist = size (res_hist) allocate (res_map%res_histories (n_hist)) do i_hist1 = 1, n_hist if (i_hist1 + 1 <= n_hist) then do i_hist2 = i_hist1 + 1, n_hist if (.not. (res_hist(i_hist1) .contains. res_hist(i_hist2))) & n_contributors = n_contributors + res_hist(i_hist2)%n_resonances end do else n_contributors = n_contributors + res_hist(i_hist1)%n_resonances end if end do allocate (res_map%p_res (n_contributors)) res_map%res_histories = res_hist res_map%p_res = vector4_null end subroutine resonance_mapping_init @ %def resonance_mapping_init @ <>= procedure :: set_alr_to_i_res => resonance_mapping_set_alr_to_i_res <>= subroutine resonance_mapping_set_alr_to_i_res (res_map, regions, alr_new_to_old) class(resonance_mapping_t), intent(inout) :: res_map type(singular_region_t), intent(in), dimension(:) :: regions integer, intent(out), dimension(:), allocatable :: alr_new_to_old integer :: alr, i_res integer :: alr_new, n_alr_res integer :: k if (debug_on) call msg_debug (D_SUBTRACTION, "resonance_mapping_set_alr_to_i_res") n_alr_res = 0 do alr = 1, size (regions) do i_res = 1, size (res_map%res_histories) if (res_map%res_histories(i_res)%contains_leg (regions(alr)%emitter)) & n_alr_res = n_alr_res + 1 end do end do allocate (res_map%alr_to_i_res (n_alr_res)) allocate (res_map%i_res_to_alr (size (res_map%res_histories), 10)) res_map%i_res_to_alr = 0 allocate (alr_new_to_old (n_alr_res)) alr_new = 1 do alr = 1, size (regions) do i_res = 1, size (res_map%res_histories) if (res_map%res_histories(i_res)%contains_leg (regions(alr)%emitter)) then res_map%alr_to_i_res (alr_new) = i_res alr_new_to_old (alr_new) = alr alr_new = alr_new + 1 end if end do end do do i_res = 1, size (res_map%res_histories) k = 1 do alr = 1, size (regions) if (res_map%res_histories(i_res)%contains_leg (regions(alr)%emitter)) then res_map%i_res_to_alr (i_res, k) = alr k = k + 1 end if end do end do if (debug_active (D_SUBTRACTION)) then print *, 'i_res_to_alr:' do i_res = 1, size(res_map%i_res_to_alr, dim=1) print *, res_map%i_res_to_alr (i_res, :) end do print *, 'alr_new_to_old:', alr_new_to_old end if end subroutine resonance_mapping_set_alr_to_i_res @ %def resonance_mapping_set_alr_to_i_res @ <>= procedure :: get_resonance_history => resonance_mapping_get_resonance_history <>= function resonance_mapping_get_resonance_history (res_map, alr) result (res_hist) type(resonance_history_t) :: res_hist class(resonance_mapping_t), intent(in) :: res_map integer, intent(in) :: alr res_hist = res_map%res_histories(res_map%alr_to_i_res (alr)) end function resonance_mapping_get_resonance_history @ %def resonance_mapping_get_resonance_history @ <>= procedure :: write => resonance_mapping_write <>= subroutine resonance_mapping_write (res_map) class(resonance_mapping_t), intent(in) :: res_map integer :: i_res do i_res = 1, size (res_map%res_histories) call res_map%res_histories(i_res)%write () end do end subroutine resonance_mapping_write @ %def resonance_mapping_write @ <>= procedure :: get_resonance_value => resonance_mapping_get_resonance_value <>= function resonance_mapping_get_resonance_value (res_map, i_res, p, i_gluon) result (p_map) real(default) :: p_map class(resonance_mapping_t), intent(in) :: res_map integer, intent(in) :: i_res type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), optional :: i_gluon p_map = res_map%res_histories(i_res)%mapping (p, i_gluon) end function resonance_mapping_get_resonance_value @ %def resonance_mapping_get_resonance_value @ <>= procedure :: get_resonance_all => resonance_mapping_get_resonance_all <>= function resonance_mapping_get_resonance_all (res_map, alr, p, i_gluon) result (p_map) real(default) :: p_map class(resonance_mapping_t), intent(in) :: res_map integer, intent(in) :: alr type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), optional :: i_gluon integer :: i_res p_map = zero do i_res = 1, size (res_map%res_histories) associate (res => res_map%res_histories(i_res)) if (any (res_map%i_res_to_alr (i_res, :) == alr)) & p_map = p_map + res%mapping (p, i_gluon) end associate end do end function resonance_mapping_get_resonance_all @ %def resonance_mapping_get_resonance_all @ <>= procedure :: get_weight => resonance_mapping_get_weight <>= function resonance_mapping_get_weight (res_map, alr, p) result (pfr) real(default) :: pfr class(resonance_mapping_t), intent(in) :: res_map integer, intent(in) :: alr type(vector4_t), intent(in), dimension(:) :: p real(default) :: sumpfr integer :: i_res sumpfr = zero do i_res = 1, size (res_map%res_histories) sumpfr = sumpfr + res_map%get_resonance_value (i_res, p) end do pfr = res_map%get_resonance_value (res_map%alr_to_i_res (alr), p) / sumpfr end function resonance_mapping_get_weight @ %def resonance_mapping_get_weight @ <>= procedure :: get_resonance_alr => resonance_mapping_get_resonance_alr <>= function resonance_mapping_get_resonance_alr (res_map, alr, p, i_gluon) result (p_map) real(default) :: p_map class(resonance_mapping_t), intent(in) :: res_map integer, intent(in) :: alr type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), optional :: i_gluon integer :: i_res i_res = res_map%alr_to_i_res (alr) p_map = res_map%res_histories(i_res)%mapping (p, i_gluon) end function resonance_mapping_get_resonance_alr @ %def resonance_mapping_get_resonance_alr @ <>= interface assignment(=) module procedure resonance_mapping_assign end interface <>= subroutine resonance_mapping_assign (res_map_out, res_map_in) type(resonance_mapping_t), intent(out) :: res_map_out type(resonance_mapping_t), intent(in) :: res_map_in if (allocated (res_map_in%res_histories)) then allocate (res_map_out%res_histories (size (res_map_in%res_histories))) res_map_out%res_histories = res_map_in%res_histories end if if (allocated (res_map_in%alr_to_i_res)) then allocate (res_map_out%alr_to_i_res (size (res_map_in%alr_to_i_res))) res_map_out%alr_to_i_res = res_map_in%alr_to_i_res end if if (allocated (res_map_in%i_res_to_alr)) then allocate (res_map_out%i_res_to_alr & (size (res_map_in%i_res_to_alr, 1), size (res_map_in%i_res_to_alr, 2))) res_map_out%i_res_to_alr = res_map_in%i_res_to_alr end if if (allocated (res_map_in%p_res)) then allocate (res_map_out%p_res (size (res_map_in%p_res))) res_map_out%p_res = res_map_in%p_res end if end subroutine resonance_mapping_assign @ %def resonance_mapping_assign @ Every FKS mapping should store the $\sum_\alpha d_{ij}^{-1}$ and $\sum_\alpha d_{ij,\rm{soft}}^{-1}$. Also we keep the option open to use a normlization factor, which ensures $\sum_\alpha S_\alpha = 1$. <>= type, abstract :: fks_mapping_t real(default) :: sumdij real(default) :: sumdij_soft logical :: pseudo_isr = .false. real(default) :: normalization_factor = one contains <> end type fks_mapping_t @ %def fks_mapping_t @ <>= public :: fks_mapping_default_t <>= type, extends (fks_mapping_t) :: fks_mapping_default_t real(default) :: exp_1, exp_2 integer :: n_in contains <> end type fks_mapping_default_t @ %def fks_mapping_default_t @ <>= public :: fks_mapping_resonances_t <>= type, extends (fks_mapping_t) :: fks_mapping_resonances_t real(default) :: exp_1, exp_2 type(resonance_mapping_t) :: res_map integer :: i_con = 0 contains <> end type fks_mapping_resonances_t @ %def fks_mapping_resonances_t @ <>= public :: operator(.equiv.) public :: operator(.equivtag.) <>= interface operator(.equiv.) module procedure flv_structure_equivalent_no_tag end interface interface operator(.equivtag.) module procedure flv_structure_equivalent_with_tag end interface interface assignment(=) module procedure flv_structure_assign_flv module procedure flv_structure_assign_integer end interface @ %def operator_equiv @ <>= public :: region_data_t <>= type :: region_data_t type(singular_region_t), dimension(:), allocatable :: regions type(flv_structure_t), dimension(:), allocatable :: flv_born type(flv_structure_t), dimension(:), allocatable :: flv_real integer, dimension(:), allocatable :: eqv_flv_index_born integer, dimension(:), allocatable :: eqv_flv_index_real integer, dimension(:), allocatable :: emitters integer :: n_regions = 0 integer :: n_emitters = 0 integer :: n_flv_born = 0 integer :: n_flv_real = 0 integer :: n_in = 0 integer :: n_legs_born = 0 integer :: n_legs_real = 0 integer :: n_phs = 0 class(fks_mapping_t), allocatable :: fks_mapping integer, dimension(:), allocatable :: resonances type(resonance_contributors_t), dimension(:), allocatable :: alr_contributors integer, dimension(:), allocatable :: alr_to_i_contributor integer, dimension(:), allocatable :: i_phs_to_i_con contains <> end type region_data_t @ %def region_data_t @ <>= procedure :: allocate_fks_mappings => region_data_allocate_fks_mappings <>= subroutine region_data_allocate_fks_mappings (reg_data, mapping_type) class(region_data_t), intent(inout) :: reg_data integer, intent(in) :: mapping_type select case (mapping_type) case (FKS_DEFAULT) allocate (fks_mapping_default_t :: reg_data%fks_mapping) case (FKS_RESONANCES) allocate (fks_mapping_resonances_t :: reg_data%fks_mapping) case default call msg_fatal ("Init region_data: FKS mapping not implemented!") end select end subroutine region_data_allocate_fks_mappings @ %def region_data_allocate_fks_mappings @ <>= procedure :: init => region_data_init <>= subroutine region_data_init (reg_data, n_in, model, flavor_born, & flavor_real, nlo_correction_type) class(region_data_t), intent(inout) :: reg_data integer, intent(in) :: n_in type(model_t), intent(in) :: model integer, intent(in), dimension(:,:) :: flavor_born, flavor_real type(ftuple_list_t), dimension(:), allocatable :: ftuples integer, dimension(:), allocatable :: emitter type(flv_structure_t), dimension(:), allocatable :: flst_alr integer :: i integer :: n_flv_real_before_check type(string_t), intent(in) :: nlo_correction_type reg_data%n_in = n_in reg_data%n_flv_born = size (flavor_born, dim = 2) reg_data%n_legs_born = size (flavor_born, dim = 1) reg_data%n_legs_real = reg_data%n_legs_born + 1 n_flv_real_before_check = size (flavor_real, dim = 2) allocate (reg_data%flv_born (reg_data%n_flv_born)) allocate (reg_data%flv_real (n_flv_real_before_check)) do i = 1, reg_data%n_flv_born call reg_data%flv_born(i)%init (flavor_born (:, i), n_in) end do do i = 1, n_flv_real_before_check call reg_data%flv_real(i)%init (flavor_real (:, i), n_in) end do call reg_data%find_regions (model, ftuples, emitter, flst_alr) call reg_data%init_singular_regions (ftuples, emitter, flst_alr, nlo_correction_type) reg_data%n_flv_real = maxval (reg_data%regions%real_index) call reg_data%find_emitters () call reg_data%set_mass_color_and_charge (model) call reg_data%set_splitting_info () end subroutine region_data_init @ %def region_data_init @ <>= procedure :: init_resonance_information => region_data_init_resonance_information <>= subroutine region_data_init_resonance_information (reg_data) class(region_data_t), intent(inout) :: reg_data call reg_data%enlarge_singular_regions_with_resonances () call reg_data%find_resonances () end subroutine region_data_init_resonance_information @ %def region_data_init_resonance_information @ <>= procedure :: set_resonance_mappings => region_data_set_resonance_mappings <>= subroutine region_data_set_resonance_mappings (reg_data, resonance_histories) class(region_data_t), intent(inout) :: reg_data type(resonance_history_t), intent(in), dimension(:) :: resonance_histories select type (map => reg_data%fks_mapping) type is (fks_mapping_resonances_t) call map%res_map%init (resonance_histories) end select end subroutine region_data_set_resonance_mappings @ %def region_data_set_resonance_mappings @ <>= procedure :: setup_fks_mappings => region_data_setup_fks_mappings <>= subroutine region_data_setup_fks_mappings (reg_data, template, n_in) class(region_data_t), intent(inout) :: reg_data type(fks_template_t), intent(in) :: template integer, intent(in) :: n_in call reg_data%allocate_fks_mappings (template%mapping_type) select type (map => reg_data%fks_mapping) type is (fks_mapping_default_t) call map%set_parameter (n_in, template%fks_dij_exp1, template%fks_dij_exp2) end select end subroutine region_data_setup_fks_mappings @ %def region_data_setup_fks_mappings @ So far, we have only created singular regions for a non-resonant case. When resonance mappings are required, we have more singular regions, since they must now be identified by their emitter-resonance pair index, where the emitter must be compatible with the resonance. <>= procedure :: enlarge_singular_regions_with_resonances & => region_data_enlarge_singular_regions_with_resonances <>= subroutine region_data_enlarge_singular_regions_with_resonances (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr integer, dimension(:), allocatable :: alr_new_to_old integer :: n_alr_new type(singular_region_t), dimension(:), allocatable :: save_regions if (debug_on) call msg_debug (D_SUBTRACTION, "region_data_enlarge_singular_regions_with_resonances") call debug_input_values () select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_default_t) return type is (fks_mapping_resonances_t) allocate (save_regions (reg_data%n_regions)) do alr = 1, reg_data%n_regions save_regions(alr) = reg_data%regions(alr) end do associate (res_map => fks_mapping%res_map) call res_map%set_alr_to_i_res (reg_data%regions, alr_new_to_old) deallocate (reg_data%regions) n_alr_new = size (alr_new_to_old) reg_data%n_regions = n_alr_new allocate (reg_data%regions (n_alr_new)) do alr = 1, n_alr_new reg_data%regions(alr) = save_regions(alr_new_to_old (alr)) reg_data%regions(alr)%i_res = res_map%alr_to_i_res (alr) end do end associate end select contains subroutine debug_input_values () if (debug2_active (D_SUBTRACTION)) then call reg_data%write () end if end subroutine debug_input_values end subroutine region_data_enlarge_singular_regions_with_resonances @ %def region_data_enlarge_singular_regions_with_resonances @ <>= procedure :: set_isr_pseudo_regions => region_data_set_isr_pseudo_regions <>= subroutine region_data_set_isr_pseudo_regions (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr integer :: n_alr_new !!! Subroutine called for threshold factorization -> !!! Size of singular regions at this point is fixed type(singular_region_t), dimension(2) :: save_regions integer, dimension(4) :: alr_new_to_old do alr = 1, reg_data%n_regions save_regions(alr) = reg_data%regions(alr) end do n_alr_new = reg_data%n_regions * 2 alr_new_to_old = [1, 1, 2, 2] deallocate (reg_data%regions) allocate (reg_data%regions (n_alr_new)) reg_data%n_regions = n_alr_new do alr = 1, n_alr_new reg_data%regions(alr) = save_regions(alr_new_to_old (alr)) call add_pseudo_emitters (reg_data%regions(alr)) if (mod (alr, 2) == 0) reg_data%regions(alr)%pseudo_isr = .true. end do contains subroutine add_pseudo_emitters (sregion) type(singular_region_t), intent(inout) :: sregion type(ftuple_t), dimension(2) :: ftuples_save integer :: alr do alr = 1, 2 ftuples_save(alr) = sregion%ftuples(alr) end do deallocate (sregion%ftuples) sregion%nregions = sregion%nregions * 2 allocate (sregion%ftuples (sregion%nregions)) do alr = 1, sregion%nregions sregion%ftuples(alr) = ftuples_save (alr_new_to_old(alr)) if (mod (alr, 2) == 0) sregion%ftuples(alr)%pseudo_isr = .true. end do end subroutine add_pseudo_emitters end subroutine region_data_set_isr_pseudo_regions @ %def region_data_set_isr_pseudo_regions @ This subroutine splits up the ftuple-list of the singular regions into interference-free lists, i.e. lists which only contain the same emitter. This is relevant for factorized NLO calculations. In the current implementation, it is hand-tailored for the threshold computation, but should be generalized further in the future. <>= procedure :: split_up_interference_regions_for_threshold => & region_data_split_up_interference_regions_for_threshold <>= subroutine region_data_split_up_interference_regions_for_threshold (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr, i_ftuple integer :: current_emitter integer :: i1, i2 integer :: n_new_reg type(ftuple_t), dimension(2) :: ftuples do alr = 1, reg_data%n_regions associate (region => reg_data%regions(alr)) current_emitter = region%emitter n_new_reg = 0 do i_ftuple = 1, region%nregions call region%ftuples(i_ftuple)%get (i1, i2) if (i1 == current_emitter) then n_new_reg = n_new_reg + 1 ftuples(n_new_reg) = region%ftuples(i_ftuple) end if end do deallocate (region%ftuples) allocate (region%ftuples(n_new_reg)) region%ftuples = ftuples (1 : n_new_reg) region%nregions = n_new_reg end associate end do reg_data%fks_mapping%normalization_factor = 0.5_default end subroutine region_data_split_up_interference_regions_for_threshold @ %def region_data_split_up_interference_regions_for_threshold @ <>= procedure :: set_mass_color_and_charge => region_data_set_mass_color_and_charge <>= subroutine region_data_set_mass_color_and_charge (reg_data, model) class(region_data_t), intent(inout) :: reg_data type(model_t), intent(in) :: model integer :: i do i = 1, reg_data%n_regions associate (region => reg_data%regions(i)) call region%flst_uborn%init_mass_color_and_charge (model) call region%flst_real%init_mass_color_and_charge (model) end associate end do do i = 1, reg_data%n_flv_born call reg_data%flv_born(i)%init_mass_color_and_charge (model) end do do i = 1, size (reg_data%flv_real) call reg_data%flv_real(i)%init_mass_color_and_charge (model) end do end subroutine region_data_set_mass_color_and_charge @ %def region_data_set_mass_color_and_charge @ <>= procedure :: uses_resonances => region_data_uses_resonances <>= function region_data_uses_resonances (reg_data) result (val) logical :: val class(region_data_t), intent(in) :: reg_data select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) val = .true. class default val = .false. end select end function region_data_uses_resonances @ %def region_data_uses_resonances @ Creates a list containing the emitter of each singular region. <>= procedure :: get_emitter_list => region_data_get_emitter_list <>= pure function region_data_get_emitter_list (reg_data) result (emitters) class(region_data_t), intent(in) :: reg_data integer, dimension(:), allocatable :: emitters integer :: i allocate (emitters (reg_data%n_regions)) do i = 1, reg_data%n_regions emitters(i) = reg_data%regions(i)%emitter end do end function region_data_get_emitter_list @ %def region_data_get_emitter_list @ Returns the number of emitters not equal to 0 to avoid double counting between emitters 0, 1 and 2. <>= procedure :: get_n_emitters_sc => region_data_get_n_emitters_sc <>= function region_data_get_n_emitters_sc (reg_data) result (n_emitters_sc) class(region_data_t), intent(in) :: reg_data integer :: n_emitters_sc n_emitters_sc = count (reg_data%emitters /= 0) end function region_data_get_n_emitters_sc @ %def region_data_get_n_emitters_sc @ <>= procedure :: get_associated_resonances => region_data_get_associated_resonances <>= function region_data_get_associated_resonances (reg_data, emitter) result (res) integer, dimension(:), allocatable :: res class(region_data_t), intent(in) :: reg_data integer, intent(in) :: emitter integer :: alr, i integer :: n_res select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) n_res = 0 do alr = 1, reg_data%n_regions if (reg_data%regions(alr)%emitter == emitter) & n_res = n_res + 1 end do if (n_res > 0) then allocate (res (n_res)) else return end if i = 1 do alr = 1, reg_data%n_regions if (reg_data%regions(alr)%emitter == emitter) then res (i) = fks_mapping%res_map%alr_to_i_res (alr) i = i + 1 end if end do end select end function region_data_get_associated_resonances @ %def region_data_get_associated_resonances @ <>= procedure :: emitter_is_compatible_with_resonance => & region_data_emitter_is_compatible_with_resonance <>= function region_data_emitter_is_compatible_with_resonance & (reg_data, i_res, emitter) result (compatible) logical :: compatible class(region_data_t), intent(in) :: reg_data integer, intent(in) :: i_res, emitter integer :: i_res_alr, alr compatible = .false. select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) do alr = 1, reg_data%n_regions i_res_alr = fks_mapping%res_map%alr_to_i_res (alr) if (i_res_alr == i_res .and. reg_data%get_emitter(alr) == emitter) then compatible = .true. exit end if end do end select end function region_data_emitter_is_compatible_with_resonance @ %def region_data_emitter_is_compatible_with_resonance @ <>= procedure :: emitter_is_in_resonance => region_data_emitter_is_in_resonance <>= function region_data_emitter_is_in_resonance (reg_data, i_res, emitter) result (exist) logical :: exist class(region_data_t), intent(in) :: reg_data integer, intent(in) :: i_res, emitter integer :: i exist = .false. select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) associate (res_history => fks_mapping%res_map%res_histories(i_res)) do i = 1, res_history%n_resonances exist = exist .or. any (res_history%resonances(i)%contributors%c == emitter) end do end associate end select end function region_data_emitter_is_in_resonance @ %def region_data_emitter_is_in_resonance @ <>= procedure :: get_contributors => region_data_get_contributors <>= subroutine region_data_get_contributors (reg_data, i_res, emitter, c, success) class(region_data_t), intent(in) :: reg_data integer, intent(in) :: i_res, emitter integer, intent(inout), dimension(:), allocatable :: c logical, intent(out) :: success integer :: i success = .false. select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) associate (res_history => fks_mapping%res_map%res_histories (i_res)) do i = 1, res_history%n_resonances if (any (res_history%resonances(i)%contributors%c == emitter)) then allocate (c (size (res_history%resonances(i)%contributors%c))) c = res_history%resonances(i)%contributors%c success = .true. exit end if end do end associate end select end subroutine region_data_get_contributors @ %def region_data_get_contributors @ <>= procedure :: get_emitter => region_data_get_emitter <>= pure function region_data_get_emitter (reg_data, alr) result (emitter) class(region_data_t), intent(in) :: reg_data integer, intent(in) :: alr integer :: emitter emitter = reg_data%regions(alr)%emitter end function region_data_get_emitter @ %def region_data_get_emitter @ <>= procedure :: map_real_to_born_index => region_data_map_real_to_born_index <>= function region_data_map_real_to_born_index (reg_data, real_index) result (uborn_index) integer :: uborn_index class(region_data_t), intent(in) :: reg_data integer, intent(in) :: real_index integer :: alr uborn_index = 0 do alr = 1, size (reg_data%regions) if (reg_data%regions(alr)%real_index == real_index) then uborn_index = reg_data%regions(alr)%uborn_index exit end if end do end function region_data_map_real_to_born_index @ %def region_data_map_real_to_born_index @ <>= generic :: get_flv_states_born => get_flv_states_born_single, get_flv_states_born_array procedure :: get_flv_states_born_single => region_data_get_flv_states_born_single procedure :: get_flv_states_born_array => region_data_get_flv_states_born_array <>= function region_data_get_flv_states_born_array (reg_data) result (flv_states) integer, dimension(:,:), allocatable :: flv_states class(region_data_t), intent(in) :: reg_data integer :: i_flv allocate (flv_states (reg_data%n_legs_born, reg_data%n_flv_born)) do i_flv = 1, reg_data%n_flv_born flv_states (:, i_flv) = reg_data%flv_born(i_flv)%flst end do end function region_data_get_flv_states_born_array function region_data_get_flv_states_born_single (reg_data, i_flv) result (flv_states) integer, dimension(:), allocatable :: flv_states class(region_data_t), intent(in) :: reg_data integer, intent(in) :: i_flv allocate (flv_states (reg_data%n_legs_born)) flv_states = reg_data%flv_born(i_flv)%flst end function region_data_get_flv_states_born_single @ %def region_data_get_flv_states_born @ <>= generic :: get_flv_states_real => get_flv_states_real_single, get_flv_states_real_array procedure :: get_flv_states_real_single => region_data_get_flv_states_real_single procedure :: get_flv_states_real_array => region_data_get_flv_states_real_array <>= function region_data_get_flv_states_real_single (reg_data, i_flv) result (flv_states) integer, dimension(:), allocatable :: flv_states class(region_data_t), intent(in) :: reg_data integer, intent(in) :: i_flv integer :: i_reg allocate (flv_states (reg_data%n_legs_real)) do i_reg = 1, reg_data%n_regions if (i_flv == reg_data%regions(i_reg)%real_index) then flv_states = reg_data%regions(i_reg)%flst_real%flst exit end if end do end function region_data_get_flv_states_real_single function region_data_get_flv_states_real_array (reg_data) result (flv_states) integer, dimension(:,:), allocatable :: flv_states class(region_data_t), intent(in) :: reg_data integer :: i_flv allocate (flv_states (reg_data%n_legs_real, reg_data%n_flv_real)) do i_flv = 1, reg_data%n_flv_real flv_states (:, i_flv) = reg_data%get_flv_states_real (i_flv) end do end function region_data_get_flv_states_real_array @ %def region_data_get_flv_states_real @ <>= procedure :: get_all_flv_states => region_data_get_all_flv_states <>= subroutine region_data_get_all_flv_states (reg_data, flv_born, flv_real) class(region_data_t), intent(in) :: reg_data integer, dimension(:,:), allocatable, intent(out) :: flv_born, flv_real allocate (flv_born (reg_data%n_legs_born, reg_data%n_flv_born)) flv_born = reg_data%get_flv_states_born () allocate (flv_real (reg_data%n_legs_real, reg_data%n_flv_real)) flv_real = reg_data%get_flv_states_real () end subroutine region_data_get_all_flv_states @ %def region_data_get_all_flv_states @ <>= procedure :: get_n_in => region_data_get_n_in <>= function region_data_get_n_in (reg_data) result (n_in) integer :: n_in class(region_data_t), intent(in) :: reg_data n_in = reg_data%n_in end function region_data_get_n_in @ %def region_data_get_n_in @ <>= procedure :: get_n_legs_real => region_data_get_n_legs_real <>= function region_data_get_n_legs_real (reg_data) result (n_legs) integer :: n_legs class(region_data_t), intent(in) :: reg_data n_legs = reg_data%n_legs_real end function region_data_get_n_legs_real @ %def region_data_get_n_legs_real <>= procedure :: get_n_legs_born => region_data_get_n_legs_born <>= function region_data_get_n_legs_born (reg_data) result (n_legs) integer :: n_legs class(region_data_t), intent(in) :: reg_data n_legs = reg_data%n_legs_born end function region_data_get_n_legs_born @ %def region_data_get_n_legs_born <>= procedure :: get_n_flv_real => region_data_get_n_flv_real <>= function region_data_get_n_flv_real (reg_data) result (n_flv) integer :: n_flv class(region_data_t), intent(in) :: reg_data n_flv = reg_data%n_flv_real end function region_data_get_n_flv_real @ %def region_data_get_n_flv_real <>= procedure :: get_n_flv_born => region_data_get_n_flv_born <>= function region_data_get_n_flv_born (reg_data) result (n_flv) integer :: n_flv class(region_data_t), intent(in) :: reg_data n_flv = reg_data%n_flv_born end function region_data_get_n_flv_born @ %def region_data_get_n_flv_born @ Returns $S_i = \frac{1}{\mathcal{D}d_i}$ or $S_{ij} = \frac{1}{\mathcal{D}d_{ij}}$ for one particular singular region. At this point, the flavor array should be rearranged in such a way that the emitted particle is at the last position of the flavor structure list. <>= generic :: get_svalue => get_svalue_last_pos, get_svalue_ij procedure :: get_svalue_last_pos => region_data_get_svalue_last_pos procedure :: get_svalue_ij => region_data_get_svalue_ij <>= function region_data_get_svalue_ij (reg_data, p_real, alr, i, j, i_res) result (sval) class(region_data_t), intent(inout) :: reg_data type(vector4_t), intent(in), dimension(:) :: p_real integer, intent(in) :: alr, i, j integer, intent(in) :: i_res real(default) :: sval associate (map => reg_data%fks_mapping) call map%compute_sumdij (reg_data%regions(alr), p_real) select type (map) type is (fks_mapping_resonances_t) map%i_con = reg_data%alr_to_i_contributor (alr) end select map%pseudo_isr = reg_data%regions(alr)%pseudo_isr sval = map%svalue (p_real, i, j, i_res) * map%normalization_factor end associate end function region_data_get_svalue_ij function region_data_get_svalue_last_pos (reg_data, p, alr, emitter, i_res) result (sval) class(region_data_t), intent(inout) :: reg_data type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: alr, emitter integer, intent(in) :: i_res real(default) :: sval sval = reg_data%get_svalue (p, alr, emitter, reg_data%n_legs_real, i_res) end function region_data_get_svalue_last_pos @ %def region_data_get_svalue @ The same as above, but for the soft limit. <>= procedure :: get_svalue_soft => region_data_get_svalue_soft <>= function region_data_get_svalue_soft & (reg_data, p_born, p_soft, alr, emitter, i_res) result (sval) class(region_data_t), intent(inout) :: reg_data type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft integer, intent(in) :: alr, emitter, i_res real(default) :: sval associate (map => reg_data%fks_mapping) call map%compute_sumdij_soft (reg_data%regions(alr), p_born, p_soft) select type (map) type is (fks_mapping_resonances_t) map%i_con = reg_data%alr_to_i_contributor (alr) end select map%pseudo_isr = reg_data%regions(alr)%pseudo_isr sval = map%svalue_soft (p_born, p_soft, emitter, i_res) * map%normalization_factor end associate end function region_data_get_svalue_soft @ %def region_data_get_svalue_soft @ This subroutine starts with a specification of $N$- and $N+1$-particle configurations, [[flst_born]] and [[flst_real]], saved in [[reg_data]]. From these, it creates a list of fundamental tuples, a list of emitters and a list containing the $N+1$-particle configuration, rearranged in such a way that the emitter-radiation pair is last ([[flst_alr]]). For the $e^+ \, e^- \, \rightarrow u \, \bar{u} \, g$- example, the generated objects are shown in table \ref{table:ftuples and flavors}. Note that at this point, [[flst_alr]] is arranged in such a way that the emitter can only be equal to $n_{legs}-1$ for final-state radiation or 0, 1, or 2 for initial-state radiation. Further, it occurs that regions can be equivalent. For example in table \ref{table:ftuples and flavors} the regions corresponding to \texttt{alr} = 1 and \texttt{alr} = 3 as well as \texttt{alr} = 2 and \texttt{alr} = 4 describe the same physics and are therefore equivalent. @ <>= procedure :: find_regions => region_data_find_regions <>= subroutine region_data_find_regions & (reg_data, model, ftuples, emitters, flst_alr) class(region_data_t), intent(in) :: reg_data type(model_t), intent(in) :: model type(ftuple_list_t), intent(out), dimension(:), allocatable :: ftuples integer, intent(out), dimension(:), allocatable :: emitters type(flv_structure_t), intent(out), dimension(:), allocatable :: flst_alr type(ftuple_list_t), dimension(:,:), allocatable :: ftuples_tmp integer, dimension(:,:), allocatable :: ftuple_index integer :: n_born, n_real integer :: n_legreal integer :: i_born, i_real, i_ftuple integer :: last_registered_i_born, last_registered_i_real n_born = size (reg_data%flv_born) n_real = size (reg_data%flv_real) n_legreal = size (reg_data%flv_real(1)%flst) allocate (emitters (0)) allocate (flst_alr (0)) allocate (ftuples (0)) i_ftuple = 0 last_registered_i_born = 0; last_registered_i_real = 0 do i_real = 1, n_real do i_born = 1, n_born call setup_flsts_emitters_and_ftuples_fsr & (i_real, i_born, i_ftuple, flst_alr, emitters, ftuples) call setup_flsts_emitters_and_ftuples_isr & (i_real, i_born, i_ftuple, flst_alr, emitters, ftuples) end do end do contains function incr_i_ftuple_if_required (i_born, i_real, i_ftuple_in) result (i_ftuple) integer :: i_ftuple integer, intent(in) :: i_born, i_real, i_ftuple_in if (last_registered_i_born /= i_born .or. last_registered_i_real /= i_real) then last_registered_i_born = i_born last_registered_i_real = i_real i_ftuple = i_ftuple_in + 1 else i_ftuple = i_ftuple_in end if end function incr_i_ftuple_if_required subroutine setup_flsts_emitters_and_ftuples_fsr & (i_real, i_born, i_ftuple, flst_alr, emitters, ftuples) integer, intent(in) :: i_real, i_born integer, intent(inout) :: i_ftuple type(flv_structure_t), intent(inout), dimension(:), allocatable :: flst_alr integer, intent(inout), dimension(:), allocatable :: emitters type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples type(ftuple_list_t) :: ftuples_tmp type(flv_structure_t) :: flst_alr_tmp type(ftuple_t) :: current_ftuple integer :: leg1, leg2 logical :: valid1, valid2 associate (flv_born => reg_data%flv_born(i_born), & flv_real => reg_data%flv_real(i_real)) do leg1 = reg_data%n_in + 1, n_legreal do leg2 = leg1 + 1, n_legreal valid1 = flv_real%valid_pair(leg1, leg2, flv_born, model) valid2 = flv_real%valid_pair(leg2, leg1, flv_born, model) if (valid1 .or. valid2) then if(valid1) then flst_alr_tmp = create_alr (flv_real, & reg_data%n_in, leg1, leg2) else flst_alr_tmp = create_alr (flv_real, & reg_data%n_in, leg2, leg1) end if flst_alr = [flst_alr, flst_alr_tmp] emitters = [emitters, n_legreal - 1] call current_ftuple%set (leg1, leg2) call current_ftuple%determine_splitting_type_fsr & (flv_real, leg1, leg2) i_ftuple = incr_i_ftuple_if_required (i_born, i_real, i_ftuple) if (i_ftuple > size (ftuples)) then call ftuples_tmp%append (current_ftuple) ftuples = [ftuples, ftuples_tmp] else call ftuples(i_ftuple)%append (current_ftuple) end if end if end do end do end associate end subroutine setup_flsts_emitters_and_ftuples_fsr subroutine setup_flsts_emitters_and_ftuples_isr & (i_real, i_born, i_ftuple, flst_alr, emitters, ftuples) integer, intent(in) :: i_real, i_born integer, intent(inout) :: i_ftuple type(flv_structure_t), intent(inout), dimension(:), allocatable :: flst_alr integer, intent(inout), dimension(:), allocatable :: emitters type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples type(ftuple_list_t) :: ftuples_tmp type(flv_structure_t) :: flst_alr_tmp type(ftuple_t) :: current_ftuple integer :: leg, emitter logical :: valid1, valid2 associate (flv_born => reg_data%flv_born(i_born), & flv_real => reg_data%flv_real(i_real)) do leg = reg_data%n_in + 1, n_legreal valid1 = flv_real%valid_pair(1, leg, flv_born, model) if (reg_data%n_in > 1) then valid2 = flv_real%valid_pair(2, leg, flv_born, model) else valid2 = .false. end if if (valid1 .and. valid2) then emitter = 0 else if (valid1 .and. .not. valid2) then emitter = 1 else if (.not. valid1 .and. valid2) then emitter = 2 else emitter = -1 end if if (valid1 .or. valid2) then flst_alr_tmp = create_alr (flv_real, reg_data%n_in, emitter, leg) flst_alr = [flst_alr, flst_alr_tmp] emitters = [emitters, emitter] call current_ftuple%set(emitter, leg) call current_ftuple%determine_splitting_type_isr & (flv_real, emitter, leg) i_ftuple = incr_i_ftuple_if_required (i_born, i_real, i_ftuple) if (i_ftuple > size (ftuples)) then call ftuples_tmp%append (current_ftuple) ftuples = [ftuples, ftuples_tmp] else call ftuples(i_ftuple)%append (current_ftuple) end if end if end do end associate end subroutine setup_flsts_emitters_and_ftuples_isr end subroutine region_data_find_regions @ %def region_data_find_regions @ We transfer the mapping of flavor structures that lead to the same amplitude (with structure functions already accounted for!) to the Born and real [[flv_structure]] of each [[singular_region]]. We then use this information, besides other data of each [[singular_region]], to determine which produce the same amplitude for the non-subtracted real and real subtraction terms and set up the equivalence index mapping for each region. <>= procedure :: find_eqv_regions => region_data_find_eqv_regions <>= subroutine region_data_find_eqv_regions (reg_data, optimize) class(region_data_t), intent(inout) :: reg_data logical, intent(in) :: optimize integer :: n_reg, alr1, alr2 n_reg = reg_data%n_regions if (optimize) then do alr1 = 1, n_reg reg_data%regions(alr1)%flst_uborn%eqv_index = & reg_data%eqv_flv_index_born(reg_data%regions(alr1)%uborn_index) reg_data%regions(alr1)%flst_real%eqv_index = & reg_data%eqv_flv_index_real(reg_data%regions(alr1)%real_index) end do do alr1 = 1, n_reg do alr2 = 1, alr1 if (reg_data%regions(alr2) .match. reg_data%regions(alr1)) then reg_data%regions(alr1)%eqv_index = alr2 exit end if end do end do else do alr1 = 1, n_reg reg_data%regions(alr1)%eqv_index = alr1 end do end if end subroutine region_data_find_eqv_regions @ %def region_data_find_eqv_regions @ Creates singular regions according to table \ref{table:singular regions}. It scans all regions in table \ref{table:ftuples and flavors} and records the real flavor structures. If they are equivalent, the flavor structure is not recorded, but the multiplicity of the present one is increased. <>= procedure :: init_singular_regions => region_data_init_singular_regions <>= subroutine region_data_init_singular_regions & (reg_data, ftuples, emitter, flv_alr, nlo_correction_type) class(region_data_t), intent(inout) :: reg_data type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples type(string_t), intent(in) :: nlo_correction_type integer :: n_independent_flv integer, intent(in), dimension(:) :: emitter type(flv_structure_t), intent(in), dimension(:) :: flv_alr type(flv_structure_t), dimension(:), allocatable :: flv_uborn, flv_alr_registered integer, dimension(:), allocatable :: mult integer, dimension(:), allocatable :: flst_emitter integer :: n_regions, maxregions integer, dimension(:), allocatable :: index integer :: i, i_flv, n_legs logical :: equiv, valid_fs_splitting integer :: i_first, i_reg, i_reg_prev integer, dimension(:), allocatable :: region_to_ftuple, alr_limits integer, dimension(:), allocatable :: equiv_index maxregions = size (emitter) n_legs = flv_alr(1)%nlegs allocate (flv_uborn (maxregions)) allocate (flv_alr_registered (maxregions)) allocate (mult (maxregions)) mult = 0 allocate (flst_emitter (maxregions)) allocate (index (0)) allocate (region_to_ftuple (maxregions)) allocate (equiv_index (maxregions)) call setup_region_mappings (n_independent_flv, alr_limits, region_to_ftuple) i_first = 1 i_reg = 1 SCAN_FLAVORS: do i_flv = 1, n_independent_flv SCAN_FTUPLES: do i = i_first, i_first + alr_limits (i_flv) - 1 equiv = .false. if (i == i_first) then flv_alr_registered(i_reg) = flv_alr(i) mult(i_reg) = mult(i_reg) + 1 flv_uborn(i_reg) = flv_alr(i)%create_uborn (emitter(i), nlo_correction_type) flst_emitter(i_reg) = emitter(i) index = [index, region_to_real_index(ftuples, i)] equiv_index(i_reg) = region_to_ftuple(i) i_reg = i_reg + 1 else !!! Check for equivalent flavor structures do i_reg_prev = 1, i_reg - 1 if (emitter(i) == flst_emitter(i_reg_prev) .and. emitter(i) > reg_data%n_in) then valid_fs_splitting = check_fs_splitting (flv_alr(i)%get_last_two(n_legs), & flv_alr_registered(i_reg_prev)%get_last_two(n_legs), & flv_alr(i)%tag(n_legs - 1), flv_alr_registered(i_reg_prev)%tag(n_legs - 1)) if ((flv_alr(i) .equiv. flv_alr_registered(i_reg_prev)) & .and. valid_fs_splitting) then mult(i_reg_prev) = mult(i_reg_prev) + 1 equiv = .true. call ftuples(region_to_real_index(ftuples, i))%set_equiv & (equiv_index(i_reg_prev), region_to_ftuple(i)) exit end if else if (emitter(i) == flst_emitter(i_reg_prev) .and. emitter(i) <= reg_data%n_in) then if (flv_alr(i) .equiv. flv_alr_registered(i_reg_prev)) then mult(i_reg_prev) = mult(i_reg_prev) + 1 equiv = .true. call ftuples(region_to_real_index(ftuples, i))%set_equiv & (equiv_index(i_reg_prev), region_to_ftuple(i)) exit end if end if end do if (.not. equiv) then flv_alr_registered(i_reg) = flv_alr(i) mult(i_reg) = mult(i_reg) + 1 flv_uborn(i_reg) = flv_alr(i)%create_uborn (emitter(i), nlo_correction_type) flst_emitter(i_reg) = emitter(i) index = [index, region_to_real_index(ftuples, i)] equiv_index (i_reg) = region_to_ftuple(i) i_reg = i_reg + 1 end if end if end do SCAN_FTUPLES i_first = i_first + alr_limits(i_flv) end do SCAN_FLAVORS n_regions = i_reg - 1 allocate (reg_data%regions (n_regions)) reg_data%n_regions = n_regions call account_for_regions_from_other_uborns (ftuples) call init_regions_with_permuted_flavors () call assign_real_indices () deallocate (flv_uborn) deallocate (flv_alr_registered) deallocate (mult) deallocate (flst_emitter) deallocate (index) deallocate (region_to_ftuple) deallocate (equiv_index) contains subroutine account_for_regions_from_other_uborns (ftuples) type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples integer :: alr1, alr2, i type(ftuple_t), dimension(:), allocatable :: ftuples_alr1, ftuples_alr2 type(flavor_permutation_t) :: perm_list logical, dimension(:,:), allocatable :: equivalences do alr1 = 1, n_regions do alr2 = 1, n_regions if (index(alr1) == index(alr2)) cycle if (flv_alr_registered(alr1) .equiv. flv_alr_registered(alr2)) then call ftuples(index(alr1))%to_array (ftuples_alr1, equivalences, .false.) call ftuples(index(alr2))%to_array (ftuples_alr2, equivalences, .false.) do i = 1, size (ftuples_alr2) if (.not. any (ftuple_equal_ireg (ftuples_alr1, ftuples_alr2(i)))) then call ftuples(index(alr1))%append (ftuples_alr2(i)) end if end do end if end do end do end subroutine account_for_regions_from_other_uborns subroutine setup_region_mappings (n_independent_flv, & alr_limits, region_to_ftuple) integer, intent(inout) :: n_independent_flv integer, intent(inout), dimension(:), allocatable :: alr_limits integer, intent(inout), dimension(:), allocatable :: region_to_ftuple integer :: i, j, i_flv if (any (ftuples%get_n_tuples() == 0)) & call msg_fatal ("Inconsistent collection of FKS pairs!") n_independent_flv = size (ftuples) alr_limits = ftuples%get_n_tuples() if (.not. (sum (alr_limits) == maxregions)) & call msg_fatal ("Too many regions!") j = 1 do i_flv = 1, n_independent_flv do i = 1, alr_limits(i_flv) region_to_ftuple(j) = i j = j + 1 end do end do end subroutine setup_region_mappings subroutine check_permutation (perm, flv_perm, flv_orig, i_reg) type(flavor_permutation_t), intent(in) :: perm type(flv_structure_t), intent(in) :: flv_perm, flv_orig integer, intent(in) :: i_reg type(flv_structure_t) :: flv_test flv_test = perm%apply (flv_orig, invert = .true.) if (.not. all (flv_test%flst == flv_perm%flst)) then print *, 'Fail at: ', i_reg print *, 'Original flavor structure: ', flv_orig%flst call perm%write () print *, 'Permuted flavor: ', flv_perm%flst print *, 'Should be: ', flv_test%flst call msg_fatal ("Permutation does not reproduce original flavor!") end if end subroutine check_permutation subroutine init_regions_with_permuted_flavors () type(flavor_permutation_t) :: perm_list type(ftuple_t), dimension(:), allocatable :: ftuple_array logical, dimension(:,:), allocatable :: equivalences integer :: i, j do j = 1, n_regions do i = 1, reg_data%n_flv_born if (reg_data%flv_born (i) .equiv. flv_uborn (j)) then call perm_list%reset () call perm_list%init (reg_data%flv_born(i), flv_uborn(j), & reg_data%n_in, reg_data%n_legs_born, .true.) flv_uborn(j) = perm_list%apply (flv_uborn(j)) flv_alr_registered(j) = perm_list%apply (flv_alr_registered(j)) flst_emitter(j) = perm_list%apply (flst_emitter(j)) end if end do call ftuples(index(j))%to_array (ftuple_array, equivalences, .false.) do i = 1, size (reg_data%flv_real) if (reg_data%flv_real(i) .equiv. flv_alr_registered(j)) then call perm_list%reset () call perm_list%init (flv_alr_registered(j), reg_data%flv_real(i), & reg_data%n_in, reg_data%n_legs_real, .false.) if (debug_active (D_SUBTRACTION)) call check_permutation & (perm_list, reg_data%flv_real(i), flv_alr_registered(j), j) ftuple_array = perm_list%apply (ftuple_array) call ftuple_sort_array (ftuple_array, equivalences) end if end do call reg_data%regions(j)%init (j, mult(j), 0, flv_alr_registered(j), & flv_uborn(j), reg_data%flv_born, flst_emitter(j), ftuple_array, & equivalences, nlo_correction_type) if (allocated (ftuple_array)) deallocate (ftuple_array) if (allocated (equivalences)) deallocate (equivalences) end do end subroutine init_regions_with_permuted_flavors subroutine assign_real_indices () type(flv_structure_t) :: current_flv_real type(flv_structure_t), dimension(:), allocatable :: these_flv integer :: i_real, current_uborn_index integer :: i, j, this_i_real allocate (these_flv (size (flv_alr_registered))) i_real = 1 associate (regions => reg_data%regions) do i = 1, reg_data%n_regions do j = 1, size (these_flv) if (.not. allocated (these_flv(j)%flst)) then this_i_real = i_real call these_flv(i_real)%init (flv_alr_registered(i)%flst, reg_data%n_in) i_real = i_real + 1 exit else if (all (these_flv(j)%flst == flv_alr_registered(i)%flst)) then this_i_real = j exit end if end do regions(i)%real_index = this_i_real end do end associate deallocate (these_flv) end subroutine assign_real_indices subroutine write_perm_list (perm_list) integer, intent(in), dimension(:,:) :: perm_list integer :: i do i = 1, size (perm_list(:,1)) write (*,'(I1,1x,I1,A)', advance = "no" ) perm_list(i,1), perm_list(i,2), '/' end do print *, '' end subroutine write_perm_list function check_fs_splitting (flv1, flv2, tag1, tag2) result (valid) logical :: valid integer, intent(in), dimension(2) :: flv1, flv2 integer, intent(in) :: tag1, tag2 if (flv1(1) + flv1(2) == 0) then valid = abs(flv1(1)) == abs(flv2(1)) .and. abs(flv1(2)) == abs(flv2(2)) else valid = flv1(1) == flv2(1) .and. flv1(2) == flv2(2) .and. tag1 == tag2 end if end function check_fs_splitting end subroutine region_data_init_singular_regions @ %def region_data_init_singular_regions @ Create an array containing all emitters and resonances of [[region_data]]. <>= procedure :: find_emitters => region_data_find_emitters <>= subroutine region_data_find_emitters (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr, j, n_em, em integer, dimension(:), allocatable :: em_count allocate (em_count(reg_data%n_regions)) em_count = -1 n_em = 0 !!!Count the number of different emitters do alr = 1, reg_data%n_regions em = reg_data%regions(alr)%emitter if (.not. any (em_count == em)) then n_em = n_em + 1 em_count(alr) = em end if end do if (n_em < 1) call msg_fatal ("region_data_find_emitters: No emitters found!") reg_data%n_emitters = n_em allocate (reg_data%emitters (reg_data%n_emitters)) reg_data%emitters = -1 j = 1 do alr = 1, size (reg_data%regions) em = reg_data%regions(alr)%emitter if (.not. any (reg_data%emitters == em)) then reg_data%emitters(j) = em j = j + 1 end if end do end subroutine region_data_find_emitters @ %def region_data_find_emitters @ <>= procedure :: find_resonances => region_data_find_resonances <>= subroutine region_data_find_resonances (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr, j, k, n_res, n_contr integer :: res integer, dimension(10) :: res_count type(resonance_contributors_t), dimension(10) :: contributors_count type(resonance_contributors_t) :: contributors integer :: i_res, emitter logical :: share_emitter res_count = -1 n_res = 0; n_contr = 0 !!! Count the number of different resonances do alr = 1, reg_data%n_regions select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) res = fks_mapping%res_map%alr_to_i_res (alr) if (.not. any (res_count == res)) then n_res = n_res + 1 res_count(alr) = res end if end select end do if (n_res > 0) allocate (reg_data%resonances (n_res)) j = 1 select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) do alr = 1, size (reg_data%regions) res = fks_mapping%res_map%alr_to_i_res (alr) if (.not. any (reg_data%resonances == res)) then reg_data%resonances(j) = res j = j + 1 end if end do allocate (reg_data%alr_to_i_contributor (size (reg_data%regions))) do alr = 1, size (reg_data%regions) i_res = fks_mapping%res_map%alr_to_i_res (alr) emitter = reg_data%regions(alr)%emitter call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter) if (.not. share_emitter) cycle if (.not. any (contributors_count == contributors)) then n_contr = n_contr + 1 contributors_count(alr) = contributors end if if (allocated (contributors%c)) deallocate (contributors%c) end do allocate (reg_data%alr_contributors (n_contr)) j = 1 do alr = 1, size (reg_data%regions) i_res = fks_mapping%res_map%alr_to_i_res (alr) emitter = reg_data%regions(alr)%emitter call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter) if (.not. share_emitter) cycle if (.not. any (reg_data%alr_contributors == contributors)) then reg_data%alr_contributors(j) = contributors reg_data%alr_to_i_contributor (alr) = j j = j + 1 else do k = 1, size (reg_data%alr_contributors) if (reg_data%alr_contributors(k) == contributors) exit end do reg_data%alr_to_i_contributor (alr) = k end if if (allocated (contributors%c)) deallocate (contributors%c) end do end select call reg_data%extend_ftuples (n_res) call reg_data%set_contributors () end subroutine region_data_find_resonances @ %def region_data_find_resonances @ <>= procedure :: set_i_phs_to_i_con => region_data_set_i_phs_to_i_con <>= subroutine region_data_set_i_phs_to_i_con (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr integer :: i_res, emitter, i_con, i_phs, i_em type(phs_identifier_t), dimension(:), allocatable :: phs_id_tmp logical :: share_emitter, phs_exist type(resonance_contributors_t) :: contributors allocate (phs_id_tmp (reg_data%n_phs)) if (allocated (reg_data%resonances)) then allocate (reg_data%i_phs_to_i_con (reg_data%n_phs)) do i_em = 1, size (reg_data%emitters) emitter = reg_data%emitters(i_em) do i_res = 1, size (reg_data%resonances) if (reg_data%emitter_is_compatible_with_resonance (i_res, emitter)) then alr = find_alr (emitter, i_res) if (alr == 0) call msg_fatal ("Could not find requested alpha region!") i_con = reg_data%alr_to_i_contributor (alr) call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter) if (.not. share_emitter) cycle call check_for_phs_identifier & (phs_id_tmp, reg_data%n_in, emitter, contributors%c, phs_exist, i_phs) if (phs_id_tmp(i_phs)%emitter < 0) then phs_id_tmp(i_phs)%emitter = emitter allocate (phs_id_tmp(i_phs)%contributors (size (contributors%c))) phs_id_tmp(i_phs)%contributors = contributors%c end if reg_data%i_phs_to_i_con (i_phs) = i_con end if if (allocated (contributors%c)) deallocate (contributors%c) end do end do end if contains function find_alr (emitter, i_res) result (alr) integer :: alr integer, intent(in) :: emitter, i_res integer :: i do i = 1, reg_data%n_regions if (reg_data%regions(i)%emitter == emitter .and. & reg_data%regions(i)%i_res == i_res) then alr = i return end if end do alr = 0 end function find_alr end subroutine region_data_set_i_phs_to_i_con @ %def region_data_set_i_phs_to_i_con @ <>= procedure :: set_alr_to_i_phs => region_data_set_alr_to_i_phs <>= subroutine region_data_set_alr_to_i_phs (reg_data, phs_identifiers, alr_to_i_phs) class(region_data_t), intent(inout) :: reg_data type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers integer, intent(out), dimension(:) :: alr_to_i_phs integer :: alr, i_phs integer :: emitter, i_res type(resonance_contributors_t) :: contributors logical :: share_emitter, phs_exist do alr = 1, reg_data%n_regions associate (region => reg_data%regions(alr)) emitter = region%emitter i_res = region%i_res if (i_res /= 0) then call reg_data%get_contributors (i_res, emitter, & contributors%c, share_emitter) if (.not. share_emitter) cycle end if if (allocated (contributors%c)) then call check_for_phs_identifier (phs_identifiers, reg_data%n_in, & emitter, contributors%c, phs_exist = phs_exist, i_phs = i_phs) else call check_for_phs_identifier (phs_identifiers, reg_data%n_in, & emitter, phs_exist = phs_exist, i_phs = i_phs) end if if (.not. phs_exist) & call msg_fatal ("phs identifiers are not set up correctly!") alr_to_i_phs(alr) = i_phs end associate if (allocated (contributors%c)) deallocate (contributors%c) end do end subroutine region_data_set_alr_to_i_phs @ %def region_data_set_alr_to_i_phs @ <>= procedure :: set_contributors => region_data_set_contributors <>= subroutine region_data_set_contributors (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr, i_res, i_reg, i_con integer :: i1, i2, i_em integer, dimension(:), allocatable :: contributors logical :: share_emitter do alr = 1, size (reg_data%regions) associate (sregion => reg_data%regions(alr)) allocate (sregion%i_reg_to_i_con (sregion%nregions)) do i_reg = 1, sregion%nregions call sregion%ftuples(i_reg)%get (i1, i2) i_em = get_emitter_index (i1, i2, reg_data%n_legs_real) i_res = sregion%ftuples(i_reg)%i_res call reg_data%get_contributors (i_res, i_em, contributors, share_emitter) !!! Lookup contributor index do i_con = 1, size (reg_data%alr_contributors) if (all (reg_data%alr_contributors(i_con)%c == contributors)) then sregion%i_reg_to_i_con (i_reg) = i_con exit end if end do deallocate (contributors) end do end associate end do contains function get_emitter_index (i1, i2, n) result (i_em) integer :: i_em integer, intent(in) :: i1, i2, n if (i1 == n) then i_em = i2 else i_em = i1 end if end function get_emitter_index end subroutine region_data_set_contributors @ %def region_data_set_contributors @ This extension of the ftuples is still too naive as it assumes that the same resonances are possible for all ftuples <>= procedure :: extend_ftuples => region_data_extend_ftuples <>= subroutine region_data_extend_ftuples (reg_data, n_res) class(region_data_t), intent(inout) :: reg_data integer, intent(in) :: n_res integer :: alr, n_reg_save integer :: i_reg, i_res, i_em, k type(ftuple_t), dimension(:), allocatable :: ftuple_save integer :: n_new do alr = 1, size (reg_data%regions) associate (sregion => reg_data%regions(alr)) n_reg_save = sregion%nregions allocate (ftuple_save (n_reg_save)) ftuple_save = sregion%ftuples n_new = count_n_new_ftuples (sregion, n_res) deallocate (sregion%ftuples) sregion%nregions = n_new allocate (sregion%ftuples (n_new)) k = 1 do i_res = 1, n_res do i_reg = 1, n_reg_save associate (ftuple_new => sregion%ftuples(k)) i_em = ftuple_save(i_reg)%ireg(1) if (reg_data%emitter_is_in_resonance (i_res, i_em)) then call ftuple_new%set (i_em, ftuple_save(i_reg)%ireg(2)) ftuple_new%i_res = i_res ftuple_new%splitting_type = ftuple_save(i_reg)%splitting_type k = k + 1 end if end associate end do end do end associate deallocate (ftuple_save) end do contains function count_n_new_ftuples (sregion, n_res) result (n_new) integer :: n_new type(singular_region_t), intent(in) :: sregion integer, intent(in) :: n_res integer :: i_reg, i_res, i_em n_new = 0 do i_reg = 1, sregion%nregions do i_res = 1, n_res i_em = sregion%ftuples(i_reg)%ireg(1) if (reg_data%emitter_is_in_resonance (i_res, i_em)) & n_new = n_new + 1 end do end do end function count_n_new_ftuples end subroutine region_data_extend_ftuples @ %def region_data_extend_ftuples @ <>= procedure :: get_flavor_indices => region_data_get_flavor_indices <>= function region_data_get_flavor_indices (reg_data, born) result (i_flv) integer, dimension(:), allocatable :: i_flv class(region_data_t), intent(in) :: reg_data logical, intent(in) :: born allocate (i_flv (reg_data%n_regions)) if (born) then i_flv = reg_data%regions%uborn_index else i_flv = reg_data%regions%real_index end if end function region_data_get_flavor_indices @ %def region_data_get_flavor_indices @ <>= procedure :: get_matrix_element_index => region_data_get_matrix_element_index <>= function region_data_get_matrix_element_index (reg_data, i_reg) result (i_me) integer :: i_me class(region_data_t), intent(in) :: reg_data integer, intent(in) :: i_reg i_me = reg_data%regions(i_reg)%real_index end function region_data_get_matrix_element_index @ %def region_data_get_matrix_element_index @ <>= procedure :: compute_number_of_phase_spaces & => region_data_compute_number_of_phase_spaces <>= subroutine region_data_compute_number_of_phase_spaces (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: i_em, i_res, i_phs integer :: emitter type(resonance_contributors_t) :: contributors integer, parameter :: n_max_phs = 10 type(phs_identifier_t), dimension(n_max_phs) :: phs_id_tmp logical :: share_emitter, phs_exist if (allocated (reg_data%resonances)) then reg_data%n_phs = 0 do i_em = 1, size (reg_data%emitters) emitter = reg_data%emitters(i_em) do i_res = 1, size (reg_data%resonances) if (reg_data%emitter_is_compatible_with_resonance (i_res, emitter)) then call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter) if (.not. share_emitter) cycle call check_for_phs_identifier & (phs_id_tmp, reg_data%n_in, emitter, contributors%c, phs_exist, i_phs) if (.not. phs_exist) then reg_data%n_phs = reg_data%n_phs + 1 if (reg_data%n_phs > n_max_phs) call msg_fatal & ("Buffer of phase space identifieres: Too much phase spaces!") call phs_id_tmp(i_phs)%init (emitter, contributors%c) end if end if if (allocated (contributors%c)) deallocate (contributors%c) end do end do else reg_data%n_phs = size (remove_duplicates_from_int_array (reg_data%emitters)) end if end subroutine region_data_compute_number_of_phase_spaces @ %def region_data_compute_number_of_phase_spaces @ <>= procedure :: get_n_phs => region_data_get_n_phs <>= function region_data_get_n_phs (reg_data) result (n_phs) integer :: n_phs class(region_data_t), intent(in) :: reg_data n_phs = reg_data%n_phs end function region_data_get_n_phs @ %def region_data_get_n_phs @ <>= procedure :: set_splitting_info => region_data_set_splitting_info <>= subroutine region_data_set_splitting_info (reg_data) class(region_data_t), intent(inout) :: reg_data integer :: alr do alr = 1, reg_data%n_regions call reg_data%regions(alr)%set_splitting_info (reg_data%n_in) end do end subroutine region_data_set_splitting_info @ %def region_data_set_splitting_info @ <>= procedure :: init_phs_identifiers => region_data_init_phs_identifiers <>= subroutine region_data_init_phs_identifiers (reg_data, phs_id) class(region_data_t), intent(in) :: reg_data type(phs_identifier_t), intent(out), dimension(:), allocatable :: phs_id integer :: i_em, i_res, i_phs integer :: emitter type(resonance_contributors_t) :: contributors logical :: share_emitter, phs_exist allocate (phs_id (reg_data%n_phs)) do i_em = 1, size (reg_data%emitters) emitter = reg_data%emitters(i_em) if (allocated (reg_data%resonances)) then do i_res = 1, size (reg_data%resonances) call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter) if (.not. share_emitter) cycle call check_for_phs_identifier & (phs_id, reg_data%n_in, emitter, contributors%c, phs_exist, i_phs) if (.not. phs_exist) & call phs_id(i_phs)%init (emitter, contributors%c) if (allocated (contributors%c)) deallocate (contributors%c) end do else call check_for_phs_identifier (phs_id, reg_data%n_in, emitter, & phs_exist = phs_exist, i_phs = i_phs) if (.not. phs_exist) call phs_id(i_phs)%init (emitter) end if end do end subroutine region_data_init_phs_identifiers @ %def region_data_init_phs_identifiers @ <>= procedure :: get_all_ftuples => region_data_get_all_ftuples <>= subroutine region_data_get_all_ftuples (reg_data, ftuples) class(region_data_t), intent(in) :: reg_data type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuples type(ftuple_t), dimension(:), allocatable :: ftuple_tmp integer :: i, j, alr !!! Can have at most n * (n-1) ftuples j = 0 allocate (ftuple_tmp (reg_data%n_legs_real * (reg_data%n_legs_real - 1))) do i = 1, reg_data%n_regions associate (region => reg_data%regions(i)) do alr = 1, region%nregions if (.not. any (region%ftuples(alr) == ftuple_tmp)) then j = j + 1 ftuple_tmp(j) = region%ftuples(alr) end if end do end associate end do allocate (ftuples (j)) ftuples = ftuple_tmp(1:j) deallocate (ftuple_tmp) end subroutine region_data_get_all_ftuples @ %def region_data_get_all_ftuples @ <>= procedure :: write_to_file => region_data_write_to_file <>= subroutine region_data_write_to_file (reg_data, proc_id, latex, os_data) class(region_data_t), intent(inout) :: reg_data type(string_t), intent(in) :: proc_id logical, intent(in) :: latex type(os_data_t), intent(in) :: os_data type(string_t) :: filename integer :: u integer :: status if (latex) then filename = proc_id // "_fks_regions.tex" else filename = proc_id // "_fks_regions.out" end if u = free_unit () open (u, file=char(filename), action = "write", status="replace") if (latex) then call reg_data%write_latex (u) close (u) call os_data%build_latex_file & (proc_id // "_fks_regions", stat_out = status) if (status /= 0) & call msg_error (char ("Failed to compile " // filename)) else call reg_data%write (u) close (u) end if end subroutine region_data_write_to_file @ %def region_data_write_to_file @ <>= procedure :: write_latex => region_data_write_latex <>= subroutine region_data_write_latex (reg_data, unit) class(region_data_t), intent(in) :: reg_data integer, intent(in), optional :: unit integer :: i, u u = given_output_unit (); if (present (unit)) u = unit write (u, "(A)") "\documentclass{article}" write (u, "(A)") "\begin{document}" write (u, "(A)") "%FKS region data, automatically created by WHIZARD" write (u, "(A)") "\begin{table}" write (u, "(A)") "\begin{center}" write (u, "(A)") "\begin{tabular} {|c|c|c|c|c|c|c|c|}" write (u, "(A)") "\hline" write (u, "(A)") "$\alpha_r$ & $f_r$ & $i_r$ & $\varepsilon$ & $\varsigma$ & $\mathcal{P}_{\rm{FKS}}$ & $i_b$ & $f_b$ \\" write (u, "(A)") "\hline" do i = 1, reg_data%n_regions call reg_data%regions(i)%write_latex (u) end do write (u, "(A)") "\hline" write (u, "(A)") "\end{tabular}" write (u, "(A)") "\caption{List of singular regions}" write (u, "(A)") "\begin{description}" write (u, "(A)") "\item[$\alpha_r$] Index of the singular region" write (u, "(A)") "\item[$f_r$] Real flavor structure" write (u, "(A)") "\item[$i_r$] Index of the associated real flavor structure" write (u, "(A)") "\item[$\varepsilon$] Emitter" write (u, "(A)") "\item[$\varsigma$] Multiplicity" !!! The symbol used by 0908.4272 for multiplicities write (u, "(A)") "\item[$\mathcal{P}_{\rm{FKS}}$] The set of singular FKS-pairs" write (u, "(A)") "\item[$i_b$] Underlying Born index" write (u, "(A)") "\item[$f_b$] Underlying Born flavor structure" write (u, "(A)") "\end{description}" write (u, "(A)") "\end{center}" write (u, "(A)") "\end{table}" write (u, "(A)") "\end{document}" end subroutine region_data_write_latex @ %def region_data_write_latex @ Creates a table with information about all singular regions and writes it to a file. <>= procedure :: write => region_data_write <>= subroutine region_data_write (reg_data, unit) class(region_data_t), intent(in) :: reg_data integer, intent(in), optional :: unit integer :: j integer :: maxnregions, i_reg_max type(string_t) :: flst_title, ftuple_title integer :: n_res, u u = given_output_unit (unit); if (u < 0) return maxnregions = 1; i_reg_max = 1 do j = 1, reg_data%n_regions if (size (reg_data%regions(j)%ftuples) > maxnregions) then maxnregions = reg_data%regions(j)%nregions i_reg_max = j end if end do flst_title = '(A' // flst_title_format(reg_data%n_legs_real) // ')' ftuple_title = '(A' // ftuple_title_format() // ')' write (u,'(A,1X,I4)') 'Total number of regions: ', size(reg_data%regions) write (u, '(A4)', advance = 'no') ' alr' call write_vline (u) write (u, char (flst_title), advance = 'no') 'flst_real' call write_vline (u) write (u, '(A6)', advance = 'no') 'i_real' call write_vline (u) write (u, '(A3)', advance = 'no') 'em' call write_vline (u) write (u, '(A3)', advance = 'no') 'mult' call write_vline (u) write (u, '(A4)', advance = 'no') 'nreg' call write_vline (u) if (allocated (reg_data%fks_mapping)) then select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) write (u, '(A3)', advance = 'no') 'res' call write_vline (u) end select end if write (u, char (ftuple_title), advance = 'no') 'ftuples' call write_vline (u) flst_title = '(A' // flst_title_format(reg_data%n_legs_born) // ')' write (u, char (flst_title), advance = 'no') 'flst_born' call write_vline (u) write (u, '(A7)') 'i_born' do j = 1, reg_data%n_regions write (u, '(I4)', advance = 'no') j call reg_data%regions(j)%write (u, maxnregions) end do call write_separator (u) if (allocated (reg_data%fks_mapping)) then select type (fks_mapping => reg_data%fks_mapping) type is (fks_mapping_resonances_t) write (u, '(A)') write (u, '(A)') "The FKS regions are combined with resonance information: " n_res = size (fks_mapping%res_map%res_histories) write (u, '(A,1X,I1)') "Number of QCD resonance histories: ", n_res do j = 1, n_res write (u, '(A,1X,I1)') "i_res = ", j call fks_mapping%res_map%res_histories(j)%write (u) call write_separator (u) end do end select end if contains function flst_title_format (n) result (frmt) integer, intent(in) :: n type(string_t) :: frmt character(len=2) :: frmt_char write (frmt_char, '(I2)') 4 * n + 1 frmt = var_str (frmt_char) end function flst_title_format function ftuple_title_format () result (frmt) type(string_t) :: frmt integer :: n_ftuple_char !!! An ftuple (x,x) consists of five characters. In the string, they !!! are separated by maxregions - 1 commas. In total these are !!! 5 * maxnregions + maxnregions - 1 = 6 * maxnregions - 1 characters. !!! The {} brackets at add two additional characters. n_ftuple_char = 6 * maxnregions + 1 !!! If there are resonances, each ftuple with a resonance adds a ";x" !!! to the ftuple n_ftuple_char = n_ftuple_char + 2 * count (reg_data%regions(i_reg_max)%ftuples%i_res > 0) !!! Pseudo-ISR regions are denoted with a * at the end n_ftuple_char = n_ftuple_char + count (reg_data%regions(i_reg_max)%ftuples%pseudo_isr) frmt = str (n_ftuple_char) end function ftuple_title_format end subroutine region_data_write @ %def region_data_write @ <>= subroutine write_vline (u) integer, intent(in) :: u character(len=10), parameter :: sep_format = "(1X,A2,1X)" write (u, sep_format, advance = 'no') '||' end subroutine write_vline @ %def write_vline @ <>= public :: assignment(=) <>= interface assignment(=) module procedure region_data_assign end interface <>= subroutine region_data_assign (reg_data_out, reg_data_in) type(region_data_t), intent(out) :: reg_data_out type(region_data_t), intent(in) :: reg_data_in integer :: i if (allocated (reg_data_in%regions)) then allocate (reg_data_out%regions (size (reg_data_in%regions))) do i = 1, size (reg_data_in%regions) reg_data_out%regions(i) = reg_data_in%regions(i) end do else call msg_warning ("Copying region data without allocated singular regions!") end if if (allocated (reg_data_in%flv_born)) then allocate (reg_data_out%flv_born (size (reg_data_in%flv_born))) do i = 1, size (reg_data_in%flv_born) reg_data_out%flv_born(i) = reg_data_in%flv_born(i) end do else call msg_warning ("Copying region data without allocated born flavor structure!") end if if (allocated (reg_data_in%flv_real)) then allocate (reg_data_out%flv_real (size (reg_data_in%flv_real))) do i = 1, size (reg_data_in%flv_real) reg_data_out%flv_real(i) = reg_data_in%flv_real(i) end do else call msg_warning ("Copying region data without allocated real flavor structure!") end if if (allocated (reg_data_in%emitters)) then allocate (reg_data_out%emitters (size (reg_data_in%emitters))) do i = 1, size (reg_data_in%emitters) reg_data_out%emitters(i) = reg_data_in%emitters(i) end do else call msg_warning ("Copying region data without allocated emitters!") end if reg_data_out%n_regions = reg_data_in%n_regions reg_data_out%n_emitters = reg_data_in%n_emitters reg_data_out%n_flv_born = reg_data_in%n_flv_born reg_data_out%n_flv_real = reg_data_in%n_flv_real reg_data_out%n_in = reg_data_in%n_in reg_data_out%n_legs_born = reg_data_in%n_legs_born reg_data_out%n_legs_real = reg_data_in%n_legs_real if (allocated (reg_data_in%fks_mapping)) then select type (fks_mapping_in => reg_data_in%fks_mapping) type is (fks_mapping_default_t) allocate (fks_mapping_default_t :: reg_data_out%fks_mapping) select type (fks_mapping_out => reg_data_out%fks_mapping) type is (fks_mapping_default_t) fks_mapping_out = fks_mapping_in end select type is (fks_mapping_resonances_t) allocate (fks_mapping_resonances_t :: reg_data_out%fks_mapping) select type (fks_mapping_out => reg_data_out%fks_mapping) type is (fks_mapping_resonances_t) fks_mapping_out = fks_mapping_in end select end select else call msg_warning ("Copying region data without allocated FKS regions!") end if if (allocated (reg_data_in%resonances)) then allocate (reg_data_out%resonances (size (reg_data_in%resonances))) reg_data_out%resonances = reg_data_in%resonances end if reg_data_out%n_phs = reg_data_in%n_phs if (allocated (reg_data_in%alr_contributors)) then allocate (reg_data_out%alr_contributors (size (reg_data_in%alr_contributors))) reg_data_out%alr_contributors = reg_data_in%alr_contributors end if if (allocated (reg_data_in%alr_to_i_contributor)) then allocate (reg_data_out%alr_to_i_contributor & (size (reg_data_in%alr_to_i_contributor))) reg_data_out%alr_to_i_contributor = reg_data_in%alr_to_i_contributor end if end subroutine region_data_assign @ %def region_data_assign @ Returns the index of the real flavor structure an ftuple belogs to. <>= function region_to_real_index (list, i) result(index) type(ftuple_list_t), intent(in), dimension(:), allocatable :: list integer, intent(in) :: i integer, dimension(:), allocatable :: nreg integer :: index, j allocate (nreg (0)) index = 0 do j = 1, size (list) nreg = [nreg, sum (list(:j)%get_n_tuples ())] if (j == 1) then if (i <= nreg(j)) then index = j exit end if else if (i > nreg(j - 1) .and. i <= nreg(j)) then index = j exit end if end if end do end function region_to_real_index @ %def region_to_real_index @ Final state emission: Rearrange the flavor array in such a way that the emitted particle is last and the emitter is second last. [[i1]] is the index of the emitter, [[i2]] is the index of the emitted particle. Initial state emission: Just put the emitted particle to the last position. <>= function create_alr (flv1, n_in, i_em, i_rad) result(flv2) type(flv_structure_t), intent(in) :: flv1 integer, intent(in) :: n_in integer, intent(in) :: i_em, i_rad type(flv_structure_t) :: flv2 integer :: n n = size (flv1%flst) allocate (flv2%flst (n), flv2%tag (n)) flv2%nlegs = n flv2%n_in = n_in if (i_em > n_in) then flv2%flst(1 : n_in) = flv1%flst(1 : n_in) flv2%flst(n - 1) = flv1%flst(i_em) flv2%flst(n) = flv1%flst(i_rad) flv2%tag(1 : n_in) = flv1%tag(1 : n_in) flv2%tag(n - 1) = flv1%tag(i_em) flv2%tag(n) = flv1%tag(i_rad) call fill_remaining_flavors (n_in, .true.) else flv2%flst(1 : n_in) = flv1%flst(1 : n_in) flv2%flst(n) = flv1%flst(i_rad) flv2%tag(1 : n_in) = flv1%tag(1 : n_in) flv2%tag(n) = flv1%tag(i_rad) call fill_remaining_flavors (n_in, .false.) end if call flv2%compute_prt_symm_fs (flv2%n_in) contains @ Order remaining particles according to their original position <>= subroutine fill_remaining_flavors (n_in, final_final) integer, intent(in) :: n_in logical, intent(in) :: final_final integer :: i, j logical :: check j = n_in + 1 do i = n_in + 1, n if (final_final) then check = (i /= i_em .and. i /= i_rad) else check = (i /= i_rad) end if if (check) then flv2%flst(j) = flv1%flst(i) flv2%tag(j) = flv1%tag(i) j = j + 1 end if end do end subroutine fill_remaining_flavors end function create_alr @ %def create_alr @ <>= procedure :: has_pseudo_isr => region_data_has_pseudo_isr <>= function region_data_has_pseudo_isr (reg_data) result (val) logical :: val class(region_data_t), intent(in) :: reg_data val = any (reg_data%regions%pseudo_isr) end function region_data_has_pseudo_isr @ %def region_data_has_pseudo_isr @ Performs consistency checks on [[region_data]]. Up to now only checks that no [[ftuple]] appears more than once. <>= procedure :: check_consistency => region_data_check_consistency <>= subroutine region_data_check_consistency (reg_data, fail_fatal, unit) class(region_data_t), intent(in) :: reg_data logical, intent(in) :: fail_fatal integer, intent(in), optional :: unit integer :: u integer :: i_reg, alr integer :: i1, f1, f2 logical :: undefined_ftuples, same_ftuple_indices, valid_splitting logical, dimension(4) :: no_fail u = given_output_unit(unit); if (u < 0) return no_fail = .true. call msg_message ("Check that no negative ftuple indices occur", unit = u) do i_reg = 1, reg_data%n_regions if (any (reg_data%regions(i_reg)%ftuples%has_negative_elements ())) then !!! This error is so severe that we stop immediately call msg_fatal ("Negative ftuple indices!") end if end do call msg_message ("Success!", unit = u) call msg_message ("Check that there is no ftuple with identical elements", unit = u) do i_reg = 1, reg_data%n_regions if (any (reg_data%regions(i_reg)%ftuples%has_identical_elements ())) then !!! This error is so severe that we stop immediately call msg_fatal ("Identical ftuple indices!") end if end do call msg_message ("Success!", unit = u) call msg_message ("Check that there are no duplicate ftuples in a region", unit = u) do i_reg = 1, reg_data%n_regions if (reg_data%regions(i_reg)%has_identical_ftuples ()) then if (no_fail(1)) then call msg_error ("FAIL: ", unit = u) no_fail(1) = .false. end if write (u, '(A,1x,I3)') 'i_reg:', i_reg end if end do if (no_fail(1)) call msg_message ("Success!", unit = u) call msg_message ("Check that ftuples add up to a valid splitting", unit = u) do i_reg = 1, reg_data%n_regions do alr = 1, reg_data%regions(i_reg)%nregions associate (region => reg_data%regions(i_reg)) i1 = region%ftuples(alr)%ireg(1) if (i1 == 0) i1 = 1 !!! Gluon emission from both initial-state particles f1 = region%flst_real%flst(i1) f2 = region%flst_real%flst(region%ftuples(alr)%ireg(2)) ! Flip PDG sign of IS fermions to allow a q -> g q splitting ! in which the ftuple has the flavors (q,q). if (i1 <= reg_data%n_in .and. is_fermion(f1)) then f1 = -f1 end if valid_splitting = f1 + f2 == 0 & .or. (is_gluon(f1) .and. is_gluon(f2)) & .or. (is_massive_vector(f1) .and. is_photon(f2)) & .or. is_fermion_vector_splitting (f1, f2) if (.not. valid_splitting) then if (no_fail(2)) then call msg_error ("FAIL: ", unit = u) no_fail(2) = .false. end if write (u, '(A,1x,I3)') 'i_reg:', i_reg exit end if end associate end do end do if (no_fail(2)) call msg_message ("Success!", unit = u) call msg_message ("Check that at least one ftuple contains the emitter", unit = u) do i_reg = 1, reg_data%n_regions associate (region => reg_data%regions(i_reg)) if (.not. any (region%emitter == region%ftuples%ireg(1))) then if (no_fail(3)) then call msg_error ("FAIL: ", unit = u) no_fail(3) = .false. end if write (u, '(A,1x,I3)') 'i_reg:', i_reg end if end associate end do if (no_fail(3)) call msg_message ("Success!", unit = u) call msg_message ("Check that each region has at least one ftuple & &with index n + 1", unit = u) do i_reg = 1, reg_data%n_regions if (.not. any (reg_data%regions(i_reg)%ftuples%ireg(2) == reg_data%n_legs_real)) then if (no_fail(4)) then call msg_error ("FAIL: ", unit = u) no_fail(4) = .false. end if write (u, '(A,1x,I3)') 'i_reg:', i_reg end if end do if (no_fail(4)) call msg_message ("Success!", unit = u) if (.not. all (no_fail)) & call abort_with_message ("Stop due to inconsistent region data!") contains subroutine abort_with_message (msg) character(len=*), intent(in) :: msg if (fail_fatal) then call msg_fatal (msg) else call msg_error (msg, unit = u) end if end subroutine abort_with_message function is_fermion_vector_splitting (pdg_1, pdg_2) result (value) logical :: value integer, intent(in) :: pdg_1, pdg_2 value = (is_fermion (pdg_1) .and. is_massless_vector (pdg_2)) .or. & (is_fermion (pdg_2) .and. is_massless_vector (pdg_1)) end function end subroutine region_data_check_consistency @ %def region_data_check_consistency @ <>= procedure :: requires_spin_correlations => region_data_requires_spin_correlations <>= function region_data_requires_spin_correlations (reg_data) result (val) class(region_data_t), intent(in) :: reg_data logical :: val integer :: alr val = .false. do alr = 1, reg_data%n_regions val = reg_data%regions(alr)%sc_required if (val) return end do end function region_data_requires_spin_correlations @ %def region_data_requires_spin_correlations @ We have to apply the symmetry factor for identical particles of the real flavor structure to the born squared matrix element. The corresponding factor from the born flavor structure has to be cancelled. <>= procedure :: born_to_real_symm_factor_fs => region_data_born_to_real_symm_factor_fs <>= function region_data_born_to_real_symm_factor_fs (reg_data, alr) result (factor) class(region_data_t), intent(in) :: reg_data integer, intent(in) :: alr real(default) :: factor associate (flv_real => reg_data%regions(alr)%flst_real, & flv_uborn => reg_data%regions(alr)%flst_uborn) factor = flv_real%prt_symm_fs / flv_uborn%prt_symm_fs end associate end function region_data_born_to_real_symm_factor_fs @ %def region_data_born_to_real_symm_factor_fs @ <>= procedure :: final => region_data_final <>= subroutine region_data_final (reg_data) class(region_data_t), intent(inout) :: reg_data if (allocated (reg_data%regions)) deallocate (reg_data%regions) if (allocated (reg_data%flv_born)) deallocate (reg_data%flv_born) if (allocated (reg_data%flv_real)) deallocate (reg_data%flv_real) if (allocated (reg_data%emitters)) deallocate (reg_data%emitters) if (allocated (reg_data%fks_mapping)) deallocate (reg_data%fks_mapping) if (allocated (reg_data%resonances)) deallocate (reg_data%resonances) if (allocated (reg_data%alr_contributors)) deallocate (reg_data%alr_contributors) if (allocated (reg_data%alr_to_i_contributor)) deallocate (reg_data%alr_to_i_contributor) end subroutine region_data_final @ %def region_data_final @ <>= procedure (fks_mapping_dij), deferred :: dij <>= abstract interface function fks_mapping_dij (map, p, i, j, i_con) result (d) import real(default) :: d class(fks_mapping_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: i, j integer, intent(in), optional :: i_con end function fks_mapping_dij end interface @ %def fks_mapping_dij @ <>= procedure (fks_mapping_compute_sumdij), deferred :: compute_sumdij <>= abstract interface subroutine fks_mapping_compute_sumdij (map, sregion, p_real) import class(fks_mapping_t), intent(inout) :: map type(singular_region_t), intent(in) :: sregion type(vector4_t), intent(in), dimension(:) :: p_real end subroutine fks_mapping_compute_sumdij end interface @ %def fks_mapping_compute_sumdij @ <>= procedure (fks_mapping_svalue), deferred :: svalue <>= abstract interface function fks_mapping_svalue (map, p, i, j, i_res) result (value) import real(default) :: value class(fks_mapping_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: i, j integer, intent(in), optional :: i_res end function fks_mapping_svalue end interface @ %def fks_mapping_svalue <>= procedure (fks_mapping_dij_soft), deferred :: dij_soft <>= abstract interface function fks_mapping_dij_soft (map, p_born, p_soft, em, i_con) result (d) import real(default) :: d class(fks_mapping_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft integer, intent(in) :: em integer, intent(in), optional :: i_con end function fks_mapping_dij_soft end interface @ %def fks_mapping_dij_soft @ <>= procedure (fks_mapping_compute_sumdij_soft), deferred :: compute_sumdij_soft <>= abstract interface subroutine fks_mapping_compute_sumdij_soft (map, sregion, p_born, p_soft) import class(fks_mapping_t), intent(inout) :: map type(singular_region_t), intent(in) :: sregion type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft end subroutine fks_mapping_compute_sumdij_soft end interface @ %def fks_mapping_compute_sumdij_soft @ <>= procedure (fks_mapping_svalue_soft), deferred :: svalue_soft <>= abstract interface function fks_mapping_svalue_soft (map, p_born, p_soft, em, i_res) result (value) import real(default) :: value class(fks_mapping_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft integer, intent(in) :: em integer, intent(in), optional :: i_res end function fks_mapping_svalue_soft end interface @ %def fks_mapping_svalue_soft @ <>= procedure :: set_parameter => fks_mapping_default_set_parameter <>= subroutine fks_mapping_default_set_parameter (map, n_in, dij_exp1, dij_exp2) class(fks_mapping_default_t), intent(inout) :: map integer, intent(in) :: n_in real(default), intent(in) :: dij_exp1, dij_exp2 map%n_in = n_in map%exp_1 = dij_exp1 map%exp_2 = dij_exp2 end subroutine fks_mapping_default_set_parameter @ %def fks_mapping_default_set_parameter @ Computes the $d_{ij}$-quantities defined als follows: \begin{align*} d_{0i} &= \left[E_i^2\left(1-y_i\right)\right]^{p_2}\\, d_{1i} &= \left[2E_i^2\left(1-y_i\right)\right]^{p_2}\\, d_{2i} &= \left[2E_i^2\left(1+y_i\right)\right]^{p_2}\\, \end{align*} for initial state regions and \begin{align*} d_{ij} = \left[2(k_i \cdot k_j) \frac{E_i E_j}{(E_i+E_j)^2}\right]^{p_1} \end{align*} for final state regions, c.f. [1002.2581, Eq. 4.23f]. The exponents $p_1$ and $p_2$ can be used for tuning the efficiency of the mapping and are set to $1$ per default. <>= procedure :: dij => fks_mapping_default_dij <>= function fks_mapping_default_dij (map, p, i, j, i_con) result (d) real(default) :: d class(fks_mapping_default_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: i, j integer, intent(in), optional :: i_con d = zero if (map%pseudo_isr) then d = dij_threshold_gluon_from_top (i, j, p, map%exp_1) else if (i > map%n_in .and. j > map%n_in) then d = dij_fsr (p(i), p(j), map%exp_1) else d = dij_isr (map%n_in, i, j, p, map%exp_2) end if contains function dij_fsr (p1, p2, expo) result (d_ij) real(default) :: d_ij type(vector4_t), intent(in) :: p1, p2 real(default), intent(in) :: expo real(default) :: E1, E2 E1 = p1%p(0); E2 = p2%p(0) d_ij = (two * p1 * p2 * E1 * E2 / (E1 + E2)**2)**expo end function dij_fsr function dij_threshold_gluon_from_top (i, j, p, expo) result (d_ij) real(default) :: d_ij integer, intent(in) :: i, j type(vector4_t), intent(in), dimension(:) :: p real(default), intent(in) :: expo type(vector4_t) :: p_top if (i == THR_POS_B) then p_top = p(THR_POS_WP) + p(THR_POS_B) else p_top = p(THR_POS_WM) + p(THR_POS_BBAR) end if d_ij = dij_fsr (p_top, p(j), expo) end function dij_threshold_gluon_from_top function dij_isr (n_in, i, j, p, expo) result (d_ij) real(default) :: d_ij integer, intent(in) :: n_in, i, j type(vector4_t), intent(in), dimension(:) :: p real(default), intent(in) :: expo real(default) :: E, y select case (n_in) case (1) call get_emitter_variables (1, i, j, p, E, y) d_ij = (E**2 * (one - y**2))**expo case (2) if ((i == 0 .and. j > 2) .or. (j == 0 .and. i > 2)) then call get_emitter_variables (0, i, j, p, E, y) d_ij = (E**2 * (one - y**2))**expo else if ((i == 1 .and. j > 2) .or. (j == 1 .and. i > 2)) then call get_emitter_variables (1, i, j, p, E, y) d_ij = (two * E**2 * (one - y))**expo else if ((i == 2 .and. j > 2) .or. (j == 2 .and. i > 2)) then call get_emitter_variables (2, i, j, p, E, y) d_ij = (two * E**2 * (one + y))**expo end if end select end function dij_isr subroutine get_emitter_variables (i_check, i, j, p, E, y) integer, intent(in) :: i_check, i, j type(vector4_t), intent(in), dimension(:) :: p real(default), intent(out) :: E, y if (j == i_check) then E = energy (p(i)) y = polar_angle_ct (p(i)) else E = energy (p(j)) y = polar_angle_ct(p(j)) end if end subroutine get_emitter_variables end function fks_mapping_default_dij @ %def fks_mapping_default_dij @ Computes the quantity \begin{equation*} \mathcal{D} = \sum_k \frac{1}{d_{0k}} + \sum_{kl} \frac{1}{d_{kl}}. \end{equation*} where the sum goes over all ftuples of a single singular region. <>= procedure :: compute_sumdij => fks_mapping_default_compute_sumdij <>= subroutine fks_mapping_default_compute_sumdij (map, sregion, p_real) class(fks_mapping_default_t), intent(inout) :: map type(singular_region_t), intent(in) :: sregion type(vector4_t), intent(in), dimension(:) :: p_real real(default) :: d integer :: i_ftuple, i, j associate (ftuples => sregion%ftuples) d = zero do i_ftuple = 1, sregion%nregions call ftuples(i_ftuple)%get (i, j) map%pseudo_isr = ftuples(i_ftuple)%pseudo_isr d = d + one / map%dij (p_real, i, j) end do end associate map%sumdij = d end subroutine fks_mapping_default_compute_sumdij @ %def fks_mapping_default_compute_sumdij @ Computes \begin{equation*} S_i = \frac{1}{\mathcal{D} d_{0i}} \end{equation*} or \begin{equation*} S_{ij} = \frac{1}{\mathcal{D} d_{ij}}, \end{equation*} respectively. <>= procedure :: svalue => fks_mapping_default_svalue <>= function fks_mapping_default_svalue (map, p, i, j, i_res) result (value) real(default) :: value class(fks_mapping_default_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: i, j integer, intent(in), optional :: i_res value = one / (map%dij (p, i, j) * map%sumdij) end function fks_mapping_default_svalue @ %def fks_mapping_default_svalue @ In the soft limit, our treatment of the divergencies requires a modification of the mapping functions. Recall that there, the ratios of the $d$-functions must approach either $1$ or $0$. This means \begin{equation*} \frac{d_{lm}}{d_{0m}} = \frac{(2k_l \cdot k_m) \left[E_lE_m /(E_l + E_m)^2\right]}{E_m^2 (1-y^2)} \overset {k_m = E_m \hat{k}} {=} \frac{E_l E_m^2}{(E_l + E_m)^2} \frac{2k_l \cdot \hat{k}}{E_m^2 (1-y^2)} \overset {E_m \to 0}{=} \frac{2k_l \cdot \hat{k}}{E_l}{(1-y^2)}, \end{equation*} where we have written the gluon momentum in terms of the soft momentum $\hat{k}$. In the same limit \begin{equation*} \frac{d_{lm}}{d_{nm}} = \frac{k_l \cdot \hat{k}}{k_n \cdot \hat{k}} \frac{E_n}{E_l}. \end{equation*} From these equations we can deduce the soft limit of $d$: \begin{align*} d_0^{\rm{soft}} &= 1 - y^2,\\ d_1^{\rm{soft}} &= 2(1-y),\\ d_2^{\rm{soft}} &= 2(1+y),\\ d_i^{\rm{soft}} &= \frac{2 k_i \cdot \hat{k}}{E_i}. \end{align*} <>= procedure :: dij_soft => fks_mapping_default_dij_soft <>= function fks_mapping_default_dij_soft (map, p_born, p_soft, em, i_con) result (d) real(default) :: d class(fks_mapping_default_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft integer, intent(in) :: em integer, intent(in), optional :: i_con if (map%pseudo_isr) then d = dij_soft_threshold_gluon_from_top (em, p_born, p_soft, map%exp_1) else if (em <= map%n_in) then d = dij_soft_isr (map%n_in, p_soft, map%exp_2) else d = dij_soft_fsr (p_born(em), p_soft, map%exp_1) end if contains function dij_soft_threshold_gluon_from_top (em, p_born, p_soft, expo) result (dij_soft) real(default) :: dij_soft integer, intent(in) :: em type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft real(default), intent(in) :: expo type(vector4_t) :: p_top if (em == THR_POS_B) then p_top = p_born(THR_POS_WP) + p_born(THR_POS_B) else p_top = p_born(THR_POS_WM) + p_born(THR_POS_BBAR) end if dij_soft = dij_soft_fsr (p_top, p_soft, expo) end function dij_soft_threshold_gluon_from_top function dij_soft_fsr (p_em, p_soft, expo) result (dij_soft) real(default) :: dij_soft type(vector4_t), intent(in) :: p_em, p_soft real(default), intent(in) :: expo dij_soft = (two * p_em * p_soft / p_em%p(0))**expo end function dij_soft_fsr function dij_soft_isr (n_in, p_soft, expo) result (dij_soft) real(default) :: dij_soft integer, intent(in) :: n_in type(vector4_t), intent(in) :: p_soft real(default), intent(in) :: expo real(default) :: y y = polar_angle_ct (p_soft) select case (n_in) case (1) dij_soft = one - y**2 case (2) select case (em) case (0) dij_soft = one - y**2 case (1) dij_soft = two * (one - y) case (2) dij_soft = two * (one + y) case default dij_soft = zero call msg_fatal ("fks_mappings_default_dij_soft: n_in > 2") end select case default dij_soft = zero call msg_fatal ("fks_mappings_default_dij_soft: n_in > 2") end select dij_soft = dij_soft**expo end function dij_soft_isr end function fks_mapping_default_dij_soft @ %def fks_mapping_default_dij_soft @ Computes the sum of all soft [[dij]]s required to normalize the soft S functions [[s_alpha_soft]] similar to [[fks_mapping_default_compute_sumdij]]. In the soft limit however, we need to skip all ftuples $(i,j)$ in which $j$ does not correspond to the emitted particle because those $d_{ij}$s are finite and thus their contribution to the soft S function vanishes in the limit of soft radiation. Technically, they would not vanish if computed here because the fixed [[p_soft]] at this point would not fit their actual emitter. <>= procedure :: compute_sumdij_soft => fks_mapping_default_compute_sumdij_soft <>= subroutine fks_mapping_default_compute_sumdij_soft (map, sregion, p_born, p_soft) class(fks_mapping_default_t), intent(inout) :: map type(singular_region_t), intent(in) :: sregion type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft real(default) :: d integer :: i_ftuple, i, j integer :: nlegs d = zero nlegs = size (sregion%flst_real%flst) associate (ftuples => sregion%ftuples) do i_ftuple = 1, sregion%nregions call ftuples(i_ftuple)%get (i ,j) if (j == nlegs) then map%pseudo_isr = ftuples(i_ftuple)%pseudo_isr d = d + one / map%dij_soft (p_born, p_soft, i) end if end do end associate map%sumdij_soft = d end subroutine fks_mapping_default_compute_sumdij_soft @ %def fks_mapping_default_compute_sumdij_soft @ <>= procedure :: svalue_soft => fks_mapping_default_svalue_soft <>= function fks_mapping_default_svalue_soft (map, p_born, p_soft, em, i_res) result (value) real(default) :: value class(fks_mapping_default_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft integer, intent(in) :: em integer, intent(in), optional :: i_res value = one / (map%sumdij_soft * map%dij_soft (p_born, p_soft, em)) end function fks_mapping_default_svalue_soft @ %def fks_mapping_default_svalue_soft @ <>= interface assignment(=) module procedure fks_mapping_default_assign end interface <>= subroutine fks_mapping_default_assign (fks_map_out, fks_map_in) type(fks_mapping_default_t), intent(out) :: fks_map_out type(fks_mapping_default_t), intent(in) :: fks_map_in fks_map_out%exp_1 = fks_map_in%exp_1 fks_map_out%exp_2 = fks_map_in%exp_2 fks_map_out%n_in = fks_map_in%n_in end subroutine fks_mapping_default_assign @ %def fks_mapping_default_assign @ The $d_{ij,k}$-functions for the resonance mapping are basically the same as in the default case, but the kinematical values here must be evaluated in the resonance frame of reference. The energy of parton $i$ in a given resonance frame with momentum $p_{res}$ is \begin{equation*} E_i = \frac{p_i^0 \cdot p_{res}}{m_{res}}. \end{equation*} However, since the expressions only depend on ratios of four-momenta, we leave out the denominator because it will cancel out anyway. <>= procedure :: dij => fks_mapping_resonances_dij <>= function fks_mapping_resonances_dij (map, p, i, j, i_con) result (d) real(default) :: d class(fks_mapping_resonances_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: i, j integer, intent(in), optional :: i_con real(default) :: E1, E2 integer :: ii_con if (present (i_con)) then ii_con = i_con else call msg_fatal ("Resonance mappings require resonance index as input!") end if d = 0 if (i /= j) then if (i > 2 .and. j > 2) then associate (p_res => map%res_map%p_res (ii_con)) E1 = p(i) * p_res E2 = p(j) * p_res d = two * p(i) * p(j) * E1 * E2 / (E1 + E2)**2 end associate else call msg_fatal ("Resonance mappings are not implemented for ISR") end if end if end function fks_mapping_resonances_dij @ %def fks_mapping_resonances_dij @ Computes \begin{equation*} S_\alpha = \frac{P^{f_r(\alpha)}d^{-1}(\alpha)} {\sum_{f_r' \in T(F_r(\alpha))}P^{f_r'}\sum_{\alpha' \in Sr(f_r')}d^{-1}(\alpha)}. \end{equation*} <>= procedure :: compute_sumdij => fks_mapping_resonances_compute_sumdij <>= subroutine fks_mapping_resonances_compute_sumdij (map, sregion, p_real) class(fks_mapping_resonances_t), intent(inout) :: map type(singular_region_t), intent(in) :: sregion type(vector4_t), intent(in), dimension(:) :: p_real real(default) :: d, pfr integer :: i_res, i_reg, i, j, i_con integer :: nlegreal nlegreal = size (p_real) d = zero do i_reg = 1, sregion%nregions associate (ftuple => sregion%ftuples(i_reg)) call ftuple%get (i, j) i_res = ftuple%i_res end associate pfr = map%res_map%get_resonance_value (i_res, p_real, nlegreal) i_con = sregion%i_reg_to_i_con (i_reg) d = d + pfr / map%dij (p_real, i, j, i_con) end do map%sumdij = d end subroutine fks_mapping_resonances_compute_sumdij @ %def fks_mapping_resonances_compute_sumdij @ <>= procedure :: svalue => fks_mapping_resonances_svalue <>= function fks_mapping_resonances_svalue (map, p, i, j, i_res) result (value) real(default) :: value class(fks_mapping_resonances_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: i, j integer, intent(in), optional :: i_res real(default) :: pfr integer :: i_gluon i_gluon = size (p) pfr = map%res_map%get_resonance_value (i_res, p, i_gluon) value = pfr / (map%dij (p, i, j, map%i_con) * map%sumdij) end function fks_mapping_resonances_svalue @ %def fks_mapping_resonances_svalue @ <>= procedure :: get_resonance_weight => fks_mapping_resonances_get_resonance_weight <>= function fks_mapping_resonances_get_resonance_weight (map, alr, p) result (pfr) real(default) :: pfr class(fks_mapping_resonances_t), intent(in) :: map integer, intent(in) :: alr type(vector4_t), intent(in), dimension(:) :: p pfr = map%res_map%get_weight (alr, p) end function fks_mapping_resonances_get_resonance_weight @ %def fks_mapping_resonances_get_resonance_weight @ As above, the soft limit of $d_{ij,k}$ must be computed in the resonance frame of reference. <>= procedure :: dij_soft => fks_mapping_resonances_dij_soft <>= function fks_mapping_resonances_dij_soft (map, p_born, p_soft, em, i_con) result (d) real(default) :: d class(fks_mapping_resonances_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft integer, intent(in) :: em integer, intent(in), optional :: i_con real(default) :: E1, E2 integer :: ii_con type(vector4_t) :: pb if (present (i_con)) then ii_con = i_con else call msg_fatal ("fks_mapping_resonances requires resonance index") end if associate (p_res => map%res_map%p_res(ii_con)) pb = p_born(em) E1 = pb * p_res E2 = p_soft * p_res d = two * pb * p_soft * E1 * E2 / E1**2 end associate end function fks_mapping_resonances_dij_soft @ %def fks_mapping_resonances_dij_soft @ <>= procedure :: compute_sumdij_soft => fks_mapping_resonances_compute_sumdij_soft <>= subroutine fks_mapping_resonances_compute_sumdij_soft (map, sregion, p_born, p_soft) class(fks_mapping_resonances_t), intent(inout) :: map type(singular_region_t), intent(in) :: sregion type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft real(default) :: d real(default) :: pfr integer :: i_res, i, j, i_reg, i_con integer :: nlegs d = zero nlegs = size (sregion%flst_real%flst) do i_reg = 1, sregion%nregions associate (ftuple => sregion%ftuples(i_reg)) call ftuple%get(i, j) i_res = ftuple%i_res end associate pfr = map%res_map%get_resonance_value (i_res, p_born) i_con = sregion%i_reg_to_i_con (i_reg) if (j == nlegs) d = d + pfr / map%dij_soft (p_born, p_soft, i, i_con) end do map%sumdij_soft = d end subroutine fks_mapping_resonances_compute_sumdij_soft @ %def fks_mapping_resonances_compute_sumdij_soft @ <>= procedure :: svalue_soft => fks_mapping_resonances_svalue_soft <>= function fks_mapping_resonances_svalue_soft (map, p_born, p_soft, em, i_res) result (value) real(default) :: value class(fks_mapping_resonances_t), intent(in) :: map type(vector4_t), intent(in), dimension(:) :: p_born type(vector4_t), intent(in) :: p_soft integer, intent(in) :: em integer, intent(in), optional :: i_res real(default) :: pfr pfr = map%res_map%get_resonance_value (i_res, p_born) value = pfr / (map%sumdij_soft * map%dij_soft (p_born, p_soft, em, map%i_con)) end function fks_mapping_resonances_svalue_soft @ %def fks_mapping_resonances_svalue_soft @ <>= procedure :: set_resonance_momentum => fks_mapping_resonances_set_resonance_momentum <>= subroutine fks_mapping_resonances_set_resonance_momentum (map, p) class(fks_mapping_resonances_t), intent(inout) :: map type(vector4_t), intent(in) :: p map%res_map%p_res = p end subroutine fks_mapping_resonances_set_resonance_momentum @ %def fks_mapping_resonances_set_resonance_momentum @ <>= procedure :: set_resonance_momenta => fks_mapping_resonances_set_resonance_momenta <>= subroutine fks_mapping_resonances_set_resonance_momenta (map, p) class(fks_mapping_resonances_t), intent(inout) :: map type(vector4_t), intent(in), dimension(:) :: p map%res_map%p_res = p end subroutine fks_mapping_resonances_set_resonance_momenta @ %def fks_mapping_resonances_set_resonance_momenta @ <>= interface assignment(=) module procedure fks_mapping_resonances_assign end interface <>= subroutine fks_mapping_resonances_assign (fks_map_out, fks_map_in) type(fks_mapping_resonances_t), intent(out) :: fks_map_out type(fks_mapping_resonances_t), intent(in) :: fks_map_in fks_map_out%exp_1 = fks_map_in%exp_1 fks_map_out%exp_2 = fks_map_in%exp_2 fks_map_out%res_map = fks_map_in%res_map end subroutine fks_mapping_resonances_assign @ %def fks_mapping_resonances_assign @ <>= public :: create_resonance_histories_for_threshold <>= function create_resonance_histories_for_threshold () result (res_history) type(resonance_history_t) :: res_history res_history%n_resonances = 2 allocate (res_history%resonances (2)) allocate (res_history%resonances(1)%contributors%c(2)) allocate (res_history%resonances(2)%contributors%c(2)) res_history%resonances(1)%contributors%c = [THR_POS_WP, THR_POS_B] res_history%resonances(2)%contributors%c = [THR_POS_WM, THR_POS_BBAR] end function create_resonance_histories_for_threshold @ %def create_resonance_histories_for_threshold @ <>= public :: setup_region_data_for_test <>= subroutine setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, nlo_corr_type) integer, intent(in) :: n_in integer, intent(in), dimension(:,:) :: flv_born, flv_real type(string_t), intent(in) :: nlo_corr_type type(region_data_t), intent(out) :: reg_data type(model_t), pointer :: test_model => null () call create_test_model (var_str ("SM"), test_model) call test_model%set_real (var_str ("me"), 0._default) call test_model%set_real (var_str ("mmu"), 0._default) call test_model%set_real (var_str ("mtau"), 0._default) call test_model%set_real (var_str ("ms"), 0._default) call test_model%set_real (var_str ("mc"), 0._default) call test_model%set_real (var_str ("mb"), 0._default) call reg_data%init (n_in, test_model, flv_born, flv_real, nlo_corr_type) end subroutine setup_region_data_for_test @ %def setup_region_data_for_test @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Unit tests} \clearpage <<[[fks_regions_ut.f90]]>>= <> module fks_regions_ut use unit_tests use fks_regions_uti <> <> contains <> end module fks_regions_ut @ %def fks_regions_ut @ <<[[fks_regions_uti.f90]]>>= <> module fks_regions_uti <> use format_utils, only: write_separator use os_interface use models use fks_regions <> <> contains <> end module fks_regions_uti @ %def fks_regions_uti @ <>= public :: fks_regions_test <>= subroutine fks_regions_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results call test(fks_regions_1, "fks_regions_1", & "Test flavor structure utilities", u, results) call test(fks_regions_2, "fks_regions_2", & "Test singular regions for final-state radiation for n = 2", & u, results) call test(fks_regions_3, "fks_regions_3", & "Test singular regions for final-state radiation for n = 3", & u, results) call test(fks_regions_4, "fks_regions_4", & "Test singular regions for final-state radiation for n = 4", & u, results) call test(fks_regions_5, "fks_regions_5", & "Test singular regions for final-state radiation for n = 5", & u, results) call test(fks_regions_6, "fks_regions_6", & "Test singular regions for initial-state radiation", & u, results) call test(fks_regions_7, "fks_regions_7", & "Check Latex output", u, results) call test(fks_regions_8, "fks_regions_8", & "Test singular regions for initial-state photon contributions", & u, results) end subroutine fks_regions_test @ %def fks_regions_test @ <>= public :: fks_regions_1 <>= subroutine fks_regions_1 (u) integer, intent(in) :: u type(flv_structure_t) :: flv_born, flv_real type(model_t), pointer :: test_model => null () write (u, "(A)") "* Test output: fks_regions_1" write (u, "(A)") "* Purpose: Test utilities of flavor structure manipulation" write (u, "(A)") call create_test_model (var_str ("SM"), test_model) flv_born = [11, -11, 2, -2] flv_real = [11, -11, 2, -2, 21] flv_born%n_in = 2; flv_real%n_in = 2 write (u, "(A)") "* Valid splittings of ee -> uu" write (u, "(A)") "Born Flavors: " call flv_born%write (u) write (u, "(A)") "Real Flavors: " call flv_real%write (u) write (u, "(A,L1)") "3, 4 (2, -2) : ", flv_real%valid_pair (3, 4, flv_born, test_model) write (u, "(A,L1)") "4, 3 (-2, 2) : ", flv_real%valid_pair (4, 3, flv_born, test_model) write (u, "(A,L1)") "3, 5 (2, 21) : ", flv_real%valid_pair (3, 5, flv_born, test_model) write (u, "(A,L1)") "5, 3 (21, 2) : ", flv_real%valid_pair (5, 3, flv_born, test_model) write (u, "(A,L1)") "4, 5 (-2, 21): ", flv_real%valid_pair (4, 5, flv_born, test_model) write (u, "(A,L1)") "5, 4 (21, -2): ", flv_real%valid_pair (5, 4, flv_born, test_model) call write_separator (u) call flv_born%final () call flv_real%final () flv_born = [2, -2, 11, -11] flv_real = [2, -2, 11, -11, 21] flv_born%n_in = 2; flv_real%n_in = 2 write (u, "(A)") "* Valid splittings of uu -> ee" write (u, "(A)") "Born Flavors: " call flv_born%write (u) write (u, "(A)") "Real Flavors: " call flv_real%write (u) write (u, "(A,L1)") "1, 2 (2, -2) : " , flv_real%valid_pair (1, 2, flv_born, test_model) write (u, "(A,L1)") "2, 1 (-2, 2) : " , flv_real%valid_pair (2, 1, flv_born, test_model) write (u, "(A,L1)") "5, 2 (21, -2): " , flv_real%valid_pair (5, 2, flv_born, test_model) write (u, "(A,L1)") "2, 5 (-2, 21): " , flv_real%valid_pair (2, 5, flv_born, test_model) write (u, "(A,L1)") "1, 5 (21, 2) : " , flv_real%valid_pair (5, 1, flv_born, test_model) write (u, "(A,L1)") "5, 1 (2, 21) : " , flv_real%valid_pair (1, 5, flv_born, test_model) call flv_real%final () flv_real = [21, -2, 11, -11, -2] flv_real%n_in = 2 write (u, "(A)") "Real Flavors: " call flv_real%write (u) write (u, "(A,L1)") "1, 2 (21, -2): " , flv_real%valid_pair (1, 2, flv_born, test_model) write (u, "(A,L1)") "2, 1 (-2, 21): " , flv_real%valid_pair (2, 1, flv_born, test_model) write (u, "(A,L1)") "5, 2 (-2, -2): " , flv_real%valid_pair (5, 2, flv_born, test_model) write (u, "(A,L1)") "2, 5 (-2, -2): " , flv_real%valid_pair (2, 5, flv_born, test_model) write (u, "(A,L1)") "5, 1 (-2, 21): " , flv_real%valid_pair (5, 1, flv_born, test_model) write (u, "(A,L1)") "1, 5 (21, -2): " , flv_real%valid_pair (1, 5, flv_born, test_model) call flv_real%final () flv_real = [2, 21, 11, -11, 2] flv_real%n_in = 2 write (u, "(A)") "Real Flavors: " call flv_real%write (u) write (u, "(A,L1)") "1, 2 (2, 21) : " , flv_real%valid_pair (1, 2, flv_born, test_model) write (u, "(A,L1)") "2, 1 (21, 2) : " , flv_real%valid_pair (2, 1, flv_born, test_model) write (u, "(A,L1)") "5, 2 (2, 21) : " , flv_real%valid_pair (5, 2, flv_born, test_model) write (u, "(A,L1)") "2, 5 (21, 2) : " , flv_real%valid_pair (2, 5, flv_born, test_model) write (u, "(A,L1)") "5, 1 (2, 2) : " , flv_real%valid_pair (5, 1, flv_born, test_model) write (u, "(A,L1)") "1, 5 (2, 2) : " , flv_real%valid_pair (1, 5, flv_born, test_model) call write_separator (u) call flv_born%final () call flv_real%final () flv_born = [11, -11, 2, -2, 21] flv_real = [11, -11, 2, -2, 21, 21] flv_born%n_in = 2; flv_real%n_in = 2 write (u, "(A)") "* Valid splittings of ee -> uug" write (u, "(A)") "Born Flavors: " call flv_born%write (u) write (u, "(A)") "Real Flavors: " call flv_real%write (u) write (u, "(A,L1)") "3, 4 (2, -2) : " , flv_real%valid_pair (3, 4, flv_born, test_model) write (u, "(A,L1)") "4, 3 (-2, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model) write (u, "(A,L1)") "3, 5 (2, 21) : " , flv_real%valid_pair (3, 5, flv_born, test_model) write (u, "(A,L1)") "5, 3 (21, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model) write (u, "(A,L1)") "4, 5 (-2, 21): " , flv_real%valid_pair (4, 5, flv_born, test_model) write (u, "(A,L1)") "5, 4 (21, -2): " , flv_real%valid_pair (5, 4, flv_born, test_model) write (u, "(A,L1)") "3, 6 (2, 21) : " , flv_real%valid_pair (3, 6, flv_born, test_model) write (u, "(A,L1)") "6, 3 (21, 2) : " , flv_real%valid_pair (6, 3, flv_born, test_model) write (u, "(A,L1)") "4, 6 (-2, 21): " , flv_real%valid_pair (4, 6, flv_born, test_model) write (u, "(A,L1)") "6, 4 (21, -2): " , flv_real%valid_pair (6, 4, flv_born, test_model) write (u, "(A,L1)") "5, 6 (21, 21): " , flv_real%valid_pair (5, 6, flv_born, test_model) write (u, "(A,L1)") "6, 5 (21, 21): " , flv_real%valid_pair (6, 5, flv_born, test_model) call flv_real%final () flv_real = [11, -11, 2, -2, 1, -1] flv_real%n_in = 2 write (u, "(A)") "Real Flavors (exemplary g -> dd splitting): " call flv_real%write (u) write (u, "(A,L1)") "3, 4 (2, -2) : " , flv_real%valid_pair (3, 4, flv_born, test_model) write (u, "(A,L1)") "4, 3 (-2, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model) write (u, "(A,L1)") "3, 5 (2, 1) : " , flv_real%valid_pair (3, 5, flv_born, test_model) write (u, "(A,L1)") "5, 3 (1, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model) write (u, "(A,L1)") "4, 5 (-2, 1) : " , flv_real%valid_pair (4, 5, flv_born, test_model) write (u, "(A,L1)") "5, 4 (1, -2) : " , flv_real%valid_pair (5, 4, flv_born, test_model) write (u, "(A,L1)") "3, 6 (2, -1) : " , flv_real%valid_pair (3, 6, flv_born, test_model) write (u, "(A,L1)") "6, 3 (-1, 2) : " , flv_real%valid_pair (6, 3, flv_born, test_model) write (u, "(A,L1)") "4, 6 (-2, -1): " , flv_real%valid_pair (4, 6, flv_born, test_model) write (u, "(A,L1)") "6, 4 (-1, -2): " , flv_real%valid_pair (6, 4, flv_born, test_model) write (u, "(A,L1)") "5, 6 (1, -1) : " , flv_real%valid_pair (5, 6, flv_born, test_model) write (u, "(A,L1)") "6, 5 (-1, 1) : " , flv_real%valid_pair (6, 5, flv_born, test_model) call write_separator (u) call flv_born%final () call flv_real%final () flv_born = [6, -5, 2, -1 ] flv_real = [6, -5, 2, -1, 21] flv_born%n_in = 1; flv_real%n_in = 1 write (u, "(A)") "* Valid splittings of t -> b u d~" write (u, "(A)") "Born Flavors: " call flv_born%write (u) write (u, "(A)") "Real Flavors: " call flv_real%write (u) write (u, "(A,L1)") "1, 2 (6, -5) : " , flv_real%valid_pair (1, 2, flv_born, test_model) write (u, "(A,L1)") "1, 3 (6, 2) : " , flv_real%valid_pair (1, 3, flv_born, test_model) write (u, "(A,L1)") "1, 4 (6, -1) : " , flv_real%valid_pair (1, 4, flv_born, test_model) write (u, "(A,L1)") "2, 1 (-5, 6) : " , flv_real%valid_pair (2, 1, flv_born, test_model) write (u, "(A,L1)") "3, 1 (2, 6) : " , flv_real%valid_pair (3, 1, flv_born, test_model) write (u, "(A,L1)") "4, 1 (-1, 6) : " , flv_real%valid_pair (4, 1, flv_born, test_model) write (u, "(A,L1)") "2, 3 (-5, 2) : " , flv_real%valid_pair (2, 3, flv_born, test_model) write (u, "(A,L1)") "2, 4 (-5, -1): " , flv_real%valid_pair (2, 4, flv_born, test_model) write (u, "(A,L1)") "3, 2 (2, -5) : " , flv_real%valid_pair (3, 2, flv_born, test_model) write (u, "(A,L1)") "4, 2 (-1, -5): " , flv_real%valid_pair (4, 2, flv_born, test_model) write (u, "(A,L1)") "3, 4 (2, -1) : " , flv_real%valid_pair (3, 4, flv_born, test_model) write (u, "(A,L1)") "4, 3 (-1, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model) write (u, "(A,L1)") "1, 5 (6, 21) : " , flv_real%valid_pair (1, 5, flv_born, test_model) write (u, "(A,L1)") "5, 1 (21, 6) : " , flv_real%valid_pair (5, 1, flv_born, test_model) write (u, "(A,L1)") "2, 5 (-5, 21): " , flv_real%valid_pair (2, 5, flv_born, test_model) write (u, "(A,L1)") "5, 2 (21, 5) : " , flv_real%valid_pair (5, 2, flv_born, test_model) write (u, "(A,L1)") "3, 5 (2, 21) : " , flv_real%valid_pair (3, 5, flv_born, test_model) write (u, "(A,L1)") "5, 3 (21, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model) write (u, "(A,L1)") "4, 5 (-1, 21): " , flv_real%valid_pair (4, 5, flv_born, test_model) write (u, "(A,L1)") "5, 4 (21, -1): " , flv_real%valid_pair (5, 4, flv_born, test_model) call flv_born%final () call flv_real%final () end subroutine fks_regions_1 @ %def fks_regions_1 @ <>= public :: fks_regions_2 <>= subroutine fks_regions_2 (u) integer, intent(in) :: u integer :: n_flv_born, n_flv_real integer :: n_legs_born, n_legs_real integer :: n_in integer, dimension(:,:), allocatable :: flv_born, flv_real type(region_data_t) :: reg_data write (u, "(A)") "* Test output: fks_regions_2" write (u, "(A)") "* Create singular regions for processes with up to four singular regions" write (u, "(A)") "* ee -> qq with QCD corrections" write (u, "(A)") n_flv_born = 1; n_flv_real = 1 n_legs_born = 4; n_legs_real = 5 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, 2, -2] flv_real (:, 1) = [11, -11, 2, -2, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () call write_separator (u) write (u, "(A)") "* ee -> qq with EW corrections" write (u, "(A)") allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, 2, -2] flv_real (:, 1) = [11, -11, 2, -2, 22] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () call write_separator (u) write (u, "(A)") "* ee -> tt" write (u, "(A)") write (u, "(A)") "* This process has four singular regions because they are not equivalent." n_flv_born = 1; n_flv_real = 1 n_legs_born = 6; n_legs_real = 7 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, 6, -6, 6, -6] flv_real (:, 1) = [11, -11, 6, -6, 6, -6, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () end subroutine fks_regions_2 @ %def fks_regions_2 @ <>= public :: fks_regions_3 <>= subroutine fks_regions_3 (u) integer, intent(in) :: u integer :: n_flv_born, n_flv_real integer :: n_legs_born, n_legs_real integer :: n_in, i, j integer, dimension(:,:), allocatable :: flv_born, flv_real type(region_data_t) :: reg_data write (u, "(A)") "* Test output: fks_regions_3" write (u, "(A)") "* Create singular regions for processes with three final-state particles" write (u, "(A)") "* ee -> qqg" write (u, "(A)") n_flv_born = 1; n_flv_real = 2 n_legs_born = 5; n_legs_real = 6 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, 2, -2, 21] flv_real (:, 1) = [11, -11, 2, -2, 21, 21] flv_real (:, 2) = [11, -11, 2, -2, 1, -1] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () call write_separator (u) write (u, "(A)") "* ee -> qqA" write (u, "(A)") n_flv_born = 1; n_flv_real = 2 n_legs_born = 5; n_legs_real = 6 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, 2, -2, 22] flv_real (:, 1) = [11, -11, 2, -2, 22, 22] flv_real (:, 2) = [11, -11, 2, -2, 11, -11] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () call write_separator (u) write (u, "(A)") "* ee -> jet jet jet" write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl" write (u, "(A)") n_flv_born = 5; n_flv_real = 22 n_legs_born = 5; n_legs_real = 6 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, -4, 4, 21] flv_born (:, 2) = [11, -11, -2, 2, 21] flv_born (:, 3) = [11, -11, -5, 5, 21] flv_born (:, 4) = [11, -11, -3, 3, 21] flv_born (:, 5) = [11, -11, -1, 1, 21] flv_real (:, 1) = [11, -11, -4, -4, 4, 4] flv_real (:, 2) = [11, -11, -4, -2, 2, 4] flv_real (:, 3) = [11, -11, -4, 4, 21, 21] flv_real (:, 4) = [11, -11, -4, -5, 4, 5] flv_real (:, 5) = [11, -11, -4, -3, 4, 3] flv_real (:, 6) = [11, -11, -4, -1, 2, 3] flv_real (:, 7) = [11, -11, -4, -1, 4, 1] flv_real (:, 8) = [11, -11, -2, -2, 2, 2] flv_real (:, 9) = [11, -11, -2, 2, 21, 21] flv_real (:, 10) = [11, -11, -2, -5, 2, 5] flv_real (:, 11) = [11, -11, -2, -3, 2, 3] flv_real (:, 12) = [11, -11, -2, -3, 4, 1] flv_real (:, 13) = [11, -11, -2, -1, 2, 1] flv_real (:, 14) = [11, -11, -5, -5, 5, 5] flv_real (:, 15) = [11, -11, -5, -3, 3, 5] flv_real (:, 16) = [11, -11, -5, -1, 1, 5] flv_real (:, 17) = [11, -11, -5, 5, 21, 21] flv_real (:, 18) = [11, -11, -3, -3, 3, 3] flv_real (:, 19) = [11, -11, -3, -1, 1, 3] flv_real (:, 20) = [11, -11, -3, 3, 21, 21] flv_real (:, 21) = [11, -11, -1, -1, 1, 1] flv_real (:, 22) = [11, -11, -1, 1, 21, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () call write_separator (u) write (u, "(A)") "* ee -> L L A" write (u, "(A)") "* with L = e2:E2:e3:E3" write (u, "(A)") n_flv_born = 2; n_flv_real = 6 n_legs_born = 5; n_legs_real = 6 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, -15, 15, 22] flv_born (:, 2) = [11, -11, -13, 13, 22] flv_real (:, 1) = [11, -11, -15, -15, 15, 15] flv_real (:, 2) = [11, -11, -15, -13, 13, 13] flv_real (:, 3) = [11, -11, -13, -15, 13, 15] flv_real (:, 4) = [11, -11, -15, 15, 22, 22] flv_real (:, 5) = [11, -11, -13, -13, 13, 13] flv_real (:, 6) = [11, -11, -13, 13, 22, 22] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () end subroutine fks_regions_3 @ %def fks_regions_3 @ <>= public :: fks_regions_4 <>= subroutine fks_regions_4 (u) integer, intent(in) :: u integer :: n_flv_born, n_flv_real integer :: n_legs_born, n_legs_real integer :: n_in integer, dimension(:,:), allocatable :: flv_born, flv_real type(region_data_t) :: reg_data write (u, "(A)") "* Test output: fks_regions_4" write (u, "(A)") "* Create singular regions for processes with four final-state particles" write (u, "(A)") "* ee -> 4 jet" write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl" write (u, "(A)") n_flv_born = 22; n_flv_real = 22 n_legs_born = 6; n_legs_real = 7 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, -4, -4, 4, 4] flv_born (:, 2) = [11, -11, -4, -2, 2, 4] flv_born (:, 3) = [11, -11, -4, 4, 21, 21] flv_born (:, 4) = [11, -11, -4, -5, 4, 5] flv_born (:, 5) = [11, -11, -4, -3, 4, 3] flv_born (:, 6) = [11, -11, -4, -1, 2, 3] flv_born (:, 7) = [11, -11, -4, -1, 4, 1] flv_born (:, 8) = [11, -11, -2, -2, 2, 2] flv_born (:, 9) = [11, -11, -2, 2, 21, 21] flv_born (:, 10) = [11, -11, -2, -5, 2, 5] flv_born (:, 11) = [11, -11, -2, -3, 2, 3] flv_born (:, 12) = [11, -11, -2, -3, 4, 1] flv_born (:, 13) = [11, -11, -2, -1, 2, 1] flv_born (:, 14) = [11, -11, -5, -5, 5, 5] flv_born (:, 15) = [11, -11, -5, -3, 3, 5] flv_born (:, 16) = [11, -11, -5, -1, 1, 5] flv_born (:, 17) = [11, -11, -5, 5, 21, 21] flv_born (:, 18) = [11, -11, -3, -3, 3, 3] flv_born (:, 19) = [11, -11, -3, -1, 1, 3] flv_born (:, 20) = [11, -11, -3, -3, 21, 21] flv_born (:, 21) = [11, -11, -1, -1, 1, 1] flv_born (:, 22) = [11, -11, -1, 1, 21, 21] flv_real (:, 1) = [11, -11, -4, -4, 4, 4, 21] flv_real (:, 2) = [11, -11, -4, -2, 2, 4, 21] flv_real (:, 3) = [11, -11, -4, 4, 21, 21, 21] flv_real (:, 4) = [11, -11, -4, -5, 4, 5, 21] flv_real (:, 5) = [11, -11, -4, -3, 4, 3, 21] flv_real (:, 6) = [11, -11, -4, -1, 2, 3, 21] flv_real (:, 7) = [11, -11, -4, -1, 4, 1, 21] flv_real (:, 8) = [11, -11, -2, -2, 2, 2, 21] flv_real (:, 9) = [11, -11, -2, 2, 21, 21, 21] flv_real (:, 10) = [11, -11, -2, -5, 2, 5, 21] flv_real (:, 11) = [11, -11, -2, -3, 2, 3, 21] flv_real (:, 12) = [11, -11, -2, -3, 4, 1, 21] flv_real (:, 13) = [11, -11, -2, -1, 2, 1, 21] flv_real (:, 14) = [11, -11, -5, -5, 5, 5, 21] flv_real (:, 15) = [11, -11, -5, -3, 3, 5, 21] flv_real (:, 16) = [11, -11, -5, -1, 1, 5, 21] flv_real (:, 17) = [11, -11, -5, 5, 21, 21, 21] flv_real (:, 18) = [11, -11, -3, -3, 3, 3, 21] flv_real (:, 19) = [11, -11, -3, -1, 1, 3, 21] flv_real (:, 20) = [11, -11, -3, 3, 21, 21, 21] flv_real (:, 21) = [11, -11, -1, -1, 1, 1, 21] flv_real (:, 22) = [11, -11, -1, 1, 21, 21, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () call write_separator (u) write (u, "(A)") "* ee -> bbmumu with QCD corrections" write (u, "(A)") n_flv_born = 1; n_flv_real = 1 n_legs_born = 6; n_legs_real = 7 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, -5, 5, -13, 13] flv_real (:, 1) = [11, -11, -5, 5, -13, 13, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () call write_separator (u) write (u, "(A)") "* ee -> bbmumu with EW corrections" write (u, "(A)") n_flv_born = 1; n_flv_real = 1 n_legs_born = 6; n_legs_real = 7 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, -5, 5, -13, 13] flv_real (:, 1) = [11, -11, -5, 5, -13, 13, 22] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () end subroutine fks_regions_4 @ %def fks_regions_4 @ <>= public :: fks_regions_5 <>= subroutine fks_regions_5 (u) integer, intent(in) :: u integer :: n_flv_born, n_flv_real integer :: n_legs_born, n_legs_real integer :: n_in integer, dimension(:,:), allocatable :: flv_born, flv_real type(region_data_t) :: reg_data write (u, "(A)") "* Test output: fks_regions_5" write (u, "(A)") "* Create singular regions for processes with five final-state particles" write (u, "(A)") "* ee -> 5 jet" write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl" write (u, "(A)") n_flv_born = 22; n_flv_real = 67 n_legs_born = 7; n_legs_real = 8 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:,1) = [11,-11,-4,-4,4,4,21] flv_born (:,2) = [11,-11,-4,-2,2,4,21] flv_born (:,3) = [11,-11,-4,4,21,21,21] flv_born (:,4) = [11,-11,-4,-5,4,5,21] flv_born (:,5) = [11,-11,-4,-3,4,3,21] flv_born (:,6) = [11,-11,-4,-1,2,3,21] flv_born (:,7) = [11,-11,-4,-1,4,1,21] flv_born (:,8) = [11,-11,-2,-2,2,2,21] flv_born (:,9) = [11,-11,-2,2,21,21,21] flv_born (:,10) = [11,-11,-2,-5,2,5,21] flv_born (:,11) = [11,-11,-2,-3,2,3,21] flv_born (:,12) = [11,-11,-2,-3,4,1,21] flv_born (:,13) = [11,-11,-2,-1,2,1,21] flv_born (:,14) = [11,-11,-5,-5,5,5,21] flv_born (:,15) = [11,-11,-5,-3,3,5,21] flv_born (:,16) = [11,-11,-5,-1,1,5,21] flv_born (:,17) = [11,-11,-5,5,21,21,21] flv_born (:,18) = [11,-11,-3,-3,3,3,21] flv_born (:,19) = [11,-11,-3,-1,1,3,21] flv_born (:,20) = [11,-11,-3,3,21,21,21] flv_born (:,21) = [11,-11,-1,-1,1,1,21] flv_born (:,22) = [11,-11,-1,1,21,21,21] flv_real (:,1) = [11,-11,-4,-4,-4,4,4,4] flv_real (:,2) = [11,-11,-4,-4,-2,2,4,4] flv_real (:,3) = [11,-11,-4,-4,4,4,21,21] flv_real (:,4) = [11,-11,-4,-4,-5,4,4,5] flv_real (:,5) = [11,-11,-4,-4,-3,4,4,3] flv_real (:,6) = [11,-11,-4,-4,-1,2,4,3] flv_real (:,7) = [11,-11,-4,-4,-1,4,4,1] flv_real (:,8) = [11,-11,-4,-2,-2,2,2,4] flv_real (:,9) = [11,-11,-4,-2,2,4,21,21] flv_real (:,10) = [11,-11,-4,-2,-5,2,4,5] flv_real (:,11) = [11,-11,-4,-2,-3,2,4,3] flv_real (:,12) = [11,-11,-4,-2,-3,4,4,1] flv_real (:,13) = [11,-11,-4,-2,-1,2,2,3] flv_real (:,14) = [11,-11,-4,-2,-1,2,4,1] flv_real (:,15) = [11,-11,-4,4,21,21,21,21] flv_real (:,16) = [11,-11,-4,-5,4,5,21,21] flv_real (:,17) = [11,-11,-4,-5,-5,4,5,5] flv_real (:,18) = [11,-11,-4,-5,-3,4,3,5] flv_real (:,19) = [11,-11,-4,-5,-1,2,3,5] flv_real (:,20) = [11,-11,-4,-5,-1,4,1,5] flv_real (:,21) = [11,-11,-4,-3,4,3,21,21] flv_real (:,22) = [11,-11,-4,-3,-3,4,3,3] flv_real (:,23) = [11,-11,-4,-3,-1,2,3,3] flv_real (:,24) = [11,-11,-4,-3,-1,4,1,3] flv_real (:,25) = [11,-11,-4,-1,2,3,21,21] flv_real (:,26) = [11,-11,-4,-1,4,1,21,21] flv_real (:,27) = [11,-11,-4,-1,-1,2,1,3] flv_real (:,28) = [11,-11,-4,-1,-1,4,1,1] flv_real (:,29) = [11,-11,-2,-2,-2,2,2,2] flv_real (:,30) = [11,-11,-2,-2,2,2,21,21] flv_real (:,31) = [11,-11,-2,-2,-5,2,2,5] flv_real (:,32) = [11,-11,-2,-2,-3,2,2,3] flv_real (:,33) = [11,-11,-2,-2,-3,2,4,1] flv_real (:,34) = [11,-11,-2,-2,-1,2,2,1] flv_real (:,35) = [11,-11,-2,2,21,21,21,21] flv_real (:,36) = [11,-11,-2,-5,2,5,21,21] flv_real (:,37) = [11,-11,-2,-5,-5,2,5,5] flv_real (:,38) = [11,-11,-2,-5,-3,2,3,5] flv_real (:,39) = [11,-11,-2,-5,-3,4,1,5] flv_real (:,40) = [11,-11,-2,-5,-1,2,1,5] flv_real (:,41) = [11,-11,-2,-3,2,3,21,21] flv_real (:,42) = [11,-11,-2,-3,4,1,21,21] flv_real (:,43) = [11,-11,-2,-3,-3,2,3,3] flv_real (:,44) = [11,-11,-2,-3,-3,4,1,3] flv_real (:,45) = [11,-11,-2,-3,-1,2,1,3] flv_real (:,46) = [11,-11,-2,-3,-1,4,1,1] flv_real (:,47) = [11,-11,-2,-1,2,1,21,21] flv_real (:,48) = [11,-11,-2,-1,-1,2,1,1] flv_real (:,49) = [11,-11,-5,-5,-5,5,5,5] flv_real (:,50) = [11,-11,-5,-5,-3,3,5,5] flv_real (:,51) = [11,-11,-5,-5,-1,1,5,5] flv_real (:,52) = [11,-11,-5,-5,5,5,21,21] flv_real (:,53) = [11,-11,-5,-3,-3,3,3,5] flv_real (:,54) = [11,-11,-5,-3,-1,1,3,5] flv_real (:,55) = [11,-11,-5,-3,3,5,21,21] flv_real (:,56) = [11,-11,-5,-1,-1,1,1,5] flv_real (:,57) = [11,-11,-5,-1,1,5,21,21] flv_real (:,58) = [11,-11,-5,5,21,21,21,21] flv_real (:,59) = [11,-11,-3,-3,-3,3,3,3] flv_real (:,60) = [11,-11,-3,-3,-1,1,3,3] flv_real (:,61) = [11,-11,-3,-3,3,3,21,21] flv_real (:,62) = [11,-11,-3,-1,-1,1,1,3] flv_real (:,63) = [11,-11,-3,-1,1,3,21,21] flv_real (:,64) = [11,-11,-3,3,21,21,21,21] flv_real (:,65) = [11,-11,-1,-1,-1,1,1,1] flv_real (:,66) = [11,-11,-1,-1,1,1,21,21] flv_real (:,67) = [11,-11,-1,1,21,21,21,21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) deallocate (flv_born, flv_real) call reg_data%final () end subroutine fks_regions_5 @ %def fks_regions_5 @ <>= public :: fks_regions_6 <>= subroutine fks_regions_6 (u) integer, intent(in) :: u integer :: n_flv_born, n_flv_real integer :: n_legs_born, n_legs_real integer :: n_in integer, dimension(:,:), allocatable :: flv_born, flv_real type(region_data_t) :: reg_data integer :: i, j integer, dimension(10) :: flavors write (u, "(A)") "* Test output: fks_regions_6" write (u, "(A)") "* Create table of singular regions for Drell Yan" write (u, "(A)") n_flv_born = 10; n_flv_real = 30 n_legs_born = 4; n_legs_real = 5 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flavors = [-5, -4, -3, -2, -1, 1, 2, 3, 4, 5] do i = 1, n_flv_born flv_born (3:4, i) = [11, -11] end do do j = 1, n_flv_born flv_born (1, j) = flavors (j) flv_born (2, j) = -flavors (j) end do do i = 1, n_flv_real flv_real (3:4, i) = [11, -11] end do i = 1 do j = 1, n_flv_real if (mod (j, 3) == 1) then flv_real (1, j) = flavors (i) flv_real (2, j) = -flavors (i) flv_real (5, j) = 21 else if (mod (j, 3) == 2) then flv_real (1, j) = flavors (i) flv_real (2, j) = 21 flv_real (5, j) = flavors (i) else flv_real (1, j) = 21 flv_real (2, j) = -flavors (i) flv_real (5, j) = -flavors (i) i = i + 1 end if end do call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) call write_separator (u) deallocate (flv_born, flv_real) call reg_data%final () write (u, "(A)") "* Create table of singular regions for hadronic top decay" write (u, "(A)") n_flv_born = 1; n_flv_real = 1 n_legs_born = 4; n_legs_real = 5 n_in = 1 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [6, -5, 2, -1] flv_real (:, 1) = [6, -5, 2, -1, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) call write_separator (u) deallocate (flv_born, flv_real) call reg_data%final () write (u, "(A)") "* Create table of singular regions for dijet s sbar -> jet jet" write (u, "(A)") "* With jet = u:d:gl" write (u, "(A)") n_flv_born = 3; n_flv_real = 3 n_legs_born = 4; n_legs_real = 5 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) do i = 1, n_flv_born flv_born (1:2, i) = [3, -3] end do flv_born (3, :) = [1, 2, 21] flv_born (4, :) = [-1, -2, 21] do i = 1, n_flv_real flv_real (1:2, i) = [3, -3] end do flv_real (3, :) = [1, 2, 21] flv_real (4, :) = [-1, -2, 21] flv_real (5, :) = [21, 21, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%check_consistency (.false., u) call reg_data%write (u) call reg_data%final () end subroutine fks_regions_6 @ %def fks_regions_6 @ <>= public :: fks_regions_7 <>= subroutine fks_regions_7 (u) integer, intent(in) :: u integer :: n_flv_born, n_flv_real integer :: n_legs_born, n_legs_real integer :: n_in integer, dimension(:,:), allocatable :: flv_born, flv_real type(region_data_t) :: reg_data write (u, "(A)") "* Test output: fks_regions_7" write (u, "(A)") "* Create table of singular regions for ee -> qq" write (u, "(A)") n_flv_born = 1; n_flv_real = 1 n_legs_born = 4; n_legs_real = 5 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, 2, -2] flv_real (:, 1) = [11, -11, 2, -2, 21] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD")) call reg_data%write_latex (u) call reg_data%final () end subroutine fks_regions_7 @ %def fks_regions_7 @ <>= public :: fks_regions_8 <>= subroutine fks_regions_8 (u) integer, intent(in) :: u integer :: n_flv_born, n_flv_real integer :: n_legs_born, n_legs_real integer :: n_in integer, dimension(:,:), allocatable :: flv_born, flv_real type(region_data_t) :: reg_data integer :: i, j integer, dimension(10) :: flavors write (u, "(A)") "* Test output: fks_regions_8" write (u, "(A)") "* Create table of singular regions for ee -> ee" write (u, "(A)") n_flv_born = 1; n_flv_real = 3 n_legs_born = 4; n_legs_real = 5 n_in = 2 allocate (flv_born (n_legs_born, n_flv_born)) allocate (flv_real (n_legs_real, n_flv_real)) flv_born (:, 1) = [11, -11, -11, 11] flv_real (:, 1) = [11, -11, -11, 11, 22] flv_real (:, 2) = [11, 22, -11, 11, 11] flv_real (:, 3) = [22, -11, 11, -11, -11] call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW")) call reg_data%check_consistency (.false., u) call reg_data%write (u) call reg_data%final () end subroutine fks_regions_8 @ %def fks_regions_8 @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Virtual contribution to the cross section} <<[[virtual.f90]]>>= <> module virtual <> <> <> use numeric_utils use constants use diagnostics use pdg_arrays use models use model_data, only: model_data_t use physics_defs use sm_physics use lorentz use flavors use nlo_data, only: get_threshold_momenta, nlo_settings_t use nlo_data, only: ASSOCIATED_LEG_PAIR use fks_regions <> <> <> <> contains <> end module virtual @ %def virtual @ <>= public :: virtual_t <>= type :: virtual_t type(nlo_settings_t), pointer :: settings real(default), dimension(:,:), allocatable :: gamma_0, gamma_p, c_flv real(default) :: ren_scale2, fac_scale, es_scale2 integer, dimension(:), allocatable :: n_is_neutrinos integer :: n_in, n_legs, n_flv logical :: bad_point = .false. type(string_t) :: selection real(default), dimension(:), allocatable :: sqme_born real(default), dimension(:), allocatable :: sqme_virt_fin real(default), dimension(:,:,:), allocatable :: sqme_color_c real(default), dimension(:,:,:), allocatable :: sqme_charge_c logical :: has_pdfs = .false. contains <> end type virtual_t @ %def virtual_t @ <>= procedure :: init => virtual_init <>= subroutine virtual_init (virt, flv_born, n_in, settings, & nlo_corr_type, model, has_pdfs) class(virtual_t), intent(inout) :: virt integer, intent(in), dimension(:,:) :: flv_born integer, intent(in) :: n_in type(nlo_settings_t), intent(in), pointer :: settings type(string_t), intent(in) :: nlo_corr_type class(model_data_t), intent(in) :: model logical, intent(in) :: has_pdfs integer :: i_flv virt%n_legs = size (flv_born, 1); virt%n_flv = size (flv_born, 2) virt%n_in = n_in allocate (virt%sqme_born (virt%n_flv)) allocate (virt%sqme_virt_fin (virt%n_flv)) allocate (virt%sqme_color_c (virt%n_legs, virt%n_legs, virt%n_flv)) allocate (virt%sqme_charge_c (virt%n_legs, virt%n_legs, virt%n_flv)) allocate (virt%gamma_0 (virt%n_legs, virt%n_flv), & virt%gamma_p (virt%n_legs, virt%n_flv), & virt%c_flv (virt%n_legs, virt%n_flv)) call virt%init_constants (flv_born, settings%fks_template%n_f, nlo_corr_type, model) allocate (virt%n_is_neutrinos (virt%n_flv)) virt%n_is_neutrinos = 0 do i_flv = 1, virt%n_flv if (is_neutrino (flv_born(1, i_flv))) & virt%n_is_neutrinos(i_flv) = virt%n_is_neutrinos(i_flv) + 1 if (is_neutrino (flv_born(2, i_flv))) & virt%n_is_neutrinos(i_flv) = virt%n_is_neutrinos(i_flv) + 1 end do select case (char (settings%virtual_selection)) case ("Full", "OLP", "Subtraction") virt%selection = settings%virtual_selection case default call msg_fatal ('Virtual selection: Possible values are "Full", "OLP" or "Subtraction') end select virt%settings => settings virt%has_pdfs = has_pdfs contains function is_neutrino (flv) result (neutrino) integer, intent(in) :: flv logical :: neutrino neutrino = (abs(flv) == 12 .or. abs(flv) == 14 .or. abs(flv) == 16) end function is_neutrino end subroutine virtual_init @ %def virtual_init @ The virtual subtraction terms contain Casimir operators and derived constants, listed below: \begin{align} \label{eqn:C(q)} C(q) = C(\bar{q}) &= C_F, \\ \label{eqn:C(g)} C(g) &= C_A,\\ \label{eqn:gamma(q)} \gamma(q) = \gamma(\bar{q}) &= \frac{3}{2} C_F,\\ \label{eqn:gamma(g)} \gamma(g) &= \frac{11}{6} C_A - \frac{2}{3} T_F N_f,\\ \label{eqn:gammap(q)} \gamma'(q) = \gamma'(\bar{q}) &= \left(\frac{13}{2} - \frac{2\pi^2}{3}\right) C_F, \\ \label{eqn:gammap(g)} \gamma'(g) &= \left(\frac{67}{9} - \frac{2\pi^2}{3}\right) C_A - \frac{23}{9} T_F N_f. \end{align} For uncolored particles, [[virtual_init_constants]] sets $C$, $\gamma$ and $\gamma'$ to zero. <>= procedure :: init_constants => virtual_init_constants <>= subroutine virtual_init_constants (virt, flv_born, nf_input, nlo_corr_type, model) class(virtual_t), intent(inout) :: virt integer, intent(in), dimension(:,:) :: flv_born integer, intent(in) :: nf_input type(string_t), intent(in) :: nlo_corr_type class(model_data_t), intent(in) :: model integer :: i_part, i_flv real(default) :: nf, CA_factor real(default), dimension(:,:), allocatable :: CF_factor, TR_factor type(flavor_t) :: flv allocate (CF_factor (size (flv_born, 1), size (flv_born, 2)), & TR_factor (size (flv_born, 1), size (flv_born, 2))) select case (char (nlo_corr_type)) case ("QCD") CA_factor = CA; CF_factor = CF; TR_factor = TR nf = real(nf_input, default) case ("EW") CA_factor = zero do i_flv = 1, size (flv_born, 2) do i_part = 1, size (flv_born, 1) call flv%init (flv_born(i_part, i_flv), model) CF_factor(i_part, i_flv) = (flv%get_charge ())**2 TR_factor(i_part, i_flv) = (flv%get_charge ())**2 end do end do ! TODO vincent_r fixed nf needs replacement !!! for testing only, needs dynamical treatment! nf = real(4, default) end select do i_flv = 1, size (flv_born, 2) do i_part = 1, size (flv_born, 1) if (is_corresponding_vector (flv_born(i_part, i_flv), nlo_corr_type)) then virt%gamma_0(i_part, i_flv) = 11._default / 6._default * CA_factor & - two / three * TR_factor(i_part, i_flv) * nf virt%gamma_p(i_part, i_flv) = (67._default / 9._default & - two * pi**2 / three) * CA_factor & - 23._default / 9._default * TR_factor(i_part, i_flv) * nf virt%c_flv(i_part, i_flv) = CA_factor else if (is_corresponding_fermion (flv_born(i_part, i_flv), nlo_corr_type)) then virt%gamma_0(i_part, i_flv) = 1.5_default * CF_factor(i_part, i_flv) virt%gamma_p(i_part, i_flv) = (6.5_default - two * pi**2 / three) * CF_factor(i_part, i_flv) virt%c_flv(i_part, i_flv) = CF_factor(i_part, i_flv) else virt%gamma_0(i_part, i_flv) = zero virt%gamma_p(i_part, i_flv) = zero virt%c_flv(i_part, i_flv) = zero end if end do end do contains function is_corresponding_vector (pdg_nr, nlo_corr_type) logical :: is_corresponding_vector integer, intent(in) :: pdg_nr type(string_t), intent(in) :: nlo_corr_type is_corresponding_vector = .false. if (nlo_corr_type == "QCD") then is_corresponding_vector = is_gluon (pdg_nr) else if (nlo_corr_type == "EW") then is_corresponding_vector = is_photon (pdg_nr) end if end function is_corresponding_vector function is_corresponding_fermion (pdg_nr, nlo_corr_type) logical :: is_corresponding_fermion integer, intent(in) :: pdg_nr type(string_t), intent(in) :: nlo_corr_type is_corresponding_fermion = .false. if (nlo_corr_type == "QCD") then is_corresponding_fermion = is_quark (pdg_nr) else if (nlo_corr_type == "EW") then is_corresponding_fermion = is_fermion (pdg_nr) end if end function is_corresponding_fermion end subroutine virtual_init_constants @ %def virtual_init_constants @ Set the renormalization scale. If the input is zero, use the center-of-mass energy. <>= procedure :: set_ren_scale => virtual_set_ren_scale <>= subroutine virtual_set_ren_scale (virt, p, ren_scale) class(virtual_t), intent(inout) :: virt type(vector4_t), intent(in), dimension(:) :: p real(default), intent(in) :: ren_scale if (ren_scale > 0) then virt%ren_scale2 = ren_scale**2 else virt%ren_scale2 = (p(1) + p(2))**2 end if end subroutine virtual_set_ren_scale @ %def virtual_set_ren_scale @ <>= procedure :: set_fac_scale => virtual_set_fac_scale <>= subroutine virtual_set_fac_scale (virt, p, fac_scale) class(virtual_t), intent(inout) :: virt type(vector4_t), dimension(:), intent(in) :: p real(default), optional :: fac_scale if (present (fac_scale)) then virt%fac_scale = fac_scale else virt%fac_scale = (p(1) + p(2))**1 end if end subroutine virtual_set_fac_scale @ %def virtual_set_fac_scale <>= procedure :: set_ellis_sexton_scale => virtual_set_ellis_sexton_scale <>= subroutine virtual_set_ellis_sexton_scale (virt, Q) class(virtual_t), intent(inout) :: virt real(default), intent(in) :: Q virt%es_scale2 = Q * Q end subroutine virtual_set_ellis_sexton_scale @ %def virtual_set_ellis_sexton_scale @ The virtual-subtracted matrix element is given by the equation \begin{equation} \label{eqn:virt_sub} \mathcal{V} = \frac{\alpha_s}{2\pi}\left(\mathcal{Q}\mathcal{B} + \sum \mathcal{I}_{ij}\mathcal{B}_{ij} + \mathcal{V}_{fin}\right), \end{equation} The expressions for $\mathcal{Q}$ can be found in equations \ref{eqn:virt_Q_isr} and \ref{eqn:virt_Q_fsr}. The expressions for $\mathcal{I}_{ij}$ can be found in equations (\ref{I_00}), (\ref{I_mm}), (\ref{I_0m}), depending on whether the particles involved in the radiation process are massive or massless. If two or more flavor structures would produce the same amplitude we only compute one and use the [[eqv_index]] to copy the result to the others (if [[reuse_amplitudes_fks]] is true). <>= procedure :: evaluate => virtual_evaluate <>= subroutine virtual_evaluate (virt, reg_data, alpha_coupling, & p_born, separate_uborns, sqme_virt) class(virtual_t), intent(inout) :: virt type(region_data_t), intent(in) :: reg_data real(default), intent(in) :: alpha_coupling type(vector4_t), intent(in), dimension(:) :: p_born logical, intent(in) :: separate_uborns real(default), dimension(:), intent(inout) :: sqme_virt integer, dimension(:), allocatable :: eqv_flv_index real(default), dimension(:), allocatable :: sqme_virt_arr real(default) :: s, s_o_Q2 real(default), dimension(reg_data%n_flv_born) :: QB, BI integer :: i_flv, ii_flv logical, dimension(:), allocatable :: flv_evaluated QB = zero; BI = zero allocate (flv_evaluated(reg_data%n_flv_born)) allocate (sqme_virt_arr(reg_data%n_flv_born)) sqme_virt_arr = zero flv_evaluated = .false. if (virt%bad_point) return if (debug2_active (D_VIRTUAL)) then print *, 'Compute virtual component using alpha = ', alpha_coupling print *, 'Virtual selection: ', char (virt%selection) print *, 'virt%es_scale2 = ', virt%es_scale2 !!! Debugging end if s = sum (p_born(1 : virt%n_in))**2 if (virt%settings%factorization_mode == FACTORIZATION_THRESHOLD) & call set_s_for_threshold () s_o_Q2 = s / virt%es_scale2 * virt%settings%fks_template%xi_cut**2 eqv_flv_index = reg_data%eqv_flv_index_born do i_flv = 1, reg_data%n_flv_born if (.not. flv_evaluated(eqv_flv_index(i_flv))) then if (virt%selection == var_str ("Full") .or. virt%selection == var_str ("OLP")) then !!! A factor of alpha_coupling/twopi is assumed to be included in vfin sqme_virt_arr(i_flv) = sqme_virt_arr(i_flv) + virt%sqme_virt_fin(i_flv) end if if (virt%selection == var_str ("Full") .or. & virt%selection == var_str ("Subtraction")) then call virt%evaluate_initial_state (i_flv, QB) call virt%compute_collinear_contribution (i_flv, p_born, sqrt(s), reg_data, QB) select case (virt%settings%factorization_mode) case (FACTORIZATION_THRESHOLD) call virt%compute_eikonals_threshold (i_flv, p_born, s_o_Q2, QB, BI) case default call virt%compute_massive_self_eikonals (i_flv, p_born, s_o_Q2, reg_data, QB) call virt%compute_eikonals (i_flv, p_born, s_o_Q2, reg_data, BI) end select if (debug2_active (D_VIRTUAL)) then print *, 'Evaluate i_flv: ', i_flv print *, 'sqme_born: ', virt%sqme_born (i_flv) print *, 'Q * sqme_born: ', alpha_coupling / twopi * QB(i_flv) print *, 'BI: ', alpha_coupling / twopi * BI(i_flv) print *, 'vfin: ', virt%sqme_virt_fin (i_flv) end if sqme_virt_arr(i_flv) = & sqme_virt_arr(i_flv) + alpha_coupling / twopi * (QB(i_flv) + BI(i_flv)) end if if (.not. (debug_active (D_VIRTUAL) .or. & debug2_active (D_VIRTUAL))) flv_evaluated(eqv_flv_index(i_flv)) = .true. else sqme_virt_arr(i_flv) = sqme_virt_arr(eqv_flv_index(i_flv)) end if if (separate_uborns) then sqme_virt(i_flv) = sqme_virt(i_flv) + sqme_virt_arr(i_flv) else sqme_virt(1) = sqme_virt(1) + sqme_virt_arr(i_flv) end if end do if (debug2_active (D_VIRTUAL)) then call msg_debug2 (D_VIRTUAL, "virtual-subtracted matrix element(s): ") print *, sqme_virt end if do i_flv = 1, reg_data%n_flv_born if (virt%n_is_neutrinos(i_flv) > 0) & sqme_virt = sqme_virt * virt%n_is_neutrinos(i_flv) * two end do contains subroutine set_s_for_threshold () use ttv_formfactors, only: m1s_to_mpole real(default) :: mtop2 mtop2 = m1s_to_mpole (sqrt(s))**2 if (s < four * mtop2) s = four * mtop2 end subroutine set_s_for_threshold end subroutine virtual_evaluate @ %def virtual_evaluate @ <>= procedure :: compute_eikonals => virtual_compute_eikonals <>= subroutine virtual_compute_eikonals (virtual, i_flv, & p_born, s_o_Q2, reg_data, BI) class(virtual_t), intent(inout) :: virtual integer, intent(in) :: i_flv type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in) :: s_o_Q2 type(region_data_t), intent(in) :: reg_data real(default), intent(inout), dimension(:) :: BI integer :: i, j real(default) :: I_ij, BI_tmp BI_tmp = zero ! TODO vincent_r: Split the procedure into one computing QCD eikonals and one computing QED eikonals. ! TODO vincent_r: In the best case, remove the dependency on reg_data completely. associate (flst_born => reg_data%flv_born(i_flv), & nlo_corr_type => reg_data%regions(1)%nlo_correction_type) do i = 1, virtual%n_legs do j = 1, virtual%n_legs if (i /= j) then if (nlo_corr_type == "QCD") then if (flst_born%colored(i) .and. flst_born%colored(j)) then I_ij = compute_eikonal_factor (p_born, flst_born%massive, & i, j, s_o_Q2) BI_tmp = BI_tmp + virtual%sqme_color_c (i, j, i_flv) * I_ij if (debug2_active (D_VIRTUAL)) & print *, 'b_ij: ', i, j, virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij end if else if (nlo_corr_type == "EW") then I_ij = compute_eikonal_factor (p_born, flst_born%massive, & i, j, s_o_Q2) BI_tmp = BI_tmp + virtual%sqme_charge_c (i, j, i_flv) * I_ij if (debug2_active (D_VIRTUAL)) & print *, 'b_ij: ', virtual%sqme_charge_c (i, j, i_flv), 'I_ij: ', I_ij end if else if (debug2_active (D_VIRTUAL)) then print *, 'b_ij: ', i, j, virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij end if end do end do if (virtual%settings%use_internal_color_correlations .or. nlo_corr_type == "EW") & BI_tmp = BI_tmp * virtual%sqme_born (i_flv) end associate BI(i_flv) = BI(i_flv) + BI_tmp end subroutine virtual_compute_eikonals @ %def virtual_compute_eikonals @ <>= procedure :: compute_eikonals_threshold => virtual_compute_eikonals_threshold <>= subroutine virtual_compute_eikonals_threshold (virtual, i_flv, & p_born, s_o_Q2, QB, BI) class(virtual_t), intent(in) :: virtual integer, intent(in) :: i_flv type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in) :: s_o_Q2 real(default), intent(inout), dimension(:) :: QB real(default), intent(inout), dimension(:) :: BI type(vector4_t), dimension(4) :: p_thr integer :: leg BI = zero; p_thr = get_threshold_momenta (p_born) call compute_massive_self_eikonals (virtual%sqme_born(i_flv), QB(i_flv)) do leg = 1, 2 BI(i_flv) = BI(i_flv) + evaluate_leg_pair (ASSOCIATED_LEG_PAIR(leg), i_flv) end do contains subroutine compute_massive_self_eikonals (sqme_born, QB) real(default), intent(in) :: sqme_born real(default), intent(inout) :: QB integer :: i if (debug_on) call msg_debug2 (D_VIRTUAL, "compute_massive_self_eikonals") if (debug_on) call msg_debug2 (D_VIRTUAL, "s_o_Q2", s_o_Q2) if (debug_on) call msg_debug2 (D_VIRTUAL, "log (s_o_Q2)", log (s_o_Q2)) do i = 1, 4 QB = QB - (cf * (log (s_o_Q2) - 0.5_default * I_m_eps (p_thr(i)))) & * sqme_born end do end subroutine compute_massive_self_eikonals function evaluate_leg_pair (i_start, i_flv) result (b_ij_times_I) real(default) :: b_ij_times_I integer, intent(in) :: i_start, i_flv real(default) :: I_ij integer :: i, j b_ij_times_I = zero do i = i_start, i_start + 1 do j = i_start, i_start + 1 if (i /= j) then I_ij = compute_eikonal_factor & (p_thr, [.true., .true., .true., .true.], i, j, s_o_Q2) b_ij_times_I = b_ij_times_I + & virtual%sqme_color_c (i, j, i_flv) * I_ij if (debug2_active (D_VIRTUAL)) & print *, 'b_ij: ', virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij end if end do end do if (virtual%settings%use_internal_color_correlations) & b_ij_times_I = b_ij_times_I * virtual%sqme_born (i_flv) if (debug2_active (D_VIRTUAL)) then print *, 'internal color: ', virtual%settings%use_internal_color_correlations print *, 'b_ij_times_I = ', b_ij_times_I print *, 'QB = ', QB end if end function evaluate_leg_pair end subroutine virtual_compute_eikonals_threshold @ %def virtual_compute_eikonals_threshold @ <>= procedure :: set_bad_point => virtual_set_bad_point <>= subroutine virtual_set_bad_point (virt, value) class(virtual_t), intent(inout) :: virt logical, intent(in) :: value virt%bad_point = value end subroutine virtual_set_bad_point @ %def virtual_set_bad_point @ The collinear limit of $\tilde{\mathcal{R}}$ can be integrated over the radiation degrees of freedom, giving the collinear contribution to the virtual component. Its general structure is $\mathcal{Q} \cdot \mathcal{B}$. The initial-state contribution to $\mathcal{Q}$ is simply given by \begin{equation} \label{eqn:virt_Q_isr} \mathcal{Q} = -\log\frac{\mu_F^2}{Q^2} \left(\gamma(\mathcal{I}_1) + 2 C (\mathcal{I}_1) \log(\xi_{\text{cut}}) + \gamma(\mathcal{I}_2) + 2 C (\mathcal{I}_2) \log(\xi_{\text{cut}}) \right), \end{equation} where $Q^2$ is the Ellis-Sexton scale and $\gamma$ is as in eqns. \ref{eqn:gamma(q)} and \ref{eqn:gamma(g)}.\\ [[virtual_evaluate_initial_state]] computes this quantity. The loop over the initial-state particles is only executed if we are dealing with a scattering process, because for decays there are no virtual initial-initial interactions. <>= procedure :: evaluate_initial_state => virtual_evaluate_initial_state <>= subroutine virtual_evaluate_initial_state (virt, i_flv, QB) class(virtual_t), intent(inout) :: virt integer, intent(in) :: i_flv real(default), intent(inout), dimension(:) :: QB integer :: i if (virt%n_in == 2) then do i = 1, virt%n_in QB(i_flv) = QB(i_flv) - (virt%gamma_0 (i, i_flv) + two * virt%c_flv(i, i_flv) & * log (virt%settings%fks_template%xi_cut)) & * log(virt%fac_scale**2 / virt%es_scale2) * virt%sqme_born (i_flv) end do end if end subroutine virtual_evaluate_initial_state @ %def virtual_evaluate_initial_state @ Same as above, but for final-state particles. The collinear limit for final-state particles follows from the integral \begin{equation*} I_{+,\alpha_r} = \int d\Phi_{n+1} \frac{\xi_+^{-1-2\epsilon}}{\xi^{-1-2\epsilon}} \mathcal{R}_{\alpha_r}. \end{equation*} We can distinguish three situations: \begin{enumerate} \item $\alpha_r$ contains a massive emitter. In this case, no collinear subtraction term is required and the integral above is irrelevant. \item $\alpha_r$ contains a massless emitter, but resonances are not taken into account in the subtraction. Here, $\xi_{max} = \frac{2E_{em}}{\sqrt{s}}$ is the upper bound on $\xi$. \item $\alpha_r$ contains a massless emitter and resonance-aware subtraction is used. Here, $\xi_{max} = \frac{2E_{em}}{\sqrt{k_{res}^2}}$. \end{enumerate} Before version 2.4, only situations 1 and 2 were covered. The difference between situation 2 and 3 comes from the expansion of the plus-distribution in the integral above, \begin{equation*} \xi_+^{-1-2\epsilon} = \xi^{-1-2\epsilon} + \frac{1}{2\epsilon}\delta(\xi) = \xi_{max}^{-1-2\epsilon}\left[(1-z)^{-1-2\epsilon} + \frac{\xi_{max}^{2\epsilon}}{2\epsilon}\delta(1-z)\right]. \end{equation*} The expression from the standard FKS literature is given by $\mathcal{Q}$ is given by \begin{equation} \label{eqn:virt_Q_fsr_old} \begin{split} \mathcal{Q} = \sum_{k=n_{in}}^{n_L^{(B)}} \left[\gamma'(\mathcal{I}_k) - \log\frac{s\delta_o}{2Q^2}\left(\gamma(\mathcal{I}_k) - 2C(\mathcal{I}_k) \log\frac{2E_k}{\xi_{\text{cut}}\sqrt{s}}\right) \right.\\ + \left. 2C(\mathcal{I}_k) \left( \log^2\frac{2E_k}{\sqrt{s}} - \log^2 \xi_{\text{cut}} \right) - 2\gamma(\mathcal{I}_k)\log\frac{2E_k}{\sqrt{s}}\right]. \end{split} \end{equation} $n_L^{(B)}$ is the number of legs at Born level. Here, $\xi_{max}$ is implicitly present in the ratios in the logarithms. Using the resonance-aware $\xi_{max}$ yields \begin{equation} \label{eqn:virt_Q_fsr} \begin{split} \mathcal{Q} = \sum_{k=n_{in}}^{n_L^{(B)}} \left[\gamma'(\mathcal{I}_k) + 2\left(\log\frac{\sqrt{s}}{2E_{em}} + \log\xi_{max}\right) \left(\log\frac{\sqrt{s}}{2E_{em}} + \log\xi_{max} + \log\frac{Q^2}{s}\right) C(\mathcal{I}_k) \right.\\ + \left. 2 \log\xi_{max} \left(\log\xi_{max} - \log\frac{Q^2}{k_{res}^2}\right) C(\mathcal{I}_k) + \left(\log\frac{Q^2}{k_{res}^2} - 2 \log\xi_{max}\right) \gamma(\mathcal{I}_k)\right]. \end{split} \end{equation} Equation \ref{eqn:virt_Q_fsr} leads to \ref{eqn:virt_Q_fsr_old} with the substitutions $\xi_{max} \rightarrow \frac{2E_{em}}{\sqrt{s}}$ and $k_{res}^2 \rightarrow s$. [[virtual_compute_collinear_contribution]] only implements the second one. <>= procedure :: compute_collinear_contribution & => virtual_compute_collinear_contribution <>= subroutine virtual_compute_collinear_contribution (virt, i_flv, & p_born, sqrts, reg_data, QB) class(virtual_t), intent(inout) :: virt integer, intent(in) :: i_flv type(vector4_t), dimension(:), intent(in) :: p_born real(default), intent(in) :: sqrts type(region_data_t), intent(in) :: reg_data real(default), intent(inout), dimension(:) :: QB real(default) :: s1, s2, s3, s4, s5 integer :: alr, em real(default) :: E_em, xi_max, log_xi_max, E_tot2 logical, dimension(virt%n_flv, virt%n_legs) :: evaluated integer :: i_contr type(vector4_t) :: k_res type(lorentz_transformation_t) :: L_to_resonance evaluated = .false. do alr = 1, reg_data%n_regions if (i_flv /= reg_data%regions(alr)%uborn_index) cycle em = reg_data%regions(alr)%emitter if (em <= virt%n_in) cycle if (evaluated(i_flv, em)) cycle !!! Collinear terms only for massless particles if (reg_data%regions(alr)%flst_uborn%massive(em)) cycle E_em = p_born(em)%p(0) if (allocated (reg_data%alr_contributors)) then i_contr = reg_data%alr_to_i_contributor (alr) k_res = get_resonance_momentum (p_born, reg_data%alr_contributors(i_contr)%c) E_tot2 = k_res%p(0)**2 L_to_resonance = inverse (boost (k_res, k_res**1)) xi_max = two * space_part_norm (L_to_resonance * p_born(em)) / k_res%p(0) else E_tot2 = sqrts**2 xi_max = two * E_em / sqrts end if log_xi_max = log (xi_max) associate (xi_cut => virt%settings%fks_template%xi_cut, delta_o => virt%settings%fks_template%delta_o) if (virt%settings%virtual_resonance_aware_collinear) then if (debug_active (D_VIRTUAL)) & call msg_debug (D_VIRTUAL, "Using resonance-aware collinear subtraction") s1 = virt%gamma_p(em, i_flv) s2 = two * (log (sqrts / (two * E_em)) + log_xi_max) * & (log (sqrts / (two * E_em)) + log_xi_max + log (virt%es_scale2 / sqrts**2)) & * virt%c_flv(em, i_flv) s3 = two * log_xi_max * & (log_xi_max - log (virt%es_scale2 / E_tot2)) * virt%c_flv(em, i_flv) s4 = (log (virt%es_scale2 / E_tot2) - two * log_xi_max) * virt%gamma_0(em, i_flv) QB(i_flv) = QB(i_flv) + (s1 + s2 + s3 + s4) * virt%sqme_born(i_flv) else if (debug_active (D_VIRTUAL)) & call msg_debug (D_VIRTUAL, "Using old-fashioned collinear subtraction") s1 = virt%gamma_p(em, i_flv) s2 = log (delta_o * sqrts**2 / (two * virt%es_scale2)) * virt%gamma_0(em,i_flv) s3 = log (delta_o * sqrts**2 / (two * virt%es_scale2)) * two * virt%c_flv(em,i_flv) * & log (two * E_em / (xi_cut * sqrts)) ! s4 = two * virt%c_flv(em,i_flv) * (log (two * E_em / sqrts)**2 - log (xi_cut)**2) s4 = two * virt%c_flv(em,i_flv) * & ! a**2 - b**2 = (a - b) * (a + b), for better numerical performance (log (two * E_em / sqrts) + log (xi_cut)) * (log (two * E_em / sqrts) - log (xi_cut)) s5 = two * virt%gamma_0(em,i_flv) * log (two * E_em / sqrts) QB(i_flv) = QB(i_flv) + (s1 - s2 + s3 + s4 - s5) * virt%sqme_born(i_flv) end if end associate evaluated(i_flv, em) = .true. end do end subroutine virtual_compute_collinear_contribution @ %def virtual_compute_collinear_contribution @ For the massless-massive case and $i = j$ we get the massive self-eikonal of (A.10) in arXiv:0908.4272, given as \begin{equation} \mathcal{I}_{ii} = \log \frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{1}{\beta} \log \frac{1 + \beta}{1 - \beta}. \end{equation} <>= procedure :: compute_massive_self_eikonals => virtual_compute_massive_self_eikonals <>= subroutine virtual_compute_massive_self_eikonals (virt, i_flv, & p_born, s_over_Q2, reg_data, QB) class(virtual_t), intent(inout) :: virt integer, intent(in) :: i_flv type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in) :: s_over_Q2 type(region_data_t), intent(in) :: reg_data real(default), intent(inout), dimension(:) :: QB integer :: i logical :: massive do i = 1, virt%n_legs massive = reg_data%flv_born(i_flv)%massive(i) if (massive) then QB(i_flv) = QB(i_flv) - (virt%c_flv (i, i_flv) & * (log (s_over_Q2) - 0.5_default * I_m_eps (p_born(i)))) & * virt%sqme_born (i_flv) end if end do end subroutine virtual_compute_massive_self_eikonals @ %def virtual_compute_massive_self_eikonals @ The following code implements the $\mathcal{I}_{ij}$-function. The complete formulas can be found in arXiv:0908.4272 (A.1-A.17) and are also discussed in arXiv:1002.2581 in Appendix A. The implementation may differ in the detail from the formulas presented in the above paper. The parameter $\xi_{\text{cut}}$ is unphysically and cancels with appropriate factors in the real subtraction. We keep the additional parameter for debug usage. The implemented formulas are then defined as follows: \begin{itemize} \item[massless-massless case] $p^2 = 0, k^2 = 0,$ \begin{equation} \begin{split} \mathcal{I}_{ij} &= \frac{1}{2}\log^2\frac{\xi^2_{\text{cut}}s}{Q^2} + \log\frac{\xi^2_{\text{cut}}s}{Q^2}\log\frac{k_ik_j}{2E_iE_j} - \rm{Li}_2\left(\frac{k_ik_j}{2E_iE_j}\right) \\ &+ \frac{1}{2}\log^2\frac{k_ik_j}{2E_iE_j} - \log\left(1-\frac{k_ik_j}{2E_iE_j}\right) \log\frac{k_ik_j}{2E_iE_j}. \end{split} \label{I_00} \end{equation} \item[massive-massive case] $p^2 \neq 0, k^2 \neq 0,$ \begin{equation} \mathcal{I}_{ij} = \frac{1}{2}I_0(k_i, k_j)\log\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{1}{2}I_\epsilon(k_i,k_j) \label{I_mm} \end{equation} with \begin{equation} I_0(k_i, k_j) = \frac{1}{\beta}\log\frac{1+\beta}{1-\beta}, \qquad \beta = \sqrt{1-\frac{k_i^2k_j^2}{(k_i \cdot k_j)^2}} \end{equation} and a rather involved expression for $I_\epsilon$: \begin{align} \allowdisplaybreaks I_\epsilon(k_i, k_j) &= \left(K(z_j)-K(z_i)\right) \frac{1-\vec{\beta_i}\cdot\vec{\beta_j}}{\sqrt{a(1-b)}}, \\ \vec{\beta_i} &= \frac{\vec{k}_i}{k_i^0}, \\ a &= \beta_i^2 + \beta_j^2 - 2\vec{\beta}_i \cdot \vec{\beta}_j, \\ x_i &= \frac{\beta_i^2 -\vec{\beta}_i \cdot \vec{\beta}_j}{a}, \\ x_j &= \frac{\beta_j^2 -\vec{\beta}_i \cdot \vec{\beta}_j}{a} = 1-x_j, \\ b &= \frac{\beta_i^2\beta_j^2 - (\vec{\beta}_i\cdot\vec{\beta}_j)^2}{a}, \\ c &= \sqrt{\frac{b}{4a}}, \\ z_+ &= \frac{1+\sqrt{1-b}}{\sqrt{b}}, \\ z_- &= \frac{1-\sqrt{1-b}}{\sqrt{b}}, \\ z_i &= \frac{\sqrt{x_i^2 + 4c^2} - x_i}{2c}, \\ z_j &= \frac{\sqrt{x_j^2 + 4c^2} + x_j}{2c}, \\ K(z) = &-\frac{1}{2}\log^2\frac{(z-z_-)(z_+-z)}{(z_++z)(z_-+z)} - 2Li_2\left(\frac{2z_-(z_+-z)}{(z_+-z_-)(z_-+z)}\right) \\ &-2Li_2\left(-\frac{2z_+(z_-+z)}{(z_+-z_-)(z_+-z)}\right) \end{align} \item[massless-massive case] $p^2 = 0, k^2 \neq 0,$ \begin{equation} \mathcal{I}_{ij} = \frac{1}{2}\left[\frac{1}{2}\log^2\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{\pi^2}{6}\right] + \frac{1}{2}I_0(k_i,k_j)\log\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{1}{2}I_\epsilon(k_i,k_j) \label{I_0m} \end{equation} with \begin{align} I_0(p,k) &= \log\frac{(\hat{p}\cdot\hat{k})^2}{\hat{k}^2}, \\ I_\varepsilon(p,k) &= -2\left[\frac{1}{4}\log^2\frac{1-\beta}{1+\beta} + \log\frac{\hat{p}\cdot\hat{k}}{1+\beta}\log\frac{\hat{p}\cdot\hat{k}}{1-\beta} + \rm{Li}_2\left(1-\frac{\hat{p}\cdot\hat{k}}{1+\beta}\right) + \rm{Li}_2\left(1-\frac{\hat{p}\cdot\hat{k}}{1-\beta}\right)\right], \end{align} using \begin{align} \hat{p} = \frac{p}{p^0}, \quad \hat{k} = \frac{k}{k^0}, \quad \beta = \frac{|\vec{k}|}{k_0}, \\ \rm{Li}_2(1 - x) + \rm{Li}_2(1 - x^{-1}) = -\frac{1}{2} \log^2 x. \end{align} \end{itemize} <>= function compute_eikonal_factor (p_born, massive, i, j, s_o_Q2) result (I_ij) real(default) :: I_ij type(vector4_t), intent(in), dimension(:) :: p_born logical, dimension(:), intent(in) :: massive integer, intent(in) :: i, j real(default), intent(in) :: s_o_Q2 if (massive(i) .and. massive(j)) then I_ij = compute_Imm (p_born(i), p_born(j), s_o_Q2) else if (.not. massive(i) .and. massive(j)) then I_ij = compute_I0m (p_born(i), p_born(j), s_o_Q2) else if (massive(i) .and. .not. massive(j)) then I_ij = compute_I0m (p_born(j), p_born(i), s_o_Q2) else I_ij = compute_I00 (p_born(i), p_born(j), s_o_Q2) end if end function compute_eikonal_factor function compute_I00 (pi, pj, s_o_Q2) result (I) type(vector4_t), intent(in) :: pi, pj real(default), intent(in) :: s_o_Q2 real(default) :: I real(default) :: Ei, Ej real(default) :: pij, Eij real(default) :: s1, s2, s3, s4, s5 real(default) :: arglog real(default), parameter :: tiny_value = epsilon(1.0) s1 = 0; s2 = 0; s3 = 0; s4 = 0; s5 = 0 Ei = pi%p(0); Ej = pj%p(0) pij = pi * pj; Eij = Ei * Ej s1 = 0.5_default * log(s_o_Q2)**2 s2 = log(s_o_Q2) * log(pij / (two * Eij)) s3 = Li2 (pij / (two * Eij)) s4 = 0.5_default * log (pij / (two * Eij))**2 arglog = one - pij / (two * Eij) if (arglog > tiny_value) then s5 = log(arglog) * log(pij / (two * Eij)) else s5 = zero end if I = s1 + s2 - s3 + s4 - s5 end function compute_I00 function compute_I0m (ki, kj, s_o_Q2) result (I) type(vector4_t), intent(in) :: ki, kj real(default), intent(in) :: s_o_Q2 real(default) :: I real(default) :: logsomu real(default) :: s1, s2, s3 s1 = 0; s2 = 0; s3 = 0 logsomu = log(s_o_Q2) s1 = 0.5 * (0.5 * logsomu**2 - pi**2 / 6) s2 = 0.5 * I_0m_0 (ki, kj) * logsomu s3 = 0.5 * I_0m_eps (ki, kj) I = s1 + s2 - s3 end function compute_I0m function compute_Imm (pi, pj, s_o_Q2) result (I) type(vector4_t), intent(in) :: pi, pj real(default), intent(in) :: s_o_Q2 real(default) :: I real(default) :: s1, s2 s1 = 0.5 * log(s_o_Q2) * I_mm_0(pi, pj) s2 = 0.5 * I_mm_eps(pi, pj) I = s1 - s2 end function compute_Imm function I_m_eps (p) result (I) type(vector4_t), intent(in) :: p real(default) :: I real(default) :: beta beta = space_part_norm (p)/p%p(0) if (beta < tiny_07) then I = four * (one + beta**2/3 + beta**4/5 + beta**6/7) else I = two * log((one + beta) / (one - beta)) / beta end if end function I_m_eps function I_0m_eps (p, k) result (I) type(vector4_t), intent(in) :: p, k real(default) :: I type(vector4_t) :: pp, kp real(default) :: beta pp = p / p%p(0); kp = k / k%p(0) beta = sqrt (one - kp*kp) I = -2*(log((one - beta) / (one + beta))**2/4 + log((pp*kp) / (one + beta))*log((pp*kp) / (one - beta)) & + Li2(one - (pp*kp) / (one + beta)) + Li2(one - (pp*kp) / (one - beta))) end function I_0m_eps function I_0m_0 (p, k) result (I) type(vector4_t), intent(in) :: p, k real(default) :: I type(vector4_t) :: pp, kp pp = p / p%p(0); kp = k / k%p(0) I = log((pp*kp)**2 / kp**2) end function I_0m_0 function I_mm_eps (p1, p2) result (I) type(vector4_t), intent(in) :: p1, p2 real(default) :: I type(vector3_t) :: beta1, beta2 real(default) :: a, b, b2 real(default) :: zp, zm, z1, z2, x1, x2 real(default) :: zmb, z1b real(default) :: K1, K2 beta1 = space_part (p1) / energy(p1) beta2 = space_part (p2) / energy(p2) a = beta1**2 + beta2**2 - 2 * beta1 * beta2 b = beta1**2 * beta2**2 - (beta1 * beta2)**2 if (beta1**1 > beta2**1) call switch_beta (beta1, beta2) if (beta1 == vector3_null) then b2 = beta2**1 I = (-0.5 * log ((one - b2) / (one + b2))**2 - two * Li2 (-two * b2 / (one - b2))) & * one / sqrt (a - b) return end if x1 = beta1**2 - beta1 * beta2 x2 = beta2**2 - beta1 * beta2 zp = sqrt (a) + sqrt (a - b) zm = sqrt (a) - sqrt (a - b) zmb = one / zp z1 = sqrt (x1**2 + b) - x1 z2 = sqrt (x2**2 + b) + x2 z1b = one / (sqrt (x1**2 + b) + x1) K1 = - 0.5 * log (((z1b - zmb) * (zp - z1)) / ((zp + z1) * (z1b + zmb)))**2 & - two * Li2 ((two * zmb * (zp - z1)) / ((zp - zm) * (zmb + z1b))) & - two * Li2 ((-two * zp * (zm + z1)) / ((zp - zm) * (zp - z1))) K2 = - 0.5 * log ((( z2 - zm) * (zp - z2)) / ((zp + z2) * (z2 + zm)))**2 & - two * Li2 ((two * zm * (zp - z2)) / ((zp - zm) * (zm + z2))) & - two * Li2 ((-two * zp * (zm + z2)) / ((zp - zm) * (zp - z2))) I = (K2 - K1) * (one - beta1 * beta2) / sqrt (a - b) contains subroutine switch_beta (beta1, beta2) type(vector3_t), intent(inout) :: beta1, beta2 type(vector3_t) :: beta_tmp beta_tmp = beta1 beta1 = beta2 beta2 = beta_tmp end subroutine switch_beta end function I_mm_eps function I_mm_0 (k1, k2) result (I) type(vector4_t), intent(in) :: k1, k2 real(default) :: I real(default) :: beta beta = sqrt (one - k1**2 * k2**2 / (k1 * k2)**2) I = log ((one + beta) / (one - beta)) / beta end function I_mm_0 @ %def I_mm_0 @ <>= procedure :: final => virtual_final <>= subroutine virtual_final (virtual) class(virtual_t), intent(inout) :: virtual if (allocated (virtual%gamma_0)) deallocate (virtual%gamma_0) if (allocated (virtual%gamma_p)) deallocate (virtual%gamma_p) if (allocated (virtual%c_flv)) deallocate (virtual%c_flv) if (allocated (virtual%n_is_neutrinos)) deallocate (virtual%n_is_neutrinos) end subroutine virtual_final @ %def virtual_final @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Real Subtraction} <<[[real_subtraction.f90]]>>= <> module real_subtraction <> <> <> use io_units use format_defs, only: FMT_15 use string_utils use constants use numeric_utils use diagnostics use pdg_arrays use models use physics_defs use sm_physics use lorentz use flavors use phs_fks, only: real_kinematics_t, isr_kinematics_t use phs_fks, only: I_PLUS, I_MINUS use phs_fks, only: SQRTS_VAR, SQRTS_FIXED use phs_fks, only: phs_point_set_t use ttv_formfactors, only: m1s_to_mpole use fks_regions use nlo_data <> <> <> <> <> contains <> end module real_subtraction @ %def real_subtraction @ \subsubsection{Soft subtraction terms} <>= integer, parameter, public :: INTEGRATION = 0 integer, parameter, public :: FIXED_ORDER_EVENTS = 1 integer, parameter, public :: POWHEG = 2 @ %def real subtraction parameters @ <>= public :: this_purpose <>= function this_purpose (purpose) type(string_t) :: this_purpose integer, intent(in) :: purpose select case (purpose) case (INTEGRATION) this_purpose = var_str ("Integration") case (FIXED_ORDER_EVENTS) this_purpose = var_str ("Fixed order NLO events") case (POWHEG) this_purpose = var_str ("Powheg events") case default this_purpose = var_str ("Undefined!") end select end function this_purpose @ %def this_purpose @ In the soft limit, the real matrix element behaves as \begin{equation*} \mathcal{R}_{\rm{soft}} = 4\pi\alpha_s \left[\sum_{i \neq j} \mathcal{B}_{ij} \frac{k_i \cdot k_j}{(k_i \cdot k)(k_j \cdot k)} - \mathcal{B} \sum_{i} \frac{k_i^2}{(k_i \cdot k)^2}C_i\right], \end{equation*} where $k$ denotes the momentum of the emitted parton. The quantity $\mathcal{B}_{ij}$ is called the color-correlated Born matrix element defined as \begin{equation*} \mathcal{B}_{ij} = \frac{1}{2s} \sum_{\stackrel{colors}{spins}} \mathcal{M}_{\{c_k\}}\left(\mathcal{M}^\dagger_{\{c_k\}}\right)_{\stackrel{c_i \rightarrow c_i'}{c_j \rightarrow c_j'}} T^a_{c_i,c_i'} T^a_{c_j,c_j'}. \end{equation*} <>= type :: soft_subtraction_t type(region_data_t), pointer :: reg_data => null () real(default), dimension(:,:), allocatable :: momentum_matrix logical :: use_resonance_mappings = .false. type(vector4_t) :: p_soft = vector4_null logical :: use_internal_color_correlations = .true. logical :: use_internal_spin_correlations = .false. logical :: xi2_expanded = .true. integer :: factorization_mode = NO_FACTORIZATION contains <> end type soft_subtraction_t @ %def soft_subtraction_t @ <>= procedure :: init => soft_subtraction_init <>= subroutine soft_subtraction_init (sub_soft, reg_data) class(soft_subtraction_t), intent(inout) :: sub_soft type(region_data_t), intent(in), target :: reg_data sub_soft%reg_data => reg_data allocate (sub_soft%momentum_matrix (reg_data%n_legs_born, & reg_data%n_legs_born)) end subroutine soft_subtraction_init @ %def soft_subtraction_init @ <>= procedure :: requires_boost => soft_subtraction_requires_boost <>= function soft_subtraction_requires_boost (sub_soft, sqrts) result (requires_boost) logical :: requires_boost class(soft_subtraction_t), intent(in) :: sub_soft real(default), intent(in) :: sqrts real(default) :: mtop logical :: above_threshold if (sub_soft%factorization_mode == FACTORIZATION_THRESHOLD) then mtop = m1s_to_mpole (sqrts) above_threshold = sqrts**2 - four * mtop**2 > zero else above_threshold = .false. end if requires_boost = sub_soft%use_resonance_mappings .or. above_threshold end function soft_subtraction_requires_boost @ %def soft_subtraction_requires_boost @ The treatment of the momentum $k$ follows the discussion about the soft limit of the partition functions (see [1002.2581], p. 29 and C. Weiss' PhD Thesis, p. 24). The parton momentum is pulled out, $k = E \hat{k}$. In fact, we will substitute $\hat{k}$ for $k$ throughout the code, because the energy will factor out of the equation when the soft $\mathcal{S}$-function is multiplied. The momentum [[p_soft]] represents the soft limit of the radiated particle divided by its energy. It is a unit vector, because $k^2 = \left(k^0\right)^2 - \left(k^0\right)^2\hat{\vec{k}}^2 = 0$. The soft momentum is constructed by first creating a unit vector parallel to the emitter's Born momentum. This unit vector is then rotated about the corresponding angles $y$ and $\phi$ to match the direction of the real radiation in the soft limit. <>= procedure :: create_softvec_fsr => soft_subtraction_create_softvec_fsr <>= subroutine soft_subtraction_create_softvec_fsr & (sub_soft, p_born, y, phi, emitter, xi_ref_momentum) class(soft_subtraction_t), intent(inout) :: sub_soft type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in) :: y, phi integer, intent(in) :: emitter type(vector4_t), intent(in) :: xi_ref_momentum type(vector3_t) :: dir type(vector4_t) :: p_em type(lorentz_transformation_t) :: rot type(lorentz_transformation_t) :: boost_to_rest_frame logical :: requires_boost associate (p_soft => sub_soft%p_soft) p_soft%p(0) = one requires_boost = sub_soft%requires_boost (two * p_born(1)%p(0)) if (requires_boost) then boost_to_rest_frame = inverse (boost (xi_ref_momentum, xi_ref_momentum**1)) p_em = boost_to_rest_frame * p_born(emitter) else p_em = p_born(emitter) end if p_soft%p(1:3) = p_em%p(1:3) / space_part_norm (p_em) dir = create_orthogonal (space_part (p_em)) rot = rotation (y, sqrt(one - y**2), dir) p_soft = rot * p_soft if (.not. vanishes (phi)) then dir = space_part (p_em) / space_part_norm (p_em) rot = rotation (cos(phi), sin(phi), dir) p_soft = rot * p_soft end if if (requires_boost) p_soft = inverse (boost_to_rest_frame) * p_soft end associate end subroutine soft_subtraction_create_softvec_fsr @ %def soft_subtraction_create_softvec_fsr @ For initial-state emissions, the soft vector is just a unit vector with the same direction as the radiated particle. As $y$ for ISR is defined independently of the emitter, also [[p_soft]] is the same for all initial state emitters. <>= procedure :: create_softvec_isr => soft_subtraction_create_softvec_isr <>= subroutine soft_subtraction_create_softvec_isr (sub_soft, y, phi) class(soft_subtraction_t), intent(inout) :: sub_soft real(default), intent(in) :: y, phi real(default) :: sin_theta sin_theta = sqrt(one - y**2) associate (p => sub_soft%p_soft%p) p(0) = one p(1) = sin_theta * sin(phi) p(2) = sin_theta * cos(phi) p(3) = y end associate end subroutine soft_subtraction_create_softvec_isr @ %def soft_subtraction_create_softvec_isr @ The soft vector for the real mismatch is basically the same as for usual FSR, except for the scaling with the total gluon energy. Moreover, the resulting vector is rotated into the frame where the 3-axis points along the direction of the emitter. This is necessary because in the collinear limit, the approximation \begin{equation*} k_i = \frac{k_i^0}{\bar{k}_j^0} \bar{k}_j = \frac{\xi\sqrt{s}}{2\bar{k}_j^0}\bar{k}_j \end{equation*} is used. The collinear limit is not included in the soft mismatch yet, but we keep the rotation for future usage here already (the performance loss is negligible). <>= procedure :: create_softvec_mismatch => & soft_subtraction_create_softvec_mismatch <>= subroutine soft_subtraction_create_softvec_mismatch (sub_soft, E, y, phi, p_em) class(soft_subtraction_t), intent(inout) :: sub_soft real(default), intent(in) :: E, phi, y type(vector4_t), intent(in) :: p_em real(default) :: sin_theta type(lorentz_transformation_t) :: rot_em_off_3_axis sin_theta = sqrt (one - y**2) associate (p => sub_soft%p_soft%p) p(0) = E p(1) = E * sin_theta * sin(phi) p(2) = E * sin_theta * cos(phi) p(3) = E * y end associate rot_em_off_3_axis = rotation_to_2nd (3, space_part (p_em)) sub_soft%p_soft = rot_em_off_3_axis * sub_soft%p_soft end subroutine soft_subtraction_create_softvec_mismatch @ %def soft_subtraction_create_softvec_mismatch @ Computation of the soft limit of $R_\alpha$. Note that what we are actually integrating (in the case of final-state radiation) is the quantity $f(0,y) / \xi$, where \begin{equation*} f(\xi,y) = \frac{J(\xi,y,\phi)}{\xi} \xi^2 R_\alpha. \end{equation*} $J/\xi$ is computed by the phase space generator. The additional factor of $\xi^{-1}$ is supplied in the [[evaluate_region_fsr]]-routine. Thus, we are left with a factor of $\xi^2$. A look on the expression for the soft limit of $R_\alpha$ below reveals that we are factoring out the gluon energy $E_i$ in the denominator. Therefore, we have a factor $\xi^2 / E_i^2 = 4 / q^2$.\\ Note that the same routine is used also for the computation of the soft mismatch. There, the gluon energy is not factored out from the soft vector, so that we are left with the $\xi^2$-factor, which will eventually be cancelled out again. So, we just multiply with 1. Both cases are distinguished by the flag [[xi2_expanded]]. Note that for the soft subtraction term, also the S functions are computed in the soft limit. The input momenta are thus the real momenta in the soft limit, i.e. the Born momenta given by [[p_born]]. <>= procedure :: compute => soft_subtraction_compute <>= function soft_subtraction_compute (sub_soft, p_born, & born_ij, y, q2, alpha_coupling, alr, emitter, i_res) result (sqme) real(default) :: sqme class(soft_subtraction_t), intent(inout) :: sub_soft type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in), dimension(:,:) :: born_ij real(default), intent(in) :: y real(default), intent(in) :: q2, alpha_coupling integer, intent(in) :: alr, emitter, i_res real(default) :: s_alpha_soft real(default) :: kb real(default) :: xi2_factor if (.not. vector_set_is_cms (p_born, sub_soft%reg_data%n_in)) then call vector4_write_set (p_born, show_mass = .true., & check_conservation = .true.) call msg_fatal ("Soft subtraction: phase space point must be in CMS") end if if (debug2_active (D_SUBTRACTION)) then select case (char (sub_soft%reg_data%regions(alr)%nlo_correction_type)) case ("QCD") print *, 'Compute soft subtraction using alpha_s = ', alpha_coupling case ("EW") print *, 'Compute soft subtraction using alpha_qed = ', alpha_coupling end select end if s_alpha_soft = sub_soft%reg_data%get_svalue_soft (p_born, & sub_soft%p_soft, alr, emitter, i_res) if (s_alpha_soft > one + tiny_07) call msg_fatal ("s_alpha_soft > 1!") if (debug2_active (D_SUBTRACTION)) & call msg_print_color ('s_alpha_soft', s_alpha_soft, COL_YELLOW) select case (sub_soft%factorization_mode) case (NO_FACTORIZATION) kb = sub_soft%evaluate_factorization_default (p_born, born_ij) case (FACTORIZATION_THRESHOLD) kb = sub_soft%evaluate_factorization_threshold (thr_leg(emitter), p_born, born_ij) end select if (debug_on) call msg_debug2 (D_SUBTRACTION, 'KB', kb) sqme = four * pi * alpha_coupling * s_alpha_soft * kb if (sub_soft%xi2_expanded) then xi2_factor = four / q2 else xi2_factor = one end if if (emitter <= sub_soft%reg_data%n_in) then sqme = xi2_factor * (one - y**2) * sqme else sqme = xi2_factor * (one - y) * sqme end if if (sub_soft%reg_data%regions(alr)%double_fsr) sqme = sqme * two end function soft_subtraction_compute @ %def soft_subtraction_compute @ We loop over all external legs and do not take care to leave out non-colored ones because [[born_ij]] is constructed in such a way that it is only non-zero for colored entries. <>= procedure :: evaluate_factorization_default => & soft_subtraction_evaluate_factorization_default <>= function soft_subtraction_evaluate_factorization_default & (sub_soft, p, born_ij) result (kb) real(default) :: kb class(soft_subtraction_t), intent(inout) :: sub_soft type(vector4_t), intent(in), dimension(:) :: p real(default), intent(in), dimension(:,:) :: born_ij integer :: i, j kb = zero call sub_soft%compute_momentum_matrix (p) do i = 1, size (p) do j = 1, size (p) kb = kb + sub_soft%momentum_matrix (i, j) * born_ij (i, j) end do end do end function soft_subtraction_evaluate_factorization_default @ %def soft_subtraction_evaluate_factorization_default @ We have to multiply this with $\xi^2(1-y)$. Further, when applying the soft $\mathcal{S}$-function, the energy of the radiated particle is factored out. Thus we have $\xi^2/E_{em}^2(1-y) = 4/q_0^2(1-y)$. Computes the quantity $\mathcal{K}_{ij} = \frac{k_i \cdot k_j}{(k_i\cdot k)(k_j\cdot k)}$. <>= procedure :: compute_momentum_matrix => & soft_subtraction_compute_momentum_matrix <>= subroutine soft_subtraction_compute_momentum_matrix & (sub_soft, p_born) class(soft_subtraction_t), intent(inout) :: sub_soft type(vector4_t), intent(in), dimension(:) :: p_born real(default) :: num, deno1, deno2 integer :: i, j do i = 1, sub_soft%reg_data%n_legs_born do j = 1, sub_soft%reg_data%n_legs_born if (i <= j) then num = p_born(i) * p_born(j) deno1 = p_born(i) * sub_soft%p_soft deno2 = p_born(j) * sub_soft%p_soft sub_soft%momentum_matrix(i, j) = num / (deno1 * deno2) else !!! momentum matrix is symmetric. sub_soft%momentum_matrix(i, j) = sub_soft%momentum_matrix(j, i) end if end do end do end subroutine soft_subtraction_compute_momentum_matrix @ %def soft_subtraction_compute_momentum_matrx @ <>= procedure :: evaluate_factorization_threshold => & soft_subtraction_evaluate_factorization_threshold <>= function soft_subtraction_evaluate_factorization_threshold & (sub_soft, leg, p_born, born_ij) result (kb) real(default) :: kb class(soft_subtraction_t), intent(inout) :: sub_soft integer, intent(in) :: leg type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in), dimension(:,:) :: born_ij type(vector4_t), dimension(4) :: p p = get_threshold_momenta (p_born) kb = evaluate_leg_pair (ASSOCIATED_LEG_PAIR (leg)) if (debug2_active (D_SUBTRACTION)) call show_debug () contains function evaluate_leg_pair (i_start) result (kbb) real(default) :: kbb integer, intent(in) :: i_start integer :: i1, i2 real(default) :: numerator, deno1, deno2 kbb = zero do i1 = i_start, i_start + 1 do i2 = i_start, i_start + 1 numerator = p(i1) * p(i2) deno1 = p(i1) * sub_soft%p_soft deno2 = p(i2) * sub_soft%p_soft kbb = kbb + numerator * born_ij (i1, i2) / deno1 / deno2 end do end do if (debug2_active (D_SUBTRACTION)) then do i1 = i_start, i_start + 1 do i2 = i_start, i_start + 1 call msg_print_color('i1', i1, COL_PEACH) call msg_print_color('i2', i2, COL_PEACH) call msg_print_color('born_ij (i1,i2)', born_ij (i1,i2), COL_PINK) print *, 'Top momentum: ', p(1)%p end do end do end if end function evaluate_leg_pair subroutine show_debug () integer :: i call msg_print_color ('soft_subtraction_evaluate_factorization_threshold', COL_GREEN) do i = 1, 4 print *, 'sqrt(p(i)**2) = ', sqrt(p(i)**2) end do end subroutine show_debug end function soft_subtraction_evaluate_factorization_threshold @ %def soft_subtraction_evaluate_factorization_threshold @ <>= procedure :: i_xi_ref => soft_subtraction_i_xi_ref <>= function soft_subtraction_i_xi_ref (sub_soft, alr, i_phs) result (i_xi_ref) integer :: i_xi_ref class(soft_subtraction_t), intent(in) :: sub_soft integer, intent(in) :: alr, i_phs if (sub_soft%use_resonance_mappings) then i_xi_ref = sub_soft%reg_data%alr_to_i_contributor (alr) else if (sub_soft%factorization_mode == FACTORIZATION_THRESHOLD) then i_xi_ref = i_phs else i_xi_ref = 1 end if end function soft_subtraction_i_xi_ref @ %def soft_subtraction_i_xi_ref @ <>= procedure :: final => soft_subtraction_final <>= subroutine soft_subtraction_final (sub_soft) class(soft_subtraction_t), intent(inout) :: sub_soft if (associated (sub_soft%reg_data)) nullify (sub_soft%reg_data) if (allocated (sub_soft%momentum_matrix)) deallocate (sub_soft%momentum_matrix) end subroutine soft_subtraction_final @ %def soft_subtraction_final @ \subsection{Soft mismatch} <>= public :: soft_mismatch_t <>= type :: soft_mismatch_t type(region_data_t), pointer :: reg_data => null () real(default), dimension(:), allocatable :: sqme_born real(default), dimension(:,:,:), allocatable :: sqme_born_color_c real(default), dimension(:,:,:), allocatable :: sqme_born_charge_c type(real_kinematics_t), pointer :: real_kinematics => null () type(soft_subtraction_t) :: sub_soft contains <> end type soft_mismatch_t @ %def soft_mismatch_t @ <>= procedure :: init => soft_mismatch_init <>= subroutine soft_mismatch_init (soft_mismatch, reg_data, & real_kinematics, factorization_mode) class(soft_mismatch_t), intent(inout) :: soft_mismatch type(region_data_t), intent(in), target :: reg_data type(real_kinematics_t), intent(in), target :: real_kinematics integer, intent(in) :: factorization_mode soft_mismatch%reg_data => reg_data allocate (soft_mismatch%sqme_born (reg_data%n_flv_born)) allocate (soft_mismatch%sqme_born_color_c (reg_data%n_legs_born, & reg_data%n_legs_born, reg_data%n_flv_born)) allocate (soft_mismatch%sqme_born_charge_c (reg_data%n_legs_born, & reg_data%n_legs_born, reg_data%n_flv_born)) call soft_mismatch%sub_soft%init (reg_data) soft_mismatch%sub_soft%xi2_expanded = .false. soft_mismatch%real_kinematics => real_kinematics soft_mismatch%sub_soft%factorization_mode = factorization_mode end subroutine soft_mismatch_init @ %def soft_mismatch_init @ Main routine to compute the soft mismatch. Loops over all singular regions. There, it first creates the soft vector, then the necessary soft real matrix element. These inputs are then used to get the numerical value of the soft mismatch. <>= procedure :: evaluate => soft_mismatch_evaluate <>= function soft_mismatch_evaluate (soft_mismatch, alpha_s) result (sqme_mismatch) real(default) :: sqme_mismatch class(soft_mismatch_t), intent(inout) :: soft_mismatch real(default), intent(in) :: alpha_s integer :: alr, i_born, emitter, i_res, i_phs, i_con real(default) :: xi, y, q2, s real(default) :: E_gluon type(vector4_t) :: p_em real(default) :: sqme_alr, sqme_soft type(vector4_t), dimension(:), allocatable :: p_born sqme_mismatch = zero associate (real_kinematics => soft_mismatch%real_kinematics) xi = real_kinematics%xi_mismatch y = real_kinematics%y_mismatch s = real_kinematics%cms_energy2 E_gluon = sqrt (s) * xi / two if (debug_active (D_MISMATCH)) then print *, 'Evaluating soft mismatch: ' print *, 'Phase space: ' call vector4_write_set (real_kinematics%p_born_cms%get_momenta(1), & show_mass = .true.) print *, 'xi: ', xi, 'y: ', y, 's: ', s, 'E_gluon: ', E_gluon end if allocate (p_born (soft_mismatch%reg_data%n_legs_born)) do alr = 1, soft_mismatch%reg_data%n_regions i_phs = real_kinematics%alr_to_i_phs (alr) if (soft_mismatch%reg_data%has_pseudo_isr ()) then i_con = 1 p_born = soft_mismatch%real_kinematics%p_born_onshell%get_momenta(1) else i_con = soft_mismatch%reg_data%alr_to_i_contributor (alr) p_born = soft_mismatch%real_kinematics%p_born_cms%get_momenta(1) end if q2 = real_kinematics%xi_ref_momenta(i_con)**2 emitter = soft_mismatch%reg_data%regions(alr)%emitter p_em = p_born (emitter) i_res = soft_mismatch%reg_data%regions(alr)%i_res i_born = soft_mismatch%reg_data%regions(alr)%uborn_index call print_debug_alr () call soft_mismatch%sub_soft%create_softvec_mismatch & (E_gluon, y, real_kinematics%phi, p_em) if (debug_active (D_MISMATCH)) & print *, 'Created soft vector: ', soft_mismatch%sub_soft%p_soft%p select type (fks_mapping => soft_mismatch%reg_data%fks_mapping) type is (fks_mapping_resonances_t) call fks_mapping%set_resonance_momentum & (real_kinematics%xi_ref_momenta(i_con)) end select sqme_soft = soft_mismatch%sub_soft%compute & (p_born, soft_mismatch%sqme_born_color_c(:,:,i_born), y, & q2, alpha_s, alr, emitter, i_res) sqme_alr = soft_mismatch%compute (alr, xi, y, p_em, & real_kinematics%xi_ref_momenta(i_con), soft_mismatch%sub_soft%p_soft, & soft_mismatch%sqme_born(i_born), sqme_soft, & alpha_s, s) if (debug_on) call msg_debug (D_MISMATCH, 'sqme_alr: ', sqme_alr) sqme_mismatch = sqme_mismatch + sqme_alr end do end associate contains subroutine print_debug_alr () if (debug_active (D_MISMATCH)) then print *, 'alr: ', alr print *, 'i_phs: ', i_phs, 'i_con: ', i_con, 'i_res: ', i_res print *, 'emitter: ', emitter, 'i_born: ', i_born print *, 'emitter momentum: ', p_em%p print *, 'resonance momentum: ', & soft_mismatch%real_kinematics%xi_ref_momenta(i_con)%p print *, 'q2: ', q2 end if end subroutine print_debug_alr end function soft_mismatch_evaluate @ %def soft_mismatch_evaluate @ Computes the soft mismatch in a given $\alpha_r$, \begin{align*} I_{s+,\alpha_r} &= \int d\Phi_B \int_0^\infty d\xi \int_{-1}^1 dy \int_0^{2\pi} d\phi \frac{s\xi}{(4\pi)^3} \\ &\times \left\lbrace\tilde{R}_{\alpha_r} \left(e^{-\frac{2k_\gamma \cdot k_{res}}{k_{res}}^2} - e^{-\xi}\right) - \frac{32 \pi \alpha_s C_{em}}{s\xi^2} B_{f_b(\alpha_r)} (1-y)^{-1} \left[e^{-\frac{2\bar{k}_{em} \cdot k_{res}}{k_{res}^2} \frac{k_\gamma^0}{k_{em}^0}} - e^{-\xi}\right]\right\rbrace. \end{align*} <>= procedure :: compute => soft_mismatch_compute <>= function soft_mismatch_compute (soft_mismatch, alr, xi, y, p_em, p_res, p_soft, & sqme_born, sqme_soft, alpha_s, s) result (sqme_mismatch) real(default) :: sqme_mismatch class(soft_mismatch_t), intent(in) :: soft_mismatch integer, intent(in) :: alr real(default), intent(in) :: xi, y type(vector4_t), intent(in) :: p_em, p_res, p_soft real(default), intent(in) :: sqme_born, sqme_soft real(default), intent(in) :: alpha_s, s real(default) :: q2, expo, sm1, sm2, jacobian q2 = p_res**2 expo = - two * p_soft * p_res / q2 !!! Divide by 1 - y to factor out the corresponding !!! factor in the soft matrix element sm1 = sqme_soft / (one - y) * ( exp(expo) - exp(- xi) ) if (debug_on) call msg_debug2 (D_MISMATCH, 'sqme_soft in mismatch ', sqme_soft) sm2 = zero if (soft_mismatch%reg_data%regions(alr)%has_collinear_divergence ()) then expo = - two * p_em * p_res / q2 * & p_soft%p(0) / p_em%p(0) sm2 = 32 * pi * alpha_s * cf / (s * xi**2) * sqme_born * & ( exp(expo) - exp(- xi) ) / (one - y) end if jacobian = soft_mismatch%real_kinematics%jac_mismatch * s * xi / (8 * twopi3) sqme_mismatch = (sm1 - sm2) * jacobian end function soft_mismatch_compute @ %def soft_mismatch_compute @ <>= procedure :: final => soft_mismatch_final <>= subroutine soft_mismatch_final (soft_mismatch) class(soft_mismatch_t), intent(inout) :: soft_mismatch call soft_mismatch%sub_soft%final () if (associated (soft_mismatch%reg_data)) nullify (soft_mismatch%reg_data) if (allocated (soft_mismatch%sqme_born)) deallocate (soft_mismatch%sqme_born) if (allocated (soft_mismatch%sqme_born_color_c)) deallocate (soft_mismatch%sqme_born_color_c) if (allocated (soft_mismatch%sqme_born_charge_c)) deallocate (soft_mismatch%sqme_born_charge_c) if (associated (soft_mismatch%real_kinematics)) nullify (soft_mismatch%real_kinematics) end subroutine soft_mismatch_final @ %def soft_mismatch_final @ \subsection{Collinear and soft-collinear subtraction terms} This data type deals with the calculation of the collinear and soft-collinear contribution to the cross section. <>= public :: coll_subtraction_t <>= type :: coll_subtraction_t integer :: n_in, n_alr logical :: use_resonance_mappings = .false. real(default) :: CA = 0, CF = 0, TR = 0 contains <> end type coll_subtraction_t @ %def coll_subtraction_t @ <>= procedure :: init => coll_subtraction_init <>= subroutine coll_subtraction_init (coll_sub, n_alr, n_in) class(coll_subtraction_t), intent(inout) :: coll_sub integer, intent(in) :: n_alr, n_in coll_sub%n_in = n_in coll_sub%n_alr = n_alr end subroutine coll_subtraction_init @ %def coll_subtraction_init @ Set the corresponding algebra parameters of the underlying gauge group of the correction. <>= procedure :: set_parameters => coll_subtraction_set_parameters <>= subroutine coll_subtraction_set_parameters (coll_sub, CA, CF, TR) class(coll_subtraction_t), intent(inout) :: coll_sub real(default), intent(in) :: CA, CF, TR coll_sub%CA = CA coll_sub%CF = CF coll_sub%TR = TR end subroutine coll_subtraction_set_parameters @ %def coll_subtraction_set_parameters @ This subroutine computes the collinear limit of $g^\alpha(\xi,y)$ introduced in eq.~\ref{fks: sub: real}. Care is given to also enable the usage for the soft-collinear limit. This, we write all formulas in terms of soft-finite quantities. We have to compute \begin{equation*} \frac{J(\Phi_n,\xi,y,\phi)}{\xi} \left[(1-y)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]|_{y = 1}. \end{equation*} The Jacobian $J$ is proportional to $\xi$, due to the $d^3 k_{n+1} / k_{n+1}^0$ factor in the integration measure. It cancels the factor of $\xi$ in the denominator. The remaining part of the Jacobian is multiplied in [[evaluate_region_fsr]] and is not relevant here. Inserting the splitting functions exemplarily for $q \to qg$ yields \begin{equation*} g^\alpha = \frac{8\pi\alpha_s}{k_{\mathrm{em}}^2} C_F (1-y) \xi^2 \frac{1+(1-z)^2}{z} \mathcal{B}, \end{equation*} where we have chosen $z = E_\mathrm{rad} / \bar{E}_\mathrm{em}$ and $\bar{E}_\mathrm{em}$ denotes the emitter energy in the Born frame. The collinear final state imposes $\bar{k}_n = k_{n} + k_{n + 1}$ for the connection between $\Phi_n$- and $\Phi_{n+1}$-phasepace and we get $1 - z = E_\mathrm{em} / \bar{E}_\mathrm{em}$. The denominator can be rewritten by the constraint $\bar{k}_n^2 = (k_n + k_{n+1})^2 = 0$ to \begin{equation*} k_{\mathrm{em}}^2 = 2 E_\mathrm{rad} E_\mathrm{em} (1-y) \end{equation*} which cancels the $(1-y)$ factor in the numerator, thus showing that the whole expression is indeed collinear-finite. We can further transform \begin{equation*} E_\mathrm{rad} E_\mathrm{em} = z (1-z) \bar{E}_\mathrm{em}^2 \end{equation*} so that in total we have \begin{equation*} g^\alpha = \frac{4\pi\alpha_s}{1-z} \frac{1}{\bar{k}_{\text{em}}^2} C_F \left(\frac{\xi}{z}\right)^2 (1 + (1-z)^2) \mathcal{B} \end{equation*} Follow up calculations give us \begin{align*} g^{\alpha, g \rightarrow gg} & = \frac{4\pi\alpha_s}{1-z}\frac{1}{\bar{k}_{\text{em}}^2} C_{\mathrm{A}} \frac{\xi}{z} \left\lbrace 2 \left( \frac{z}{1 - z} \xi + \frac{1 - z}{\frac{z}{\xi}} \right) \mathcal{B} + 4\xi z(1 - z) \hat{k}_{\perp}^{\mu} \hat{k}_{\perp}^{\nu} \mathcal{B}_{\mu\nu} \right\rbrace, \\ g^{\alpha, g \rightarrow qq} & = \frac{4\pi\alpha_s}{1-z} \frac{1}{\bar{k}_{\text{em}}^2} T_{\mathrm{R}} \frac{\xi}{z} \left\lbrace \xi \mathcal{B} - 4\xi z(1 - z) \hat{k}_{\perp}^{\mu} \hat{k}_{\perp}^{\nu} \mathcal{B}_{\mu\nu} \right\rbrace. \end{align*} The ratio $z / \xi$ is finite in the soft limit \begin{equation*} \frac{z}{\xi} = \frac{q^0}{2\bar{E}_\mathrm{em}} \end{equation*} so that $\xi$ does not appear explicitly in the computation. The argumentation above is valid for $q \to qg$--splittings, but the general factorization is valid for general splittings, also for those involving spin correlations and QED splittings. Note that care has to be given to the definition of $z$. Further, we have factored out a factor of $z$ to include in the ratio $z/\xi$, which has to be taken into account in the implementation of the splitting functions. <>= procedure :: compute_fsr => coll_subtraction_compute_fsr <>= function coll_subtraction_compute_fsr & (coll_sub, emitter, flst, p_res, p_born, sqme_born, mom_times_sqme_spin_c, & xi, alpha_coupling, double_fsr) result (sqme) real(default) :: sqme class(coll_subtraction_t), intent(in) :: coll_sub integer, intent(in) :: emitter integer, dimension(:), intent(in) :: flst type(vector4_t), intent(in) :: p_res type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in) :: sqme_born, mom_times_sqme_spin_c real(default), intent(in) :: xi, alpha_coupling logical, intent(in) :: double_fsr real(default) :: q0, z, p0, z_o_xi, onemz integer :: nlegs, flv_em, flv_rad nlegs = size (flst) flv_rad = flst(nlegs); flv_em = flst(emitter) q0 = p_res**1 p0 = p_res * p_born(emitter) / q0 !!! Here, z corresponds to 1-z in the formulas of arXiv:1002.2581; !!! the integrand is symmetric under this variable change z_o_xi = q0 / (two * p0) z = xi * z_o_xi; onemz = one - z if (is_gluon (flv_em) .and. is_gluon (flv_rad)) then sqme = coll_sub%CA * ( two * ( z / onemz * xi + onemz / z_o_xi ) * sqme_born & + four * xi * z * onemz * mom_times_sqme_spin_c ) else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then sqme = coll_sub%TR * xi * (sqme_born - four * z * onemz * mom_times_sqme_spin_c) else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then sqme = sqme_born * coll_sub%CF * (one + onemz**2) / z_o_xi else sqme = zero end if sqme = sqme / (p0**2 * onemz * z_o_xi) sqme = sqme * four * pi * alpha_coupling if (double_fsr) sqme = sqme * onemz * two end function coll_subtraction_compute_fsr @ %def coll_subtraction_compute_fsr @ Like in the context of [[coll_subtraction_compute_fsr]] we compute the quantity \begin{equation*} \lim_{y\to\pm1}{\left\{\frac{J(\Phi_n,\xi,y,\phi)}{\xi} \left[(1-y^2)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]\right\}}, \end{equation*} where the $(1-y^2)$ accounts for both $y=\pm1$. Again, the Jacobian is proportional to $\xi$, so we drop the $J / \xi$ factor. Note that it is important to take into account this missing factor of $\xi$ in the computation of the Jacobian during phase-space generation both for fixed-beam and structure ISR. We consider only a $q \to qg$ splitting arguing that other splittings are identical in terms of the factors which cancel. It is given by \begin{equation*} g^\alpha = \frac{8\pi\alpha_s}{-k_{\mathrm{em}}^2} C_F (1-y^2) \xi^2 \frac{1+z^2}{1-z} \mathcal{B}, \end{equation*} where $g^\alpha$ is defined akin to the one for FSR in eq.~\ref{fks: sub: real}. Note the negative sign of $k_\mathrm{em}^2$ to compensate the negative virtuality of the initial-state emitter. For ISR, $z$ is defined with respect to the emitter energy entering the hard interaction, i.e. \begin{equation*} z = \frac{E_\mathrm{beam} - E_\mathrm{rad}}{E_\mathrm{beam}} = 1 - \frac{E_\mathrm{rad}}{E_\mathrm{beam}}. \end{equation*} Because $E_\mathrm{rad} = E_\mathrm{beam} \cdot \xi$, it is $z = 1 - \xi$, thus one factor of $\xi$ is cancelled by $(1-z)$ in the denominator of $g^\alpha$. The factor $k_\mathrm{em}^2$ in the denominator is rewritten as \begin{equation*} k_\mathrm{em}^2 = \left(p_\mathrm{beam} - p_\mathrm{rad}\right)^2 = - 2 p_\mathrm{beam} \cdot p_\mathrm{rad} = - 2 E_\mathrm{beam} E_\mathrm{rad} (1\pm y) = - 2 E_\mathrm{beam}^2 (1-z) (1\pm y), \end{equation*} where we used \begin{equation*} E_\mathrm{beam} E_\mathrm{rad} = E_\mathrm{beam}^2 (1-z). \end{equation*} This leads to the cancellation of the corresponding $(1\pm y)$ factor in $(1-y^2)$, with the other factor becoming a simple factor of $2$, and the remaining factor of $\xi$ in the numerator. We thus end up with \begin{equation*} g^\alpha = \frac{8\pi\alpha_s}{E_\mathrm{beam}^2} C_F \left(1 + z^2\right)\mathcal{B}, \end{equation*} which is soft-finite. Note that here in [[compute_isr]], [[sqme_born]] is supposed to be the squared Born matrix element convoluted with the real PDF. <>= procedure :: compute_isr => coll_subtraction_compute_isr <>= function coll_subtraction_compute_isr & (coll_sub, emitter, flst, p_born, sqme_born, mom_times_sqme_spin_c, & xi, alpha_coupling, isr_mode) result (sqme) real(default) :: sqme class(coll_subtraction_t), intent(in) :: coll_sub integer, intent(in) :: emitter integer, dimension(:), intent(in) :: flst type(vector4_t), intent(in), dimension(:) :: p_born real(default), intent(in) :: sqme_born real(default), intent(in) :: mom_times_sqme_spin_c real(default), intent(in) :: xi, alpha_coupling integer, intent(in) :: isr_mode real(default) :: z, onemz, p02 integer :: nlegs, flv_em, flv_rad !!! p_born must be in lab frame. nlegs = size (flst) flv_rad = flst(nlegs); flv_em = flst(emitter) !!! No need to pay attention to n_in = 1, because this case always has a !!! massive initial-state particle and thus no collinear divergence. p02 = p_born(1)%p(0) * p_born(2)%p(0) / two z = one - xi; onemz = xi if (is_massless_vector (flv_em) .and. is_massless_vector (flv_rad)) then sqme = coll_sub%CA * (two * (z + z * onemz**2) * sqme_born + four * onemz**2 & / z * mom_times_sqme_spin_c) else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then sqme = coll_sub%CF * (one + z**2) * sqme_born else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then sqme = coll_sub%CF * (z * onemz * sqme_born + four * onemz**2 / z * mom_times_sqme_spin_c) else if (is_massless_vector (flv_em) .and. is_fermion (flv_rad)) then sqme = coll_sub%TR * (z**2 + onemz**2) * onemz * sqme_born else sqme = zero end if if (isr_mode == SQRTS_VAR) then sqme = sqme / p02 * z else !!! We have no idea why this seems to work as there should be no factor !!! of z for the fixed-beam settings. This should definitely be understood in the !!! future! sqme = sqme / p02 / z end if sqme = sqme * four * pi * alpha_coupling end function coll_subtraction_compute_isr @ %def coll_subtraction_compute_isr @ <>= procedure :: final => coll_subtraction_final <>= subroutine coll_subtraction_final (sub_coll) class(coll_subtraction_t), intent(inout) :: sub_coll sub_coll%use_resonance_mappings = .false. end subroutine coll_subtraction_final @ %def coll_subtraction_final @ \subsection{Real Subtraction} We store a pointer to the [[nlo_settings_t]] object which holds tuning parameters, e.g. cutoffs for the subtraction terms. <>= public :: real_subtraction_t <>= type :: real_subtraction_t type(nlo_settings_t), pointer :: settings => null () type(region_data_t), pointer :: reg_data => null () type(real_kinematics_t), pointer :: real_kinematics => null () type(isr_kinematics_t), pointer :: isr_kinematics => null () type(real_scales_t) :: scales real(default), dimension(:,:), allocatable :: sqme_real_non_sub real(default), dimension(:), allocatable :: sqme_born real(default), dimension(:,:), allocatable :: sf_factors real(default), dimension(:,:,:), allocatable :: sqme_born_color_c real(default), dimension(:,:,:), allocatable :: sqme_born_charge_c real(default), dimension(:,:,:,:), allocatable :: sqme_born_spin_c type(soft_subtraction_t) :: sub_soft type(coll_subtraction_t) :: sub_coll logical, dimension(:), allocatable :: sc_required logical :: subtraction_deactivated = .false. integer :: purpose = INTEGRATION logical :: radiation_event = .true. logical :: subtraction_event = .false. integer, dimension(:), allocatable :: selected_alr contains <> end type real_subtraction_t @ %def real_subtraction_t @ Initializer <>= procedure :: init => real_subtraction_init <>= subroutine real_subtraction_init (rsub, reg_data, settings) class(real_subtraction_t), intent(inout), target :: rsub type(region_data_t), intent(in), target :: reg_data type(nlo_settings_t), intent(in), target :: settings integer :: alr if (debug_on) call msg_debug (D_SUBTRACTION, "real_subtraction_init") if (debug_on) call msg_debug (D_SUBTRACTION, "n_in", reg_data%n_in) if (debug_on) call msg_debug (D_SUBTRACTION, "nlegs_born", reg_data%n_legs_born) if (debug_on) call msg_debug (D_SUBTRACTION, "nlegs_real", reg_data%n_legs_real) if (debug_on) call msg_debug (D_SUBTRACTION, "reg_data%n_regions", reg_data%n_regions) if (debug2_active (D_SUBTRACTION)) call reg_data%write () rsub%reg_data => reg_data allocate (rsub%sqme_born (reg_data%n_flv_born)) rsub%sqme_born = zero allocate (rsub%sf_factors (reg_data%n_regions, 0:reg_data%n_in)) rsub%sf_factors = zero allocate (rsub%sqme_born_color_c (reg_data%n_legs_born, reg_data%n_legs_born, & reg_data%n_flv_born)) rsub%sqme_born_color_c = zero allocate (rsub%sqme_born_charge_c (reg_data%n_legs_born, reg_data%n_legs_born, & reg_data%n_flv_born)) rsub%sqme_born_charge_c = zero allocate (rsub%sqme_real_non_sub (reg_data%n_flv_real, reg_data%n_phs)) rsub%sqme_real_non_sub = zero allocate (rsub%sc_required (reg_data%n_regions)) do alr = 1, reg_data%n_regions rsub%sc_required(alr) = reg_data%regions(alr)%sc_required end do if (rsub%requires_spin_correlations ()) then allocate (rsub%sqme_born_spin_c (1:3, 1:3, reg_data%n_legs_born, reg_data%n_flv_born)) rsub%sqme_born_spin_c = zero end if call rsub%sub_soft%init (reg_data) call rsub%sub_coll%init (reg_data%n_regions, reg_data%n_in) rsub%settings => settings rsub%sub_soft%use_resonance_mappings = settings%use_resonance_mappings rsub%sub_coll%use_resonance_mappings = settings%use_resonance_mappings rsub%sub_soft%factorization_mode = settings%factorization_mode end subroutine real_subtraction_init @ %def real_subtraction_init @ <>= procedure :: set_real_kinematics => real_subtraction_set_real_kinematics <>= subroutine real_subtraction_set_real_kinematics (rsub, real_kinematics) class(real_subtraction_t), intent(inout) :: rsub type(real_kinematics_t), intent(in), target :: real_kinematics rsub%real_kinematics => real_kinematics end subroutine real_subtraction_set_real_kinematics @ %def real_subtraction_set_real_kinematics @ <>= procedure :: set_isr_kinematics => real_subtraction_set_isr_kinematics <>= subroutine real_subtraction_set_isr_kinematics (rsub, fractions) class(real_subtraction_t), intent(inout) :: rsub type(isr_kinematics_t), intent(in), target :: fractions rsub%isr_kinematics => fractions end subroutine real_subtraction_set_isr_kinematics @ %def real_subtraction_set_isr_kinematics @ <>= procedure :: get_i_res => real_subtraction_get_i_res <>= function real_subtraction_get_i_res (rsub, alr) result (i_res) integer :: i_res class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr select type (fks_mapping => rsub%reg_data%fks_mapping) type is (fks_mapping_resonances_t) i_res = fks_mapping%res_map%alr_to_i_res (alr) class default i_res = 0 end select end function real_subtraction_get_i_res @ %def real_subtraction_get_i_res @ \subsection{The real contribution to the cross section} In each singular region $\alpha$, the real contribution to $\sigma$ is given by the second summand of eqn. \ref{fks: sub: complete}, \begin{equation} \label{fks: sub: real} \sigma^\alpha_{\text{real}} = \int d\Phi_n \int_0^{2\pi} d\phi \int_{-1}^1 dy \int_0^{\xi_{\text{max}}} d\xi \left(\frac{1}{\xi}\right)_+ \left(\frac{1}{1-y}\right)_+ \underbrace{\frac{J(\Phi_n, \xi, y, \phi)}{\xi} \left[(1-y)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]}_{g^\alpha(\xi,y)}. \end{equation} Writing out the plus-distribution and introducing $\tilde{\xi} = \xi/\xi_{\text{max}}$ to set the upper integration limit to 1, this turns out to be equal to \begin{equation} \begin{split} \sigma^\alpha_{\rm{real}} &= \int d\Phi_n \int_0^{2\pi}d\phi \int_{-1}^1 \frac{dy}{1-y} \Bigg\{\int_0^1 d\tilde{\xi}\Bigg[\frac{g^\alpha(\tilde{\xi}\xi_{\rm{max}},y)}{\tilde{\xi}} - \underbrace{\frac{g^\alpha(0,y)}{\tilde{\xi}}}_{\text{soft}} - \underbrace{\frac{g^\alpha(\tilde{\xi}\xi_{\rm{max}},1)}{\tilde{\xi}}}_{\text{coll.}} + \underbrace{\frac{g^\alpha(0,1)}{\tilde{\xi}}}_{\text{coll.+soft}}\Bigg] \\ &+ \left[\log\xi_{\rm{max}}(y)g^\alpha(0,y) - \log\xi_{\rm{max}}(1)g^\alpha(0,1)\right]\Bigg\}. \end{split} \end{equation} This formula is implemented in \texttt{compute\_sqme\_real\_fin} If two or more singular regions would produce the same amplitude we only compute one and use the [[eqv_index]] to copy the result to the others (if [[reuse_amplitudes_fks]] is true). <>= procedure :: compute => real_subtraction_compute <>= subroutine real_subtraction_compute (rsub, emitter, i_phs, alpha_s, & alpha_qed, separate_alrs, sqme) class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: emitter, i_phs logical, intent(in) :: separate_alrs real(default), intent(inout), dimension(:) :: sqme real(default), dimension(:), allocatable :: sqme_alr_arr real(default), intent(in) :: alpha_s, alpha_qed real(default) :: sqme_alr, alpha_coupling integer :: alr, i_con, i_res, this_emitter logical :: same_emitter logical, dimension(:), allocatable :: alr_evaluated allocate (alr_evaluated(rsub%reg_data%n_regions)) allocate (sqme_alr_arr(rsub%reg_data%n_regions)) sqme_alr_arr = zero alr_evaluated = .false. do alr = 1, rsub%reg_data%n_regions if (.not. alr_evaluated(rsub%reg_data%regions(alr)%eqv_index)) then if (allocated (rsub%selected_alr)) then if (.not. any (rsub%selected_alr == alr)) cycle end if sqme_alr = zero if (emitter > rsub%isr_kinematics%n_in) then same_emitter = emitter == rsub%reg_data%regions(alr)%emitter else same_emitter = rsub%reg_data%regions(alr)%emitter <= rsub%isr_kinematics%n_in end if select case (char(rsub%reg_data%regions(alr)%nlo_correction_type)) case ("QCD") alpha_coupling = alpha_s case ("EW") alpha_coupling = alpha_qed end select if (same_emitter .and. i_phs == rsub%real_kinematics%alr_to_i_phs (alr)) then i_res = rsub%get_i_res (alr) this_emitter = rsub%reg_data%regions(alr)%emitter sqme_alr = rsub%evaluate_emitter_region (alr, this_emitter, i_phs, i_res, & alpha_coupling) if (rsub%purpose == INTEGRATION .or. rsub%purpose == FIXED_ORDER_EVENTS) then i_con = rsub%get_i_contributor (alr) sqme_alr = sqme_alr * rsub%get_phs_factor (i_con) end if end if sqme_alr_arr(alr) = sqme_alr_arr(alr) + sqme_alr if (.not. (debug_active (D_SUBTRACTION) .or. debug2_active (D_SUBTRACTION))) then if (.not. allocated (rsub%selected_alr)) & alr_evaluated(rsub%reg_data%regions(alr)%eqv_index) = .true. end if else sqme_alr_arr(alr) = sqme_alr_arr(rsub%reg_data%regions(alr)%eqv_index) end if if (separate_alrs) then sqme(alr) = sqme(alr) + sqme_alr_arr(alr) else sqme(1) = sqme(1) + sqme_alr_arr(alr) end if end do if (debug_on) then if (debug2_active (D_SUBTRACTION)) call check_s_alpha_consistency () end if contains subroutine check_s_alpha_consistency () real(default) :: sum_s_alpha, sum_s_alpha_soft integer :: i_ftuple if (debug_on) call msg_debug2 (D_SUBTRACTION, "Check consistency of s_alpha: ") do alr = 1, rsub%reg_data%n_regions sum_s_alpha = rsub%sum_up_s_alpha(alr, i_phs) call msg_debug2 (D_SUBTRACTION, 'sum_s_alpha', sum_s_alpha) if (.not. nearly_equal(sum_s_alpha, one)) then call msg_bug ("The sum of all S functions should be equal to one!") end if sum_s_alpha_soft = rsub%sum_up_s_alpha_soft(alr, i_phs) call msg_debug2 (D_SUBTRACTION, 'sum_s_alpha_soft', sum_s_alpha_soft) if (.not. nearly_equal(sum_s_alpha_soft, one)) then call msg_bug ("The sum of all soft S functions should be equal to one!") end if end do end subroutine check_s_alpha_consistency end subroutine real_subtraction_compute @ %def real_subtraction_compute @ The emitter is fixed. We now have to decide whether we evaluate in ISR or FSR region, and also if resonances are used. <>= procedure :: evaluate_emitter_region => real_subtraction_evaluate_emitter_region <>= function real_subtraction_evaluate_emitter_region (rsub, alr, emitter, & i_phs, i_res, alpha_coupling) result (sqme) real(default) :: sqme class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, emitter, i_phs, i_res real(default), intent(in) :: alpha_coupling if (emitter <= rsub%isr_kinematics%n_in) then sqme = rsub%evaluate_region_isr (alr, emitter, i_phs, i_res, alpha_coupling) else select type (fks_mapping => rsub%reg_data%fks_mapping) type is (fks_mapping_resonances_t) call fks_mapping%set_resonance_momenta & (rsub%real_kinematics%xi_ref_momenta) end select sqme = rsub%evaluate_region_fsr (alr, emitter, i_phs, i_res, alpha_coupling) end if end function real_subtraction_evaluate_emitter_region @ %def real_subtraction_evaluate_emitter_region @ Sums up $\sum_{i_1, i_2} S_{i_1 i_2}$ for the given [[alr]]. <>= procedure :: sum_up_s_alpha => real_subtraction_sum_up_s_alpha <>= function real_subtraction_sum_up_s_alpha (rsub, alr, i_phs) result (sum_s_alpha) real(default) :: sum_s_alpha class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, i_phs type(vector4_t), dimension(:), allocatable :: p_real integer :: i_res, i_ftuple, i1, i2 allocate (p_real (rsub%reg_data%n_legs_real)) if (rsub%reg_data%has_pseudo_isr ()) then p_real = rsub%real_kinematics%p_real_onshell(i_phs)%get_momenta (i_phs) else p_real = rsub%real_kinematics%p_real_cms%get_momenta (i_phs) end if i_res = rsub%get_i_res (alr) sum_s_alpha = zero do i_ftuple = 1, rsub%reg_data%regions(alr)%nregions call rsub%reg_data%regions(alr)%ftuples(i_ftuple)%get (i1, i2) sum_s_alpha = sum_s_alpha + rsub%reg_data%get_svalue (p_real, alr, i1, i2, i_res) end do end function real_subtraction_sum_up_s_alpha @ %def real_subtraction_sum_up_s_alpha @ Sums up $\sum_{i_1, i_2} S_{i_1 i_2}$ for the given [[alr]]. The soft S functions take the real momenta in the soft limit, i.e. the Born momenta. For each summand of [[sum_s_alpha_soft]] we take [[p_soft]] constructed from the emitter of the given alpha region also for ftuples in which the first integer [[i1]] does not coincide with the emitter. This is necessary because only if we keep [[p_soft]] fixed, all soft S functions are computed with the same denominator and thus add up to 1. <>= procedure :: sum_up_s_alpha_soft => real_subtraction_sum_up_s_alpha_soft <>= function real_subtraction_sum_up_s_alpha_soft (rsub, alr, i_phs) result (sum_s_alpha_soft) real(default) :: sum_s_alpha_soft class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, i_phs type(vector4_t), dimension(:), allocatable :: p_born integer :: i_res, i_ftuple, i1, i2, emitter, nlegs allocate (p_born (rsub%reg_data%n_legs_born)) if (rsub%reg_data%has_pseudo_isr ()) then p_born = rsub%real_kinematics%p_born_onshell%get_momenta (1) else p_born = rsub%real_kinematics%p_born_cms%get_momenta (1) end if i_res = rsub%get_i_res (alr) emitter = rsub%reg_data%regions(alr)%emitter associate (r => rsub%real_kinematics) if (emitter > rsub%sub_soft%reg_data%n_in) then call rsub%sub_soft%create_softvec_fsr (p_born, r%y_soft(i_phs), r%phi, & emitter, r%xi_ref_momenta(rsub%sub_soft%i_xi_ref (alr, i_phs))) else call rsub%sub_soft%create_softvec_isr (r%y_soft(i_phs), r%phi) end if end associate nlegs = rsub%reg_data%n_legs_real sum_s_alpha_soft = zero do i_ftuple = 1, rsub%reg_data%regions(alr)%nregions call rsub%reg_data%regions(alr)%ftuples(i_ftuple)%get (i1, i2) if (i2 == nlegs) then sum_s_alpha_soft = sum_s_alpha_soft + rsub%reg_data%get_svalue_soft & (p_born, rsub%sub_soft%p_soft, alr, i1, i_res) end if end do end function real_subtraction_sum_up_s_alpha_soft @ %def real_subtraction_sum_up_s_alpha_soft @ This subroutine computes the finite part of the real matrix element in an individual singular region. First, the radiation variables are fetched and $\mathcal{R}$ is multiplied by the appropriate $S_\alpha$-factors, region multiplicities and double-FSR factors. Then, it computes the soft, collinear, soft-collinear and remnant matrix elements and supplies the corresponding factor $1/\xi/(1-y)$ as well as the corresponding Jacobians. <>= procedure :: evaluate_region_fsr => real_subtraction_evaluate_region_fsr <>= function real_subtraction_evaluate_region_fsr (rsub, alr, emitter, i_phs, & i_res, alpha_coupling) result (sqme_tot) real(default) :: sqme_tot class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, emitter, i_phs, i_res real(default), intent(in) :: alpha_coupling real(default) :: sqme_rad, sqme_soft, sqme_coll, sqme_cs, sqme_remn sqme_rad = zero; sqme_soft = zero; sqme_coll = zero sqme_cs = zero; sqme_remn = zero associate (region => rsub%reg_data%regions(alr), template => rsub%settings%fks_template) if (rsub%radiation_event) then sqme_rad = rsub%sqme_real_non_sub (rsub%reg_data%get_matrix_element_index (alr), i_phs) call evaluate_fks_factors (sqme_rad, rsub%reg_data, rsub%real_kinematics, & alr, i_phs, emitter, i_res) call apply_kinematic_factors_radiation (sqme_rad, rsub%purpose, & rsub%real_kinematics, i_phs, .false., rsub%reg_data%has_pseudo_isr (), & emitter) end if if (rsub%subtraction_event .and. .not. rsub%subtraction_deactivated) then if (debug2_active (D_SUBTRACTION)) then print *, "[real_subtraction_evaluate_region_fsr]" print *, "xi: ", rsub%real_kinematics%xi_max(i_phs) * rsub%real_kinematics%xi_tilde print *, "y: ", rsub%real_kinematics%y(i_phs) end if call rsub%evaluate_subtraction_terms_fsr (alr, emitter, i_phs, i_res, alpha_coupling, & sqme_soft, sqme_coll, sqme_cs) call apply_kinematic_factors_subtraction_fsr (sqme_soft, sqme_coll, sqme_cs, & rsub%real_kinematics, i_phs) associate (symm_factor_fs => rsub%reg_data%born_to_real_symm_factor_fs (alr)) sqme_soft = sqme_soft * symm_factor_fs sqme_coll = sqme_coll * symm_factor_fs sqme_cs = sqme_cs * symm_factor_fs end associate sqme_remn = compute_sqme_remnant_fsr (sqme_soft, sqme_cs, & rsub%real_kinematics%xi_max(i_phs), template%xi_cut, rsub%real_kinematics%xi_tilde) select case (rsub%purpose) case (INTEGRATION) sqme_tot = sqme_rad - sqme_soft - sqme_coll + sqme_cs + sqme_remn case (FIXED_ORDER_EVENTS) sqme_tot = - sqme_soft - sqme_coll + sqme_cs + sqme_remn case default sqme_tot = zero call msg_bug ("real_subtraction_evaluate_region_fsr: " // & "Undefined rsub%purpose") end select else sqme_tot = sqme_rad end if sqme_tot = sqme_tot * rsub%real_kinematics%jac_rand(i_phs) sqme_tot = sqme_tot * rsub%reg_data%regions(alr)%mult end associate if (debug_active (D_SUBTRACTION) .and. .not. debug2_active (D_SUBTRACTION)) then call real_subtraction_register_debug_sqme (rsub, alr, emitter, i_phs, sqme_rad, sqme_soft, & sqme_coll=sqme_coll, sqme_cs=sqme_cs) else if (debug2_active (D_SUBTRACTION)) then call write_computation_status_fsr () end if contains <> subroutine write_computation_status_fsr (passed, total, region_type, full) integer, intent(in), optional :: passed, total character(*), intent(in), optional :: region_type integer :: i_born integer :: u real(default) :: xi logical :: yorn logical, intent(in), optional :: full yorn = .true. if (present (full)) yorn = full if (debug_on) call msg_debug (D_SUBTRACTION, "real_subtraction_evaluate_region_fsr") u = given_output_unit (); if (u < 0) return i_born = rsub%reg_data%regions(alr)%uborn_index xi = rsub%real_kinematics%xi_max (i_phs) * rsub%real_kinematics%xi_tilde write (u,'(A,I2)') 'rsub%purpose: ', rsub%purpose write (u,'(A,I4)') 'alr: ', alr write (u,'(A,I3)') 'emitter: ', emitter write (u,'(A,I3)') 'i_phs: ', i_phs write (u,'(A,F6.4)') 'xi_max: ', rsub%real_kinematics%xi_max (i_phs) write (u,'(A,F6.4)') 'xi_cut: ', rsub%real_kinematics%xi_max(i_phs) * rsub%settings%fks_template%xi_cut write (u,'(A,F6.4,2X,A,F6.4)') 'xi: ', xi, 'y: ', rsub%real_kinematics%y (i_phs) if (yorn) then write (u,'(A,ES16.9)') 'sqme_born: ', rsub%sqme_born(i_born) write (u,'(A,ES16.9)') 'sqme_real: ', sqme_rad write (u,'(A,ES16.9)') 'sqme_soft: ', sqme_soft write (u,'(A,ES16.9)') 'sqme_coll: ', sqme_coll write (u,'(A,ES16.9)') 'sqme_coll-soft: ', sqme_cs write (u,'(A,ES16.9)') 'sqme_remn: ', sqme_remn write (u,'(A,ES16.9)') 'sqme_tot: ', sqme_tot if (present (passed) .and. present (total) .and. & present (region_type)) & write (u,'(A)') char (str (passed) // " of " // str (total) // & " " // region_type // " points passed in total") end if write (u,'(A,ES16.9)') 'jacobian - real: ', rsub%real_kinematics%jac(i_phs)%jac(1) write (u,'(A,ES16.9)') 'jacobian - soft: ', rsub%real_kinematics%jac(i_phs)%jac(2) write (u,'(A,ES16.9)') 'jacobian - coll: ', rsub%real_kinematics%jac(i_phs)%jac(3) end subroutine write_computation_status_fsr end function real_subtraction_evaluate_region_fsr @ %def real_subtraction_evalute_region_fsr @ Compares the real matrix element to the subtraction terms in the soft, the collinear or the soft-collinear limits. Used for debug purposes if [[?test_anti_coll_limit]], [[?test_coll_limit]] and/or [[?test_soft_limit]] are set in the Sindarin. [[sqme_soft]] and [[sqme_cs]] need to be provided if called for FSR and [[sqme_coll_plus]], [[sqme_coll_minus]], [[sqme_cs_plus]] as well as [[sqme_cs_minus]] need to be provided if called for ISR. <>= subroutine real_subtraction_register_debug_sqme (rsub, alr, emitter, i_phs, sqme_rad, sqme_soft,& sqme_coll, sqme_cs, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus) class(real_subtraction_t), intent(in) :: rsub integer, intent(in) :: alr, emitter, i_phs real(default), intent(in) :: sqme_rad, sqme_soft real(default), intent(in), optional :: sqme_coll, sqme_cs, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus real(default), dimension(:), allocatable, save :: sqme_rad_store logical :: is_soft, is_collinear_plus, is_collinear_minus, is_fsr real(default), parameter :: soft_threshold = 0.001_default real(default), parameter :: coll_threshold = 0.99_default real(default), parameter :: rel_smallness = 0.01_default real(default) :: sqme_dummy, this_sqme_rad, y, xi_tilde logical, dimension(:), allocatable, save :: count_alr if (.not. allocated (sqme_rad_store)) then allocate (sqme_rad_store (rsub%reg_data%n_regions)) sqme_rad_store = zero end if if (rsub%radiation_event) then sqme_rad_store(alr) = sqme_rad else if (.not. allocated (count_alr)) then allocate (count_alr (rsub%reg_data%n_regions)) count_alr = .false. end if if (is_gluon (rsub%reg_data%regions(alr)%flst_real%flst(rsub%reg_data%n_legs_real))) then xi_tilde = rsub%real_kinematics%xi_tilde is_soft = xi_tilde < soft_threshold else is_soft = .false. end if y = rsub%real_kinematics%y(i_phs) is_collinear_plus = y > coll_threshold .and. & rsub%reg_data%regions(alr)%has_collinear_divergence() is_collinear_minus = -y > coll_threshold .and. & rsub%reg_data%regions(alr)%has_collinear_divergence() is_fsr = emitter > rsub%isr_kinematics%n_in if (is_fsr) then if (.not. present(sqme_coll) .or. .not. present(sqme_cs)) & call msg_error ("real_subtraction_register_debug_sqme: Wrong arguments for FSR") else if (.not. present(sqme_coll_plus) .or. .not. present(sqme_coll_minus) & .or. .not. present(sqme_cs_plus) .or. .not. present(sqme_cs_minus)) & call msg_error ("real_subtraction_register_debug_sqme: Wrong arguments for ISR") end if this_sqme_rad = sqme_rad_store(alr) if (is_soft .and. .not. is_collinear_plus .and. .not. is_collinear_minus) then if ( .not. nearly_equal (this_sqme_rad, sqme_soft, & abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then call msg_print_color (char ("Soft MEs do not match in region " // str (alr)), COL_RED) else call msg_print_color (char ("sqme_soft OK in region " // str (alr)), COL_GREEN) end if print *, 'this_sqme_rad, sqme_soft = ', this_sqme_rad, sqme_soft end if if (is_collinear_plus .and. .not. is_soft) then if (is_fsr) then if ( .not. nearly_equal (this_sqme_rad, sqme_coll, & abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED) else call msg_print_color (char ("sqme_coll OK in region " // str (alr)), COL_GREEN) end if print *, 'this_sqme_rad, sqme_coll = ', this_sqme_rad, sqme_coll else if ( .not. nearly_equal (this_sqme_rad, sqme_coll_plus, & abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED) else call msg_print_color (char ("sqme_coll_plus OK in region " // str (alr)), COL_GREEN) end if print *, 'this_sqme_rad, sqme_coll_plus = ', this_sqme_rad, sqme_coll_plus end if end if if (is_collinear_minus .and. .not. is_soft) then if (.not. is_fsr) then if ( .not. nearly_equal (this_sqme_rad, sqme_coll_minus, & abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED) else call msg_print_color (char ("sqme_coll_minus OK in region " // str (alr)), COL_GREEN) end if print *, 'this_sqme_rad, sqme_coll_minus = ', this_sqme_rad, sqme_coll_minus end if end if if (is_soft .and. is_collinear_plus) then if (is_fsr) then if ( .not. nearly_equal (this_sqme_rad, sqme_cs, & abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED) else call msg_print_color (char ("sqme_cs OK in region " // str (alr)), COL_GREEN) end if print *, 'this_sqme_rad, sqme_cs = ', this_sqme_rad, sqme_cs else if ( .not. nearly_equal (this_sqme_rad, sqme_cs_plus, & abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED) else call msg_print_color (char ("sqme_cs_plus OK in region " // str (alr)), COL_GREEN) end if print *, 'this_sqme_rad, sqme_cs_plus = ', this_sqme_rad, sqme_cs_plus end if end if if (is_soft .and. is_collinear_minus) then if (.not. is_fsr) then if ( .not. nearly_equal (this_sqme_rad, sqme_cs_minus, & abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED) else call msg_print_color (char ("sqme_cs_minus OK in region " // str (alr)), COL_GREEN) end if print *, 'this_sqme_rad, sqme_cs_minus = ', this_sqme_rad, sqme_cs_minus end if end if count_alr (alr) = .true. if (all (count_alr)) then deallocate (count_alr) deallocate (sqme_rad_store) end if end if end subroutine real_subtraction_register_debug_sqme @ %def real_subtraction_register_debug_sqme @ For final state radiation, the subtraction remnant cross section is \begin{equation} \sigma_{\text{remn}} = \left(\sigma_{\text{soft}} - \sigma_{\text{soft-coll}}\right) - \log (\xi_{\text{max}}\xi_{\text{cut}})) \cdot \tilde{\xi}. + \log (\xi_{\text{max}}) \cdot \frac{\tilde{\xi}}{\xi_{\text{cut}}}. \end{equation} -There is only one factor of $\log (\xi_{\text{max}}\xi_{\text{cut}})$ for both limits +There is only one factor of $\log (\xi_{\text{max}})$ for both limits as $\xi_{\text{max}}$ does not depend on $y$ in the case of FSR. We use the already computed [[sqme_soft]] and [[sqme_cs]] with a factor of -$\tilde{\xi}$ which we have to compensate. +$\tilde{\xi}$ which we have to compensate. We also need a factor $1/\xi_{\text{cut}}$ here +to assure that the cross section is independent of this free cutoff parameter. +However, it still remains to be motivated analytically. <>= function compute_sqme_remnant_fsr (sqme_soft, sqme_cs, xi_max, xi_cut, xi_tilde) result (sqme_remn) real(default) :: sqme_remn real(default), intent(in) :: sqme_soft, sqme_cs, xi_max, xi_cut, xi_tilde if (debug_on) call msg_debug (D_SUBTRACTION, "compute_sqme_remnant_fsr") - sqme_remn = (sqme_soft - sqme_cs) * log (xi_max * xi_cut) * xi_tilde + sqme_remn = (sqme_soft - sqme_cs) * log (xi_max) * xi_tilde / xi_cut end function compute_sqme_remnant_fsr @ %def compute_sqme_remnant_fsr @ <>= procedure :: evaluate_region_isr => real_subtraction_evaluate_region_isr <>= function real_subtraction_evaluate_region_isr (rsub, alr, emitter, i_phs, i_res, alpha_coupling) & result (sqme_tot) real(default) :: sqme_tot class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, emitter, i_phs, i_res real(default), intent(in) :: alpha_coupling real(default) :: sqme_rad, sqme_soft, sqme_coll_plus, sqme_coll_minus real(default) :: sqme_cs_plus, sqme_cs_minus real(default) :: sqme_remn sqme_rad = zero; sqme_soft = zero; sqme_coll_plus = zero; sqme_coll_minus = zero sqme_cs_plus = zero; sqme_cs_minus = zero sqme_remn = zero associate (region => rsub%reg_data%regions(alr), template => rsub%settings%fks_template) if (rsub%radiation_event) then sqme_rad = rsub%sqme_real_non_sub (rsub%reg_data%get_matrix_element_index (alr), i_phs) call evaluate_fks_factors (sqme_rad, rsub%reg_data, rsub%real_kinematics, & alr, i_phs, emitter, i_res) call apply_kinematic_factors_radiation (sqme_rad, rsub%purpose, rsub%real_kinematics, & i_phs, .true., .false.) end if if (rsub%subtraction_event .and. .not. rsub%subtraction_deactivated) then call rsub%evaluate_subtraction_terms_isr (alr, emitter, i_phs, i_res, alpha_coupling, & sqme_soft, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus) call apply_kinematic_factors_subtraction_isr (sqme_soft, sqme_coll_plus, & sqme_coll_minus, sqme_cs_plus, sqme_cs_minus, rsub%real_kinematics, i_phs) associate (symm_factor_fs => rsub%reg_data%born_to_real_symm_factor_fs (alr)) sqme_soft = sqme_soft * symm_factor_fs sqme_coll_plus = sqme_coll_plus * symm_factor_fs sqme_coll_minus = sqme_coll_minus * symm_factor_fs sqme_cs_plus = sqme_cs_plus * symm_factor_fs sqme_cs_minus = sqme_cs_minus * symm_factor_fs end associate sqme_remn = compute_sqme_remnant_isr (rsub%isr_kinematics%isr_mode, & sqme_soft, sqme_cs_plus, sqme_cs_minus, & rsub%isr_kinematics, rsub%real_kinematics, i_phs, template%xi_cut) sqme_tot = sqme_rad - sqme_soft - sqme_coll_plus - sqme_coll_minus & + sqme_cs_plus + sqme_cs_minus + sqme_remn else sqme_tot = sqme_rad end if end associate sqme_tot = sqme_tot * rsub%real_kinematics%jac_rand (i_phs) sqme_tot = sqme_tot * rsub%reg_data%regions(alr)%mult if (debug_active (D_SUBTRACTION) .and. .not. debug2_active (D_SUBTRACTION)) then call real_subtraction_register_debug_sqme (rsub, alr, emitter, i_phs, sqme_rad,& sqme_soft, sqme_coll_plus=sqme_coll_plus, sqme_coll_minus=sqme_coll_minus,& sqme_cs_plus=sqme_cs_plus, sqme_cs_minus=sqme_cs_minus) else if (debug2_active (D_SUBTRACTION)) then call write_computation_status_isr () end if contains <> subroutine write_computation_status_isr (unit) integer, intent(in), optional :: unit integer :: i_born integer :: u real(default) :: xi u = given_output_unit (unit); if (u < 0) return i_born = rsub%reg_data%regions(alr)%uborn_index xi = rsub%real_kinematics%xi_max (i_phs) * rsub%real_kinematics%xi_tilde write (u,'(A,I4)') 'alr: ', alr write (u,'(A,I2)') 'emitter: ', emitter write (u,'(A,F4.2)') 'xi_max: ', rsub%real_kinematics%xi_max (i_phs) print *, 'xi: ', xi, 'y: ', rsub%real_kinematics%y (i_phs) print *, 'xb1: ', rsub%isr_kinematics%x(1), 'xb2: ', rsub%isr_kinematics%x(2) print *, 'random jacobian: ', rsub%real_kinematics%jac_rand (i_phs) write (u,'(A,ES16.9)') 'sqme_born: ', rsub%sqme_born(i_born) write (u,'(A,ES16.9)') 'sqme_real: ', sqme_rad write (u,'(A,ES16.9)') 'sqme_soft: ', sqme_soft write (u,'(A,ES16.9)') 'sqme_coll_plus: ', sqme_coll_plus write (u,'(A,ES16.9)') 'sqme_coll_minus: ', sqme_coll_minus write (u,'(A,ES16.9)') 'sqme_cs_plus: ', sqme_cs_plus write (u,'(A,ES16.9)') 'sqme_cs_minus: ', sqme_cs_minus write (u,'(A,ES16.9)') 'sqme_remn: ', sqme_remn write (u,'(A,ES16.9)') 'sqme_tot: ', sqme_tot write (u,'(A,ES16.9)') 'jacobian - real: ', rsub%real_kinematics%jac(i_phs)%jac(1) write (u,'(A,ES16.9)') 'jacobian - soft: ', rsub%real_kinematics%jac(i_phs)%jac(2) write (u,'(A,ES16.9)') 'jacobian - collplus: ', rsub%real_kinematics%jac(i_phs)%jac(3) write (u,'(A,ES16.9)') 'jacobian - collminus: ', rsub%real_kinematics%jac(i_phs)%jac(4) end subroutine write_computation_status_isr end function real_subtraction_evaluate_region_isr @ %def real_subtraction_evaluate_region_isr @ Computes the soft remnant for ISR. The formulas can be found in arXiv:1002.2581, eq. 4.21. and arXiv:0709.2092, sec. 5.1.2. This results in \begin{equation} \sigma_{\text{remn}}^{\text{ISR}} = \log(\xi_{\text{max}}(y)) \sigma_{\text{soft}} - \frac{1}{2} \log(\xi_{\text{max}}(1)) \sigma^{\text{soft-coll}}_{\oplus} - \frac{1}{2} \log(\xi_{\text{max}}(-1)) \sigma^{\text{soft-coll}}_{\ominus} \end{equation} where for ISR, $\xi_{\text{max}}$ does explicitly depend on $y$ due to the rescaling of the $x$ values from the Born to the real partonic system according to \begin{equation} x_\oplus = \frac{\overline{x}_\oplus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1-y)}{2-\xi(1+y)}} , \qquad x_\ominus = \frac{\overline{x}_\ominus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1+y)}{2-\xi(1-y)}} \end{equation} As $\xi_{\text{max}}$ is determined by the fact that the real $x_\oplus,x_\ominus$ have to stay in a physically meaningful regime, i.e. $x_\oplus,x_\ominus < 1$, this leads to \begin{align} \label{eqn:xi_max_isr} \xi_\text{max} = 1 - \text{max} &\left\{\frac{2(1+y)\overline{x}_\oplus^2}{\sqrt{(1+\overline{x}_\oplus^2)^2(1-y)^2 + 16y\overline{x}_\oplus^2} + (1-y)(1-\overline{x}_\oplus^2)}\right., \\ &\left.\frac{2(1-y)\overline{x}_\oplus^2}{\sqrt{(1+\overline{x}_\oplus^2)^2(1+y)^2 - 16y\overline{x}_\oplus^2} + (1+y)(1-\overline{x}_\oplus^2)}\right\} \end{align} and thus \begin{align} \xi_{\text{max}}(y=1) &= 1 - \overline{x}_\oplus \\ \xi_{\text{max}}(y=-1) &= 1 - \overline{x}_\ominus \end{align} So we need to use the unrescaled $\overline{x}_\oplus,\overline{x}_\ominus$ here. Factors of $\frac{1}{2}$ and $\frac{1}{\tilde{\xi}}$ are already included in the matrix elements from [[apply_kinematic_factors_subtraction_isr]]. We keep the former and remove the latter by multiplying with $\tilde{\xi}$. +The factor $1/\xi_{\text{cut}}$ is probably needed to assure that the cross section is +independent of this free cutoff parameter in analogy to the FSR case. +However, it still remains to be motivated analytically and to be validated. <>= function compute_sqme_remnant_isr (isr_mode, sqme_soft, sqme_cs_plus, sqme_cs_minus, & isr_kinematics, real_kinematics, i_phs, xi_cut) result (sqme_remn) real(default) :: sqme_remn integer, intent(in) :: isr_mode real(default), intent(in) :: sqme_soft, sqme_cs_plus, sqme_cs_minus type(isr_kinematics_t), intent(in) :: isr_kinematics type(real_kinematics_t), intent(in) :: real_kinematics integer, intent(in) :: i_phs real(default), intent(in) :: xi_cut real(default) :: xi_tilde, xi_max, xi_max_plus, xi_max_minus, xb_plus, xb_minus xi_max = real_kinematics%xi_max (i_phs) xi_tilde = real_kinematics%xi_tilde select case (isr_mode) case (SQRTS_VAR) xb_plus = isr_kinematics%x(I_PLUS) xb_minus = isr_kinematics%x(I_MINUS) xi_max_plus = one - xb_plus xi_max_minus = one - xb_minus case (SQRTS_FIXED) xi_max_plus = real_kinematics%xi_max (i_phs) xi_max_minus = real_kinematics%xi_max (i_phs) end select - sqme_remn = log (xi_max * xi_cut) * xi_tilde * sqme_soft & - - log (xi_max_plus * xi_cut) * xi_tilde * sqme_cs_plus & - - log (xi_max_minus * xi_cut) * xi_tilde * sqme_cs_minus + sqme_remn = log (xi_max) * xi_tilde * sqme_soft & + - log (xi_max_plus) * xi_tilde * sqme_cs_plus & + - log (xi_max_minus) * xi_tilde * sqme_cs_minus + sqme_remn = sqme_remn / xi_cut end function compute_sqme_remnant_isr @ %def compute_sqme_remnant_isr @ <>= procedure :: evaluate_subtraction_terms_fsr => & real_subtraction_evaluate_subtraction_terms_fsr <>= subroutine real_subtraction_evaluate_subtraction_terms_fsr (rsub, & alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, sqme_coll, sqme_cs) class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, emitter, i_phs, i_res real(default), intent(in) :: alpha_coupling real(default), intent(out) :: sqme_soft, sqme_coll, sqme_cs if (debug_on) call msg_debug (D_SUBTRACTION, "real_subtraction_evaluate_subtraction_terms_fsr") sqme_soft = zero; sqme_coll = zero; sqme_cs = zero associate (xi_tilde => rsub%real_kinematics%xi_tilde, & y => rsub%real_kinematics%y(i_phs), template => rsub%settings%fks_template) if (template%xi_cut > xi_tilde) & sqme_soft = rsub%compute_sub_soft (alr, emitter, i_phs, i_res, alpha_coupling) if (y - 1 + template%delta_o > 0) & sqme_coll = rsub%compute_sub_coll (alr, emitter, i_phs, alpha_coupling) if (template%xi_cut > xi_tilde .and. y - 1 + template%delta_o > 0) & sqme_cs = rsub%compute_sub_coll_soft (alr, emitter, i_phs, alpha_coupling) if (debug2_active (D_SUBTRACTION)) then print *, "FSR Cutoff:" print *, "sub_soft: ", template%xi_cut > xi_tilde, "(ME: ", sqme_soft, ")" print *, "sub_coll: ", (y - 1 + template%delta_o) > 0, "(ME: ", sqme_coll, ")" print *, "sub_coll_soft: ", template%xi_cut > xi_tilde .and. (y - 1 + template%delta_o) > 0, & "(ME: ", sqme_cs, ")" end if end associate end subroutine real_subtraction_evaluate_subtraction_terms_fsr @ %def real_subtraction_evaluate_subtraction_terms_fsr @ <>= subroutine evaluate_fks_factors (sqme, reg_data, real_kinematics, & alr, i_phs, emitter, i_res) real(default), intent(inout) :: sqme type(region_data_t), intent(inout) :: reg_data type(real_kinematics_t), intent(in), target :: real_kinematics integer, intent(in) :: alr, i_phs, emitter, i_res real(default) :: s_alpha type(phs_point_set_t), pointer :: p_real => null () if (reg_data%has_pseudo_isr ()) then p_real => real_kinematics%p_real_onshell (i_phs) else p_real => real_kinematics%p_real_cms end if s_alpha = reg_data%get_svalue (p_real%get_momenta(i_phs), alr, emitter, i_res) if (debug2_active (D_SUBTRACTION)) call msg_print_color('s_alpha', s_alpha, COL_YELLOW) if (s_alpha > one + tiny_07) call msg_fatal ("s_alpha > 1!") sqme = sqme * s_alpha associate (region => reg_data%regions(alr)) if (emitter > reg_data%n_in) then if (debug2_active (D_SUBTRACTION)) & print *, 'Double FSR: ', region%double_fsr_factor (p_real%get_momenta(i_phs)) sqme = sqme * region%double_fsr_factor (p_real%get_momenta(i_phs)) end if end associate end subroutine evaluate_fks_factors @ %def evaluate_fks_factors @ <>= subroutine apply_kinematic_factors_radiation (sqme, purpose, real_kinematics, & i_phs, isr, threshold, emitter) real(default), intent(inout) :: sqme integer, intent(in) :: purpose type(real_kinematics_t), intent(in) :: real_kinematics integer, intent(in) :: i_phs logical, intent(in) :: isr, threshold integer, intent(in), optional :: emitter real(default) :: xi, xi_tilde, s xi_tilde = real_kinematics%xi_tilde xi = xi_tilde * real_kinematics%xi_max (i_phs) select case (purpose) case (INTEGRATION, FIXED_ORDER_EVENTS) sqme = sqme * xi**2 / xi_tilde * real_kinematics%jac(i_phs)%jac(1) case (POWHEG) if (.not. isr) then s = real_kinematics%cms_energy2 sqme = sqme * real_kinematics%jac(i_phs)%jac(1) * s / (8 * twopi3) * xi else call msg_fatal ("POWHEG with initial-state radiation not implemented yet") end if end select end subroutine apply_kinematic_factors_radiation @ %def apply_kinematics_factors_radiation @ This routine applies the factors in the integrand of eq. 4.20 in arXiv:1002.2581 to the matrix elements. <>= subroutine apply_kinematic_factors_subtraction_fsr & (sqme_soft, sqme_coll, sqme_cs, real_kinematics, i_phs) real(default), intent(inout) :: sqme_soft, sqme_coll, sqme_cs type(real_kinematics_t), intent(in) :: real_kinematics integer, intent(in) :: i_phs real(default) :: xi_tilde, onemy xi_tilde = real_kinematics%xi_tilde onemy = one - real_kinematics%y(i_phs) sqme_soft = sqme_soft / onemy / xi_tilde sqme_coll = sqme_coll / onemy / xi_tilde sqme_cs = sqme_cs / onemy / xi_tilde associate (jac => real_kinematics%jac(i_phs)%jac) sqme_soft = sqme_soft * jac(2) sqme_coll = sqme_coll * jac(3) sqme_cs = sqme_cs * jac(2) end associate end subroutine apply_kinematic_factors_subtraction_fsr @ %def apply_kinematic_factors_subtraction_fsr @ This routine applies the factors in the integrand of eq. 4.21 in arXiv:1002.2581 to the matrix elements. <>= subroutine apply_kinematic_factors_subtraction_isr & (sqme_soft, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, & sqme_cs_minus, real_kinematics, i_phs) real(default), intent(inout) :: sqme_soft, sqme_coll_plus, sqme_coll_minus real(default), intent(inout) :: sqme_cs_plus, sqme_cs_minus type(real_kinematics_t), intent(in) :: real_kinematics integer, intent(in) :: i_phs real(default) :: xi_tilde, y, onemy, onepy xi_tilde = real_kinematics%xi_tilde y = real_kinematics%y (i_phs) onemy = one - y; onepy = one + y associate (jac => real_kinematics%jac(i_phs)%jac) sqme_soft = sqme_soft / (one - y**2) / xi_tilde * jac(2) sqme_coll_plus = sqme_coll_plus / onemy / xi_tilde / two * jac(3) sqme_coll_minus = sqme_coll_minus / onepy / xi_tilde / two * jac(4) sqme_cs_plus = sqme_cs_plus / onemy / xi_tilde / two * jac(2) sqme_cs_minus = sqme_cs_minus / onepy / xi_tilde / two * jac(2) end associate end subroutine apply_kinematic_factors_subtraction_isr @ %def apply_kinematic_factors_subtraction_isr @ This subroutine evaluates the soft and collinear subtraction terms for ISR. References: \begin{itemize} \item arXiv:0709.2092, sec. 2.4.2 \item arXiv:0908.4272, sec. 4.2 \end{itemize} For the collinear terms, the procedure is as follows: If the emitter is 0, then a gluon was radiated from one of the incoming partons. Gluon emissions require two counter terms: One for emission in the direction of the first incoming parton $\oplus$ and a second for emission in the direction of the second incoming parton $\ominus$ because in both cases, there are divergent diagrams contributing to the matrix element. So in this case both, [[sqme_coll_plus]] and [[sqme_coll_minus]], are non-zero. If the emitter is 1 or 2, then a quark was emitted instead of a gluon. This only leads to a divergence collinear to the emitter because for anti-collinear quark emission, there are simply no divergent diagrams in the same region as two collinear quarks that cannot originate in the same splitting are non-divergent. This means that in case the emitter is 1, we need non-zero [[sqme_coll_plus]] and in case the emitter is 2, we need non-zero [[sqme_coll_minus]]. At this point, we want to remind ourselves that in case of initial state divergences, $y$ is just the polar angle, so the [[sqme_coll_minus]] terms are there to counter emissions in the direction of the second incoming parton $\ominus$ and \textbf{not} to counter in general anti-collinear divergences. <>= procedure :: evaluate_subtraction_terms_isr => & real_subtraction_evaluate_subtraction_terms_isr <>= subroutine real_subtraction_evaluate_subtraction_terms_isr (rsub, & alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, sqme_coll_plus, & sqme_coll_minus, sqme_cs_plus, sqme_cs_minus) class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, emitter, i_phs, i_res real(default), intent(in) :: alpha_coupling real(default), intent(out) :: sqme_soft real(default), intent(out) :: sqme_coll_plus, sqme_coll_minus real(default), intent(out) :: sqme_cs_plus, sqme_cs_minus sqme_coll_plus = zero; sqme_cs_plus = zero sqme_coll_minus = zero; sqme_cs_minus = zero associate (xi_tilde => rsub%real_kinematics%xi_tilde, & y => rsub%real_kinematics%y(i_phs), template => rsub%settings%fks_template) if (template%xi_cut > xi_tilde) & sqme_soft = rsub%compute_sub_soft (alr, emitter, i_phs, i_res, alpha_coupling) if (emitter /= 2) then if (y - 1 + template%delta_i > 0) then sqme_coll_plus = rsub%compute_sub_coll (alr, 1, i_phs, alpha_coupling) if (template%xi_cut > xi_tilde) then sqme_cs_plus = rsub%compute_sub_coll_soft (alr, 1, i_phs, alpha_coupling) end if end if end if if (emitter /= 1) then if (-y - 1 + template%delta_i > 0) then sqme_coll_minus = rsub%compute_sub_coll (alr, 2, i_phs, alpha_coupling) if (template%xi_cut > xi_tilde) then sqme_cs_minus = rsub%compute_sub_coll_soft (alr, 2, i_phs, alpha_coupling) end if end if end if if (debug2_active (D_SUBTRACTION)) then print *, "ISR Cutoff:" print *, "y: ", y print *, "delta_i: ", template%delta_i print *, "emitter: ", emitter print *, "sub_soft: ", template%xi_cut > xi_tilde, "(ME: ", sqme_soft, ")" print *, "sub_coll_plus: ", (y - 1 + template%delta_i) > 0, "(ME: ", sqme_coll_plus, ")" print *, "sub_coll_minus: ", (-y - 1 + template%delta_i) > 0, "(ME: ", sqme_coll_minus, ")" print *, "sub_coll_soft_plus: ", template%xi_cut > xi_tilde .and. (y - 1 + template%delta_i) > 0, & "(ME: ", sqme_cs_plus, ")" print *, "sub_coll_soft_minus: ", template%xi_cut > xi_tilde .and. (-y - 1 + template%delta_i) > 0, & "(ME: ", sqme_cs_minus, ")" end if end associate end subroutine real_subtraction_evaluate_subtraction_terms_isr @ %def real_subtraction_evaluate_subtraction_terms_isr @ This is basically the global part of the real Jacobian corresponding to \begin{equation*} \frac{q^2}{8 (2\pi)^3}. \end{equation*} We interpret it as the additional phase space factor of the real component, to be more consistent with the evaluation of the Born phase space. We specifically use the Born center-of-mass energy here. The real center-of-mass energy is only different from the Born center-of-mass energy in case of ISR. The missing factor $\frac{1}{1 - \xi}$ for this conversion is supplied in [[apply_kinematic_factors_radiation]] and [[phs_fks_generator_generate_isr]]. <>= procedure :: get_phs_factor => real_subtraction_get_phs_factor <>= function real_subtraction_get_phs_factor (rsub, i_con) result (factor) real(default) :: factor class(real_subtraction_t), intent(in) :: rsub integer, intent(in) :: i_con real(default) :: s s = rsub%real_kinematics%xi_ref_momenta (i_con)**2 factor = s / (8 * twopi3) end function real_subtraction_get_phs_factor @ %def real_subtraction_get_phs_factor @ <>= procedure :: get_i_contributor => real_subtraction_get_i_contributor <>= function real_subtraction_get_i_contributor (rsub, alr) result (i_con) integer :: i_con class(real_subtraction_t), intent(in) :: rsub integer, intent(in) :: alr if (allocated (rsub%reg_data%alr_to_i_contributor)) then i_con = rsub%reg_data%alr_to_i_contributor (alr) else i_con = 1 end if end function real_subtraction_get_i_contributor @ %def real_subtraction_get_i_contributor @ Computes the soft subtraction term. If there is an initial state emission having a soft divergence, then a gluon has to have been emitted. A gluon can always be emitted from both IS partons and thus, we can take the [[sf_factor]] for emitter $0$ in this case. Be aware that this approach will not work for $pe$ collisions. <>= procedure :: compute_sub_soft => real_subtraction_compute_sub_soft <>= function real_subtraction_compute_sub_soft (rsub, alr, emitter, & i_phs, i_res, alpha_coupling) result (sqme_soft) real(default) :: sqme_soft class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, emitter, i_phs, i_res real(default), intent(in) :: alpha_coupling integer :: i_xi_ref, i_born real(default) :: q2, sf_factor type(vector4_t), dimension(:), allocatable :: p_born associate (real_kinematics => rsub%real_kinematics, & nlo_corr_type => rsub%reg_data%regions(alr)%nlo_correction_type, & sregion => rsub%reg_data%regions(alr)) sqme_soft = zero if (sregion%has_soft_divergence ()) then i_xi_ref = rsub%sub_soft%i_xi_ref (alr, i_phs) q2 = real_kinematics%xi_ref_momenta (i_xi_ref)**2 allocate (p_born (rsub%reg_data%n_legs_born)) if (rsub%reg_data%has_pseudo_isr ()) then p_born = real_kinematics%p_born_onshell%get_momenta (1) else p_born = real_kinematics%p_born_cms%get_momenta (1) end if if (emitter > rsub%sub_soft%reg_data%n_in) then call rsub%sub_soft%create_softvec_fsr & (p_born, real_kinematics%y_soft(i_phs), & real_kinematics%phi, emitter, & real_kinematics%xi_ref_momenta(i_xi_ref)) sf_factor = one else call rsub%sub_soft%create_softvec_isr & (real_kinematics%y_soft(i_phs), real_kinematics%phi) sf_factor = rsub%sf_factors(alr, 0) end if i_born = sregion%uborn_index select case (char (nlo_corr_type)) case ("QCD") sqme_soft = rsub%sub_soft%compute & (p_born, rsub%sqme_born_color_c(:,:,i_born) * & sf_factor, real_kinematics%y(i_phs), & q2, alpha_coupling, alr, emitter, i_res) case ("EW") sqme_soft = rsub%sub_soft%compute & (p_born, rsub%sqme_born_charge_c(:,:,i_born) * & sf_factor, real_kinematics%y(i_phs), & q2, alpha_coupling, alr, emitter, i_res) end select end if end associate if (debug2_active (D_SUBTRACTION)) call check_soft_vector () contains subroutine check_soft_vector () !!! p_soft = p_gluon / E_gluon only in the soft limit !!! This check only has to be passed for ISR or for FSR if ?test_soft_limit = true is set. type(vector4_t) :: p_gluon if (debug_on) call msg_debug2 (D_SUBTRACTION, "Compare soft vector: ") print *, 'p_soft: ', rsub%sub_soft%p_soft%p print *, 'Normalized gluon momentum: ' if (rsub%reg_data%has_pseudo_isr ()) then p_gluon = rsub%real_kinematics%p_real_onshell(thr_leg(emitter))%get_momentum & (i_phs, rsub%reg_data%n_legs_real) else p_gluon = rsub%real_kinematics%p_real_cms%get_momentum & (i_phs, rsub%reg_data%n_legs_real) end if call vector4_write (p_gluon / p_gluon%p(0), show_mass = .true.) end subroutine check_soft_vector end function real_subtraction_compute_sub_soft @ %def real_subtraction_compute_sub_soft @ <>= procedure :: get_spin_correlation_term => real_subtraction_get_spin_correlation_term <>= function real_subtraction_get_spin_correlation_term (rsub, alr, i_born, emitter) & result (mom_times_sqme) real(default) :: mom_times_sqme class(real_subtraction_t), intent(in) :: rsub integer, intent(in) :: alr, i_born, emitter real(default), dimension(0:3) :: k_perp integer :: mu, nu if (rsub%sc_required(alr)) then if (debug2_active(D_SUBTRACTION)) call check_me_consistency () associate (real_kin => rsub%real_kinematics) if (emitter > rsub%reg_data%n_in) then k_perp = real_subtraction_compute_k_perp_fsr ( & real_kin%p_born_lab%get_momentum(1, emitter), & rsub%real_kinematics%phi) else k_perp = real_subtraction_compute_k_perp_isr ( & real_kin%p_born_lab%get_momentum(1, emitter), & rsub%real_kinematics%phi) end if end associate mom_times_sqme = zero do mu = 1, 3 do nu = 1, 3 mom_times_sqme = mom_times_sqme + & k_perp(mu) * k_perp(nu) * rsub%sqme_born_spin_c (mu, nu, emitter, i_born) end do end do else mom_times_sqme = zero end if contains subroutine check_me_consistency () real(default) :: sqme_sum if (debug_on) call msg_debug2 (D_SUBTRACTION, "Spin-correlation: Consistency check") sqme_sum = rsub%sqme_born_spin_c(1,1,emitter,i_born) & - rsub%sqme_born_spin_c(2,2,emitter,i_born) & - rsub%sqme_born_spin_c(3,3,emitter,i_born) if (.not. nearly_equal (sqme_sum, -rsub%sqme_born(i_born), 0.0001_default)) then print *, 'Spin-correlated matrix elements are not consistent: ' print *, 'emitter: ', emitter print *, 'g^{mu,nu} B_{mu,nu}: ', -sqme_sum print *, 'all Born matrix elements: ', rsub%sqme_born call msg_fatal ("FAIL") else call msg_print_color ("Success", COL_GREEN) end if end subroutine check_me_consistency end function real_subtraction_get_spin_correlation_term @ %def real_subtraction_get_spin_correlation_term @ Construct a normalised momentum perpendicular to momentum [[p]] and rotate by an arbitrary angle [[phi]]. The angular conventions we use here are equivalent to those used by POWHEG. <>= public :: real_subtraction_compute_k_perp_fsr, & real_subtraction_compute_k_perp_isr <>= function real_subtraction_compute_k_perp_fsr (p, phi) result (k_perp_fsr) real(default), dimension(0:3) :: k_perp_fsr type(vector4_t), intent(in) :: p real(default), intent(in) :: phi type(vector4_t) :: k type(vector3_t) :: vec type(lorentz_transformation_t) :: rot vec = p%p(1:3) / p%p(0) k%p(0) = zero k%p(1) = p%p(1); k%p(2) = p%p(2) k%p(3) = - (p%p(1)**2 + p%p(2)**2) / p%p(3) rot = rotation (cos(phi), sin(phi), vec) k = rot * k k%p(1:3) = k%p(1:3) / space_part_norm (k) k_perp_fsr = k%p end function real_subtraction_compute_k_perp_fsr function real_subtraction_compute_k_perp_isr (p, phi) result (k_perp_isr) real(default), dimension(0:3) :: k_perp_isr type(vector4_t), intent(in) :: p real(default), intent(in) :: phi k_perp_isr(0) = zero k_perp_isr(1) = sin(phi) k_perp_isr(2) = cos(phi) k_perp_isr(3) = zero end function real_subtraction_compute_k_perp_isr @ %def real_subtraction_compute_k_perp_fsr, real_subtraction_compute_k_perp_isr @ <>= procedure :: compute_sub_coll => real_subtraction_compute_sub_coll <>= function real_subtraction_compute_sub_coll (rsub, alr, em, i_phs, alpha_coupling) & result (sqme_coll) real(default) :: sqme_coll class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, em, i_phs real(default), intent(in) :: alpha_coupling real(default) :: xi, xi_max real(default) :: mom_times_sqme_spin_c integer :: i_con real(default) :: pfr associate (sregion => rsub%reg_data%regions(alr)) sqme_coll = zero if (sregion%has_collinear_divergence ()) then xi = rsub%real_kinematics%xi_tilde * rsub%real_kinematics%xi_max(i_phs) if (rsub%sub_coll%use_resonance_mappings) then i_con = rsub%reg_data%alr_to_i_contributor (alr) else i_con = 1 end if mom_times_sqme_spin_c = rsub%get_spin_correlation_term (alr, sregion%uborn_index, em) if (em <= rsub%sub_coll%n_in) then select case (rsub%isr_kinematics%isr_mode) case (SQRTS_FIXED) xi_max = rsub%real_kinematics%xi_max(i_phs) case (SQRTS_VAR) xi_max = one - rsub%isr_kinematics%x(em) end select xi = rsub%real_kinematics%xi_tilde * xi_max if (sregion%nlo_correction_type == "QCD") then call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR) else if (sregion%nlo_correction_type == "EW") then call rsub%sub_coll%set_parameters (CA = zero, & CF = sregion%flst_real%charge(em)**2, & TR = sregion%flst_real%charge(size(sregion%flst_real%flst))**2) end if sqme_coll = rsub%sub_coll%compute_isr (em, sregion%flst_real%flst, & rsub%real_kinematics%p_born_lab%phs_point(1)%p, & rsub%sqme_born(sregion%uborn_index) * rsub%sf_factors(alr, em), & mom_times_sqme_spin_c * rsub%sf_factors(alr, em), & xi, alpha_coupling, rsub%isr_kinematics%isr_mode) else if (sregion%nlo_correction_type == "QCD") then call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR) else if (sregion%nlo_correction_type == "EW") then call rsub%sub_coll%set_parameters (CA = zero, & CF = sregion%flst_real%charge(sregion%emitter)**2, & TR = sregion%flst_real%charge(sregion%emitter)**2) end if sqme_coll = rsub%sub_coll%compute_fsr (sregion%emitter, sregion%flst_real%flst, & rsub%real_kinematics%xi_ref_momenta (i_con), & rsub%real_kinematics%p_born_lab%get_momenta(1), & rsub%sqme_born(sregion%uborn_index), & mom_times_sqme_spin_c, & xi, alpha_coupling, sregion%double_fsr) if (rsub%sub_coll%use_resonance_mappings) then select type (fks_mapping => rsub%reg_data%fks_mapping) type is (fks_mapping_resonances_t) pfr = fks_mapping%get_resonance_weight (alr, & rsub%real_kinematics%p_born_cms%get_momenta(1)) end select sqme_coll = sqme_coll * pfr end if end if end if end associate end function real_subtraction_compute_sub_coll @ %def real_subtraction_compute_sub_coll @ Computes the soft-collinear subtraction term. For alpha regions with emitter $0$, this routine is called with [[em == 1]] and [[em == 2]] separately. To still be able to use the unrescaled pdf factors stored in [[sf_factors(alr, 0)]] in this case, we need to differentiate between [[em]] and [[em_pdf]]. <>= procedure :: compute_sub_coll_soft => real_subtraction_compute_sub_coll_soft <>= function real_subtraction_compute_sub_coll_soft (rsub, alr, em, i_phs, alpha_coupling) & result (sqme_cs) real(default) :: sqme_cs class(real_subtraction_t), intent(inout) :: rsub integer, intent(in) :: alr, em, i_phs real(default), intent(in) :: alpha_coupling real(default) :: mom_times_sqme_spin_c integer :: i_con, em_pdf associate (sregion => rsub%reg_data%regions(alr)) sqme_cs = zero if (sregion%has_collinear_divergence ()) then if (rsub%sub_coll%use_resonance_mappings) then i_con = rsub%reg_data%alr_to_i_contributor (alr) else i_con = 1 end if mom_times_sqme_spin_c = rsub%get_spin_correlation_term (alr, sregion%uborn_index, em) if (em <= rsub%sub_coll%n_in) then em_pdf = sregion%emitter if (sregion%nlo_correction_type == "QCD") then call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR) else if (sregion%nlo_correction_type == "EW") then call rsub%sub_coll%set_parameters (CA = zero, & CF = sregion%flst_real%charge(em)**2, & TR = sregion%flst_real%charge(size(sregion%flst_real%flst))**2) end if sqme_cs = rsub%sub_coll%compute_isr (em, sregion%flst_real%flst, & rsub%real_kinematics%p_born_lab%phs_point(1)%p, & rsub%sqme_born(sregion%uborn_index) * rsub%sf_factors(alr, em_pdf), & mom_times_sqme_spin_c * rsub%sf_factors(alr, em_pdf), & zero, alpha_coupling, rsub%isr_kinematics%isr_mode) else if (sregion%nlo_correction_type == "QCD") then call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR) else if (sregion%nlo_correction_type == "EW") then call rsub%sub_coll%set_parameters (CA = zero, & CF = sregion%flst_real%charge(sregion%emitter)**2, & TR = sregion%flst_real%charge(sregion%emitter)**2) end if sqme_cs = rsub%sub_coll%compute_fsr (sregion%emitter, sregion%flst_real%flst, & rsub%real_kinematics%xi_ref_momenta(i_con), & rsub%real_kinematics%p_born_lab%phs_point(1)%p, & rsub%sqme_born(sregion%uborn_index), & mom_times_sqme_spin_c, & zero, alpha_coupling, sregion%double_fsr) end if end if end associate end function real_subtraction_compute_sub_coll_soft @ %def real_subtraction_compute_sub_coll_soft <>= procedure :: requires_spin_correlations => & real_subtraction_requires_spin_correlations <>= function real_subtraction_requires_spin_correlations (rsub) result (val) logical :: val class(real_subtraction_t), intent(in) :: rsub val = any (rsub%sc_required) end function real_subtraction_requires_spin_correlations @ %def real_subtraction_requires_spin_correlations @ <>= procedure :: final => real_subtraction_final <>= subroutine real_subtraction_final (rsub) class(real_subtraction_t), intent(inout) :: rsub call rsub%sub_soft%final () call rsub%sub_coll%final () !!! Finalization of region data is done in pcm_nlo_final if (associated (rsub%reg_data)) nullify (rsub%reg_data) !!! Finalization of real kinematics is done in pcm_instance_nlo_final if (associated (rsub%real_kinematics)) nullify (rsub%real_kinematics) if (associated (rsub%isr_kinematics)) nullify (rsub%isr_kinematics) if (allocated (rsub%sqme_real_non_sub)) deallocate (rsub%sqme_real_non_sub) if (allocated (rsub%sqme_born)) deallocate (rsub%sqme_born) if (allocated (rsub%sf_factors)) deallocate (rsub%sf_factors) if (allocated (rsub%sqme_born_color_c)) deallocate (rsub%sqme_born_color_c) if (allocated (rsub%sqme_born_charge_c)) deallocate (rsub%sqme_born_charge_c) if (allocated (rsub%sc_required)) deallocate (rsub%sc_required) if (allocated (rsub%selected_alr)) deallocate (rsub%selected_alr) end subroutine real_subtraction_final @ %def real_subtraction_final @ \subsubsection{Partitions of the real matrix element and Powheg damping} <>= public :: real_partition_t <>= type, abstract :: real_partition_t contains <> end type real_partition_t @ %def real partition_t @ <>= procedure (real_partition_init), deferred :: init <>= abstract interface subroutine real_partition_init (partition, scale, reg_data) import class(real_partition_t), intent(out) :: partition real(default), intent(in) :: scale type(region_data_t), intent(in) :: reg_data end subroutine real_partition_init end interface @ %def real_partition_init @ <>= procedure (real_partition_write), deferred :: write <>= abstract interface subroutine real_partition_write (partition, unit) import class(real_partition_t), intent(in) :: partition integer, intent(in), optional :: unit end subroutine real_partition_write end interface @ %def real_partition_write @ To allow really arbitrary damping functions, [[get_f]] should get the full real phase space as argument and not just some [[pt2]] that is extracted higher up. <>= procedure (real_partition_get_f), deferred :: get_f <>= abstract interface function real_partition_get_f (partition, p) result (f) import real(default) :: f class(real_partition_t), intent(in) :: partition type(vector4_t), intent(in), dimension(:) :: p end function real_partition_get_f end interface @ %def real_partition_get_f @ <>= public :: powheg_damping_simple_t <>= type, extends (real_partition_t) :: powheg_damping_simple_t real(default) :: h2 = 5._default integer :: emitter contains <> end type powheg_damping_simple_t @ %def powheg_damping_simple_t @ <>= procedure :: get_f => powheg_damping_simple_get_f <>= function powheg_damping_simple_get_f (partition, p) result (f) real(default) :: f class(powheg_damping_simple_t), intent(in) :: partition type(vector4_t), intent(in), dimension(:) :: p !!! real(default) :: pt2 f = 1 call msg_bug ("Simple damping currently not available") !!! TODO (cw-2017-03-01) Compute pt2 from emitter) !!! f = partition%h2 / (pt2 + partition%h2) end function powheg_damping_simple_get_f @ %def powheg_damping_simple_get_f @ <>= procedure :: init => powheg_damping_simple_init <>= subroutine powheg_damping_simple_init (partition, scale, reg_data) class(powheg_damping_simple_t), intent(out) :: partition real(default), intent(in) :: scale type(region_data_t), intent(in) :: reg_data partition%h2 = scale**2 end subroutine powheg_damping_simple_init @ %def powheg_damping_simple_init @ <>= procedure :: write => powheg_damping_simple_write <>= subroutine powheg_damping_simple_write (partition, unit) class(powheg_damping_simple_t), intent(in) :: partition integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(1x,A)") "Powheg damping simple: " write (u, "(1x,A, "// FMT_15 // ")") "scale h2: ", partition%h2 end subroutine powheg_damping_simple_write @ %def powheg_damping_simple_write @ <>= public :: real_partition_fixed_order_t <>= type, extends (real_partition_t) :: real_partition_fixed_order_t real(default) :: scale type(ftuple_t), dimension(:), allocatable :: fks_pairs contains <> end type real_partition_fixed_order_t @ %def real_partition_fixed_order_t @ <>= procedure :: init => real_partition_fixed_order_init <>= subroutine real_partition_fixed_order_init (partition, scale, reg_data) class(real_partition_fixed_order_t), intent(out) :: partition real(default), intent(in) :: scale type(region_data_t), intent(in) :: reg_data end subroutine real_partition_fixed_order_init @ %def real_partition_fixed_order_init @ <>= procedure :: write => real_partition_fixed_order_write <>= subroutine real_partition_fixed_order_write (partition, unit) class(real_partition_fixed_order_t), intent(in) :: partition integer, intent(in), optional :: unit end subroutine real_partition_fixed_order_write @ %def real_partition_fixed_order_write @ <>= procedure :: get_f => real_partition_fixed_order_get_f <>= function real_partition_fixed_order_get_f (partition, p) result (f) real(default) :: f class(real_partition_fixed_order_t), intent(in) :: partition type(vector4_t), intent(in), dimension(:) :: p integer :: i f = zero do i = 1, size (partition%fks_pairs) associate (ii => partition%fks_pairs(i)%ireg) if ((p(ii(1)) + p(ii(2)))**1 < p(ii(1))**1 + p(ii(2))**1 + partition%scale) then f = one exit end if end associate end do end function real_partition_fixed_order_get_f @ %def real_partition_fixed_order_get_f @ \subsection{Unit tests} Test module, followed by the corresponding implementation module. <<[[real_subtraction_ut.f90]]>>= <> module real_subtraction_ut use unit_tests use real_subtraction_uti <> <> contains <> end module real_subtraction_ut @ %def real_subtraction_ut @ <<[[real_subtraction_uti.f90]]>>= <> module real_subtraction_uti <> use physics_defs use lorentz use numeric_utils use real_subtraction <> <> contains <> end module real_subtraction_uti @ %def real_subtraction_ut @ API: driver for the unit tests below. <>= public :: real_subtraction_test <>= subroutine real_subtraction_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine real_subtraction_test @ %def real_subtraction_test @ Test the final-state collinear subtraction. <>= call test (real_subtraction_1, "real_subtraction_1", & "final-state collinear subtraction", & u, results) <>= public :: real_subtraction_1 <>= subroutine real_subtraction_1 (u) integer, intent(in) :: u type(coll_subtraction_t) :: coll_sub real(default) :: sqme_coll type(vector4_t) :: p_res type(vector4_t), dimension(5) :: p_born real(default), dimension(4) :: k_perp real(default), dimension(4,4) :: b_munu integer :: mu, nu real(default) :: born, born_c integer, dimension(6) :: flst p_born(1)%p = [500, 0, 0, 500] p_born(2)%p = [500, 0, 0, -500] p_born(3)%p = [3.7755E+02, 2.2716E+02, -95.4172, 2.8608E+02] p_born(4)%p = [4.9529E+02, -2.739E+02, 84.8535, -4.0385E+02] p_born(5)%p = [1.2715E+02, 46.7375, 10.5637, 1.1778E+02] p_res = p_born(1) + p_born(2) flst = [11, -11 , -2, 2, -2, 2] b_munu(1, :) = [0., 0., 0., 0.] b_munu(2, :) = [0., 1., 1., 1.] b_munu(3, :) = [0., 1., 1., 1.] b_munu(4, :) = [0., 1., 1., 1.] k_perp = real_subtraction_compute_k_perp_fsr (p = p_born(5), phi = 0.5_default) born = - b_munu(1, 1) + b_munu(2, 2) + b_munu(3, 3) + b_munu(4, 4) born_c = 0. do mu = 1, 4 do nu = 1, 4 born_c = born_c + k_perp(mu) * k_perp(nu) * b_munu(mu, nu) end do end do write (u, "(A)") "* Test output: real_subtraction_1" write (u, "(A)") "* Purpose: final-state collinear subtraction" write (u, "(A)") write (u, "(A, L1)") "* vanishing scalar-product of 3-momenta k_perp and p_born(emitter): ", & nearly_equal (dot_product (p_born(5)%p(1:3), k_perp(2:4)), 0._default) call coll_sub%init (n_alr = 1, n_in = 2) call coll_sub%set_parameters (CA, CF, TR) write (u, "(A)") write (u, "(A)") "* g -> qq splitting" write (u, "(A)") sqme_coll = coll_sub%compute_fsr(5, flst, p_res, p_born, & born, born_c, 0.5_default, 0.25_default, .false.) write (u, "(A,F15.12)") "ME: ", sqme_coll write (u, "(A)") write (u, "(A)") "* g -> gg splitting" write (u, "(A)") b_munu(1, :) = [0., 0., 0., 0.] b_munu(2, :) = [0., 0., 0., 1.] b_munu(3, :) = [0., 0., 1., 1.] b_munu(4, :) = [0., 0., 1., 1.] k_perp = real_subtraction_compute_k_perp_fsr (p = p_born(5), phi = 0.5_default) born = - b_munu(1, 1) + b_munu(2, 2) + b_munu(3, 3) + b_munu(4, 4) born_c = 0. do mu = 1, 4 do nu = 1, 4 born_c = born_c + k_perp(mu) * k_perp(nu) * b_munu(mu, nu) end do end do flst = [11, -11, 2, -2, 21, 21] sqme_coll = coll_sub%compute_fsr(5, flst, p_res, p_born, & born, born_c, 0.5_default, 0.25_default, .true.) write (u, "(A,F15.12)") "ME: ", sqme_coll write (u, "(A)") write (u, "(A)") "* Test output end: real_subtraction_1" write (u, "(A)") end subroutine real_subtraction_1 @ %def real_subtraction_1 @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Combining the FKS Pieces} <<[[nlo_data.f90]]>>= <> module nlo_data <> <> use diagnostics use constants, only: zero use string_utils, only: split_string, read_ival, string_contains_word use io_units use lorentz use variables, only: var_list_t use format_defs, only: FMT_15 use physics_defs, only: THR_POS_WP, THR_POS_WM use physics_defs, only: THR_POS_B, THR_POS_BBAR use physics_defs, only: NO_FACTORIZATION, FACTORIZATION_THRESHOLD <> <> <> <> <> contains <> end module nlo_data @ %def nlo_data @ <>= integer, parameter, public :: FKS_DEFAULT = 1 integer, parameter, public :: FKS_RESONANCES = 2 integer, dimension(2), parameter, public :: ASSOCIATED_LEG_PAIR = [1, 3] @ %def parameters @ <>= public :: fks_template_t <>= type :: fks_template_t logical :: subtraction_disabled = .false. integer :: mapping_type = FKS_DEFAULT logical :: count_kinematics = .false. real(default) :: fks_dij_exp1 real(default) :: fks_dij_exp2 real(default) :: xi_min real(default) :: y_max real(default) :: xi_cut, delta_o, delta_i type(string_t), dimension(:), allocatable :: excluded_resonances integer :: n_f contains <> end type fks_template_t @ %def fks_template_t @ <>= procedure :: write => fks_template_write <>= subroutine fks_template_write (template, unit) class(fks_template_t), intent(in) :: template integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit) write (u,'(1x,A)') 'FKS Template: ' write (u,'(1x,A)', advance = 'no') 'Mapping Type: ' select case (template%mapping_type) case (FKS_DEFAULT) write (u,'(A)') 'Default' case (FKS_RESONANCES) write (u,'(A)') 'Resonances' case default write (u,'(A)') 'Unkown' end select write (u,'(1x,A,ES4.3,ES4.3)') 'd_ij exponentials: ', & template%fks_dij_exp1, template%fks_dij_exp2 write (u, '(1x,A,ES4.3,ES4.3)') 'xi_cut: ', & template%xi_cut write (u, '(1x,A,ES4.3,ES4.3)') 'delta_o: ', & template%delta_o write (u, '(1x,A,ES4.3,ES4.3)') 'delta_i: ', & template%delta_i end subroutine fks_template_write @ %def fks_template_write @ Set FKS parameters. $\xi_{\text{cut}}, \delta_o$ and $\delta_{\mathrm{I}}$ steer the ratio of the integrated and real subtraction. <>= procedure :: set_parameters => fks_template_set_parameters <>= subroutine fks_template_set_parameters (template, exp1, exp2, xi_min, & y_max, xi_cut, delta_o, delta_i) class(fks_template_t), intent(inout) :: template real(default), intent(in) :: exp1, exp2 real(default), intent(in) :: xi_min, y_max, & xi_cut, delta_o, delta_i template%fks_dij_exp1 = exp1 template%fks_dij_exp2 = exp2 template%xi_min = xi_min template%y_max = y_max template%xi_cut = xi_cut template%delta_o = delta_o template%delta_i = delta_i end subroutine fks_template_set_parameters @ %def fks_template_set_parameters <>= procedure :: set_mapping_type => fks_template_set_mapping_type <>= subroutine fks_template_set_mapping_type (template, val) class(fks_template_t), intent(inout) :: template integer, intent(in) :: val template%mapping_type = val end subroutine fks_template_set_mapping_type @ %def fks_template_set_mapping_type @ <>= procedure :: set_counter => fks_template_set_counter <>= subroutine fks_template_set_counter (template) class(fks_template_t), intent(inout) :: template template%count_kinematics = .true. end subroutine fks_template_set_counter @ %def fks_template_set_counter @ <>= public :: real_scales_t <>= type :: real_scales_t real(default) :: scale real(default) :: ren_scale real(default) :: fac_scale real(default) :: scale_born real(default) :: fac_scale_born real(default) :: ren_scale_born end type real_scales_t @ %def real_scales_t @ <>= public :: get_threshold_momenta <>= function get_threshold_momenta (p) result (p_thr) type(vector4_t), dimension(4) :: p_thr type(vector4_t), intent(in), dimension(:) :: p p_thr(1) = p(THR_POS_WP) + p(THR_POS_B) p_thr(2) = p(THR_POS_B) p_thr(3) = p(THR_POS_WM) + p(THR_POS_BBAR) p_thr(4) = p(THR_POS_BBAR) end function get_threshold_momenta @ %def get_threshold_momenta @ \subsection{Putting it together} <>= public :: nlo_settings_t <>= type :: nlo_settings_t logical :: use_internal_color_correlations = .true. logical :: use_internal_spin_correlations = .false. logical :: use_resonance_mappings = .false. logical :: combined_integration = .false. logical :: fixed_order_nlo = .false. logical :: test_soft_limit = .false. logical :: test_coll_limit = .false. logical :: test_anti_coll_limit = .false. integer, dimension(:), allocatable :: selected_alr integer :: factorization_mode = NO_FACTORIZATION !!! Probably not the right place for this. Revisit after refactoring real(default) :: powheg_damping_scale = zero type(fks_template_t) :: fks_template type(string_t) :: virtual_selection logical :: virtual_resonance_aware_collinear = .true. logical :: use_born_scale = .false. logical :: cut_all_real_sqmes = .false. type(string_t) :: nlo_correction_type logical :: reuse_amplitudes_fks = .false. contains <> end type nlo_settings_t @ %def nlo_settings_t @ <>= procedure :: init => nlo_settings_init <>= subroutine nlo_settings_init (nlo_settings, var_list, fks_template) class(nlo_settings_t), intent(inout) :: nlo_settings type(var_list_t), intent(in) :: var_list type(fks_template_t), intent(in), optional :: fks_template type(string_t) :: color_method if (present (fks_template)) nlo_settings%fks_template = fks_template color_method = var_list%get_sval (var_str ('$correlation_me_method')) if (color_method == "") color_method = var_list%get_sval (var_str ('$method')) nlo_settings%use_internal_color_correlations = color_method == 'omega' & .or. color_method == 'threshold' nlo_settings%combined_integration = var_list%get_lval & (var_str ("?combined_nlo_integration")) nlo_settings%fixed_order_nlo = var_list%get_lval & (var_str ("?fixed_order_nlo_events")) nlo_settings%test_soft_limit = var_list%get_lval (var_str ('?test_soft_limit')) nlo_settings%test_coll_limit = var_list%get_lval (var_str ('?test_coll_limit')) nlo_settings%test_anti_coll_limit = var_list%get_lval (var_str ('?test_anti_coll_limit')) call setup_alr_selection () nlo_settings%virtual_selection = var_list%get_sval (var_str ('$virtual_selection')) nlo_settings%virtual_resonance_aware_collinear = & var_list%get_lval (var_str ('?virtual_collinear_resonance_aware')) nlo_settings%powheg_damping_scale = & var_list%get_rval (var_str ('powheg_damping_scale')) nlo_settings%use_born_scale = & var_list%get_lval (var_str ("?nlo_use_born_scale")) nlo_settings%cut_all_real_sqmes = & var_list%get_lval (var_str ("?nlo_cut_all_real_sqmes")) nlo_settings%nlo_correction_type = var_list%get_sval (var_str ('$nlo_correction_type')) nlo_settings%reuse_amplitudes_fks = var_list%get_lval (var_str ('?nlo_reuse_amplitudes_fks')) contains subroutine setup_alr_selection () type(string_t) :: alr_selection type(string_t), dimension(:), allocatable :: alr_split integer :: i, i1, i2 alr_selection = var_list%get_sval (var_str ('$select_alpha_regions')) if (string_contains_word (alr_selection, var_str (","))) then call split_string (alr_selection, var_str (","), alr_split) allocate (nlo_settings%selected_alr (size (alr_split))) do i = 1, size (alr_split) nlo_settings%selected_alr(i) = read_ival(alr_split(i)) end do else if (string_contains_word (alr_selection, var_str (":"))) then call split_string (alr_selection, var_str (":"), alr_split) if (size (alr_split) == 2) then i1 = read_ival (alr_split(1)) i2 = read_ival (alr_split(2)) allocate (nlo_settings%selected_alr (i2 - i1 + 1)) do i = 1, i2 - i1 + 1 nlo_settings%selected_alr(i) = read_ival (alr_split(i)) end do else call msg_fatal ("select_alpha_regions: ':' specifies a range!") end if else if (len(alr_selection) == 1) then allocate (nlo_settings%selected_alr (1)) nlo_settings%selected_alr(1) = read_ival (alr_selection) end if if (allocated (alr_split)) deallocate (alr_split) end subroutine setup_alr_selection end subroutine nlo_settings_init @ %def nlo_settings_init @ <>= procedure :: write => nlo_settings_write <>= subroutine nlo_settings_write (nlo_settings, unit) class(nlo_settings_t), intent(in) :: nlo_settings integer, intent(in), optional :: unit integer :: i, u u = given_output_unit (unit); if (u < 0) return write (u, '(A)') 'nlo_settings:' write (u, '(3X,A,L1)') 'internal_color_correlations = ', & nlo_settings%use_internal_color_correlations write (u, '(3X,A,L1)') 'internal_spin_correlations = ', & nlo_settings%use_internal_spin_correlations write (u, '(3X,A,L1)') 'use_resonance_mappings = ', & nlo_settings%use_resonance_mappings write (u, '(3X,A,L1)') 'combined_integration = ', & nlo_settings%combined_integration write (u, '(3X,A,L1)') 'test_soft_limit = ', & nlo_settings%test_soft_limit write (u, '(3X,A,L1)') 'test_coll_limit = ', & nlo_settings%test_coll_limit write (u, '(3X,A,L1)') 'test_anti_coll_limit = ', & nlo_settings%test_anti_coll_limit if (allocated (nlo_settings%selected_alr)) then write (u, '(3x,A)', advance = "no") 'selected alpha regions = [' do i = 1, size (nlo_settings%selected_alr) write (u, '(A,I0)', advance = "no") ",", nlo_settings%selected_alr(i) end do write (u, '(A)') "]" end if write (u, '(3X,A,' // FMT_15 // ')') 'powheg_damping_scale = ', & nlo_settings%powheg_damping_scale write (u, '(3X,A,A)') 'virtual_selection = ', & char (nlo_settings%virtual_selection) write (u, '(3X,A,A)') 'Real factorization mode = ', & char (factorization_mode (nlo_settings%factorization_mode)) contains function factorization_mode (fm) type(string_t) :: factorization_mode integer, intent(in) :: fm select case (fm) case (NO_FACTORIZATION) factorization_mode = var_str ("None") case (FACTORIZATION_THRESHOLD) factorization_mode = var_str ("Threshold") case default factorization_mode = var_str ("Undefined!") end select end function factorization_mode end subroutine nlo_settings_write @ %def nlo_settings_write @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Contribution of divergencies due to PDF Evolution} References: \begin{itemize} \item arXiv:hep-ph/9512328, (2.1)-(2.5), (4.29)-(4.53) \item arXiv:0709.2092, (2.102)-(2.106) \end{itemize} The parton distrubition densities have to be evaluated at NLO, too. The NLO PDF evolution is given by \begin{equation} \label{eqn:pdf_nlo} f (\bar{x}) = \int_0^1 \int_0^1 dx dz f(x) \Gamma(z) \delta (\bar{x} - x z), \end{equation} where $\Gamma$ are the DGLAP evolution kernels for an $a \to d$ splitting, \begin{equation} \label{eqn:dglap} \Gamma_a^{(d)} = \delta_{ad}\delta(1-x) - \frac{\alpha_s}{2\pi} \left(\frac{1}{\epsilon} P_{ad}(x,0) - K_{ad}(x)\right) + \mathcal{O}(\alpha_s^2). \end{equation} $K_{ad}$ is a renormalization scheme matching factor, which is exactly zero in $\overline{\text{MS}}$. Let the leading-order hadronic cross section be given by \begin{equation} \label{eqn:xsec_hadro_lo} d\sigma^{(0)}(s) = \int dx_\oplus dx_\ominus f_\oplus (x_\oplus) f_\ominus (x_\ominus) d\tilde{\sigma}^{(0)} (x_\oplus x_\ominus s), \end{equation} then the NLO hadronic cross section is \begin{equation} \label{eqn:xsec_hadro_nlo} d\sigma^{(1)}(s) = \int dx_\oplus dx_\ominus dz_\oplus dz_\ominus f_\oplus (x_\oplus) f_\ominus (x_\ominus) \underbrace{\Gamma_\oplus (z_\oplus) \Gamma_\ominus (z_\ominus) d\tilde{\sigma}^{(1)} (z_\oplus z_\ominus s)}_{d\hat{\sigma}^{(1)}}. \end{equation} $d\hat{\sigma}$ is called the subtracted partonic cross section. Expanding in $\alpha_s$ we find \begin{align} d\hat{\sigma}^{(0)}_{ab}(k_1, k_2) &= d\tilde{\sigma}_{ab}^{(0)} (k_1, k_2), \\ d\hat{\sigma}^{(1)}_{ab}(k_1, k_2) &= d\tilde{\sigma}_{ab}^{(1)} (k_1, k_2) \\ &+ \frac{\alpha_s}{2\pi} \sum_d \int dx \left (\frac{1}{\epsilon} P_{da}(x,0) - K_{da}(x)\right) d\tilde{\sigma}_{db}^{(0)}(xk_1, k_2)\\ &+ \frac{\alpha_s}{2\pi} \sum_d \int \left (\frac{1}{\epsilon} P_{db} (x, 0) - K_{db}(x)\right) d\tilde{\sigma}_{ad}^{(0)}(k_1, xk_2).\\ &= d\tilde{\sigma}_{ab}^{(1)} + d\tilde{\sigma}_{ab}^{(cnt,+)} + d\tilde{\sigma}_{ab}^{(cnt,-)} \end{align} Let us now turn to the soft-subtracted real part of the cross section. For ease of notation, it is constrained to one singular region, \begin{align*} \label{eqn:R-in} d\sigma^{(in)}_\alpha &= \left[\left(\frac{1}{\xi}\right)_{c} - 2\epsilon\left(\frac{\log \xi}{\xi}\right)_{c}\right] (1-y^2)\xi^2 \mathcal{R}_\alpha \mathcal{S}_\alpha \\ &\times \frac{1}{2(2\pi)^{3-2\epsilon}} \left(\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} \left( 1 - y^2\right)^{-1-\epsilon} d\phi d\xi dy d\Omega^{2-2\epsilon}, \end{align*} where we regularize collinear divergencies using the identity \begin{equation*} \left (1 - y^2 \right)^{-1-\epsilon} = -\frac{2^{-\epsilon}}{2\epsilon} \left (\delta(1-y) + \delta(1+y)\right) + \underbrace{\frac{1}{2} \left[ \left (\frac {1}{1-y}\right)_{c} + \left (\frac{1}{1+y}\right)_{c} \right]}_{\mathcal{P}(y)}. \end{equation*} This enables us to split the cross section into a finite and a singular part. The latter can further be separated into a contribution of the incoming and of the outgoing particles, \begin{equation*} d\sigma^{(in)}_\alpha = d\sigma^{(in,+)}_\alpha + d\sigma^{(in,-)}_\alpha + d\sigma^{(in,f)}_\alpha. \end{equation*} They are given by \begin{align} d\sigma^{(in,f)}_\alpha = & \mathcal{P}(y) \left[\left(\frac{1}{\xi}\right)_{c} - 2\epsilon \left(\frac{\log\xi}{\xi}\right)_{c}\right] \frac{1}{2(2\pi)^{3-2\epsilon}} \left(\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} \nonumber\\ & \times (1-y^2)\xi^2 \mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy d\Omega^{2-2\epsilon} \label{eqn:sigma-f} \end{align} and \begin{align} d\sigma^{(in,\pm)}_\alpha &= -\frac{2^{-\epsilon}}{2\epsilon} \delta (1 \mp y) \left[ \left( \frac{1}{\xi}\right)_{c} - 2\epsilon \left(\frac{\log\xi}{\xi}\right)_{c}\right] \nonumber\\ & \times \frac{1}{2(2\pi)^{3-2\epsilon}} \left( \frac{\sqrt{s}}{2}\right)^{2-2\epsilon} (1-y^2)\xi^2 \mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy d\Omega^{2-2\epsilon}. \label{eqn:sigma-pm} \end{align} Equation \ref{eqn:sigma-f} is the contribution to the real cross section which is computed in [[evaluate_region_isr]]. It is regularized both in the soft and collinear limit via the plus distributions. Equation \ref{eqn:sigma-pm} is a different contribution. It is only present exactly in the collinear limit, due to the delta function. The divergences present in this term do not completely cancel out divergences in the virtual matrix element, because the beam axis is distinguished. Thus, the conditions in which the KLN theorem applies are not met. To see this, we carry out the collinear limit, obtaining \begin{equation*} \lim_{y \to 1} (1-y^2)\xi^2\mathcal{R}_\alpha = 8\pi\alpha_s \mu^{2\epsilon} \left(\frac{2}{\sqrt{s}}\right)^2 \xi P^<(1-\xi, \epsilon) \mathcal{R}_\alpha, \end{equation*} with the Altarelli-Parisi splitting kernel for $z < 1$, $P^<(z,\epsilon)$. Moreover, $\lim_{\vec{k} \parallel \vec{k}_1} d\phi = d\phi_3$ violates spatial averaging. The integration over the spherical angle $d\Omega$ can be carried out easily, yielding a factor of $2\pi^{1-\epsilon} / \Gamma(1-\epsilon)$. This allows us to redefine $\epsilon$, \begin{equation} \frac{1}{\epsilon} - \gamma_E + \log(4\pi) \to \frac{1}{\epsilon}. \end{equation} Coming back to $d\tilde{\sigma}_{ab}^{(cnt,+)}$ in order to make a connection to $d{\sigma}^{(in,+)}_\alpha$, we relate $P_{ab}(z,0)$ to $P^<_{ab}(z,0)$ via the equation \begin{equation*} P_{ab}(z,0) = (1-z)P_{ab}^<(z,0)\left(\frac{1}{1-z}\right)_+ + \gamma(a)\delta_{ab}\delta(1-z), \end{equation*} which yields \begin{equation} \label{eqn:sigma-cnt} d\tilde{\sigma}^{(cnt,+)}_{\alpha} = \frac{\alpha_s}{2\pi} \sum_d \left\lbrace -K_{da}(1-\xi) + \frac{1}{\epsilon} \left[\left(\frac{1}{\xi}\right)_+ \xi P_{da}^<(1-\xi,0) + \delta_{da}\delta(\xi)\gamma(d)\right]\right\rbrace \mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy. \end{equation} This term has the same pole structure as eqn. \ref{eqn:sigma-pm}. This makes clear that the quantity \begin{equation} d\hat{\sigma}^{(in,+)} = d\tilde{\sigma}^{(in,+)} + d\tilde{\sigma}^{(cnt,+)} \end{equation} has no collinear poles. Therefore, our task is to add up eqns. \ref{eqn:sigma-pm} and \ref{eqn:sigma-cnt} in order to compute the finite remainder. This is the integrand which is evaluated in the [[dglap_remnant]] component.\\ So, we have to perform an expansion of $d\hat{\sigma}^{(in,+)}$ in $\epsilon$. Hereby, we must not neglect the implicit $\epsilon$-dependence of $P^<$, which leads to additional terms involving the first derivative, \begin{equation*} P_{ab}^<(z,\epsilon) = P_{ab}^<(z,0) + \epsilon \frac{\partial P_{ab}^<(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} + \mathcal{O}(\alpha_s^2). \end{equation*} This finally gives us the equation for the collinear remnant. Note that there is still one soft $1/\epsilon$-pole, which cancels out with the corresponding expression in the soft-virtual terms. \begin{align} \label{eqn:sigma-in-p-final} d\hat{\sigma}^{(in,+)} &= \frac{\alpha_s}{2\pi} \frac{1}{\epsilon} \gamma(a) \mathcal{R}_\alpha \mathcal{S}_\alpha \nonumber\\ &+ \frac{\alpha_s}{2\pi} \sum_d \left\lbrace (1-z) P_{da}^<(z,0)\left[\left(\frac{1}{1-z}\right)_{c} \log\frac{s\delta_{\mathrm{I}}}{2\mu^2} + 2 \left(\frac{\log(1-z)}{1-z}\right)_{c}\right] \right. \nonumber\\ &\left . -(1-z)\frac{\partial P_{da}^<(z,\epsilon)}{\partial \epsilon} \left(\frac{1}{1-z}\right)_{c} - K_{da}(z)\right\rbrace \mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy \end{align} <<[[dglap_remnant.f90]]>>= <> module dglap_remnant <> <> use numeric_utils use diagnostics use constants use physics_defs use pdg_arrays use phs_fks, only: isr_kinematics_t use fks_regions, only: region_data_t use nlo_data <> <> <> contains <> end module dglap_remnant @ %def module dglap_remnant @ <>= public :: dglap_remnant_t <>= type :: dglap_remnant_t type(nlo_settings_t), pointer :: settings => null () type(region_data_t), pointer :: reg_data => null () type(isr_kinematics_t), pointer :: isr_kinematics => null () real(default), dimension(:), allocatable :: sqme_born real(default), dimension(:,:), allocatable :: sf_factors contains <> end type dglap_remnant_t @ %def dglap_remnant_t @ <>= procedure :: init => dglap_remnant_init <>= subroutine dglap_remnant_init (dglap, settings, reg_data, isr_kinematics) class(dglap_remnant_t), intent(inout) :: dglap type(nlo_settings_t), intent(in), target :: settings type(region_data_t), intent(in), target :: reg_data integer :: n_flv_born type(isr_kinematics_t), intent(in), target :: isr_kinematics dglap%reg_data => reg_data n_flv_born = reg_data%get_n_flv_born () allocate (dglap%sf_factors (reg_data%n_regions, 0:reg_data%n_in)) dglap%sf_factors = zero dglap%settings => settings allocate (dglap%sqme_born(n_flv_born)) dglap%sqme_born = zero dglap%isr_kinematics => isr_kinematics end subroutine dglap_remnant_init @ %def dglap_remnant_init @ Evaluates formula \ref{eqn:sigma-in-p-final}. Note that, as also in the case for the real subtraction, we have to take into account an additional term, occuring because the integral the plus distribution is evaluated over is not constrained on the interval $[0,1]$. Explicitly, this means (see JHEP 06(2010)043, (4.11)-(4.12)) \begin{align} \int_{\bar{x}_\oplus}^1 dz \left( \frac{1}{1-z} \right)_{\xi_{\text{cut}}} & = \log \frac{1-\bar{x}_\oplus}{\xi_{\text{cut}}} f(1) + \int_{\bar{x}_\oplus}^1 \frac{f(z) - f(1)}{1-z}, \\ \int_{\bar{x}_\oplus}^1 dz \left(\frac{\log(1-z)}{1-z}\right)_{\xi_{\text{cut}}} f(z) & = \frac{1}{2}\left( \log^2(1-\bar{x}_\oplus) - \log^2 (\xi_{\text{cut}}) \right)f(1) + \int_{\bar{x}_\oplus}^1 \frac{\log(1-z)[f(z) - f(1)]}{1-z}, \end{align} and the same of course for $\bar{x}_\ominus$. These two terms are stored in the [[plus_dist_remnant]] variable below. The option [[separate_uborns]] allows to compute the contribution of the DGLAP remnant separately for each underlying Born flavor structure. We need this option during event generation to generate counter events with a specific Born flavor structure. <>= procedure :: evaluate => dglap_remnant_evaluate <>= subroutine dglap_remnant_evaluate (dglap, alpha_s, separate_uborns, sqme_dglap) class(dglap_remnant_t), intent(inout) :: dglap real(default), intent(in) :: alpha_s logical, intent(in) :: separate_uborns real(default), intent(inout), dimension(:) :: sqme_dglap integer :: alr, emitter real(default) :: sqme_alr logical, dimension(:,:,:), allocatable :: evaluated real(default) :: sb, fac_scale2 sb = dglap%isr_kinematics%sqrts_born**2 fac_scale2 = dglap%isr_kinematics%fac_scale**2 allocate (evaluated(dglap%reg_data%get_n_flv_born (), dglap%reg_data%get_n_flv_real (), & dglap%reg_data%n_in)) evaluated = .false. do alr = 1, dglap%reg_data%n_regions sqme_alr = zero emitter = dglap%reg_data%regions(alr)%emitter if (emitter > dglap%reg_data%n_in) cycle associate (i_flv_born => dglap%reg_data%regions(alr)%uborn_index, & i_flv_real => dglap%reg_data%regions(alr)%real_index) if (emitter == 0) then do emitter = 1, 2 if (evaluated(i_flv_born, i_flv_real, emitter)) cycle call evaluate_alr (alr, emitter, i_flv_born, i_flv_real, sqme_alr, evaluated) end do else if (emitter > 0) then if (evaluated(i_flv_born, i_flv_real, emitter)) cycle call evaluate_alr (alr, emitter, i_flv_born, i_flv_real, sqme_alr, evaluated) end if if (separate_uborns) then sqme_dglap(i_flv_born) = sqme_dglap(i_flv_born) + alpha_s / twopi * sqme_alr else sqme_dglap(1) = sqme_dglap(1) + alpha_s / twopi * sqme_alr end if end associate end do contains <> end subroutine dglap_remnant_evaluate @ %def dglap_remnant_evaluate @ We introduce $\hat{P}(z, \epsilon) = (1 - z) P(z, \epsilon)$ and have \begin{align} \hat{P}_{g\to gg}(z) & = 2C_A \left[z + \frac{(1-z)^2}{z} + z(1-z)^2\right], \\ \hat{P}_{g\to qq}(z) & = C_F (1-z) \frac{1 + (1-z)^2}{z}, \\ \hat{P}_{q\to gq}(z) & = T_F (1 - z - 2z(1-z)^2), \\ \hat{P}_{q\to qg}(z) & = C_F (1 + z^2). \end{align} <>= function p_hat_gtogg (z) real(default) :: p_hat_gtogg <

> p_hat_gtogg = two * CA * (z + onemz**2 / z + z * onemz**2) end function p_hat_gtogg function p_hat_gtoqq (z) real(default) :: p_hat_gtoqq <

> p_hat_gtoqq = CF * onemz / z * (one + onemz**2) end function p_hat_gtoqq function p_hat_qtogq (z) real(default) :: p_hat_qtogq <

> p_hat_qtogq = TR * (onemz - two * z * onemz**2) end function p_hat_qtogq function p_hat_qtoqg (z) real(default) :: p_hat_qtoqg real(default), intent(in) :: z p_hat_qtoqg = CF * (one + z**2) end function p_hat_qtoqg @ %def p_hat_qtoqg, p_hat_qtogq, p_hat_gtoqq, p_hat_gtogg @ \begin{align} \frac{\partial P_{g\to gg}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = 0, \\ \frac{\partial P_{g\to qq}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = -C_F z, \\ \frac{\partial P_{q\to gq}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = - 2 T_F z (1-z), \\ \frac{\partial P_{q\to qg}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = -C_F (1-z).\\ \end{align} <>= function p_derived_gtogg (z) real(default) :: p_derived_gtogg real(default), intent(in) :: z p_derived_gtogg = zero end function p_derived_gtogg function p_derived_gtoqq (z) real(default) :: p_derived_gtoqq real(default), intent(in) :: z p_derived_gtoqq = -CF * z end function p_derived_gtoqq function p_derived_qtogq (z) real(default) :: p_derived_qtogq <

> p_derived_qtogq = -two * TR * z * onemz end function p_derived_qtogq function p_derived_qtoqg (z) real(default) :: p_derived_qtoqg <

> p_derived_qtoqg = -CF * onemz end function p_derived_qtoqg @ %def p_derived_gtogg, p_derived_gtoqq, p_derived_qtogq, p_derived_qtoqg @ <>= subroutine evaluate_alr (alr, emitter, i_flv_born, i_flv_real, sqme_alr, evaluated) integer, intent(in) :: alr, emitter, i_flv_born, i_flv_real real(default), intent(inout) :: sqme_alr logical, intent(inout), dimension(:,:,:) :: evaluated real(default) :: z, jac real(default) :: factor, factor_soft, plus_dist_remnant real(default) :: xb, onemz real(default) :: sqme_scaled integer :: flv_em, flv_rad associate (template => dglap%settings%fks_template) z = dglap%isr_kinematics%z(emitter) flv_rad = dglap%reg_data%regions(alr)%flst_real%flst(dglap%reg_data%n_legs_real) flv_em = dglap%reg_data%regions(alr)%flst_real%flst(emitter) jac = dglap%isr_kinematics%jacobian(emitter) onemz = one - z factor = log (sb * template%delta_i / two / z / fac_scale2) / & onemz + two * log (onemz) / onemz factor_soft = log (sb * template%delta_i / two / fac_scale2) / & onemz + two * log (onemz) / onemz xb = dglap%isr_kinematics%x(emitter) plus_dist_remnant = log ((one - xb) / template%xi_cut) * log (sb * template%delta_i / & two / fac_scale2) + (log (one - xb)**2 - log (template%xi_cut)**2) end associate sqme_scaled = dglap%sqme_born(i_flv_born) * dglap%sf_factors(alr, emitter) if (is_massless_vector (flv_em) .and. is_massless_vector (flv_rad)) then sqme_alr = sqme_alr + p_hat_gtogg(z) * factor / z * sqme_scaled * jac & - p_hat_gtogg(one) * factor_soft * dglap%sqme_born(i_flv_born) * jac & + p_hat_gtogg(one) * plus_dist_remnant * dglap%sqme_born(i_flv_born) else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then sqme_alr = sqme_alr + p_hat_qtoqg(z) * factor / z * sqme_scaled * jac & - p_derived_qtoqg(z) / z * sqme_scaled * jac & - p_hat_qtoqg(one) * factor_soft * dglap%sqme_born(i_flv_born) * jac & + p_hat_qtoqg(one) * plus_dist_remnant * dglap%sqme_born(i_flv_born) else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then sqme_alr = sqme_alr + (p_hat_gtoqq(z) * factor - p_derived_gtoqq(z)) / z * jac * & sqme_scaled else if (is_massless_vector (flv_em) .and. is_fermion (flv_rad)) then sqme_alr = sqme_alr + (p_hat_qtogq(z) * factor - p_derived_qtogq(z)) / z * sqme_scaled * jac else sqme_alr = sqme_alr + zero end if evaluated(i_flv_born, i_flv_real, emitter) = .true. end subroutine evaluate_alr @ %dglap_remnant_evaluate_alr @ <

>= real(default), intent(in) :: z real(default) :: onemz onemz = one - z @ %def variables @ <>= procedure :: final => dglap_remnant_final <>= subroutine dglap_remnant_final (dglap) class(dglap_remnant_t), intent(inout) :: dglap if (associated (dglap%isr_kinematics)) nullify (dglap%isr_kinematics) if (associated (dglap%reg_data)) nullify (dglap%reg_data) if (associated (dglap%settings)) nullify (dglap%settings) if (allocated (dglap%sqme_born)) deallocate (dglap%sqme_born) if (allocated (dglap%sf_factors)) deallocate (dglap%sf_factors) end subroutine dglap_remnant_final @ %def dglap_remnant_final @ \section{Dispatch} @ <<[[dispatch_fks.f90]]>>= <> module dispatch_fks <> <> use string_utils, only: split_string use variables, only: var_list_t use nlo_data, only: fks_template_t, FKS_DEFAULT, FKS_RESONANCES <> <> contains <> end module dispatch_fks @ %def dispatch_fks @ Initialize parameters used to optimize FKS calculations. <>= public :: dispatch_fks_s <>= subroutine dispatch_fks_s (fks_template, var_list) type(fks_template_t), intent(inout) :: fks_template type(var_list_t), intent(in) :: var_list real(default) :: fks_dij_exp1, fks_dij_exp2 type(string_t) :: fks_mapping_type logical :: subtraction_disabled type(string_t) :: exclude_from_resonance fks_dij_exp1 = & var_list%get_rval (var_str ("fks_dij_exp1")) fks_dij_exp2 = & var_list%get_rval (var_str ("fks_dij_exp2")) fks_mapping_type = & var_list%get_sval (var_str ("$fks_mapping_type")) subtraction_disabled = & var_list%get_lval (var_str ("?disable_subtraction")) exclude_from_resonance = & var_list%get_sval (var_str ("$resonances_exclude_particles")) if (exclude_from_resonance /= var_str ("default")) & call split_string (exclude_from_resonance, var_str (":"), & fks_template%excluded_resonances) call fks_template%set_parameters ( & exp1 = fks_dij_exp1, exp2 = fks_dij_exp2, & xi_min = var_list%get_rval (var_str ("fks_xi_min")), & y_max = var_list%get_rval (var_str ("fks_y_max")), & xi_cut = var_list%get_rval (var_str ("fks_xi_cut")), & delta_o = var_list%get_rval (var_str ("fks_delta_o")), & delta_i = var_list%get_rval (var_str ("fks_delta_i"))) select case (char (fks_mapping_type)) case ("default") call fks_template%set_mapping_type (FKS_DEFAULT) case ("resonances") call fks_template%set_mapping_type (FKS_RESONANCES) end select fks_template%subtraction_disabled = subtraction_disabled fks_template%n_f = var_list%get_ival (var_str ("alphas_nf")) end subroutine dispatch_fks_s @ %def dispatch_fks_s @ Index: trunk/vamp/share/doc/preview2.tex =================================================================== --- trunk/vamp/share/doc/preview2.tex (revision 8449) +++ trunk/vamp/share/doc/preview2.tex (revision 8450) @@ -1,1110 +1,1110 @@ % $Id: preview2.tex 314 2010-04-17 20:32:33Z ohl $ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \iffalse %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% To: hep-ph@xxx.lanl.gov Subject: put \\ Title: Yet Another Approach to Small and Medium Scale Parallelization of Adaptive Monte Carlo Integration Author: Thorsten Ohl (TU Darmstadt) Comments: ?? pages, LaTeX (using amsmath.sty) Report-no: IKDA 98/?? \\ ... \\ \fi %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \NeedsTeXFormat{LaTeX2e} \newif\ifPDFLaTeX \expandafter\ifx\csname pdfoutput\endcsname\relax \PDFLaTeXfalse \else \PDFLaTeXtrue \fi \ifPDFLaTeX \documentclass[12pt,a4paper]{article} \usepackage{type1cm} \usepackage{amsmath,amssymb,amscd} \allowdisplaybreaks \usepackage{feynmp} \setlength{\unitlength}{1mm} \usepackage{emp} \empaddtoprelude{input graph;} \setlength{\unitlength}{1mm} \DeclareGraphicsRule{*}{mps}{*}{} \usepackage[colorlinks]{hyperref} \def\pdffit{fit} \else %%% `normal' LaTeX2e \documentclass[12pt,a4paper]{article} \usepackage{amsmath,amssymb,amscd} \allowdisplaybreaks \usepackage{feynmp} \setlength{\unitlength}{1mm} \usepackage{emp} \empaddtoprelude{input graph;} \fi \usepackage{verbatim} \makeatletter \def\verbatimcmd{% \small \@verbatim \catcode`\\=0 \catcode`\{=1 \catcode`\}=2 % \catcode`\$=3 \frenchspacing\@vobeyspaces\verbatim@start} \def\endverbatimcmd{% \let\par\relax \def\verbatim@{\endtrivlist\endgroup}% \begingroup} \makeatother \newcommand{\verbatimesc}[1]{% \textit{$\langle\langle$\ #1\ $\rangle\rangle$}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \DeclareMathOperator{\Vol}{Vol} \DeclareMathOperator{\atan}{atan} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \makeindex \begin{document} \title{% Yet~Another~Approach to Small~and~Medium~Scale~Parallelization of Adaptive~Monte~Carlo~Integration} \author{% Thorsten Ohl% \thanks{e-mail: \texttt{ohl@hep.tu-darmstadt.de}} {}\thanks{Supported by Bundesministerium f\"ur Bildung, Wissenschaft, Forschung und Technologie, Germany.}\\ \hfil \\ Darmstadt University of Technology \\ Schlo\ss gartenstr.~9 \\ D-64289 Darmstadt \\ Germany} \date{% IKDA 98/??\\ hep-ph/yymmnnn\\ July 1998} \maketitle \begin{abstract} \ldots \end{abstract} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{empfile} \begin{fmffile}{\jobname pics} \fmfset{curly_len}{2mm} \fmfset{wiggly_len}{3mm} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% (Ab)use FeynMF for drawing portable commutative diagrams \fmfcmd{% style_def isomorphism expr p = cdraw (subpath (0, 1 - arrow_len/pixlen(p,10)) of p); cfill (harrow (p, 1)) enddef; style_def morphism expr p = draw_dots (subpath (0, 1 - arrow_len/pixlen(p,10)) of p); cfill (harrow (p, 1)) enddef;} \def\fmfcd(#1,#2){% \begin{minipage}{#1\unitlength}% \vspace*{.5\baselineskip}% \begin{fmfgraph*}(#1,#2)% \fmfset{arrow_len}{3mm}% \fmfset{arrow_ang}{10}% \fmfstraight} \def\endfmfcd{% \end{fmfgraph*}% \vspace*{.5\baselineskip}% \end{minipage}} \newcommand{\fmfcdmorphism}[4]{% \fmf{#1,label.side=#2,label.dist=3pt,label={\small $#4$}}{#3}} \newcommand{\fmfcdisomorph}[3][left]{% \fmfcdmorphism{isomorphism}{#1}{#2}{#3}} \newcommand{\fmfcdmorph}[3][left]{% \fmfcdmorphism{morphism}{#1}{#2}{#3}} \newcommand{\fmfcdeq}[1]{\fmf{double}{#1}} \def\fmfcdsetaux[#1]#2{% \fmfv{decor.shape=circle,decor.size=18pt,foreground=white, label.dist=0,label=$#1$}{#2}} \makeatletter \def\fmfcdset{\@dblarg{\fmfcdsetaux}} \makeatother %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{empcmds} numeric pi; pi = 180; vardef adap_fct_one (expr x) = (x + sind(2*x*pi)/8) enddef; vardef adap_fct_two (expr x) = (x + sind(4*x*pi)/16) enddef; vardef adap_fct (expr x) = adap_fct_two (x) enddef; vardef drawbar expr p = draw ((0,-.5)--(0,.5)) scaled 1mm shifted p enddef; \end{empcmds} \begin{empcmds} vardef pseudo (expr xlo, xhi, ylo, yhi, equ_lo, equ_hi, equ_div, adap_lo, adap_hi, adap_div, r, do_labels, do_arrow) = pair equ_grid.lo, equ_grid.hi, adap_grid[]lo, adap_grid[]hi; ypart (equ_grid.lo) = ypart (equ_grid.hi); ypart (adap_grid[1]lo) = ypart (adap_grid[1]hi); ypart (adap_grid[2]lo) = ypart (adap_grid[2]hi); xpart (equ_grid.lo) = xpart (adap_grid[1]lo) = xpart (adap_grid[2]lo); xpart (equ_grid.hi) = xpart (adap_grid[1]hi) = xpart (adap_grid[2]hi); equ_grid.hi = (xhi, yhi); adap_grid[1]lo = .5[equ_grid.lo,adap_grid[2]lo]; adap_grid[2]lo = (xlo, ylo); numeric rp, rm; rp = ceiling r; rm = floor r; pickup pencircle scaled .5pt; for i = adap_lo upto adap_hi: draw (i/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (adap_fct(i/adap_div))[adap_grid[2]lo,adap_grid[2]hi] withcolor 0.7white; endfor if do_arrow: fill (rm/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (rp/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (adap_fct(rp/adap_div))[adap_grid[2]lo,adap_grid[2]hi] -- (adap_fct(rm/adap_div))[adap_grid[2]lo,adap_grid[2]hi] -- cycle withcolor 0.7white; fi if do_labels: label.lft (btex \texttt{0} etex, equ_grid.lo); label.rt (btex \texttt{d\%ng} etex, equ_grid.hi); fi draw (equ_lo/equ_div)[equ_grid.lo,equ_grid.hi] -- (equ_hi/equ_div)[equ_grid.lo,equ_grid.hi]; for i = equ_lo upto equ_hi: drawbar (i/equ_div)[equ_grid.lo,equ_grid.hi]; endfor if do_labels: label.lft (btex $\xi$, \texttt{i: 0} etex, adap_grid[1]lo); label.rt (btex \texttt{ubound(d\%x)} etex, adap_grid[1]hi); label.lft (btex \texttt{d\%x: 0} etex, adap_grid[2]lo); label.rt (btex \texttt{1} etex, adap_grid[2]hi); fi draw (adap_lo/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (adap_hi/adap_div)[adap_grid[1]lo,adap_grid[1]hi]; draw (adap_fct(adap_lo/adap_div))[adap_grid[2]lo,adap_grid[2]hi] -- (adap_fct(adap_hi/adap_div))[adap_grid[2]lo,adap_grid[2]hi]; for i = adap_lo upto adap_hi: drawbar (i/adap_div)[adap_grid[1]lo,adap_grid[1]hi]; drawbar (adap_fct(i/adap_div))[adap_grid[2]lo,adap_grid[2]hi]; endfor if do_arrow: pickup pencircle scaled 1pt; pair cell, ia, grid; ia = (r/adap_div)[adap_grid[1]lo,adap_grid[1]hi]; cell = ia shifted (equ_grid.hi - adap_grid[1]hi); grid = (adap_fct(r/adap_div))[adap_grid[2]lo,adap_grid[2]hi]; if do_labels: label.top (btex \texttt{cell - r} etex, cell); fi drawarrow cell -- ia; drawarrow ia -- grid; if do_labels: label.bot (btex \texttt{x} etex, grid); fi fi enddef; \end{empcmds} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} The problem of the parallelization of adaptive Monte Carlo integration algorithms has gained some attention recently~\cite{Krecker:1997:Parallel-Vegas,Veseli:1998:Parallel-Vegas}. Both authors present parallel versions of the Vegas algorithm~\cite{Lepage:1978:vegas}. The implementations start from the classic implementation of Vegas and add synchronization barriers, either mutexes for threads accessing shared memory or explicit message passing. This approach results in compact code and achieves high performance, but the implementations of threads bases parallelism on one hand and message passing on the other are very different. Therefore, a close coupling of parallelization and of the integration algorithm sacrifices flexibility. Even the move from one message passing library to another is a non trivial exercise with many subtle failure modes. The same is true for any improvement of the integration algorithm. Instead, we suggest a \emph{mathematical} model of parallelism for -adaptive Monte Carlo integration that is independend both of a +adaptive Monte Carlo integration that is independent both of a concrete paradigm for parallelism and of the programming language used for an implementation. We decompose the algorithm and prove that certain parts can be executed in \emph{any} order without changing the result. As a corollary, we know that they can be executed in parallel. The algorithms presented below have been implemented successfully in the library VAMP~\cite{Ohl:1998:VAMP}, along with other, independent, improvements of Vegas~\cite{Ohl:1998:VAMP-preview}. In section~\ref{sec:vegas} we discuss the features of Vegas, that are important for our model. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Vegas} \label{sec:vegas} In this section we discuss the features of Vegas, that are important for building a model of parallelism, but are not discussed in~\cite{Lepage:1978:vegas}. Vegas uses two \emph{grids}: an adaptive grid~$G^A$, which is used to adapt the distribution of the sampling points and a stratification grid~$G^S$ for stratified sampling. The latter is static and depends only on the number of dimensions and on the number of sampling points. Both grids factorize into \emph{divisions}~$d_{A,S}^i$ \begin{subequations} \begin{align} G^A &= d^A_1 \otimes d^A_2 \otimes \cdots \otimes d^A_n \\ G^S &= d^S_1 \otimes d^S_2 \otimes \cdots \otimes d^S_n \,. \end{align} \end{subequations} The divisions come in three kinds \begin{subequations} \begin{align} \label{eq:importance} d^S_i &= \emptyset &&\text{(importance sampling)} \\ \label{eq:stratified} d^A_i &= d^S_i/m &&\text{(stratified sampling)} \\ \label{eq:pseudo} d^A_i &\not= d^S_i/m &&\text{(pseudo-stratified sampling)}\,. \end{align} \end{subequations} In the classic implementation of Vegas~\cite{Lepage:1978:vegas}, \emph{all} divisions are of the same type. In a more general implementation~\cite{Ohl:1998:VAMP}, this is not required and it can be useful to use stratification only in a few dimensions. \begin{empcmds} vardef layout = pair ul, ur, ll, lr; ypart (ul) = ypart (ur); ypart (ll) = ypart (lr); xpart (ul) = xpart (ll); xpart (ur) = xpart (lr); numeric weight_width, weight_dist; weight_width = 0.1w; weight_dist = 0.05w; ll = (.1w,.1w); ur = (w-weight_width-weight_dist,h-weight_width-weight_dist); numeric equ_div, adap_div, rx, ry, rxp, rxm, ryp, rym; equ_div = 3; adap_div = 8; rx = 5.2; ry = 3.6; rxp = ceiling rx; rxm = floor rx; ryp = ceiling ry; rym = floor ry; numeric pi; pi = 180; vardef adap_fct_x (expr x) = (x + sind(2*x*pi)/8) enddef; vardef weight_x (expr x) = (1 + 2*sind(1*x*pi)**2) / 3 enddef; vardef adap_fct_y (expr x) = (x + sind(4*x*pi)/16) enddef; vardef weight_y (expr x) = (1 + 2*sind(2*x*pi)**2) / 3 enddef; vardef grid_pos (expr i, j) = (adap_fct_y(j/adap_div))[(adap_fct_x(i/adap_div))[ll,lr], (adap_fct_x(i/adap_div))[ul,ur]] enddef; vardef grid_square (expr i, j) = grid_pos (i,j) -- grid_pos (i+1,j) -- grid_pos (i+1,j+1) -- grid_pos (i,j+1) -- cycle enddef; enddef; vardef decoration = fill (lr shifted (weight_y(0)*(weight_width,0)) for y = .1 step .1 until 1.01: .. y[lr,ur] shifted (weight_y(y)*(weight_width,0)) endfor -- ur -- lr -- cycle) shifted (weight_dist,0) withcolor 0.7white; fill (ul shifted (weight_x(0)*(0,weight_width)) for x = .1 step .1 until 1.01: .. x[ul,ur] shifted (weight_x(x)*(0,weight_width)) endfor -- ur -- ul -- cycle) shifted (0,weight_dist) withcolor 0.7white; picture px, py; px = btex $p_1(x_1)$ etex; py = btex $p_2(x_2)$ etex; label.top (image (unfill bbox px; draw px), .5[ul,ur] shifted (0,weight_dist)); label.rt (image (unfill bbox py; draw py), .75[lr,ur] shifted (weight_dist,0)); label.lrt (btex $\mathcal{D}_{1,1}$ etex, ll); label.bot (btex $x_1$ etex, .5[ll,lr]); label.bot (btex $\mathcal{D}_{2,1}$ etex, lr); label.ulft (btex $\mathcal{D}_{1,2}$ etex, ll); label.lft (btex $x_2$ etex, .5[ll,ul]); label.lft (btex $\mathcal{D}_{2,2}$ etex, ul); enddef; \end{empcmds} \begin{figure} \begin{center} \begin{emp}(55,50) layout; fill grid_square (rxm,rym) withcolor 0.7white; pickup pencircle scaled .7pt; for i = 0 upto adap_div: draw grid_pos(i,0) -- grid_pos(i,adap_div); draw grid_pos(0,i) -- grid_pos(adap_div,i); endfor pickup pencircle scaled 2pt; drawdot grid_pos(rx,ry); decoration; \end{emp} \begin{emp}(55,50) layout; vardef grid_sub_pos (expr i, di, j, dj) = (dj/equ_div)[(di/equ_div)[grid_pos(i,j),grid_pos(i+1,j)], (di/equ_div)[grid_pos(i,j+1),grid_pos(i+1,j+1)]] enddef; vardef grid_sub_square (expr i, di, j, dj) = grid_sub_pos (i,di,j,dj) -- grid_sub_pos (i,di+1,j,dj) -- grid_sub_pos (i,di+1,j,dj+1) -- grid_sub_pos (i,di,j,dj+1) -- cycle enddef; fill grid_square (rxm,rym) withcolor 0.8white; fill grid_sub_square (rxm,0,rym,1) withcolor 0.6white; pickup pencircle scaled .7pt; for i = 0 upto adap_div: draw grid_pos(i,0) -- grid_pos(i,adap_div); draw grid_pos(0,i) -- grid_pos(adap_div,i); endfor pickup pencircle scaled .5pt; for i = 0 upto (adap_div-1): for j = 1 upto (equ_div-1): draw grid_sub_pos(i,j,0,0) -- grid_sub_pos(i,j,adap_div,0) dashed evenly; draw grid_sub_pos(0,0,i,j) -- grid_sub_pos(adap_div,0,i,j) dashed evenly; endfor endfor pickup pencircle scaled 2pt; drawdot grid_pos(rx,ry); decoration; \end{emp} \end{center} \caption{\label{fig:nonstrat/strat}% Vegas grid structure for importance sampling~(\ref{eq:importance}) on the left and for genuinely stratified sampling~(\ref{eq:stratified}) on the right. The latter is used in low dimensions only.} \end{figure} Two-dimensional grids for the cases~(\ref{eq:importance}) and~(\ref{eq:stratified}) are illustrated in figure~\ref{fig:nonstrat/strat}. In case~(\ref{eq:importance}), there is no stratification grid and the points are picked at random in the whole region according to~$G_A$. In case~(\ref{eq:stratified}), the adaptive grid~$G_A$ is a regular subgrid of the stratification grid~$G_S$ and an equal number of points are picked at random in each cell of~$G_S$. Since~$d^A_i = d^S_i/m$, the points will be distributed according to~$G_A$ as well. \begin{empcmds} numeric pi; pi = 180; vardef adap_fct_one (expr x) = (x + sind(2*x*pi)/8) enddef; vardef adap_fct_two (expr x) = (x + sind(4*x*pi)/16) enddef; vardef adap_fct (expr x) = adap_fct_two (x) enddef; vardef drawbar expr p = draw ((0,-.5)--(0,.5)) scaled 1mm shifted p enddef; \end{empcmds} \begin{empcmds} vardef pseudo (expr xlo, xhi, ylo, yhi, equ_lo, equ_hi, equ_div, adap_lo, adap_hi, adap_div, r, do_labels, do_arrow) = pair equ_grid.lo, equ_grid.hi, adap_grid[]lo, adap_grid[]hi; ypart (equ_grid.lo) = ypart (equ_grid.hi); ypart (adap_grid[1]lo) = ypart (adap_grid[1]hi); ypart (adap_grid[2]lo) = ypart (adap_grid[2]hi); xpart (equ_grid.lo) = xpart (adap_grid[1]lo) = xpart (adap_grid[2]lo); xpart (equ_grid.hi) = xpart (adap_grid[1]hi) = xpart (adap_grid[2]hi); equ_grid.hi = (xhi, yhi); adap_grid[1]lo = .5[equ_grid.lo,adap_grid[2]lo]; adap_grid[2]lo = (xlo, ylo); numeric rp, rm; rp = ceiling r; rm = floor r; pickup pencircle scaled .5pt; for i = adap_lo upto adap_hi: draw (i/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (adap_fct(i/adap_div))[adap_grid[2]lo,adap_grid[2]hi] withcolor 0.7white; endfor if do_arrow: fill (rm/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (rp/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (adap_fct(rp/adap_div))[adap_grid[2]lo,adap_grid[2]hi] -- (adap_fct(rm/adap_div))[adap_grid[2]lo,adap_grid[2]hi] -- cycle withcolor 0.7white; fi if do_labels: label.lft (btex \texttt{0} etex, equ_grid.lo); label.rt (btex \texttt{d\%ng} etex, equ_grid.hi); fi draw (equ_lo/equ_div)[equ_grid.lo,equ_grid.hi] -- (equ_hi/equ_div)[equ_grid.lo,equ_grid.hi]; for i = equ_lo upto equ_hi: drawbar (i/equ_div)[equ_grid.lo,equ_grid.hi]; endfor if do_labels: label.lft (btex $\xi$, \texttt{i: 0} etex, adap_grid[1]lo); label.rt (btex \texttt{ubound(d\%x)} etex, adap_grid[1]hi); label.lft (btex \texttt{d\%x: 0} etex, adap_grid[2]lo); label.rt (btex \texttt{1} etex, adap_grid[2]hi); fi draw (adap_lo/adap_div)[adap_grid[1]lo,adap_grid[1]hi] -- (adap_hi/adap_div)[adap_grid[1]lo,adap_grid[1]hi]; draw (adap_fct(adap_lo/adap_div))[adap_grid[2]lo,adap_grid[2]hi] -- (adap_fct(adap_hi/adap_div))[adap_grid[2]lo,adap_grid[2]hi]; for i = adap_lo upto adap_hi: drawbar (i/adap_div)[adap_grid[1]lo,adap_grid[1]hi]; drawbar (adap_fct(i/adap_div))[adap_grid[2]lo,adap_grid[2]hi]; endfor if do_arrow: pickup pencircle scaled 1pt; pair cell, ia, grid; ia = (r/adap_div)[adap_grid[1]lo,adap_grid[1]hi]; cell = ia shifted (equ_grid.hi - adap_grid[1]hi); grid = (adap_fct(r/adap_div))[adap_grid[2]lo,adap_grid[2]hi]; if do_labels: label.top (btex \texttt{cell - r} etex, cell); fi drawarrow cell -- ia; drawarrow ia -- grid; if do_labels: label.bot (btex \texttt{x} etex, grid); fi fi enddef; \end{empcmds} \begin{figure} \begin{center} \begin{emp}(120,30) pseudo (.3w, .8w, .1h, .8h, 0, 8, 8, 0, 12, 12, 5.2, true, true); \end{emp} \end{center} \caption{\label{fig:pseudo}% One-dimensional illustration of the \texttt{vegas} grid structure for pseudo stratified sampling, which is used in high dimensions.} \end{figure} A one-dimensional illustration of~(\ref{eq:pseudo}) is shown in figure~(\ref{fig:pseudo}). The case~(\ref{eq:pseudo}) is the most complicated. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Parallelization} \label{sec:parallelization} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Formalization of Adaptive Sampling} \label{sec:adaptive-sampling} In order to discuss the problems with parallelizing adaptive integration algorithms and to present solutions, it helps to introduce some mathematical notation. A sampling~$S$ is a map from the space~$\pi$ of point sets and the space~$F$ of functions to the real (or complex) numbers \begin{equation*} \begin{aligned} S: \pi \times F & \to \mathbf{R} \\ (p,f) & \mapsto I = S(p,f) \end{aligned} \end{equation*} For our purposes, we have to be more specific about the nature of the point set. In general, the point set will be characterized by a sequence of pseudo random numbers~$\rho\in R$ and by one or more grids~$G\in\Gamma$ used for importance or stratified sampling. A simple sampling \begin{equation} \label{eq:S0} \begin{aligned} S_0: R \times \Gamma \times A \times F \times\mathbf{R}\times\mathbf{R} & \to R \times \Gamma \times A \times F \times\mathbf{R}\times\mathbf{R}\\ (\rho, G, a, f, \mu_1, \mu_2) & \mapsto (\rho', G, a', f, \mu_1', \mu_2') = S_0 (\rho, G, a, f, \mu_1, \mu_2) \end{aligned} \end{equation} estimates the $n$-th moments $\mu_n'\in\mathbf{R}$ of the function~$f\in F$. The integral and its standard deviation can be derived easily from the moments \begin{subequations} \begin{align} I &= \mu_1 \\ \sigma^2 &= \frac{1}{N-1} \left(\mu_2 - \mu_1^2\right) \end{align} \end{subequations} while the latter are more convenient for the following discussion. In addition, $S_0$ collects auxiliary information to be used in the grid refinement, denoted by~$a\in A$. The unchanged arguments~$G$ and~$f$ have been added to the result of~$S_0$ in~(\ref{eq:S0}), so that~$S_0$ has identical domain and codomain and can therefore be iterated. Previous estimates~$\mu_n$ may be used in the estimation of~$\mu_n'$, but a particular~$S_0$ is free to ignore them as well. Using a little notational freedom, we augment~$\mathbf{R}$ and~$A$ with a special value~$\bot$, which will always be discarded by~$S_0$. In an adaptive integration algorithm, there is also a refinement operation~$r:\Gamma\times A \to\Gamma$ that can be extended naturally to the codomain of~$S_0$ \begin{equation} \begin{aligned} r: R \times \Gamma \times A \times F \times\mathbf{R}\times\mathbf{R} & \to R \times \Gamma \times A \times F \times\mathbf{R}\times\mathbf{R}\\ (\rho, G, a, f, \mu_1, \mu_2) & \mapsto (\rho, G', a, f, \mu_1, \mu_2) = r (\rho, G, a, f, \mu_1, \mu_2) \end{aligned} \end{equation} so that~$S=rS_0$ is well defined and we can specify $n$-step adaptive sampling as \begin{equation} \label{eq:Sn} S_n = S_0 (rS_0)^n \end{equation} Since, in a typical application, only the estimate of the integral and the standard deviation are used, a projection can be applied to the result of~$S_n$: \begin{equation} \label{eq:P} \begin{aligned} P: R \times \Gamma \times A \times F \times\mathbf{R}\times\mathbf{R} & \to \mathbf{R}\times\mathbf{R}\\ (\rho, G, a, f, \mu_1, \mu_2) & \mapsto (I,\sigma) \end{aligned} \end{equation} Then \begin{equation} (I,\sigma) = P S_0 (rS_0)^n (\rho, G_0, \bot, f, \bot, \bot) \end{equation} and a good refinement prescription~$r$, such as Vegas, will minimize the~$\sigma$. For parallelization, it is crucial to find a division of~$S_n$ or any part of it into \emph{independent} pieces that can be evaluated in parallel. In order to be effective, $r$ has to be applied to \emph{all} of~$a$ and therefore a sychronization of~$G$ before and after~$r$ is appropriately. Forthermore, $r$ usually uses only a tiny fraction of the CPU time and it makes little sense to invest a lot of effort into parallelizing it beyond what the Fortran compiler can infer from array notation. On the other hand, $S_0$ can be parallelized naturally, because all operations are linear, including he computation of~$a$. We only have to make sure that the cost of communicating the results of~$S_0$ and~$r$ back and forth during the computation of~$S_n$ do not offset any performance gain from parallel processing. When we construct a decomposition of~$S_0$ and proof that it does not change the results, i.e. \begin{equation} S_0 = \iota S_0 \phi \end{equation} where~$\phi$ is a forking operation and~$\iota$ is a joining operation, we are faced with the technical problem of a parallel random number source~$\rho$. \begin{equation} \begin{CD} \bigoplus_{i=1}^N G_i @>{\bigoplus_{i=1}^N S_0}>> \bigoplus_{i=1}^N G_i \\ @A{\phi}AA @V{\iota}VV \\ G @>S_0>> G \end{CD} \end{equation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Weakly Commutative Diagrams} \label{sec:weak-CD} As made explicit in~(\ref{eq:S0}, $S_0$ changes the state of the random number general~$\rho$, demanding \emph{identical} results therefore imposes a strict ordering on the operations and defeats parallelization. It is possible to devise implementations of~$S_0$ and~$\rho$ that circumvent this problem by distributing subsequences of~$\rho$ in such a way among processes that results do not depend on the number of parallel processes. However, a reordering of the random number sequence will only change the result by the statistical error, as long as the scale of the allowed reorderings is \emph{bounded} and much smaller than the period of the random number generator~\footnote{Arbirtrary reorderings on the scale of the period of the random number generators could select constant sequences and have to be forbidden.} Below, we will therefore use the notation $x\approx y$ for ``equal for an appropriate finite reordering of the~$\rho$ used in calculating~$x$ and~$y$''. For our porposes, the relation~$x\approx y$ is strong enough and allows simple and efficient implementations. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Multilinear Structure of the Sampling Algorithm} \label{sec:multi-linear} Since~$S_0$ is essentially a summation, it is natural to expect a linear structure \begin{subequations} \label{eq:S0-parallel} \begin{equation} \bigoplus_i S_0(\rho_i, G_i, a_i, f, \mu_{1,i}, \mu_{2,i}) \approx S_0 (\rho, G, a, f, \mu_1, \mu_2) \end{equation} where \begin{align} \rho &= \bigoplus_i \rho_i \\ G &= \bigoplus_i G_i \\ a &= \bigoplus_i a_i \\ \mu_n &= \bigoplus_i \mu_{n,i} \end{align} \end{subequations} for appropriate definitions of ``$\oplus$''. For the moments, we have standard addition \begin{equation} \mu_{n,1} \oplus \mu_{n,2} = \mu_{n,1} + \mu_{n,2} \end{equation} and since we only demand equality up to reordering, we only need that the~$\rho_i$ are statistically independent. This leaves us with~$G$ and~$a$ and we have to discuss importance sampling ans stratified sampling separately. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Importance Sampling} In the case of naive Monte Carlo and importance sampling the natural decomposition of~$G$ is to take~$j$ copies of the same grid~$G/j$ which is identical to~$G$, each with one $j$-th of the total sampling points. As long as the~$a$ are linear themselves, we can add them up just like the moments \begin{equation} a_1 \oplus a_2 = a_1 + a_2 \end{equation} and we have found a decomposition~(\ref{eq:S0-parallel}). In the case of Vegas, the~$a_i$ are sums of function values at the sampling points. Thus they are obviously linear and this approach is applicable to Vegas in the importance sampling mode. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Stratified Sampling} The situation is more complicated in the case of stratified sampling. The first complication is that in pure stratified sampling there are only two sampling points per cell. Splitting the grid in two pieces as above provide only a very limited amount of parallelization. The second complication is that the~$a$ are no longer linear, since they corrspond to a sampling of the variance per cell and no longer of function values themselves. However, as long as the samplings contribute to disjoint bins only, we can still ``add'' the variances by combining bins. The solution is therefore to divide the grid into disjoint bins along the divisions of the stratification grid and to assign a set of bins to each processor. Finer decompositions will incur higher communications costs and other resource utilization. An implementation based on~PVM is described in~\cite{Veseli:1998:Parallel-Vegas}, which miminizes the overhead by running identical copies of the grid~$G$ on each processor. Since most of the time is usually spent in function evaluations, it makes sense to run a full~$S_0$ on each processor, skipping function evaluations everywhere but in the region assigned to the processor. This is a neat trick, which is unfortunately tied to the computational model of message passing systems such as~PVM and~MPI~\cite{MPI}. More general paradigms can not be supported since the separation of the state for the processors is not explicit (it is implicit in the separated address space of the PVM or MPI processes). However, it is possible to implement~(\ref{eq:S0-parallel}) directly in an efficient manner. This is based on the observation that the grid~$G$ used by Vegas is factorized into divisions~$D^j$ for each dimension \begin{equation} \label{eq:factorize} G = \bigotimes_{j=1}^{n_{\text{dim}}} D^j \end{equation} and decompositions of the~$D^j$ induce decompositions of~$G$ \begin{multline} \label{eq:decomp} G_1 \oplus G_2 = \left( \bigotimes_{j=1}^{i-1} D^j \otimes D^i_1 \otimes \bigotimes_{i=j+1}^{n_{\text{dim}}} D^j \right) \oplus \left( \bigotimes_{j=1}^{i-1} D^j \otimes D^i_2 \otimes \bigotimes_{i=j+1}^{n_{\text{dim}}} D^j \right) \\ = \bigotimes_{j=1}^{i-1} D^j \otimes \left( D^i_1 \oplus D^i_2 \right) \otimes \bigotimes_{j=i+1}^{n_{\text{dim}}} D^j \end{multline} We can translate~(\ref{eq:decomp}) directly to code that performs the decomposition~$D^i = D^i_1 \oplus D^i_2$ discussed below and simply duplicates the other divisions~$D^{j\not=i}$. A decomposition along multiple dimensions is implemented by a recursive application of~(\ref{eq:decomp}). In Vegas, the auxiliary information~$a$ inherits a factorization similar to the grid~$(\ref{eq:factorize})$ \begin{equation} \label{eq:factorize'} a = (d^1,\ldots,d^{n_{\text{dim}}}) \end{equation} but not a multilinear structure. Instead, \emph{as long as the decomposition respects the stratification grid}, we find the in place of~(\ref{eq:decomp}) \begin{equation} \label{eq:decomp'} a_1 \oplus a_2 = (d^1_1 + d^1_2,\ldots, d^i_1 \oplus d^i_2, \ldots, d^{n_{\text{dim}}}_1 + d^{n_{\text{dim}}}_2) \end{equation} with ``$+$'' denoting the standard addition of the bin contents and ``$\oplus$'' denoting the aggregation of disjoint bins. If the decomposition of the division would break up cells of the stratification grid~(\ref{eq:decomp'}) would be incorrect, because, as discussed above, the variance is not linear. Now it remains to find a decomposition \begin{equation} D^i = D^i_1 \oplus D^i_2 \end{equation} for both the pure stratification mode and the pseudo stratification mode of vegas (cf.\ figure~\ref{fig:nonstrat/strat}). In the pure stratification mode, the stratification grid is strictly finer than the adaptive grid and we can decompose along either of them immediately. Technically, a decomposition along the coarser of the two is straightforward. Since the adaptive grid already has more than 25~bins, a decomposition along the stratification grid makes no practical sense and the decomposition along the adaptive grid has been implemented. The sampling algorithm~$S_0$ can be applied \emph{unchanged} to the individual grids resulting from the decomposition. \begin{figure} \begin{center} \begin{emp}(120,90) pseudo (.3w, .8w, .7h, .9h, 0, 8, 8, 0, 12, 12, 5.2, true, true); % lcm (lcm (3, 8) / 3, 12) pseudo (.3w, .8w, .4h, .6h, 0, 8, 8, 0, 24, 24, 5.2*2, false, true); % forks pseudo (.2w, .7w, .1h, .3h, 0, 2, 8, 0, 6, 24, 5.2*2, false, false); pseudo (.3w, .8w, .1h, .3h, 2, 5, 8, 6, 15, 24, 5.2*2, false, true); pseudo (.4w, .9w, .1h, .3h, 5, 8, 8, 15, 24, 24, 5.2*2, false, false); label.urt (btex \texttt{ds(1)} etex, (.2w, 0)); label.top (btex \texttt{ds(2)} etex, (.5w, 0)); label.ulft (btex \texttt{ds(3)} etex, (.9w, 0)); \end{emp} \end{center} \caption{\label{fig:pseudo-fork}% Forking one dimension~\texttt{d} of a grid into three parts \texttt{ds(1)}, \texttt{ds(2)}, and~\texttt{ds(3)}. The picture illustrates the most complex case of pseudo stratified sampling (cf.~fig.~\ref{fig:pseudo}).} \end{figure} For pseudo stratified sampling (cf.\ figure~\ref{fig:pseudo}), the situation is more complicated, because the adaptive and the stratification grid do not share bin boundaries. Since Vegas does \emph{not} use the variance in this mode, it would be theoretically possible to decompose along the adaptive grid and to mimic the incomplete bins of the stratification grid in the sampling algorithm. However, this would be a technical complication, destroying the universality of~$S_0$. Therefore, the adaptive grid is subdivided in a first step in \begin{equation} \mathop{\textrm{lcm}} \left( \frac{\mathop{\textrm{lcm}}(n_f,n_g)}{n_f}, n_x \right) \end{equation} bins,\footnote{The coarsest grid covering the division of~$n_g$ bins into~$n_f$ forks has $n_g / \mathop{\textrm{gcd}}(n_f,n_g) = \mathop{\textrm{lcm}}(n_f,n_g) / n_f$ bins per fork.} such that the adaptive grid is strictly finer than the stratification grid. This procedure is shown in figure~\ref{fig:pseudo-fork}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{State and Message Passing} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Random Numbers} In the parallel example sitting on top of MPI~\cite{MPI} takes advantage of the ability of Knuth's generator~\cite{Knuth:1997:TAOCP2} to generate statistically independent subsequences. However, since the state of the random number generator is explicit in all procedure calls, other means of obtaining subsequences can be implemented in a trivial wrapper. The results of the parallel example will depend on the number of processors, because this effects the subsequences being used. Of course, the variation will be compatible with the statistical error. It must be stressed that the results are deterministic for a given number of processors and a given set of random number generator seeds. Since parallel computing environments allow to fix the number of processors, debugging of exceptional conditions is possible. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Practice} In this section we show three implementations of~$S_n$: one serial, and two parallel, based on HPF~\cite{HPF1.1,HPF2.0} and MPI~\cite{MPI}, respectively. From these examples, it should be obvious how to adapt VAMP to other parallel computing paradigms. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Serial} Here is a bare bones serail version of~$S_n$, for comparison with the parallel versions below. The real implementation of \verb|vamp_sample_grid| in the module \verb|vamp| includes some error handling, diagnostics and the projection~$P$ (cf.~(\ref{eq:P})): \begin{verbatimcmd} subroutine vamp_sample_grid (rng, g, iterations, func) type(tao_random_state), intent(inout) :: rng type(vamp_grid), intent(inout) :: g integer, intent(in) :: iterations \verbatimesc{Interface declaration for \texttt{func}} integer :: iteration iterate: do iteration = 1, iterations call vamp_sample_grid0 (rng, g, func) call vamp_refine_grid (g) end do iterate end subroutine vamp_sample_grid \end{verbatimcmd} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{HPF} The HPF version of~$S_n$ is based on decomposing the grid~\verb|g| as described in section~\ref{sec:multi-linear} and lining up the components in an array~\verb|gs|. The elements of~\verb|gs| can then be processed im parallel. This version can be compiled with any Fortran compiler and a more complete version of this procedure (including error handling, diagnostics and the projection~$P$) is included with VAMP as \verb|vamp_sample_grid_parallel| in the module \verb|vamp|. This way, the algorithm can be tested on a serial machine, but there will obviously be no performance gain.\par Instead of one random number generator state~\verb|rng|, it takes an array consisting of one state per processor. These \verb|rng(:)| are assumed to be initialized, such that the resulting sequences are statistically independent. For this purpose, Knuth's random number generator~\cite{Knuth:1997:TAOCP2} is most convenient and is included with VAMP (see the example on page~\pageref{pg:tao-hpf}). Before each~$S_0$, the procedure \verb|vamp_distribute_work| determines a good decomposition of the grid~\verb|d| into \verb|size(rng)| pieces. This decomposition is encoded in the array \verb|d| where \verb|d(1,:)| holds the dimensions along which to split the grid and \verb|d(2,:)| holds the corrsponding number of divisions. Using this information, the grid is decomposed by \verb|vamp_fork_grid|. The HPF compiler will then distribute the \verb|!hpf$ independent| loop among the processors. Finally, \verb|vamp_join_grid| gathers the results. \begin{verbatimcmd} subroutine vamp_sample_grid_hpf (rng, g, iterations, func) type(tao_random_state), dimension(:), intent(inout) :: rng type(vamp_grid), intent(inout) :: g integer, intent(in) :: iterations \verbatimesc{Interface declaration for \texttt{func}} type(vamp_grid), dimension(:), allocatable :: gs, gx !hpf$ processors p(number_of_processors()) !hpf$ distribute gs(cyclic(1)) onto p integer, dimension(:,:), pointer :: d integer :: iteration, num_workers iterate: do iteration = 1, iterations call vamp_distribute_work (size (rng), vamp_rigid_divisions (g), d) num_workers = max (1, product (d(2,:))) if (num_workers > 1) then allocate (gs(num_workers), gx(vamp_fork_grid_joints (d))) call vamp_create_empty_grid (gs) call vamp_fork_grid (g, gs, gx, d) !hpf$ independent do i = 1, num_workers call vamp_sample_grid0 (rng(i), gs(i), func) end do call vamp_join_grid (g, gs, gx, d) call vamp_delete_grid (gs) deallocate (gs, gx) else call vamp_sample_grid0 (rng(1), g, func) end if call vamp_refine_grid (g) end do iterate end subroutine vamp_sample_grid_hpf \end{verbatimcmd} Since \verb|vamp_sample_grid0| performes the bulk of the computation, an almost linear speedup with the number of processors can be achieved, if \verb|vamp_distribute_work| finds a good decomposition of the grid. The version of \verb|vamp_distribute_work| distributed with VAMP does a good job in most cases, but will not be able to use all processors if their number is a prime number larger than the number of divisions in the stratification grid. Therefore it can be beneficial to tune \verb|vamp_distribute_work| to specific hardware. Furthermore, using a finer stratification grid can improve performance.\par For definiteness, here is an example of how to set up the array of random number generators for HPF. Note that this simple seeding procedure only guarantees statistically independent sequences with Knuth's random number generator~\cite{Knuth:1997:TAOCP2} and will fail with other approaches. \label{pg:tao-hpf} \begin{verbatimcmd} type(tao_random_state), dimension(:), allocatable :: rngs !hpf$ processors p(number_of_processors()) !hpf$ distribute gs(cyclic(1)) onto p integer :: i, seed ! ... allocate (rngs(number_of_processors())) seed = 42 !: can be read from a file, of course \ldots !hpf$ independent do i = 1, size (rngs) call tao_random_create (rngs(i), seed + i) end do ! ... call vamp_sample_grid_hpf (rngs, g, 6, func) ! ... \end{verbatimcmd} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{MPI} The MPI version is more low level, because we have to keep track of message passing ourselves. Note that we have made this synchronization points explicit with three \verb|if ... then ... else ... end if| blocks: forking, sampling, and joining. These blocks could be merged (without any performance gain) at the expense of readability. We assume that \verb|rng| has been initialized in each process such that the sequences are again statistically independent. \begin{verbatimcmd} subroutine vamp_sample_grid_mpi (rng, g, iterations, func) type(tao_random_state), dimension(:), intent(inout) :: rng type(vamp_grid), intent(inout) :: g integer, intent(in) :: iterations \verbatimesc{Interface declaration for \texttt{func}} type(vamp_grid), dimension(:), allocatable :: gs, gx integer, dimension(:,:), pointer :: d integer :: num_proc, proc_id, iteration, num_workers call mpi90_size (num_proc) call mpi90_rank (proc_id) iterate: do iteration = 1, iterations if (proc_id == 0) then call vamp_distribute_work (num_proc, vamp_rigid_divisions (g), d) num_workers = max (1, product (d(2,:))) end if call mpi90_broadcast (num_workers, 0) if (proc_id == 0) then allocate (gs(num_workers), gx(vamp_fork_grid_joints (d))) call vamp_create_empty_grid (gs) call vamp_fork_grid (g, gs, gx, d) do i = 2, num_workers call vamp_send_grid (gs(i), i-1, 0) end do else if (proc_id < num_workers) then call vamp_receive_grid (g, 0, 0) end if if (proc_id == 0) then if (num_workers > 1) then call vamp_sample_grid0 (rng, gs(1), func) else call vamp_sample_grid0 (rng, g, func) end if else if (proc_id < num_workers) then call vamp_sample_grid0 (rng, g, func) end if if (proc_id == 0) then do i = 2, num_workers call vamp_receive_grid (gs(i), i-1, 0) end do call vamp_join_grid (g, gs, gx, d) call vamp_delete_grid (gs) deallocate (gs, gx) call vamp_refine_grid (g) else if (proc_id < num_workers) then call vamp_send_grid (g, 0, 0) end if end do iterate end subroutine vamp_sample_grid_mpi \end{verbatimcmd} A more complete version of this procedure is included with VAMP as well, this time as \verb|vamp_sample_grid| in the MPI support module \verb|vampi|. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Performance} \label{sec:performance} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Conclusions} \label{sec:conclusions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% \bibliography{jpsi} \begin{thebibliography}{10} \bibitem{Krecker:1997:Parallel-Vegas} R.~Krecker, Comp.\ Phys.\ Comm.\ \textbf{106}, 258 (1997). \bibitem{Veseli:1998:Parallel-Vegas} S.~Veseli, Comp.\ Phys.\ Comm.\ \textbf{108}, 9 (1998). \bibitem{Lepage:1978:vegas} G.~P.~Lepage, J.~Comp.\ Phys.\ \textbf{27}, 192 (1978); G.~P.~Lepage, Cornell Preprint, CLNS-80/447, March 1980. \bibitem{Ohl:1998:VAMP} T.~Ohl, \textit{\texttt{VAMP}, Version 1.0: Vegas AMPlified: Anisotropy, Multi-channel sampling and Parallelization}, Preprint, Darmstadt University of Technology, 1998 (in preparation). \bibitem{Ohl:1998:VAMP-preview} T.~Ohl, \textit{Vegas Revisited: Adaptive Monte Carlo Integration Beyond Factorization}, hep-ph/9806432, Preprint IKDA 98/15, Darmstadt University of Technology, 1998. \bibitem{FORTRAN77} American National Standards Institute, \textit{American National Standard Programming Languages FORTRAN, ANSI X3.9-1978,} New York, 1978. \bibitem{Fortran90} International Standards Organization, \textit{ISO/IEC 1539:1991, Information technology --- Programming Languages --- Fortran,} Geneva, 1991. \bibitem{Fortran95} International Standards Organization, \textit{ISO/IEC 1539:1997, Information technology --- Programming Languages --- Fortran,} Geneva, 1997. \bibitem{HPF1.1} High Performance Fortran Forum, \textit{High Performance Fortran Language Specification, Version 1.1}, Rice University, Houston, Texas, 1994. \bibitem{HPF2.0} High Performance Fortran Forum, \textit{High Performance Fortran Language Specification, Version 2.0}, Rice University, Houston, Texas, 1997. \bibitem{MPI} Message Passing Interface Forum, \textit{MPI: A Message Passing Interface Standard}, Technical Report CS-94230, University of Tennessee, Knoxville, Tennessee, 1994. \bibitem{Knuth:1997:TAOCP2} D.~E. Knuth, \textit{Seminumerical Algorithms} (third edition), Vol.~2 of \textit{The Art of Computer Programming}, (Addison-Wesley, 1997). \bibitem{Kleiss/Pittau:1994:multichannel} R.~Kleiss, R.~Pittau, \textit{Weight Optimization in Multichannel Monte Carlo,} Comp.\ Phys.\ Comm.\ \textbf{83}, 141 (1994). \bibitem{Marsaglia:1996:CD} George Marsaglia, \textit{The Marsaglia Random Number CD-ROM}, FSU, Dept.~of Statistics and SCRI, 1996. \end{thebibliography} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \end{fmffile} \end{empfile} \end{document} % Local Variables: % mode:latex % indent-tabs-mode:nil % page-delimiter:"^%%%.*\n" % End: