Index: trunk/src/physics/physics.nw =================================================================== --- trunk/src/physics/physics.nw (revision 8863) +++ trunk/src/physics/physics.nw (revision 8864) @@ -1,9066 +1,10074 @@ % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*- % WHIZARD code as NOWEB source: physics and such \chapter{Physics} \includemodulegraph{physics} Here we collect definitions and functions that we need for (particle) physics in general, to make them available for the more specific needs of WHIZARD. \begin{description} \item[physics\_defs] Physical constants. \item[c\_particles] A simple data type for particles which is C compatible. \item[lorentz] Define three-vectors, four-vectors and Lorentz transformations and common operations for them. \item[phs\_point] Collections of Lorentz vectors. \item[sm\_physics] Here, running functions are stored for special kinematical setup like running coupling constants, Catani-Seymour dipoles, or Sudakov factors. \item[sm\_qcd] Definitions and methods for dealing with the running QCD coupling. \item[shower\_algorithms] Algorithms typically used in Parton Showers as well as in their matching to NLO computations, e.g. with the POWHEG method. \end{description} \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Physics Constants} There is also the generic [[constants]] module. The constants listed here are more specific for particle physics. <<[[physics_defs.f90]]>>= <> module physics_defs <> <> use constants, only: one, two, three <> <> <> <> interface <> end interface end module physics_defs @ %def physics_defs @ <<[[physics_defs_sub.f90]]>>= <> submodule (physics_defs) physics_defs_s implicit none contains <> end submodule physics_defs_s @ %def physics_defs_s @ \subsection{Units} Conversion from energy units to cross-section units. <>= real(default), parameter, public :: & conv = 0.38937966e12_default @ Conversion from millimeter to nanoseconds for lifetimes. <>= real(default), parameter, public :: & ns_per_mm = 1.e6_default / 299792458._default @ Rescaling factor. <>= real(default), parameter, public :: & pb_per_fb = 1.e-3_default @ String for the default energy and cross-section units. <>= character(*), parameter, public :: & energy_unit = "GeV" character(*), parameter, public :: & cross_section_unit = "fb" @ \subsection{SM and QCD constants} <>= real(default), parameter, public :: & NC = three, & CF = (NC**2 - one) / two / NC, & CA = NC, & TR = one / two @ \subsection{Parameter Reference values} These are used exclusively in the context of running QCD parameters. In other contexts, we rely on the uniform parameter set as provided by the model definition, modifiable by the user. <>= real(default), public, parameter :: MZ_REF = 91.188_default real(default), public, parameter :: ME_REF = 0.000510998928_default real(default), public, parameter :: ALPHA_QCD_MZ_REF = 0.1178_default real(default), public, parameter :: ALPHA_QED_ME_REF = 0.0072973525693_default real(default), public, parameter :: LAMBDA_QCD_REF = 200.e-3_default @ %def alpha_s_mz_ref mz_ref lambda_qcd_ref @ \subsection{Particle codes} Let us define a few particle codes independent of the model. We need an UNDEFINED value: <>= integer, parameter, public :: UNDEFINED = 0 @ %def UNDEFINED @ SM fermions: <>= integer, parameter, public :: DOWN_Q = 1 integer, parameter, public :: UP_Q = 2 integer, parameter, public :: STRANGE_Q = 3 integer, parameter, public :: CHARM_Q = 4 integer, parameter, public :: BOTTOM_Q = 5 integer, parameter, public :: TOP_Q = 6 integer, parameter, public :: ELECTRON = 11 integer, parameter, public :: ELECTRON_NEUTRINO = 12 integer, parameter, public :: MUON = 13 integer, parameter, public :: MUON_NEUTRINO = 14 integer, parameter, public :: TAU = 15 integer, parameter, public :: TAU_NEUTRINO = 16 @ %def ELECTRON MUON TAU @ Gauge bosons: <>= integer, parameter, public :: GLUON = 21 integer, parameter, public :: PHOTON = 22 integer, parameter, public :: PHOTON_OFFSHELL = -2002 integer, parameter, public :: PHOTON_ONSHELL = 2002 integer, parameter, public :: Z_BOSON = 23 integer, parameter, public :: W_BOSON = 24 @ %def GLUON PHOTON Z_BOSON W_BOSON @ Light mesons: <>= integer, parameter, public :: PION = 111 integer, parameter, public :: PIPLUS = 211 integer, parameter, public :: PIMINUS = - PIPLUS @ %def PION PIPLUS PIMINUS @ Di-Quarks: <>= integer, parameter, public :: UD0 = 2101 integer, parameter, public :: UD1 = 2103 integer, parameter, public :: UU1 = 2203 @ %def UD0 UD1 UU1 @ Mesons: <>= integer, parameter, public :: K0L = 130 integer, parameter, public :: K0S = 310 integer, parameter, public :: K0 = 311 integer, parameter, public :: KPLUS = 321 integer, parameter, public :: DPLUS = 411 integer, parameter, public :: D0 = 421 integer, parameter, public :: B0 = 511 integer, parameter, public :: BPLUS = 521 @ %def K0L K0S K0 KPLUS DPLUS D0 B0 BPLUS @ Light baryons: <>= integer, parameter, public :: PROTON = 2212 integer, parameter, public :: NEUTRON = 2112 integer, parameter, public :: DELTAPLUSPLUS = 2224 integer, parameter, public :: DELTAPLUS = 2214 integer, parameter, public :: DELTA0 = 2114 integer, parameter, public :: DELTAMINUS = 1114 @ %def PROTON NEUTRON DELTAPLUSPLUS DELTAPLUS DELTA0 DELTAMINUS @ Strange baryons: <>= integer, parameter, public :: SIGMAPLUS = 3222 integer, parameter, public :: SIGMA0 = 3212 integer, parameter, public :: SIGMAMINUS = 3112 @ %def SIGMAPLUS SIGMA0 SIGMAMINUS @ Charmed baryons: <>= integer, parameter, public :: SIGMACPLUSPLUS = 4222 integer, parameter, public :: SIGMACPLUS = 4212 integer, parameter, public :: SIGMAC0 = 4112 @ %def SIGMACPLUSPLUS SIGMACPLUS SIGMAC0 @ Bottom baryons: <>= integer, parameter, public :: SIGMAB0 = 5212 integer, parameter, public :: SIGMABPLUS = 5222 @ %def SIGMAB0 SIGMABPLUS @ 81-100 are reserved for internal codes. Hadron and beam remnants: <>= integer, parameter, public :: BEAM_REMNANT = 9999 integer, parameter, public :: HADRON_REMNANT = 90 integer, parameter, public :: HADRON_REMNANT_SINGLET = 91 integer, parameter, public :: HADRON_REMNANT_TRIPLET = 92 integer, parameter, public :: HADRON_REMNANT_OCTET = 93 @ %def BEAM_REMNANT HADRON_REMNANT @ %def HADRON_REMNANT_SINGLET HADRON_REMNANT_TRIPLET HADRON_REMNANT_OCTET @ Further particle codes for internal use: <>= integer, parameter, public :: INTERNAL = 94 integer, parameter, public :: INVALID = 97 integer, parameter, public :: COMPOSITE = 99 @ %def INTERNAL INVALID COMPOSITE @ \subsection{Spin codes} Somewhat redundant, but for better readability we define named constants for spin types. If the mass is nonzero, this is equal to the number of degrees of freedom. <>= integer, parameter, public:: UNKNOWN = 0 integer, parameter, public :: SCALAR = 1, SPINOR = 2, VECTOR = 3, & VECTORSPINOR = 4, TENSOR = 5 @ %def UNKNOWN SCALAR SPINOR VECTOR VECTORSPINOR TENSOR @ Isospin types and charge types are counted in an analogous way, where charge type 1 is charge 0, 2 is charge 1/3, and so on. Zero always means unknown. Note that charge and isospin types have an explicit sign. Color types are defined as the dimension of the representation. \subsection{NLO status codes} Used to specify whether a [[term_instance_t]] of a [[process_instance_t]] is associated with a Born, real-subtracted, virtual-subtracted or subtraction-dummy matrix element. <>= integer, parameter, public :: BORN = 0 integer, parameter, public :: NLO_REAL = 1 integer, parameter, public :: NLO_VIRTUAL = 2 integer, parameter, public :: NLO_MISMATCH = 3 integer, parameter, public :: NLO_DGLAP = 4 integer, parameter, public :: NLO_SUBTRACTION = 5 integer, parameter, public :: NLO_FULL = 6 integer, parameter, public :: GKS = 7 integer, parameter, public :: COMPONENT_UNDEFINED = 99 @ % def BORN, NLO_REAL, NLO_VIRTUAL, NLO_SUBTRACTION, GKS @ [[NLO_FULL]] is not strictly a component status code but having it is convenient. We define the number of additional subtractions for beam-involved NLO calculations. Each subtraction refers to a rescaling of one of two beams. Obviously, this approach is not flexible enough to support setups with just a single beam described by a structure function. <>= integer, parameter, public :: n_beams_rescaled = 2 @ %def n_beams_rescaled @ Orders of the electron PDFs. <>= integer, parameter, public :: EPDF_LL = 0 integer, parameter, public :: EPDF_NLL = 1 @ %def EPDF_LL EPDF_NLL @ <>= public :: component_status <>= interface component_status module procedure component_status_of_string module procedure component_status_to_string end interface <>= elemental module function component_status_of_string (string) result (i) integer :: i type(string_t), intent(in) :: string end function component_status_of_string elemental module function component_status_to_string (i) result (string) type(string_t) :: string integer, intent(in) :: i end function component_status_to_string <>= elemental module function component_status_of_string (string) result (i) integer :: i type(string_t), intent(in) :: string select case (char(string)) case ("born") i = BORN case ("real") i = NLO_REAL case ("virtual") i = NLO_VIRTUAL case ("mismatch") i = NLO_MISMATCH case ("dglap") i = NLO_DGLAP case ("subtraction") i = NLO_SUBTRACTION case ("full") i = NLO_FULL case ("GKS") i = GKS case default i = COMPONENT_UNDEFINED end select end function component_status_of_string elemental module function component_status_to_string (i) result (string) type(string_t) :: string integer, intent(in) :: i select case (i) case (BORN) string = "born" case (NLO_REAL) string = "real" case (NLO_VIRTUAL) string = "virtual" case (NLO_MISMATCH) string = "mismatch" case (NLO_DGLAP) string = "dglap" case (NLO_SUBTRACTION) string = "subtraction" case (NLO_FULL) string = "full" case (GKS) string = "GKS" case default string = "undefined" end select end function component_status_to_string @ %def component_status @ <>= public :: is_nlo_component <>= elemental module function is_nlo_component (comp) result (is_nlo) logical :: is_nlo integer, intent(in) :: comp end function is_nlo_component <>= elemental module function is_nlo_component (comp) result (is_nlo) logical :: is_nlo integer, intent(in) :: comp select case (comp) case (BORN : GKS) is_nlo = .true. case default is_nlo = .false. end select end function is_nlo_component @ %def is_nlo_component @ <>= public :: is_subtraction_component <>= module function is_subtraction_component (emitter, nlo_type) result (is_subtraction) logical :: is_subtraction integer, intent(in) :: emitter, nlo_type end function is_subtraction_component <>= module function is_subtraction_component (emitter, nlo_type) result (is_subtraction) logical :: is_subtraction integer, intent(in) :: emitter, nlo_type is_subtraction = nlo_type == NLO_REAL .and. emitter < 0 end function is_subtraction_component @ %def is_subtraction_component @ \subsection{Threshold} Some commonly used variables for the threshold computation <>= integer, parameter, public :: THR_POS_WP = 3 integer, parameter, public :: THR_POS_WM = 4 integer, parameter, public :: THR_POS_B = 5 integer, parameter, public :: THR_POS_BBAR = 6 integer, parameter, public :: THR_POS_GLUON = 7 integer, parameter, public :: THR_EMITTER_OFFSET = 4 integer, parameter, public :: NO_FACTORIZATION = 0 integer, parameter, public :: FACTORIZATION_THRESHOLD = 1 integer, dimension(2), parameter, public :: ass_quark = [5, 6] integer, dimension(2), parameter, public :: ass_boson = [3, 4] integer, parameter, public :: PROC_MODE_UNDEFINED = 0 integer, parameter, public :: PROC_MODE_TT = 1 integer, parameter, public :: PROC_MODE_WBWB = 2 @ @ <>= public :: thr_leg <>= module function thr_leg (emitter) result (leg) integer :: leg integer, intent(in) :: emitter end function thr_leg <>= module function thr_leg (emitter) result (leg) integer :: leg integer, intent(in) :: emitter leg = emitter - THR_EMITTER_OFFSET end function thr_leg @ %def thr_leg @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{C-compatible Particle Type} For easy communication with C code, we introduce a simple C-compatible type for particles. The components are either default C integers or default C doubles. The [[c_prt]] type is transparent, and its contents should be regarded as part of the interface. <<[[c_particles.f90]]>>= <> module c_particles use, intrinsic :: iso_c_binding !NODEP! <> <> <> interface <> end interface end module c_particles @ %def c_particles @ <<[[c_particles_sub.f90]]>>= <> submodule (c_particles) c_particles_s use io_units use format_defs, only: FMT_14, FMT_19 implicit none contains <> end submodule c_particles_s @ %def c_particles_s @ <>= public :: c_prt_t <>= type, bind(C) :: c_prt_t integer(c_int) :: type = 0 integer(c_int) :: pdg = 0 integer(c_int) :: polarized = 0 integer(c_int) :: h = 0 real(c_double) :: pe = 0 real(c_double) :: px = 0 real(c_double) :: py = 0 real(c_double) :: pz = 0 real(c_double) :: p2 = 0 end type c_prt_t @ %def c_prt_t @ This is for debugging only, there is no C binding. It is a simplified version of [[prt_write]]. <>= public :: c_prt_write <>= module subroutine c_prt_write (prt, unit) type(c_prt_t), intent(in) :: prt integer, intent(in), optional :: unit end subroutine c_prt_write <>= module subroutine c_prt_write (prt, unit) type(c_prt_t), intent(in) :: prt integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(1x,A)", advance="no") "prt(" write (u, "(I0,':')", advance="no") prt%type if (prt%polarized /= 0) then write (u, "(I0,'/',I0,'|')", advance="no") prt%pdg, prt%h else write (u, "(I0,'|')", advance="no") prt%pdg end if write (u, "(" // FMT_14 // ",';'," // FMT_14 // ",','," // & FMT_14 // ",','," // FMT_14 // ")", advance="no") & prt%pe, prt%px, prt%py, prt%pz write (u, "('|'," // FMT_19 // ")", advance="no") prt%p2 write (u, "(A)") ")" end subroutine c_prt_write @ %def c_prt_write @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Lorentz algebra} Define Lorentz vectors, three-vectors, boosts, and some functions to manipulate them. To make maximum use of this, all functions, if possible, are declared elemental (or pure, if this is not possible). <<[[lorentz.f90]]>>= <> module lorentz <> use constants, only: zero, one use c_particles <> <> <> <> <> <> <> interface <> end interface end module lorentz @ %def lorentz @ <<[[lorentz_sub.f90]]>>= <> submodule (lorentz) lorentz_s use constants, only: pi, twopi, degree, two, tiny_07, eps0 use numeric_utils use io_units use format_defs, only: FMT_11, FMT_13, FMT_15, FMT_19 use format_utils, only: pac_fmt use diagnostics implicit none contains <> end submodule lorentz_s @ %def lorentz_s @ \subsection{Three-vectors} First of all, let us introduce three-vectors in a trivial way. The functions and overloaded elementary operations clearly are too much overhead, but we like to keep the interface for three-vectors and four-vectors exactly parallel. By the way, we might attach a label to a vector by extending the type definition later. <>= public :: vector3_t <>= type :: vector3_t real(default), dimension(3) :: p end type vector3_t @ %def vector3_t @ Output a vector <>= public :: vector3_write <>= module subroutine vector3_write (p, unit, testflag) type(vector3_t), intent(in) :: p integer, intent(in), optional :: unit logical, intent(in), optional :: testflag end subroutine vector3_write <>= module subroutine vector3_write (p, unit, testflag) type(vector3_t), intent(in) :: p integer, intent(in), optional :: unit logical, intent(in), optional :: testflag character(len=7) :: fmt integer :: u u = given_output_unit (unit); if (u < 0) return call pac_fmt (fmt, FMT_19, FMT_15, testflag) write(u, "(1x,A,3(1x," // fmt // "))") 'P = ', p%p end subroutine vector3_write @ %def vector3_write @ This is a three-vector with zero components <>= public :: vector3_null <>= type(vector3_t), parameter :: vector3_null = & vector3_t ([ zero, zero, zero ]) @ %def vector3_null @ Canonical three-vector: <>= public :: vector3_canonical <>= elemental module function vector3_canonical (k) result (p) type(vector3_t) :: p integer, intent(in) :: k end function vector3_canonical <>= elemental module function vector3_canonical (k) result (p) type(vector3_t) :: p integer, intent(in) :: k p = vector3_null p%p(k) = 1 end function vector3_canonical @ %def vector3_canonical @ A moving particle ($k$-axis, or arbitrary axis). Note that the function for the generic momentum cannot be elemental. <>= public :: vector3_moving <>= interface vector3_moving module procedure vector3_moving_canonical module procedure vector3_moving_generic end interface <>= elemental module function vector3_moving_canonical (p, k) result(q) type(vector3_t) :: q real(default), intent(in) :: p integer, intent(in) :: k end function vector3_moving_canonical pure module function vector3_moving_generic (p) result(q) real(default), dimension(3), intent(in) :: p type(vector3_t) :: q end function vector3_moving_generic <>= elemental module function vector3_moving_canonical (p, k) result(q) type(vector3_t) :: q real(default), intent(in) :: p integer, intent(in) :: k q = vector3_null q%p(k) = p end function vector3_moving_canonical pure module function vector3_moving_generic (p) result(q) real(default), dimension(3), intent(in) :: p type(vector3_t) :: q q%p = p end function vector3_moving_generic @ %def vector3_moving @ Equality and inequality <>= public :: operator(==), operator(/=) <>= interface operator(==) module procedure vector3_eq end interface interface operator(/=) module procedure vector3_neq end interface <>= elemental module function vector3_eq (p, q) result (r) logical :: r type(vector3_t), intent(in) :: p,q end function vector3_eq elemental module function vector3_neq (p, q) result (r) logical :: r type(vector3_t), intent(in) :: p,q end function vector3_neq <>= elemental module function vector3_eq (p, q) result (r) logical :: r type(vector3_t), intent(in) :: p,q r = all (abs (p%p - q%p) < eps0) end function vector3_eq elemental module function vector3_neq (p, q) result (r) logical :: r type(vector3_t), intent(in) :: p,q r = any (abs(p%p - q%p) > eps0) end function vector3_neq @ %def == /= @ Define addition and subtraction <>= public :: operator(+), operator(-) <>= interface operator(+) module procedure add_vector3 end interface interface operator(-) module procedure sub_vector3 end interface <>= elemental module function add_vector3 (p, q) result (r) type(vector3_t) :: r type(vector3_t), intent(in) :: p,q end function add_vector3 elemental module function sub_vector3 (p, q) result (r) type(vector3_t) :: r type(vector3_t), intent(in) :: p,q end function sub_vector3 <>= elemental module function add_vector3 (p, q) result (r) type(vector3_t) :: r type(vector3_t), intent(in) :: p,q r%p = p%p + q%p end function add_vector3 elemental module function sub_vector3 (p, q) result (r) type(vector3_t) :: r type(vector3_t), intent(in) :: p,q r%p = p%p - q%p end function sub_vector3 @ %def + - @ The multiplication sign is overloaded with scalar multiplication; similarly division: <>= public :: operator(*), operator(/) <>= interface operator(*) module procedure prod_integer_vector3, prod_vector3_integer module procedure prod_real_vector3, prod_vector3_real end interface interface operator(/) module procedure div_vector3_real, div_vector3_integer end interface <>= elemental module function prod_real_vector3 (s, p) result (q) type(vector3_t) :: q real(default), intent(in) :: s type(vector3_t), intent(in) :: p end function prod_real_vector3 elemental module function prod_vector3_real (p, s) result (q) type(vector3_t) :: q real(default), intent(in) :: s type(vector3_t), intent(in) :: p end function prod_vector3_real elemental module function div_vector3_real (p, s) result (q) type(vector3_t) :: q real(default), intent(in) :: s type(vector3_t), intent(in) :: p end function div_vector3_real elemental module function prod_integer_vector3 (s, p) result (q) type(vector3_t) :: q integer, intent(in) :: s type(vector3_t), intent(in) :: p end function prod_integer_vector3 elemental module function prod_vector3_integer (p, s) result (q) type(vector3_t) :: q integer, intent(in) :: s type(vector3_t), intent(in) :: p end function prod_vector3_integer elemental module function div_vector3_integer (p, s) result (q) type(vector3_t) :: q integer, intent(in) :: s type(vector3_t), intent(in) :: p end function div_vector3_integer <>= elemental module function prod_real_vector3 (s, p) result (q) type(vector3_t) :: q real(default), intent(in) :: s type(vector3_t), intent(in) :: p q%p = s * p%p end function prod_real_vector3 elemental module function prod_vector3_real (p, s) result (q) type(vector3_t) :: q real(default), intent(in) :: s type(vector3_t), intent(in) :: p q%p = s * p%p end function prod_vector3_real elemental module function div_vector3_real (p, s) result (q) type(vector3_t) :: q real(default), intent(in) :: s type(vector3_t), intent(in) :: p q%p = p%p/s end function div_vector3_real elemental module function prod_integer_vector3 (s, p) result (q) type(vector3_t) :: q integer, intent(in) :: s type(vector3_t), intent(in) :: p q%p = s * p%p end function prod_integer_vector3 elemental module function prod_vector3_integer (p, s) result (q) type(vector3_t) :: q integer, intent(in) :: s type(vector3_t), intent(in) :: p q%p = s * p%p end function prod_vector3_integer elemental module function div_vector3_integer (p, s) result (q) type(vector3_t) :: q integer, intent(in) :: s type(vector3_t), intent(in) :: p q%p = p%p/s end function div_vector3_integer @ %def * / @ The multiplication sign can also indicate scalar products: <>= interface operator(*) module procedure prod_vector3 end interface <>= elemental module function prod_vector3 (p, q) result (s) real(default) :: s type(vector3_t), intent(in) :: p,q end function prod_vector3 <>= elemental module function prod_vector3 (p, q) result (s) real(default) :: s type(vector3_t), intent(in) :: p,q s = dot_product (p%p, q%p) end function prod_vector3 @ %def * <>= public :: cross_product <>= interface cross_product module procedure vector3_cross_product end interface <>= elemental module function vector3_cross_product (p, q) result (r) type(vector3_t) :: r type(vector3_t), intent(in) :: p,q end function vector3_cross_product <>= elemental module function vector3_cross_product (p, q) result (r) type(vector3_t) :: r type(vector3_t), intent(in) :: p,q integer :: i do i=1,3 r%p(i) = dot_product (p%p, matmul(epsilon_three(i,:,:), q%p)) end do end function vector3_cross_product @ %def cross_product @ Exponentiation is defined only for integer powers. Odd powers mean take the square root; so [[p**1]] is the length of [[p]]. <>= public :: operator(**) <>= interface operator(**) module procedure power_vector3 end interface <>= elemental module function power_vector3 (p, e) result (s) real(default) :: s type(vector3_t), intent(in) :: p integer, intent(in) :: e end function power_vector3 <>= elemental module function power_vector3 (p, e) result (s) real(default) :: s type(vector3_t), intent(in) :: p integer, intent(in) :: e s = dot_product (p%p, p%p) if (e/=2) then if (mod(e,2)==0) then s = s**(e/2) else s = sqrt(s)**e end if end if end function power_vector3 @ %def ** @ Finally, we need a negation. <>= interface operator(-) module procedure negate_vector3 end interface <>= elemental module function negate_vector3 (p) result (q) type(vector3_t) :: q type(vector3_t), intent(in) :: p end function negate_vector3 <>= elemental module function negate_vector3 (p) result (q) type(vector3_t) :: q type(vector3_t), intent(in) :: p integer :: i do i = 1, 3 if (abs (p%p(i)) < eps0) then q%p(i) = 0 else q%p(i) = -p%p(i) end if end do end function negate_vector3 @ %def - @ The sum function can be useful: <>= public :: sum <>= interface sum module procedure sum_vector3 end interface @ %def sum @ <>= public :: vector3_set_component <>= module subroutine vector3_set_component (p, i, value) type(vector3_t), intent(inout) :: p integer, intent(in) :: i real(default), intent(in) :: value end subroutine vector3_set_component <>= module subroutine vector3_set_component (p, i, value) type(vector3_t), intent(inout) :: p integer, intent(in) :: i real(default), intent(in) :: value p%p(i) = value end subroutine vector3_set_component @ %def vector3_set_component @ <>= pure module function sum_vector3 (p) result (q) type(vector3_t) :: q type(vector3_t), dimension(:), intent(in) :: p end function sum_vector3 <>= pure module function sum_vector3 (p) result (q) type(vector3_t) :: q type(vector3_t), dimension(:), intent(in) :: p integer :: i do i=1, 3 q%p(i) = sum (p%p(i)) end do end function sum_vector3 @ %def sum @ Any component: <>= public :: vector3_get_component @ %def component <>= elemental module function vector3_get_component (p, k) result (c) type(vector3_t), intent(in) :: p integer, intent(in) :: k real(default) :: c end function vector3_get_component <>= elemental module function vector3_get_component (p, k) result (c) type(vector3_t), intent(in) :: p integer, intent(in) :: k real(default) :: c c = p%p(k) end function vector3_get_component @ %def vector3_get_component @ Extract all components. This is not elemental. <>= public :: vector3_get_components <>= pure module function vector3_get_components (p) result (a) type(vector3_t), intent(in) :: p real(default), dimension(3) :: a end function vector3_get_components <>= pure module function vector3_get_components (p) result (a) type(vector3_t), intent(in) :: p real(default), dimension(3) :: a a = p%p end function vector3_get_components @ %def vector3_get_components @ This function returns the direction of a three-vector, i.e., a normalized three-vector. If the vector is null, we return a null vector. <>= public :: direction <>= interface direction module procedure vector3_get_direction end interface <>= elemental module function vector3_get_direction (p) result (q) type(vector3_t) :: q type(vector3_t), intent(in) :: p end function vector3_get_direction <>= elemental module function vector3_get_direction (p) result (q) type(vector3_t) :: q type(vector3_t), intent(in) :: p real(default) :: pp pp = p**1 if (pp > eps0) then q%p = p%p / pp else q%p = 0 end if end function vector3_get_direction @ %def direction @ \subsection{Four-vectors} In four-vectors the zero-component needs special treatment, therefore we do not use the standard operations. Sure, we pay for the extra layer of abstraction by losing efficiency; so we have to assume that the time-critical applications do not involve four-vector operations. <>= public :: vector4_t <>= type :: vector4_t real(default), dimension(0:3) :: p = & [zero, zero, zero, zero] contains <> end type vector4_t @ %def vector4_t @ Output a vector <>= public :: vector4_write <>= procedure :: write => vector4_write <>= module subroutine vector4_write & (p, unit, show_mass, testflag, compressed, ultra) class(vector4_t), intent(in) :: p integer, intent(in), optional :: unit logical, intent(in), optional :: show_mass, testflag, compressed, ultra end subroutine vector4_write <>= module subroutine vector4_write & (p, unit, show_mass, testflag, compressed, ultra) class(vector4_t), intent(in) :: p integer, intent(in), optional :: unit logical, intent(in), optional :: show_mass, testflag, compressed, ultra logical :: comp, sm, tf, extreme integer :: u character(len=7) :: fmt real(default) :: m comp = .false.; if (present (compressed)) comp = compressed sm = .false.; if (present (show_mass)) sm = show_mass tf = .false.; if (present (testflag)) tf = testflag extreme = .false.; if (present (ultra)) extreme = ultra if (extreme) then call pac_fmt (fmt, FMT_19, FMT_11, testflag) else call pac_fmt (fmt, FMT_19, FMT_13, testflag) end if u = given_output_unit (unit); if (u < 0) return if (comp) then write (u, "(4(F12.3,1X))", advance="no") p%p(0:3) else write (u, "(1x,A,1x," // fmt // ")") 'E = ', p%p(0) write (u, "(1x,A,3(1x," // fmt // "))") 'P = ', p%p(1:) if (sm) then m = p**1 if (tf) call pacify (m, tolerance = 1E-6_default) write (u, "(1x,A,1x," // fmt // ")") 'M = ', m end if end if end subroutine vector4_write @ %def vector4_write @ Binary I/O <>= public :: vector4_write_raw public :: vector4_read_raw <>= module subroutine vector4_write_raw (p, u) type(vector4_t), intent(in) :: p integer, intent(in) :: u end subroutine vector4_write_raw module subroutine vector4_read_raw (p, u, iostat) type(vector4_t), intent(out) :: p integer, intent(in) :: u integer, intent(out), optional :: iostat end subroutine vector4_read_raw <>= module subroutine vector4_write_raw (p, u) type(vector4_t), intent(in) :: p integer, intent(in) :: u write (u) p%p end subroutine vector4_write_raw module subroutine vector4_read_raw (p, u, iostat) type(vector4_t), intent(out) :: p integer, intent(in) :: u integer, intent(out), optional :: iostat read (u, iostat=iostat) p%p end subroutine vector4_read_raw @ %def vector4_write_raw vector4_read_raw @ This is a four-vector with zero components <>= public :: vector4_null <>= type(vector4_t), parameter :: vector4_null = & vector4_t ([ zero, zero, zero, zero ]) @ %def vector4_null @ Canonical four-vector: <>= public :: vector4_canonical <>= elemental module function vector4_canonical (k) result (p) type(vector4_t) :: p integer, intent(in) :: k end function vector4_canonical <>= elemental module function vector4_canonical (k) result (p) type(vector4_t) :: p integer, intent(in) :: k p = vector4_null p%p(k) = 1 end function vector4_canonical @ %def vector4_canonical @ A particle at rest: <>= public :: vector4_at_rest <>= elemental module function vector4_at_rest (m) result (p) type(vector4_t) :: p real(default), intent(in) :: m end function vector4_at_rest <>= elemental module function vector4_at_rest (m) result (p) type(vector4_t) :: p real(default), intent(in) :: m p = vector4_t ([ m, zero, zero, zero ]) end function vector4_at_rest @ %def vector4_at_rest @ A moving particle ($k$-axis, or arbitrary axis) <>= public :: vector4_moving <>= interface vector4_moving module procedure vector4_moving_canonical module procedure vector4_moving_generic end interface <>= elemental module function vector4_moving_canonical (E, p, k) result (q) type(vector4_t) :: q real(default), intent(in) :: E, p integer, intent(in) :: k end function vector4_moving_canonical elemental module function vector4_moving_generic (E, p) result (q) type(vector4_t) :: q real(default), intent(in) :: E type(vector3_t), intent(in) :: p end function vector4_moving_generic <>= elemental module function vector4_moving_canonical (E, p, k) result (q) type(vector4_t) :: q real(default), intent(in) :: E, p integer, intent(in) :: k q = vector4_at_rest(E) q%p(k) = p end function vector4_moving_canonical elemental module function vector4_moving_generic (E, p) result (q) type(vector4_t) :: q real(default), intent(in) :: E type(vector3_t), intent(in) :: p q%p(0) = E q%p(1:) = p%p end function vector4_moving_generic @ %def vector4_moving @ Equality and inequality <>= interface operator(==) module procedure vector4_eq end interface interface operator(/=) module procedure vector4_neq end interface <>= elemental module function vector4_eq (p, q) result (r) logical :: r type(vector4_t), intent(in) :: p,q end function vector4_eq elemental module function vector4_neq (p, q) result (r) logical :: r type(vector4_t), intent(in) :: p,q end function vector4_neq <>= elemental module function vector4_eq (p, q) result (r) logical :: r type(vector4_t), intent(in) :: p,q r = all (abs (p%p - q%p) < eps0) end function vector4_eq elemental module function vector4_neq (p, q) result (r) logical :: r type(vector4_t), intent(in) :: p,q r = any (abs (p%p - q%p) > eps0) end function vector4_neq @ %def == /= @ Addition and subtraction: <>= interface operator(+) module procedure add_vector4 end interface interface operator(-) module procedure sub_vector4 end interface <>= elemental module function add_vector4 (p,q) result (r) type(vector4_t) :: r type(vector4_t), intent(in) :: p,q end function add_vector4 elemental module function sub_vector4 (p,q) result (r) type(vector4_t) :: r type(vector4_t), intent(in) :: p,q end function sub_vector4 <>= elemental module function add_vector4 (p,q) result (r) type(vector4_t) :: r type(vector4_t), intent(in) :: p,q r%p = p%p + q%p end function add_vector4 elemental module function sub_vector4 (p,q) result (r) type(vector4_t) :: r type(vector4_t), intent(in) :: p,q r%p = p%p - q%p end function sub_vector4 @ %def + - @ We also need scalar multiplication and division: <>= interface operator(*) module procedure prod_real_vector4, prod_vector4_real module procedure prod_integer_vector4, prod_vector4_integer end interface interface operator(/) module procedure div_vector4_real module procedure div_vector4_integer end interface <>= elemental module function prod_real_vector4 (s, p) result (q) type(vector4_t) :: q real(default), intent(in) :: s type(vector4_t), intent(in) :: p end function prod_real_vector4 elemental module function prod_vector4_real (p, s) result (q) type(vector4_t) :: q real(default), intent(in) :: s type(vector4_t), intent(in) :: p end function prod_vector4_real elemental module function div_vector4_real (p, s) result (q) type(vector4_t) :: q real(default), intent(in) :: s type(vector4_t), intent(in) :: p end function div_vector4_real elemental module function prod_integer_vector4 (s, p) result (q) type(vector4_t) :: q integer, intent(in) :: s type(vector4_t), intent(in) :: p end function prod_integer_vector4 elemental module function prod_vector4_integer (p, s) result (q) type(vector4_t) :: q integer, intent(in) :: s type(vector4_t), intent(in) :: p end function prod_vector4_integer elemental module function div_vector4_integer (p, s) result (q) type(vector4_t) :: q integer, intent(in) :: s type(vector4_t), intent(in) :: p end function div_vector4_integer <>= elemental module function prod_real_vector4 (s, p) result (q) type(vector4_t) :: q real(default), intent(in) :: s type(vector4_t), intent(in) :: p q%p = s * p%p end function prod_real_vector4 elemental module function prod_vector4_real (p, s) result (q) type(vector4_t) :: q real(default), intent(in) :: s type(vector4_t), intent(in) :: p q%p = s * p%p end function prod_vector4_real elemental module function div_vector4_real (p, s) result (q) type(vector4_t) :: q real(default), intent(in) :: s type(vector4_t), intent(in) :: p q%p = p%p/s end function div_vector4_real elemental module function prod_integer_vector4 (s, p) result (q) type(vector4_t) :: q integer, intent(in) :: s type(vector4_t), intent(in) :: p q%p = s * p%p end function prod_integer_vector4 elemental module function prod_vector4_integer (p, s) result (q) type(vector4_t) :: q integer, intent(in) :: s type(vector4_t), intent(in) :: p q%p = s * p%p end function prod_vector4_integer elemental module function div_vector4_integer (p, s) result (q) type(vector4_t) :: q integer, intent(in) :: s type(vector4_t), intent(in) :: p q%p = p%p/s end function div_vector4_integer @ %def * / @ Scalar products and squares in the Minkowski sense: <>= interface operator(*) module procedure prod_vector4 end interface interface operator(**) module procedure power_vector4 end interface <>= elemental module function prod_vector4 (p, q) result (s) real(default) :: s type(vector4_t), intent(in) :: p,q end function prod_vector4 <>= elemental module function prod_vector4 (p, q) result (s) real(default) :: s type(vector4_t), intent(in) :: p,q s = p%p(0)*q%p(0) - dot_product(p%p(1:), q%p(1:)) end function prod_vector4 @ %def * @ The power operation for four-vectors is signed, i.e., [[p**1]] is positive for timelike and negative for spacelike vectors. Note that [[(p**1)**2]] is not necessarily equal to [[p**2]]. <>= elemental module function power_vector4 (p, e) result (s) real(default) :: s type(vector4_t), intent(in) :: p integer, intent(in) :: e end function power_vector4 <>= elemental module function power_vector4 (p, e) result (s) real(default) :: s type(vector4_t), intent(in) :: p integer, intent(in) :: e s = p * p if (e /= 2) then if (mod(e, 2) == 0) then s = s**(e / 2) else if (s >= 0) then s = sqrt(s)**e else s = -(sqrt(abs(s))**e) end if end if end function power_vector4 @ %def ** @ Finally, we introduce a negation <>= interface operator(-) module procedure negate_vector4 end interface <>= elemental module function negate_vector4 (p) result (q) type(vector4_t) :: q type(vector4_t), intent(in) :: p end function negate_vector4 <>= elemental module function negate_vector4 (p) result (q) type(vector4_t) :: q type(vector4_t), intent(in) :: p integer :: i do i = 0, 3 if (abs (p%p(i)) < eps0) then q%p(i) = 0 else q%p(i) = -p%p(i) end if end do end function negate_vector4 @ %def - @ The sum function can be useful: <>= interface sum module procedure sum_vector4, sum_vector4_mask end interface @ %def sum @ <>= pure module function sum_vector4 (p) result (q) type(vector4_t) :: q type(vector4_t), dimension(:), intent(in) :: p end function sum_vector4 pure module function sum_vector4_mask (p, mask) result (q) type(vector4_t) :: q type(vector4_t), dimension(:), intent(in) :: p logical, dimension(:), intent(in) :: mask end function sum_vector4_mask <>= pure module function sum_vector4 (p) result (q) type(vector4_t) :: q type(vector4_t), dimension(:), intent(in) :: p integer :: i do i = 0, 3 q%p(i) = sum (p%p(i)) end do end function sum_vector4 pure module function sum_vector4_mask (p, mask) result (q) type(vector4_t) :: q type(vector4_t), dimension(:), intent(in) :: p logical, dimension(:), intent(in) :: mask integer :: i do i = 0, 3 q%p(i) = sum (p%p(i), mask=mask) end do end function sum_vector4_mask @ %def sum @ \subsection{Conversions} Manually set a component of the four-vector: <>= public :: vector4_set_component <>= module subroutine vector4_set_component (p, k, c) type(vector4_t), intent(inout) :: p integer, intent(in) :: k real(default), intent(in) :: c end subroutine vector4_set_component <>= module subroutine vector4_set_component (p, k, c) type(vector4_t), intent(inout) :: p integer, intent(in) :: k real(default), intent(in) :: c p%p(k) = c end subroutine vector4_set_component @ %def vector4_get_component Any component: <>= public :: vector4_get_component <>= elemental module function vector4_get_component (p, k) result (c) real(default) :: c type(vector4_t), intent(in) :: p integer, intent(in) :: k end function vector4_get_component <>= elemental module function vector4_get_component (p, k) result (c) real(default) :: c type(vector4_t), intent(in) :: p integer, intent(in) :: k c = p%p(k) end function vector4_get_component @ %def vector4_get_component @ Extract all components. This is not elemental. <>= public :: vector4_get_components <>= pure module function vector4_get_components (p) result (a) real(default), dimension(0:3) :: a type(vector4_t), intent(in) :: p end function vector4_get_components <>= pure module function vector4_get_components (p) result (a) real(default), dimension(0:3) :: a type(vector4_t), intent(in) :: p a = p%p end function vector4_get_components @ %def vector4_get_components @ This function returns the space part of a four-vector, such that we can apply three-vector operations on it: <>= public :: space_part <>= interface space_part module procedure vector4_get_space_part end interface <>= elemental module function vector4_get_space_part (p) result (q) type(vector3_t) :: q type(vector4_t), intent(in) :: p end function vector4_get_space_part <>= elemental module function vector4_get_space_part (p) result (q) type(vector3_t) :: q type(vector4_t), intent(in) :: p q%p = p%p(1:) end function vector4_get_space_part @ %def space_part @ This function returns the direction of a four-vector, i.e., a normalized three-vector. If the four-vector has zero space part, we return a null vector. <>= interface direction module procedure vector4_get_direction end interface <>= elemental module function vector4_get_direction (p) result (q) type(vector3_t) :: q type(vector4_t), intent(in) :: p end function vector4_get_direction <>= elemental module function vector4_get_direction (p) result (q) type(vector3_t) :: q type(vector4_t), intent(in) :: p real(default) :: qq q%p = p%p(1:) qq = q**1 if (abs(qq) > eps0) then q%p = q%p / qq else q%p = 0 end if end function vector4_get_direction @ %def direction @ Change the sign of the spatial part of a four-vector <>= public :: vector4_invert_direction <>= elemental module subroutine vector4_invert_direction (p) type(vector4_t), intent(inout) :: p end subroutine vector4_invert_direction <>= elemental module subroutine vector4_invert_direction (p) type(vector4_t), intent(inout) :: p p%p(1:3) = -p%p(1:3) end subroutine vector4_invert_direction @ %def vector4_invert_direction @ This function returns the four-vector as an ordinary array. A second version for an array of four-vectors. <>= public :: assignment (=) <>= interface assignment (=) module procedure array_from_vector4_1, array_from_vector4_2, & array_from_vector3_1, array_from_vector3_2, & vector4_from_array, vector3_from_array end interface <>= pure module subroutine array_from_vector4_1 (a, p) real(default), dimension(:), intent(out) :: a type(vector4_t), intent(in) :: p end subroutine array_from_vector4_1 pure module subroutine array_from_vector4_2 (a, p) type(vector4_t), dimension(:), intent(in) :: p real(default), dimension(:,:), intent(out) :: a end subroutine array_from_vector4_2 pure module subroutine array_from_vector3_1 (a, p) real(default), dimension(:), intent(out) :: a type(vector3_t), intent(in) :: p end subroutine array_from_vector3_1 pure module subroutine array_from_vector3_2 (a, p) type(vector3_t), dimension(:), intent(in) :: p real(default), dimension(:,:), intent(out) :: a end subroutine array_from_vector3_2 pure module subroutine vector4_from_array (p, a) type(vector4_t), intent(out) :: p real(default), dimension(:), intent(in) :: a end subroutine vector4_from_array pure module subroutine vector3_from_array (p, a) type(vector3_t), intent(out) :: p real(default), dimension(:), intent(in) :: a end subroutine vector3_from_array <>= pure module subroutine array_from_vector4_1 (a, p) real(default), dimension(:), intent(out) :: a type(vector4_t), intent(in) :: p a = p%p end subroutine array_from_vector4_1 pure module subroutine array_from_vector4_2 (a, p) type(vector4_t), dimension(:), intent(in) :: p real(default), dimension(:,:), intent(out) :: a integer :: i forall (i=1:size(p)) a(:,i) = p(i)%p end forall end subroutine array_from_vector4_2 pure module subroutine array_from_vector3_1 (a, p) real(default), dimension(:), intent(out) :: a type(vector3_t), intent(in) :: p a = p%p end subroutine array_from_vector3_1 pure module subroutine array_from_vector3_2 (a, p) type(vector3_t), dimension(:), intent(in) :: p real(default), dimension(:,:), intent(out) :: a integer :: i forall (i=1:size(p)) a(:,i) = p(i)%p end forall end subroutine array_from_vector3_2 pure module subroutine vector4_from_array (p, a) type(vector4_t), intent(out) :: p real(default), dimension(:), intent(in) :: a p%p(0:3) = a end subroutine vector4_from_array pure module subroutine vector3_from_array (p, a) type(vector3_t), intent(out) :: p real(default), dimension(:), intent(in) :: a p%p(1:3) = a end subroutine vector3_from_array @ %def array_from_vector4 array_from_vector3 @ <>= public :: vector4 <>= pure module function vector4 (a) result (p) type(vector4_t) :: p real(default), intent(in), dimension(4) :: a end function vector4 <>= pure module function vector4 (a) result (p) type(vector4_t) :: p real(default), intent(in), dimension(4) :: a p%p = a end function vector4 @ %def vector4 @ <>= procedure :: to_pythia6 => vector4_to_pythia6 <>= pure module function vector4_to_pythia6 (vector4, m) result (p) real(double), dimension(1:5) :: p class(vector4_t), intent(in) :: vector4 real(default), intent(in), optional :: m end function vector4_to_pythia6 <>= pure module function vector4_to_pythia6 (vector4, m) result (p) real(double), dimension(1:5) :: p class(vector4_t), intent(in) :: vector4 real(default), intent(in), optional :: m p(1:3) = vector4%p(1:3) p(4) = vector4%p(0) if (present (m)) then p(5) = m else p(5) = vector4 ** 1 end if end function vector4_to_pythia6 @ %def vector4_to_pythia6 @ \subsection{Interface to [[c_prt]]} Transform the momentum of a [[c_prt]] object into a four-vector and vice versa: <>= interface assignment (=) module procedure vector4_from_c_prt, c_prt_from_vector4 end interface <>= pure module subroutine vector4_from_c_prt (p, c_prt) type(vector4_t), intent(out) :: p type(c_prt_t), intent(in) :: c_prt end subroutine vector4_from_c_prt pure module subroutine c_prt_from_vector4 (c_prt, p) type(c_prt_t), intent(out) :: c_prt type(vector4_t), intent(in) :: p end subroutine c_prt_from_vector4 <>= pure module subroutine vector4_from_c_prt (p, c_prt) type(vector4_t), intent(out) :: p type(c_prt_t), intent(in) :: c_prt p%p(0) = c_prt%pe p%p(1) = c_prt%px p%p(2) = c_prt%py p%p(3) = c_prt%pz end subroutine vector4_from_c_prt pure module subroutine c_prt_from_vector4 (c_prt, p) type(c_prt_t), intent(out) :: c_prt type(vector4_t), intent(in) :: p c_prt%pe = p%p(0) c_prt%px = p%p(1) c_prt%py = p%p(2) c_prt%pz = p%p(3) c_prt%p2 = p ** 2 end subroutine c_prt_from_vector4 @ %def vector4_from_c_prt c_prt_from_vector4 @ Initialize a [[c_prt_t]] object with the components of a four-vector as its kinematical entries. Compute the invariant mass, or use the optional mass-squared value instead. <>= public :: vector4_to_c_prt <>= elemental module function vector4_to_c_prt (p, p2) result (c_prt) type(c_prt_t) :: c_prt type(vector4_t), intent(in) :: p real(default), intent(in), optional :: p2 end function vector4_to_c_prt <>= elemental module function vector4_to_c_prt (p, p2) result (c_prt) type(c_prt_t) :: c_prt type(vector4_t), intent(in) :: p real(default), intent(in), optional :: p2 c_prt%pe = p%p(0) c_prt%px = p%p(1) c_prt%py = p%p(2) c_prt%pz = p%p(3) if (present (p2)) then c_prt%p2 = p2 else c_prt%p2 = p ** 2 end if end function vector4_to_c_prt @ %def vector4_to_c_prt @ \subsection{Angles} Return the angles in a canonical system. The angle $\phi$ is defined between $0\leq\phi<2\pi$. In degenerate cases, return zero. <>= public :: azimuthal_angle <>= interface azimuthal_angle module procedure vector3_azimuthal_angle module procedure vector4_azimuthal_angle end interface <>= elemental module function vector3_azimuthal_angle (p) result (phi) real(default) :: phi type(vector3_t), intent(in) :: p end function vector3_azimuthal_angle elemental module function vector4_azimuthal_angle (p) result (phi) real(default) :: phi type(vector4_t), intent(in) :: p end function vector4_azimuthal_angle <>= elemental module function vector3_azimuthal_angle (p) result (phi) real(default) :: phi type(vector3_t), intent(in) :: p if (any (abs (p%p(1:2)) > 0)) then phi = atan2(p%p(2), p%p(1)) if (phi < 0) phi = phi + twopi else phi = 0 end if end function vector3_azimuthal_angle elemental module function vector4_azimuthal_angle (p) result (phi) real(default) :: phi type(vector4_t), intent(in) :: p phi = vector3_azimuthal_angle (space_part (p)) end function vector4_azimuthal_angle @ %def azimuthal_angle @ Azimuthal angle in degrees <>= public :: azimuthal_angle_deg <>= interface azimuthal_angle_deg module procedure vector3_azimuthal_angle_deg module procedure vector4_azimuthal_angle_deg end interface <>= elemental module function vector3_azimuthal_angle_deg (p) result (phi) real(default) :: phi type(vector3_t), intent(in) :: p end function vector3_azimuthal_angle_deg elemental module function vector4_azimuthal_angle_deg (p) result (phi) real(default) :: phi type(vector4_t), intent(in) :: p end function vector4_azimuthal_angle_deg <>= elemental module function vector3_azimuthal_angle_deg (p) result (phi) real(default) :: phi type(vector3_t), intent(in) :: p phi = vector3_azimuthal_angle (p) / degree end function vector3_azimuthal_angle_deg elemental module function vector4_azimuthal_angle_deg (p) result (phi) real(default) :: phi type(vector4_t), intent(in) :: p phi = vector4_azimuthal_angle (p) / degree end function vector4_azimuthal_angle_deg @ %def azimuthal_angle_deg @ The azimuthal distance of two vectors. This is the difference of the azimuthal angles, but cannot be larger than $\pi$: The result is between $-\pi<\Delta\phi\leq\pi$. <>= public :: azimuthal_distance <>= interface azimuthal_distance module procedure vector3_azimuthal_distance module procedure vector4_azimuthal_distance end interface <>= elemental module function vector3_azimuthal_distance (p, q) result (dphi) real(default) :: dphi type(vector3_t), intent(in) :: p,q end function vector3_azimuthal_distance elemental module function vector4_azimuthal_distance (p, q) result (dphi) real(default) :: dphi type(vector4_t), intent(in) :: p,q end function vector4_azimuthal_distance <>= elemental module function vector3_azimuthal_distance (p, q) result (dphi) real(default) :: dphi type(vector3_t), intent(in) :: p,q dphi = vector3_azimuthal_angle (q) - vector3_azimuthal_angle (p) if (dphi <= -pi) then dphi = dphi + twopi else if (dphi > pi) then dphi = dphi - twopi end if end function vector3_azimuthal_distance elemental module function vector4_azimuthal_distance (p, q) result (dphi) real(default) :: dphi type(vector4_t), intent(in) :: p,q dphi = vector3_azimuthal_distance & (space_part (p), space_part (q)) end function vector4_azimuthal_distance @ %def azimuthal_distance @ The same in degrees: <>= public :: azimuthal_distance_deg <>= interface azimuthal_distance_deg module procedure vector3_azimuthal_distance_deg module procedure vector4_azimuthal_distance_deg end interface <>= elemental module function vector3_azimuthal_distance_deg (p, q) result (dphi) real(default) :: dphi type(vector3_t), intent(in) :: p,q end function vector3_azimuthal_distance_deg elemental module function vector4_azimuthal_distance_deg (p, q) result (dphi) real(default) :: dphi type(vector4_t), intent(in) :: p,q end function vector4_azimuthal_distance_deg <>= elemental module function vector3_azimuthal_distance_deg (p, q) result (dphi) real(default) :: dphi type(vector3_t), intent(in) :: p,q dphi = vector3_azimuthal_distance (p, q) / degree end function vector3_azimuthal_distance_deg elemental module function vector4_azimuthal_distance_deg (p, q) result (dphi) real(default) :: dphi type(vector4_t), intent(in) :: p,q dphi = vector4_azimuthal_distance (p, q) / degree end function vector4_azimuthal_distance_deg @ %def azimuthal_distance_deg @ The polar angle is defined $0\leq\theta\leq\pi$. Note that [[ATAN2]] has the reversed order of arguments: [[ATAN2(Y,X)]]. Here, $x$ is the 3-component while $y$ is the transverse momentum which is always nonnegative. Therefore, the result is nonnegative as well. <>= public :: polar_angle <>= interface polar_angle module procedure polar_angle_vector3 module procedure polar_angle_vector4 end interface <>= elemental module function polar_angle_vector3 (p) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p end function polar_angle_vector3 elemental module function polar_angle_vector4 (p) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p end function polar_angle_vector4 <>= elemental module function polar_angle_vector3 (p) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p if (any (abs (p%p) > 0)) then theta = atan2 (sqrt(p%p(1)**2 + p%p(2)**2), p%p(3)) else theta = 0 end if end function polar_angle_vector3 elemental module function polar_angle_vector4 (p) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p theta = polar_angle (space_part (p)) end function polar_angle_vector4 @ %def polar_angle @ This is the cosine of the polar angle: $-1\leq\cos\theta\leq 1$. <>= public :: polar_angle_ct <>= interface polar_angle_ct module procedure polar_angle_ct_vector3 module procedure polar_angle_ct_vector4 end interface <>= elemental module function polar_angle_ct_vector3 (p) result (ct) real(default) :: ct type(vector3_t), intent(in) :: p end function polar_angle_ct_vector3 elemental module function polar_angle_ct_vector4 (p) result (ct) real(default) :: ct type(vector4_t), intent(in) :: p end function polar_angle_ct_vector4 <>= elemental module function polar_angle_ct_vector3 (p) result (ct) real(default) :: ct type(vector3_t), intent(in) :: p if (any (abs (p%p) > 0)) then ct = p%p(3) / p**1 else ct = 1 end if end function polar_angle_ct_vector3 elemental module function polar_angle_ct_vector4 (p) result (ct) real(default) :: ct type(vector4_t), intent(in) :: p ct = polar_angle_ct (space_part (p)) end function polar_angle_ct_vector4 @ %def polar_angle_ct @ The polar angle in degrees. <>= public :: polar_angle_deg <>= interface polar_angle_deg module procedure polar_angle_deg_vector3 module procedure polar_angle_deg_vector4 end interface <>= elemental module function polar_angle_deg_vector3 (p) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p end function polar_angle_deg_vector3 elemental module function polar_angle_deg_vector4 (p) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p end function polar_angle_deg_vector4 <>= elemental module function polar_angle_deg_vector3 (p) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p theta = polar_angle (p) / degree end function polar_angle_deg_vector3 elemental module function polar_angle_deg_vector4 (p) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p theta = polar_angle (p) / degree end function polar_angle_deg_vector4 @ %def polar_angle_deg @ This is the angle enclosed between two three-momenta. If one of the momenta is zero, we return an angle of zero. The range of the result is $0\leq\theta\leq\pi$. If there is only one argument, take the positive $z$ axis as reference. <>= public :: enclosed_angle <>= interface enclosed_angle module procedure enclosed_angle_vector3 module procedure enclosed_angle_vector4 end interface <>= elemental module function enclosed_angle_vector3 (p, q) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p, q end function enclosed_angle_vector3 elemental module function enclosed_angle_vector4 (p, q) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p, q end function enclosed_angle_vector4 <>= elemental module function enclosed_angle_vector3 (p, q) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p, q theta = acos (enclosed_angle_ct (p, q)) end function enclosed_angle_vector3 elemental module function enclosed_angle_vector4 (p, q) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p, q theta = enclosed_angle (space_part (p), space_part (q)) end function enclosed_angle_vector4 @ %def enclosed_angle @ The cosine of the enclosed angle. <>= public :: enclosed_angle_ct <>= interface enclosed_angle_ct module procedure enclosed_angle_ct_vector3 module procedure enclosed_angle_ct_vector4 end interface <>= elemental module function enclosed_angle_ct_vector3 (p, q) result (ct) real(default) :: ct type(vector3_t), intent(in) :: p, q end function enclosed_angle_ct_vector3 elemental module function enclosed_angle_ct_vector4 (p, q) result (ct) real(default) :: ct type(vector4_t), intent(in) :: p, q end function enclosed_angle_ct_vector4 <>= elemental module function enclosed_angle_ct_vector3 (p, q) result (ct) real(default) :: ct type(vector3_t), intent(in) :: p, q if (any (abs (p%p) > 0) .and. any (abs (q%p) > 0)) then ct = p*q / (p**1 * q**1) if (ct>1) then ct = 1 else if (ct<-1) then ct = -1 end if else ct = 1 end if end function enclosed_angle_ct_vector3 elemental module function enclosed_angle_ct_vector4 (p, q) result (ct) real(default) :: ct type(vector4_t), intent(in) :: p, q ct = enclosed_angle_ct (space_part (p), space_part (q)) end function enclosed_angle_ct_vector4 @ %def enclosed_angle_ct @ The enclosed angle in degrees. <>= public :: enclosed_angle_deg <>= interface enclosed_angle_deg module procedure enclosed_angle_deg_vector3 module procedure enclosed_angle_deg_vector4 end interface <>= elemental module function enclosed_angle_deg_vector3 (p, q) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p, q end function enclosed_angle_deg_vector3 elemental module function enclosed_angle_deg_vector4 (p, q) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p, q end function enclosed_angle_deg_vector4 <>= elemental module function enclosed_angle_deg_vector3 (p, q) result (theta) real(default) :: theta type(vector3_t), intent(in) :: p, q theta = enclosed_angle (p, q) / degree end function enclosed_angle_deg_vector3 elemental module function enclosed_angle_deg_vector4 (p, q) result (theta) real(default) :: theta type(vector4_t), intent(in) :: p, q theta = enclosed_angle (p, q) / degree end function enclosed_angle_deg_vector4 @ %def enclosed_angle @ The polar angle of the first momentum w.r.t.\ the second momentum, evaluated in the rest frame of the second momentum. If the second four-momentum is not timelike, return zero. <>= public :: enclosed_angle_rest_frame public :: enclosed_angle_ct_rest_frame public :: enclosed_angle_deg_rest_frame <>= interface enclosed_angle_rest_frame module procedure enclosed_angle_rest_frame_vector4 end interface interface enclosed_angle_ct_rest_frame module procedure enclosed_angle_ct_rest_frame_vector4 end interface interface enclosed_angle_deg_rest_frame module procedure enclosed_angle_deg_rest_frame_vector4 end interface <>= elemental module function enclosed_angle_rest_frame_vector4 (p, q) result (theta) type(vector4_t), intent(in) :: p, q real(default) :: theta end function enclosed_angle_rest_frame_vector4 elemental module function enclosed_angle_ct_rest_frame_vector4 (p, q) result (ct) type(vector4_t), intent(in) :: p, q real(default) :: ct end function enclosed_angle_ct_rest_frame_vector4 elemental module function enclosed_angle_deg_rest_frame_vector4 (p, q) & result (theta) type(vector4_t), intent(in) :: p, q real(default) :: theta end function enclosed_angle_deg_rest_frame_vector4 <>= elemental module function enclosed_angle_rest_frame_vector4 (p, q) result (theta) type(vector4_t), intent(in) :: p, q real(default) :: theta theta = acos (enclosed_angle_ct_rest_frame (p, q)) end function enclosed_angle_rest_frame_vector4 elemental module function enclosed_angle_ct_rest_frame_vector4 (p, q) result (ct) type(vector4_t), intent(in) :: p, q real(default) :: ct if (invariant_mass(q) > 0) then ct = enclosed_angle_ct ( & space_part (boost(-q, invariant_mass (q)) * p), & space_part (q)) else ct = 1 end if end function enclosed_angle_ct_rest_frame_vector4 elemental module function enclosed_angle_deg_rest_frame_vector4 (p, q) & result (theta) type(vector4_t), intent(in) :: p, q real(default) :: theta theta = enclosed_angle_rest_frame (p, q) / degree end function enclosed_angle_deg_rest_frame_vector4 @ %def enclosed_angle_rest_frame @ %def enclosed_angle_ct_rest_frame @ %def enclosed_angle_deg_rest_frame @ \subsection{More kinematical functions (some redundant)} The scalar transverse momentum (assuming the $z$ axis is longitudinal) <>= public :: transverse_part <>= interface transverse_part module procedure transverse_part_vector4_beam_axis module procedure transverse_part_vector4_vector4 end interface <>= elemental module function transverse_part_vector4_beam_axis (p) result (pT) real(default) :: pT type(vector4_t), intent(in) :: p end function transverse_part_vector4_beam_axis elemental module function transverse_part_vector4_vector4 (p1, p2) result (pT) real(default) :: pT type(vector4_t), intent(in) :: p1, p2 end function transverse_part_vector4_vector4 <>= elemental module function transverse_part_vector4_beam_axis (p) result (pT) real(default) :: pT type(vector4_t), intent(in) :: p pT = sqrt(p%p(1)**2 + p%p(2)**2) end function transverse_part_vector4_beam_axis elemental module function transverse_part_vector4_vector4 (p1, p2) result (pT) real(default) :: pT type(vector4_t), intent(in) :: p1, p2 real(default) :: p1_norm, p2_norm, p1p2, pT2 p1_norm = space_part_norm(p1)**2 p2_norm = space_part_norm(p2)**2 ! p1p2 = p1%p(1:3)*p2%p(1:3) p1p2 = vector4_get_space_part(p1) * vector4_get_space_part(p2) pT2 = (p1_norm*p2_norm - p1p2)/p1_norm pT = sqrt (pT2) end function transverse_part_vector4_vector4 @ %def transverse_part @ The scalar longitudinal momentum (assuming the $z$ axis is longitudinal). Identical to [[momentum_z_component]]. <>= public :: longitudinal_part <>= interface longitudinal_part module procedure longitudinal_part_vector4 end interface <>= elemental module function longitudinal_part_vector4 (p) result (pL) real(default) :: pL type(vector4_t), intent(in) :: p end function longitudinal_part_vector4 <>= elemental module function longitudinal_part_vector4 (p) result (pL) real(default) :: pL type(vector4_t), intent(in) :: p pL = p%p(3) end function longitudinal_part_vector4 @ %def longitudinal_part @ Absolute value of three-momentum <>= public :: space_part_norm <>= interface space_part_norm module procedure space_part_norm_vector4 end interface <>= elemental module function space_part_norm_vector4 (p) result (p3) real(default) :: p3 type(vector4_t), intent(in) :: p end function space_part_norm_vector4 <>= elemental module function space_part_norm_vector4 (p) result (p3) real(default) :: p3 type(vector4_t), intent(in) :: p p3 = sqrt (p%p(1)**2 + p%p(2)**2 + p%p(3)**2) end function space_part_norm_vector4 @ %def momentum @ The energy (the zeroth component) <>= public :: energy <>= interface energy module procedure energy_vector4 module procedure energy_vector3 module procedure energy_real end interface <>= elemental module function energy_vector4 (p) result (E) real(default) :: E type(vector4_t), intent(in) :: p end function energy_vector4 elemental module function energy_vector3 (p, mass) result (E) real(default) :: E type(vector3_t), intent(in) :: p real(default), intent(in), optional :: mass end function energy_vector3 elemental module function energy_real (p, mass) result (E) real(default) :: E real(default), intent(in) :: p real(default), intent(in), optional :: mass end function energy_real <>= elemental module function energy_vector4 (p) result (E) real(default) :: E type(vector4_t), intent(in) :: p E = p%p(0) end function energy_vector4 @ Alternative: The energy corresponding to a given momentum and mass. If the mass is omitted, it is zero <>= elemental module function energy_vector3 (p, mass) result (E) real(default) :: E type(vector3_t), intent(in) :: p real(default), intent(in), optional :: mass if (present (mass)) then E = sqrt (p**2 + mass**2) else E = p**1 end if end function energy_vector3 elemental module function energy_real (p, mass) result (E) real(default) :: E real(default), intent(in) :: p real(default), intent(in), optional :: mass if (present (mass)) then E = sqrt (p**2 + mass**2) else E = abs (p) end if end function energy_real @ %def energy @ The invariant mass of four-momenta. Zero for lightlike, negative for spacelike momenta. <>= public :: invariant_mass <>= interface invariant_mass module procedure invariant_mass_vector4 end interface <>= elemental module function invariant_mass_vector4 (p) result (m) real(default) :: m type(vector4_t), intent(in) :: p end function invariant_mass_vector4 <>= elemental module function invariant_mass_vector4 (p) result (m) real(default) :: m type(vector4_t), intent(in) :: p real(default) :: msq msq = p*p if (msq >= 0) then m = sqrt (msq) else m = - sqrt (abs (msq)) end if end function invariant_mass_vector4 @ %def invariant_mass @ The invariant mass squared. Zero for lightlike, negative for spacelike momenta. <>= public :: invariant_mass_squared <>= interface invariant_mass_squared module procedure invariant_mass_squared_vector4 end interface <>= elemental module function invariant_mass_squared_vector4 (p) result (msq) real(default) :: msq type(vector4_t), intent(in) :: p end function invariant_mass_squared_vector4 <>= elemental module function invariant_mass_squared_vector4 (p) result (msq) real(default) :: msq type(vector4_t), intent(in) :: p msq = p*p end function invariant_mass_squared_vector4 @ %def invariant_mass_squared @ The transverse mass. If the mass squared is negative, this value also is negative. <>= public :: transverse_mass <>= interface transverse_mass module procedure transverse_mass_vector4 end interface <>= elemental module function transverse_mass_vector4 (p) result (m) real(default) :: m type(vector4_t), intent(in) :: p end function transverse_mass_vector4 <>= elemental module function transverse_mass_vector4 (p) result (m) real(default) :: m type(vector4_t), intent(in) :: p real(default) :: msq msq = p%p(0)**2 - p%p(1)**2 - p%p(2)**2 if (msq >= 0) then m = sqrt (msq) else m = - sqrt (abs (msq)) end if end function transverse_mass_vector4 @ %def transverse_mass @ The rapidity (defined if particle is massive or $p_\perp>0$) <>= public :: rapidity <>= interface rapidity module procedure rapidity_vector4 end interface <>= elemental module function rapidity_vector4 (p) result (y) real(default) :: y type(vector4_t), intent(in) :: p end function rapidity_vector4 <>= elemental module function rapidity_vector4 (p) result (y) real(default) :: y type(vector4_t), intent(in) :: p y = .5 * log( (energy (p) + longitudinal_part (p)) & & /(energy (p) - longitudinal_part (p))) end function rapidity_vector4 @ %def rapidity @ The pseudorapidity (defined if $p_\perp>0$) <>= public :: pseudorapidity <>= interface pseudorapidity module procedure pseudorapidity_vector4 end interface <>= elemental module function pseudorapidity_vector4 (p) result (eta) real(default) :: eta type(vector4_t), intent(in) :: p end function pseudorapidity_vector4 <>= elemental module function pseudorapidity_vector4 (p) result (eta) real(default) :: eta type(vector4_t), intent(in) :: p eta = -log( tan (.5 * polar_angle (p))) end function pseudorapidity_vector4 @ %def pseudorapidity @ The rapidity distance (defined if both $p_\perp>0$) <>= public :: rapidity_distance <>= interface rapidity_distance module procedure rapidity_distance_vector4 end interface <>= elemental module function rapidity_distance_vector4 (p, q) result (dy) type(vector4_t), intent(in) :: p, q real(default) :: dy end function rapidity_distance_vector4 <>= elemental module function rapidity_distance_vector4 (p, q) result (dy) type(vector4_t), intent(in) :: p, q real(default) :: dy dy = rapidity (q) - rapidity (p) end function rapidity_distance_vector4 @ %def rapidity_distance @ The pseudorapidity distance (defined if both $p_\perp>0$) <>= public :: pseudorapidity_distance <>= interface pseudorapidity_distance module procedure pseudorapidity_distance_vector4 end interface <>= elemental module function pseudorapidity_distance_vector4 (p, q) result (deta) real(default) :: deta type(vector4_t), intent(in) :: p, q end function pseudorapidity_distance_vector4 <>= elemental module function pseudorapidity_distance_vector4 (p, q) result (deta) real(default) :: deta type(vector4_t), intent(in) :: p, q deta = pseudorapidity (q) - pseudorapidity (p) end function pseudorapidity_distance_vector4 @ %def pseudorapidity_distance @ The distance on the $\eta-\phi$ cylinder: <>= public :: eta_phi_distance <>= interface eta_phi_distance module procedure eta_phi_distance_vector4 end interface <>= elemental module function eta_phi_distance_vector4 (p, q) result (dr) type(vector4_t), intent(in) :: p, q real(default) :: dr end function eta_phi_distance_vector4 <>= elemental module function eta_phi_distance_vector4 (p, q) result (dr) type(vector4_t), intent(in) :: p, q real(default) :: dr dr = sqrt ( & pseudorapidity_distance (p, q)**2 & + azimuthal_distance (p, q)**2) end function eta_phi_distance_vector4 @ %def eta_phi_distance @ \subsection{Lorentz transformations} <>= public :: lorentz_transformation_t <>= type :: lorentz_transformation_t private real(default), dimension(0:3, 0:3) :: L contains <> end type lorentz_transformation_t @ %def lorentz_transformation_t @ Output: <>= public :: lorentz_transformation_write <>= procedure :: write => lorentz_transformation_write <>= module subroutine lorentz_transformation_write (L, unit, testflag, ultra) class(lorentz_transformation_t), intent(in) :: L integer, intent(in), optional :: unit logical, intent(in), optional :: testflag, ultra end subroutine lorentz_transformation_write <>= module subroutine lorentz_transformation_write (L, unit, testflag, ultra) class(lorentz_transformation_t), intent(in) :: L integer, intent(in), optional :: unit logical, intent(in), optional :: testflag, ultra integer :: u, i logical :: ult character(len=7) :: fmt ult = .false.; if (present (ultra)) ult = ultra if (ult) then call pac_fmt (fmt, FMT_19, FMT_11, ultra) else call pac_fmt (fmt, FMT_19, FMT_13, testflag) end if u = given_output_unit (unit); if (u < 0) return write (u, "(1x,A,3(1x," // fmt // "))") "L00 = ", L%L(0,0) write (u, "(1x,A,3(1x," // fmt // "))") "L0j = ", L%L(0,1:3) do i = 1, 3 write (u, "(1x,A,I0,A,3(1x," // fmt // "))") & "L", i, "0 = ", L%L(i,0) write (u, "(1x,A,I0,A,3(1x," // fmt // "))") & "L", i, "j = ", L%L(i,1:3) end do end subroutine lorentz_transformation_write @ %def lorentz_transformation_write @ Extract all components: <>= public :: lorentz_transformation_get_components <>= pure module function lorentz_transformation_get_components (L) result (a) type(lorentz_transformation_t), intent(in) :: L real(default), dimension(0:3,0:3) :: a end function lorentz_transformation_get_components <>= pure module function lorentz_transformation_get_components (L) result (a) type(lorentz_transformation_t), intent(in) :: L real(default), dimension(0:3,0:3) :: a a = L%L end function lorentz_transformation_get_components @ %def lorentz_transformation_get_components @ \subsection{Functions of Lorentz transformations} For the inverse, we make use of the fact that $\Lambda^{\mu\nu}\Lambda_{\mu\rho}=\delta^\nu_\rho$. So, lowering the indices and transposing is sufficient. <>= public :: inverse <>= interface inverse module procedure lorentz_transformation_inverse end interface <>= elemental module function lorentz_transformation_inverse (L) result (IL) type(lorentz_transformation_t) :: IL type(lorentz_transformation_t), intent(in) :: L end function lorentz_transformation_inverse <>= elemental module function lorentz_transformation_inverse (L) result (IL) type(lorentz_transformation_t) :: IL type(lorentz_transformation_t), intent(in) :: L IL%L(0,0) = L%L(0,0) IL%L(0,1:) = -L%L(1:,0) IL%L(1:,0) = -L%L(0,1:) IL%L(1:,1:) = transpose(L%L(1:,1:)) end function lorentz_transformation_inverse @ %def lorentz_transformation_inverse @ %def inverse @ \subsection{Invariants} These are used below. The first array index is varying fastest in [[FORTRAN]]; therefore the extra minus in the odd-rank tensor epsilon. <>= integer, dimension(3,3), parameter :: delta_three = & & reshape( source = [ 1,0,0, 0,1,0, 0,0,1 ], & & shape = [3,3] ) integer, dimension(3,3,3), parameter :: epsilon_three = & & reshape( source = [ 0, 0,0, 0,0,-1, 0,1,0, & & 0, 0,1, 0,0, 0, -1,0,0, & & 0,-1,0, 1,0, 0, 0,0,0 ],& & shape = [3,3,3] ) @ %def delta_three epsilon_three @ This could be of some use: <>= public :: identity <>= type(lorentz_transformation_t), parameter :: & & identity = & & lorentz_transformation_t ( & & reshape( source = [ one, zero, zero, zero, & & zero, one, zero, zero, & & zero, zero, one, zero, & & zero, zero, zero, one ],& & shape = [4,4] ) ) @ %def identity <>= public :: space_reflection <>= type(lorentz_transformation_t), parameter :: & & space_reflection = & & lorentz_transformation_t ( & & reshape( source = [ one, zero, zero, zero, & & zero,-one, zero, zero, & & zero, zero,-one, zero, & & zero, zero, zero,-one ],& & shape = [4,4] ) ) @ %def space_reflection @ Builds a unit vector orthogal to the input vector in the xy-plane. <>= public :: create_orthogonal <>= module function create_orthogonal (p_in) result (p_out) type(vector3_t), intent(in) :: p_in type(vector3_t) :: p_out end function create_orthogonal <>= module function create_orthogonal (p_in) result (p_out) type(vector3_t), intent(in) :: p_in type(vector3_t) :: p_out real(default) :: ab ab = sqrt (p_in%p(1)**2 + p_in%p(2)**2) if (abs (ab) < eps0) then p_out%p(1) = 1 p_out%p(2) = 0 p_out%p(3) = 0 else p_out%p(1) = p_in%p(2) p_out%p(2) = -p_in%p(1) p_out%p(3) = 0 p_out = p_out / ab end if end function create_orthogonal @ %def create_orthogonal @ <>= public :: create_unit_vector <>= module function create_unit_vector (p_in) result (p_out) type(vector4_t), intent(in) :: p_in type(vector3_t) :: p_out end function create_unit_vector <>= module function create_unit_vector (p_in) result (p_out) type(vector4_t), intent(in) :: p_in type(vector3_t) :: p_out p_out%p = p_in%p(1:3) / space_part_norm (p_in) end function create_unit_vector @ %def create_unit_vector @ <>= public :: normalize <>= module function normalize(p) result (p_norm) type(vector3_t) :: p_norm type(vector3_t), intent(in) :: p end function normalize <>= module function normalize(p) result (p_norm) type(vector3_t) :: p_norm type(vector3_t), intent(in) :: p real(default) :: abs abs = sqrt (p%p(1)**2 + p%p(2)**2 + p%p(3)**2) p_norm = p / abs end function normalize @ %def normalize @ Computes the invariant mass of the momenta sum given by the indices in [[i_res_born]] and the optional argument [[i_emitter]]. <>= public :: compute_resonance_mass <>= pure module function compute_resonance_mass (p, i_res_born, i_gluon) result (m) real(default) :: m type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), dimension(:) :: i_res_born integer, intent(in), optional :: i_gluon end function compute_resonance_mass <>= pure module function compute_resonance_mass (p, i_res_born, i_gluon) result (m) real(default) :: m type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), dimension(:) :: i_res_born integer, intent(in), optional :: i_gluon type(vector4_t) :: p_res p_res = get_resonance_momentum (p, i_res_born, i_gluon) m = p_res**1 end function compute_resonance_mass @ %def compute_resonance_mass @ <>= public :: get_resonance_momentum <>= pure module function get_resonance_momentum & (p, i_res_born, i_gluon) result (p_res) type(vector4_t) :: p_res type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), dimension(:) :: i_res_born integer, intent(in), optional :: i_gluon end function get_resonance_momentum <>= pure module function get_resonance_momentum & (p, i_res_born, i_gluon) result (p_res) type(vector4_t) :: p_res type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), dimension(:) :: i_res_born integer, intent(in), optional :: i_gluon integer :: i p_res = vector4_null do i = 1, size (i_res_born) p_res = p_res + p (i_res_born(i)) end do if (present (i_gluon)) p_res = p_res + p (i_gluon) end function get_resonance_momentum @ %def get_resonance_momentum @ <>= public :: create_two_particle_decay <>= module function create_two_particle_decay (s, p1, p2) result (p_rest) type(vector4_t), dimension(3) :: p_rest real(default), intent(in) :: s type(vector4_t), intent(in) :: p1, p2 end function create_two_particle_decay <>= module function create_two_particle_decay (s, p1, p2) result (p_rest) type(vector4_t), dimension(3) :: p_rest real(default), intent(in) :: s type(vector4_t), intent(in) :: p1, p2 real(default) :: m1_sq, m2_sq real(default) :: E1, E2, p m1_sq = p1**2; m2_sq = p2**2 p = sqrt (lambda (s, m1_sq, m2_sq)) / (two * sqrt (s)) E1 = sqrt (m1_sq + p**2); E2 = sqrt (m2_sq + p**2) p_rest(1)%p = [sqrt (s), zero, zero, zero] p_rest(2)%p(0) = E1 p_rest(2)%p(1:3) = p * p1%p(1:3) / space_part_norm (p1) p_rest(3)%p(0) = E2; p_rest(3)%p(1:3) = -p_rest(2)%p(1:3) end function create_two_particle_decay @ %def create_two_particle_decay @ This function creates a phase-space point for a $1 \to 3$ decay in the decaying particle's rest frame. There are three rest frames for this system, corresponding to $s$-, $t$,- and $u$-channel momentum exchange, also referred to as Gottfried-Jackson frames. Below, we choose the momentum with index 1 to be aligned along the $z$-axis. We then have \begin{align*} s_1 &= \left(p_1 + p_2\right)^2, \\ s_2 &= \left(p_2 + p_3\right)^2, \\ s_3 &= \left(p_1 + p_3\right)^2, \\ s_1 + s_2 + s_3 &= s + m_1^2 + m_2^2 + m_3^2. \end{align*} From these we can construct \begin{align*} E_1^{R23} = \frac{s - s_2 - m_1^2}{2\sqrt{s_2}} &\quad P_1^{R23} = \frac{\lambda^{1/2}(s, s_2, m_1^2)}{2\sqrt{s_2}},\\ E_2^{R23} = \frac{s_2 + m_2^2 - m_3^2}{2\sqrt{s_2}} &\quad P_2^{R23} = \frac{\lambda^{1/2}(s_2, m_2^2, m_3^2)}{2\sqrt{s_2}},\\ E_3^{R23} = \frac{s_2 + m_3^2 - m_2^2}{2\sqrt{s_2}} &\quad P_3^{R23} = P_2^{R23}, \end{align*} where $R23$ denotes the Gottfried-Jackson frame of our choice. Finally, the scattering angle $\theta_{12}^{R23}$ between momentum $1$ and $2$ can be determined to be \begin{equation*} \cos\theta_{12}^{R23} = \frac{(s - s_2 - m_1^2)(s_2 + m_2^2 - m_3^2) + 2s_2 (m_1^2 + m_2^2 - s_1)} {\lambda^{1/2}(s, s_2, m_1^2) \lambda^{1/2}(s_2, m_2^2, m_3^2)} \end{equation*} <>= public :: create_three_particle_decay <>= module function create_three_particle_decay (p1, p2, p3) result (p_rest) type(vector4_t), dimension(4) :: p_rest type(vector4_t), intent(in) :: p1, p2, p3 end function create_three_particle_decay <>= module function create_three_particle_decay (p1, p2, p3) result (p_rest) type(vector4_t), dimension(4) :: p_rest type(vector4_t), intent(in) :: p1, p2, p3 real(default) :: E1, E2, E3 real(default) :: pr1, pr2, pr3 real(default) :: s, s1, s2, s3 real(default) :: m1_sq, m2_sq, m3_sq real(default) :: cos_theta_12 type(vector3_t) :: v3_unit type(lorentz_transformation_t) :: rot m1_sq = p1**2 m2_sq = p2**2 m3_sq = p3**2 s1 = (p1 + p2)**2 s2 = (p2 + p3)**2 s3 = (p3 + p1)**2 s = s1 + s2 + s3 - m1_sq - m2_sq - m3_sq E1 = (s - s2 - m1_sq) / (two * sqrt (s2)) E2 = (s2 + m2_sq - m3_sq) / (two * sqrt (s2)) E3 = (s2 + m3_sq - m2_sq) / (two * sqrt (s2)) pr1 = sqrt (lambda (s, s2, m1_sq)) / (two * sqrt (s2)) pr2 = sqrt (lambda (s2, m2_sq, m3_sq)) / (two * sqrt(s2)) pr3 = pr2 cos_theta_12 = ((s - s2 - m1_sq) * (s2 + m2_sq - m3_sq) + two * s2 * (m1_sq + m2_sq - s1)) / & sqrt (lambda (s, s2, m1_sq) * lambda (s2, m2_sq, m3_sq)) v3_unit%p = [zero, zero, one] p_rest(1)%p(0) = E1 p_rest(1)%p(1:3) = v3_unit%p * pr1 p_rest(2)%p(0) = E2 p_rest(2)%p(1:3) = v3_unit%p * pr2 p_rest(3)%p(0) = E3 p_rest(3)%p(1:3) = v3_unit%p * pr3 p_rest(4)%p(0) = (s + s2 - m1_sq) / (2 * sqrt (s2)) p_rest(4)%p(1:3) = - p_rest(1)%p(1:3) rot = rotation (cos_theta_12, sqrt (one - cos_theta_12**2), 2) p_rest(2) = rot * p_rest(2) p_rest(3)%p(1:3) = - p_rest(2)%p(1:3) end function create_three_particle_decay @ %def create_three_particle_decay @ <>= public :: evaluate_one_to_two_splitting_special <>= abstract interface subroutine evaluate_one_to_two_splitting_special (p_origin, & p1_in, p2_in, p1_out, p2_out, msq_in, jac) import type(vector4_t), intent(in) :: p_origin type(vector4_t), intent(in) :: p1_in, p2_in type(vector4_t), intent(inout) :: p1_out, p2_out real(default), intent(in), optional :: msq_in real(default), intent(inout), optional :: jac end subroutine evaluate_one_to_two_splitting_special end interface @ %def evaluate_one_to_two_splitting_special @ <>= public :: generate_on_shell_decay <>= recursive module subroutine generate_on_shell_decay (p_dec, & p_in, p_out, i_real, msq_in, jac, evaluate_special) type(vector4_t), intent(in) :: p_dec type(vector4_t), intent(in), dimension(:) :: p_in type(vector4_t), intent(inout), dimension(:) :: p_out integer, intent(in) :: i_real real(default), intent(in), optional :: msq_in real(default), intent(inout), optional :: jac procedure(evaluate_one_to_two_splitting_special), intent(in), & pointer, optional :: evaluate_special end subroutine generate_on_shell_decay <>= recursive module subroutine generate_on_shell_decay (p_dec, & p_in, p_out, i_real, msq_in, jac, evaluate_special) type(vector4_t), intent(in) :: p_dec type(vector4_t), intent(in), dimension(:) :: p_in type(vector4_t), intent(inout), dimension(:) :: p_out integer, intent(in) :: i_real real(default), intent(in), optional :: msq_in real(default), intent(inout), optional :: jac procedure(evaluate_one_to_two_splitting_special), intent(in), & pointer, optional :: evaluate_special type(vector4_t) :: p_dec_new integer :: n_recoil n_recoil = size (p_in) - 1 if (n_recoil > 1) then if (present (evaluate_special)) then call evaluate_special (p_dec, p_in(1), sum (p_in (2 : n_recoil + 1)), & p_out(i_real), p_dec_new) call generate_on_shell_decay (p_dec_new, p_in (2 : ), p_out, & i_real + 1, msq_in, jac, evaluate_special) else call evaluate_one_to_two_splitting (p_dec, p_in(1), & sum (p_in (2 : n_recoil + 1)), p_out(i_real), p_dec_new, msq_in, jac) call generate_on_shell_decay (p_dec_new, p_in (2 : ), p_out, & i_real + 1, msq_in, jac) end if else call evaluate_one_to_two_splitting (p_dec, p_in(1), p_in(2), & p_out(i_real), p_out(i_real + 1), msq_in, jac) end if end subroutine generate_on_shell_decay subroutine evaluate_one_to_two_splitting (p_origin, & p1_in, p2_in, p1_out, p2_out, msq_in, jac) type(vector4_t), intent(in) :: p_origin type(vector4_t), intent(in) :: p1_in, p2_in type(vector4_t), intent(inout) :: p1_out, p2_out real(default), intent(in), optional :: msq_in real(default), intent(inout), optional :: jac type(lorentz_transformation_t) :: L type(vector4_t) :: p1_rest, p2_rest real(default) :: m, msq, msq1, msq2 real(default) :: E1, E2, p real(default) :: lda, rlda_soft call get_rest_frame (p1_in, p2_in, p1_rest, p2_rest) msq = p_origin**2; m = sqrt(msq) msq1 = p1_in**2; msq2 = p2_in**2 lda = lambda (msq, msq1, msq2) if (lda < zero) then print *, 'Encountered lambda < 0 in 1 -> 2 splitting! ' print *, 'lda: ', lda print *, 'm: ', m, 'msq: ', msq print *, 'm1: ', sqrt (msq1), 'msq1: ', msq1 print *, 'm2: ', sqrt (msq2), 'msq2: ', msq2 stop end if p = sqrt (lda) / (two * m) E1 = sqrt (msq1 + p**2) E2 = sqrt (msq2 + p**2) p1_out = shift_momentum (p1_rest, E1, p) p2_out = shift_momentum (p2_rest, E2, p) L = boost (p_origin, p_origin**1) p1_out = L * p1_out p2_out = L * p2_out if (present (jac) .and. present (msq_in)) then jac = jac * sqrt(lda) / msq rlda_soft = sqrt (lambda (msq_in, msq1, msq2)) !!! We have to undo the Jacobian which has already been !!! supplied by the Born phase space. jac = jac * msq_in / rlda_soft end if contains subroutine get_rest_frame (p1_in, p2_in, p1_out, p2_out) type(vector4_t), intent(in) :: p1_in, p2_in type(vector4_t), intent(out) :: p1_out, p2_out type(lorentz_transformation_t) :: L L = inverse (boost (p1_in + p2_in, (p1_in + p2_in)**1)) p1_out = L * p1_in; p2_out = L * p2_in end subroutine get_rest_frame function shift_momentum (p_in, E, p) result (p_out) type(vector4_t) :: p_out type(vector4_t), intent(in) :: p_in real(default), intent(in) :: E, p type(vector3_t) :: vec vec%p(1:3) = p_in%p(1:3) / space_part_norm (p_in) p_out = vector4_moving (E, p * vec) end function shift_momentum end subroutine evaluate_one_to_two_splitting @ %def generate_on_shell_decay @ \subsection{Boosts} We build Lorentz transformations from boosts and rotations. In both cases we can supply a three-vector which defines the axis and (hyperbolic) angle. For a boost, this is the vector $\vec\beta=\vec p/E$, such that a particle at rest with mass $m$ is boosted to a particle with three-vector $\vec p$. Here, we have \begin{equation} \beta = \tanh\chi = p/E, \qquad \gamma = \cosh\chi = E/m, \qquad \beta\gamma = \sinh\chi = p/m \end{equation} <>= public :: boost <>= interface boost module procedure boost_from_rest_frame module procedure boost_from_rest_frame_vector3 module procedure boost_generic module procedure boost_canonical end interface @ %def boost @ In the first form, the argument is some four-momentum, the space part of which determines a direction, and the associated mass (which is not checked against the four-momentum). The boost vector $\gamma\vec\beta$ is then given by $\vec p/m$. This boosts from the rest frame of a particle to the current frame. To be explicit, if $\vec p$ is the momentum of a particle and $m$ its mass, $L(\vec p/m)$ is the transformation that turns $(m;\vec 0)$ into $(E;\vec p)$. Conversely, the inverse transformation boosts a vector \emph{into} the rest frame of a particle, in particular $(E;\vec p)$ into $(m;\vec 0)$. <>= elemental module function boost_from_rest_frame (p, m) result (L) type(lorentz_transformation_t) :: L type(vector4_t), intent(in) :: p real(default), intent(in) :: m end function boost_from_rest_frame elemental module function boost_from_rest_frame_vector3 (p, m) result (L) type(lorentz_transformation_t) :: L type(vector3_t), intent(in) :: p real(default), intent(in) :: m end function boost_from_rest_frame_vector3 <>= elemental module function boost_from_rest_frame (p, m) result (L) type(lorentz_transformation_t) :: L type(vector4_t), intent(in) :: p real(default), intent(in) :: m L = boost_from_rest_frame_vector3 (space_part (p), m) end function boost_from_rest_frame elemental module function boost_from_rest_frame_vector3 (p, m) result (L) type(lorentz_transformation_t) :: L type(vector3_t), intent(in) :: p real(default), intent(in) :: m type(vector3_t) :: beta_gamma real(default) :: bg2, g, c integer :: i,j if (m > eps0) then beta_gamma = p / m bg2 = beta_gamma**2 else bg2 = 0 L = identity return end if if (bg2 > eps0) then g = sqrt(1 + bg2); c = (g-1)/bg2 else g = one + bg2 / two c = one / two end if L%L(0,0) = g L%L(0,1:) = beta_gamma%p L%L(1:,0) = L%L(0,1:) do i=1,3 do j=1,3 L%L(i,j) = delta_three(i,j) + c*beta_gamma%p(i)*beta_gamma%p(j) end do end do end function boost_from_rest_frame_vector3 @ %def boost_from_rest_frame @ A canonical boost is a boost along one of the coordinate axes, which we may supply as an integer argument. Here, $\gamma\beta$ is scalar. <>= elemental module function boost_canonical (beta_gamma, k) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: beta_gamma integer, intent(in) :: k end function boost_canonical <>= elemental module function boost_canonical (beta_gamma, k) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: beta_gamma integer, intent(in) :: k real(default) :: g g = sqrt(1 + beta_gamma**2) L = identity L%L(0,0) = g L%L(0,k) = beta_gamma L%L(k,0) = L%L(0,k) L%L(k,k) = L%L(0,0) end function boost_canonical @ %def boost_canonical @ Instead of a canonical axis, we can supply an arbitrary axis which need not be normalized. If it is zero, return the unit matrix. <>= elemental module function boost_generic (beta_gamma, axis) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: beta_gamma type(vector3_t), intent(in) :: axis end function boost_generic <>= elemental module function boost_generic (beta_gamma, axis) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: beta_gamma type(vector3_t), intent(in) :: axis if (any (abs (axis%p) > 0)) then L = boost_from_rest_frame_vector3 (beta_gamma * axis, axis**1) else L = identity end if end function boost_generic @ %def boost_generic @ \subsection{Rotations} For a rotation, the vector defines the rotation axis, and its length the rotation angle. All of these rotations rotate counterclockwise in a right-handed coordinate system. <>= public :: rotation <>= interface rotation module procedure rotation_generic module procedure rotation_canonical module procedure rotation_generic_cs module procedure rotation_canonical_cs end interface @ %def rotation @ If $\cos\phi$ and $\sin\phi$ is already known, we do not have to calculate them. Of course, the user has to ensure that $\cos^2\phi+\sin^2\phi=1$, and that the given axis [[n]] is normalized to one. In the second form, the length of [[axis]] is the rotation angle. <>= elemental module function rotation_generic_cs (cp, sp, axis) result (R) type(lorentz_transformation_t) :: R real(default), intent(in) :: cp, sp type(vector3_t), intent(in) :: axis end function rotation_generic_cs elemental module function rotation_generic (axis) result (R) type(lorentz_transformation_t) :: R type(vector3_t), intent(in) :: axis end function rotation_generic elemental module function rotation_canonical_cs (cp, sp, k) result (R) type(lorentz_transformation_t) :: R real(default), intent(in) :: cp, sp integer, intent(in) :: k end function rotation_canonical_cs elemental module function rotation_canonical (phi, k) result (R) type(lorentz_transformation_t) :: R real(default), intent(in) :: phi integer, intent(in) :: k end function rotation_canonical <>= elemental module function rotation_generic_cs (cp, sp, axis) result (R) type(lorentz_transformation_t) :: R real(default), intent(in) :: cp, sp type(vector3_t), intent(in) :: axis integer :: i,j R = identity do i=1,3 do j=1,3 R%L(i,j) = cp*delta_three(i,j) + (1-cp)*axis%p(i)*axis%p(j) & & - sp*dot_product(epsilon_three(i,j,:), axis%p) end do end do end function rotation_generic_cs elemental module function rotation_generic (axis) result (R) type(lorentz_transformation_t) :: R type(vector3_t), intent(in) :: axis real(default) :: phi if (any (abs(axis%p) > 0)) then phi = abs(axis**1) R = rotation_generic_cs (cos(phi), sin(phi), axis/phi) else R = identity end if end function rotation_generic @ %def rotation_generic_cs rotation_generic @ Alternatively, give just the angle and label the coordinate axis by an integer. <>= elemental module function rotation_canonical_cs (cp, sp, k) result (R) type(lorentz_transformation_t) :: R real(default), intent(in) :: cp, sp integer, intent(in) :: k integer :: i,j R = identity do i=1,3 do j=1,3 R%L(i,j) = -sp*epsilon_three(i,j,k) end do R%L(i,i) = cp end do R%L(k,k) = 1 end function rotation_canonical_cs elemental module function rotation_canonical (phi, k) result (R) type(lorentz_transformation_t) :: R real(default), intent(in) :: phi integer, intent(in) :: k R = rotation_canonical_cs(cos(phi), sin(phi), k) end function rotation_canonical @ %def rotation_canonical_cs rotation_canonical @ This is viewed as a method for the first argument (three-vector): Reconstruct the rotation that rotates it into the second three-vector. <>= public :: rotation_to_2nd <>= interface rotation_to_2nd module procedure rotation_to_2nd_generic module procedure rotation_to_2nd_canonical end interface <>= elemental module function rotation_to_2nd_generic (p, q) result (R) type(lorentz_transformation_t) :: R type(vector3_t), intent(in) :: p, q end function rotation_to_2nd_generic elemental module function rotation_to_2nd_canonical (k, p) result (R) type(lorentz_transformation_t) :: R integer, intent(in) :: k type(vector3_t), intent(in) :: p end function rotation_to_2nd_canonical <>= elemental module function rotation_to_2nd_generic (p, q) result (R) type(lorentz_transformation_t) :: R type(vector3_t), intent(in) :: p, q type(vector3_t) :: a, b, ab real(default) :: ct, st if (any (abs (p%p) > 0) .and. any (abs (q%p) > 0)) then a = direction (p) b = direction (q) ab = cross_product(a,b) ct = a * b; st = ab**1 if (abs(st) > eps0) then R = rotation_generic_cs (ct, st, ab / st) else if (ct < 0) then R = space_reflection else R = identity end if else R = identity end if end function rotation_to_2nd_generic @ %def rotation_to_2nd_generic @ The same for a canonical axis: The function returns the transformation that rotates the $k$-axis into the direction of $p$. <>= elemental module function rotation_to_2nd_canonical (k, p) result (R) type(lorentz_transformation_t) :: R integer, intent(in) :: k type(vector3_t), intent(in) :: p type(vector3_t) :: b, ab real(default) :: ct, st integer :: i, j if (any (abs (p%p) > 0)) then b = direction (p) ab%p = 0 do i = 1, 3 do j = 1, 3 ab%p(j) = ab%p(j) + b%p(i) * epsilon_three(i,j,k) end do end do ct = b%p(k); st = ab**1 if (abs(st) > eps0) then R = rotation_generic_cs (ct, st, ab / st) else if (ct < 0) then R = space_reflection else R = identity end if else R = identity end if end function rotation_to_2nd_canonical @ %def rotation_to_2nd_canonical @ \subsection{Composite Lorentz transformations} This function returns the transformation that, given a pair of vectors $p_{1,2}$, (a) boosts from the rest frame of the c.m. system (with invariant mass $m$) into the lab frame where $p_i$ are defined, and (b) turns the given axis (or the canonical vectors $\pm e_k$) in the rest frame into the directions of $p_{1,2}$ in the lab frame. Note that the energy components are not used; for a consistent result one should have $(p_1+p_2)^2 = m^2$. <>= public :: transformation <>= interface transformation module procedure transformation_rec_generic module procedure transformation_rec_canonical end interface @ %def transformation <>= elemental module function transformation_rec_generic (axis, p1, p2, m) result (L) type(vector3_t), intent(in) :: axis type(vector4_t), intent(in) :: p1, p2 real(default), intent(in) :: m type(lorentz_transformation_t) :: L end function transformation_rec_generic elemental module function transformation_rec_canonical (k, p1, p2, m) result (L) integer, intent(in) :: k type(vector4_t), intent(in) :: p1, p2 real(default), intent(in) :: m type(lorentz_transformation_t) :: L end function transformation_rec_canonical <>= elemental module function transformation_rec_generic (axis, p1, p2, m) result (L) type(vector3_t), intent(in) :: axis type(vector4_t), intent(in) :: p1, p2 real(default), intent(in) :: m type(lorentz_transformation_t) :: L L = boost (p1 + p2, m) L = L * rotation_to_2nd (axis, space_part (inverse (L) * p1)) end function transformation_rec_generic elemental module function transformation_rec_canonical (k, p1, p2, m) result (L) integer, intent(in) :: k type(vector4_t), intent(in) :: p1, p2 real(default), intent(in) :: m type(lorentz_transformation_t) :: L L = boost (p1 + p2, m) L = L * rotation_to_2nd (k, space_part (inverse (L) * p1)) end function transformation_rec_canonical @ %def transformation_rec_generic transformation_rec_canonical @ \subsection{Applying Lorentz transformations} Multiplying vectors and Lorentz transformations is straightforward. <>= interface operator(*) module procedure prod_LT_vector4 module procedure prod_LT_LT module procedure prod_vector4_LT end interface <>= elemental module function prod_LT_vector4 (L, p) result (np) type(vector4_t) :: np type(lorentz_transformation_t), intent(in) :: L type(vector4_t), intent(in) :: p end function prod_LT_vector4 elemental module function prod_LT_LT (L1, L2) result (NL) type(lorentz_transformation_t) :: NL type(lorentz_transformation_t), intent(in) :: L1,L2 end function prod_LT_LT elemental module function prod_vector4_LT (p, L) result (np) type(vector4_t) :: np type(vector4_t), intent(in) :: p type(lorentz_transformation_t), intent(in) :: L end function prod_vector4_LT <>= elemental module function prod_LT_vector4 (L, p) result (np) type(vector4_t) :: np type(lorentz_transformation_t), intent(in) :: L type(vector4_t), intent(in) :: p np%p = matmul (L%L, p%p) end function prod_LT_vector4 elemental module function prod_LT_LT (L1, L2) result (NL) type(lorentz_transformation_t) :: NL type(lorentz_transformation_t), intent(in) :: L1,L2 NL%L = matmul (L1%L, L2%L) end function prod_LT_LT elemental module function prod_vector4_LT (p, L) result (np) type(vector4_t) :: np type(vector4_t), intent(in) :: p type(lorentz_transformation_t), intent(in) :: L np%p = matmul (p%p, L%L) end function prod_vector4_LT @ %def * @ \subsection{Special Lorentz transformations} These routines have their application in the generation and extraction of angles in the phase-space sampling routine. Since this part of the program is time-critical, we calculate the composition of transformations directly instead of multiplying rotations and boosts. This Lorentz transformation is the composition of a rotation by $\phi$ around the $3$ axis, a rotation by $\theta$ around the $2$ axis, and a boost along the $3$ axis: \begin{equation} L = B_3(\beta\gamma)\,R_2(\theta)\,R_3(\phi) \end{equation} Instead of the angles we provide sine and cosine. <>= public :: LT_compose_r3_r2_b3 <>= elemental module function LT_compose_r3_r2_b3 & (cp, sp, ct, st, beta_gamma) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: cp, sp, ct, st, beta_gamma end function LT_compose_r3_r2_b3 <>= elemental module function LT_compose_r3_r2_b3 & (cp, sp, ct, st, beta_gamma) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: cp, sp, ct, st, beta_gamma real(default) :: gamma if (abs(beta_gamma) < eps0) then L%L(0,0) = 1 L%L(1:,0) = 0 L%L(0,1:) = 0 L%L(1,1:) = [ ct*cp, -ct*sp, st ] L%L(2,1:) = [ sp, cp, zero ] L%L(3,1:) = [ -st*cp, st*sp, ct ] else gamma = sqrt(1 + beta_gamma**2) L%L(0,0) = gamma L%L(1,0) = 0 L%L(2,0) = 0 L%L(3,0) = beta_gamma L%L(0,1:) = beta_gamma * [ -st*cp, st*sp, ct ] L%L(1,1:) = [ ct*cp, -ct*sp, st ] L%L(2,1:) = [ sp, cp, zero ] L%L(3,1:) = gamma * [ -st*cp, st*sp, ct ] end if end function LT_compose_r3_r2_b3 @ %def LT_compose_r3_r2_b3 @ Different ordering: \begin{equation} L = B_3(\beta\gamma)\,R_3(\phi)\,R_2(\theta) \end{equation} <>= public :: LT_compose_r2_r3_b3 <>= elemental module function LT_compose_r2_r3_b3 & (ct, st, cp, sp, beta_gamma) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: ct, st, cp, sp, beta_gamma end function LT_compose_r2_r3_b3 <>= elemental module function LT_compose_r2_r3_b3 & (ct, st, cp, sp, beta_gamma) result (L) type(lorentz_transformation_t) :: L real(default), intent(in) :: ct, st, cp, sp, beta_gamma real(default) :: gamma if (abs(beta_gamma) < eps0) then L%L(0,0) = 1 L%L(1:,0) = 0 L%L(0,1:) = 0 L%L(1,1:) = [ ct*cp, -sp, st*cp ] L%L(2,1:) = [ ct*sp, cp, st*sp ] L%L(3,1:) = [ -st , zero, ct ] else gamma = sqrt(1 + beta_gamma**2) L%L(0,0) = gamma L%L(1,0) = 0 L%L(2,0) = 0 L%L(3,0) = beta_gamma L%L(0,1:) = beta_gamma * [ -st , zero, ct ] L%L(1,1:) = [ ct*cp, -sp, st*cp ] L%L(2,1:) = [ ct*sp, cp, st*sp ] L%L(3,1:) = gamma * [ -st , zero, ct ] end if end function LT_compose_r2_r3_b3 @ %def LT_compose_r2_r3_b3 @ This function returns the previous Lorentz transformation applied to an arbitrary four-momentum and extracts the space part of the result: \begin{equation} \vec n = [B_3(\beta\gamma)\,R_2(\theta)\,R_3(\phi)\,p]_{\rm space\ part} \end{equation} The second variant applies if there is no rotation <>= public :: axis_from_p_r3_r2_b3, axis_from_p_b3 <>= elemental module function axis_from_p_r3_r2_b3 & (p, cp, sp, ct, st, beta_gamma) result (n) type(vector3_t) :: n type(vector4_t), intent(in) :: p real(default), intent(in) :: cp, sp, ct, st, beta_gamma end function axis_from_p_r3_r2_b3 elemental module function axis_from_p_b3 (p, beta_gamma) result (n) type(vector3_t) :: n type(vector4_t), intent(in) :: p real(default), intent(in) :: beta_gamma end function axis_from_p_b3 <>= elemental module function axis_from_p_r3_r2_b3 & (p, cp, sp, ct, st, beta_gamma) result (n) type(vector3_t) :: n type(vector4_t), intent(in) :: p real(default), intent(in) :: cp, sp, ct, st, beta_gamma real(default) :: gamma, px, py px = cp * p%p(1) - sp * p%p(2) py = sp * p%p(1) + cp * p%p(2) n%p(1) = ct * px + st * p%p(3) n%p(2) = py n%p(3) = -st * px + ct * p%p(3) if (abs(beta_gamma) > eps0) then gamma = sqrt(1 + beta_gamma**2) n%p(3) = n%p(3) * gamma + p%p(0) * beta_gamma end if end function axis_from_p_r3_r2_b3 elemental module function axis_from_p_b3 (p, beta_gamma) result (n) type(vector3_t) :: n type(vector4_t), intent(in) :: p real(default), intent(in) :: beta_gamma real(default) :: gamma n%p = p%p(1:3) if (abs(beta_gamma) > eps0) then gamma = sqrt(1 + beta_gamma**2) n%p(3) = n%p(3) * gamma + p%p(0) * beta_gamma end if end function axis_from_p_b3 @ %def axis_from_p_r3_r2_b3 axis_from_p_b3 @ \subsection{Special functions} The K\"all\'en function, mostly used for the phase space. This is equivalent to $\lambda(x,y,z)=x^2+y^2+z^2-2xy-2xz-2yz$. <>= public :: lambda <>= elemental module function lambda (m1sq, m2sq, m3sq) real(default) :: lambda real(default), intent(in) :: m1sq, m2sq, m3sq end function lambda <>= elemental module function lambda (m1sq, m2sq, m3sq) real(default) :: lambda real(default), intent(in) :: m1sq, m2sq, m3sq lambda = (m1sq - m2sq - m3sq)**2 - 4*m2sq*m3sq end function lambda @ %def lambda @ Return a pair of head-to-head colliding momenta, given the collider energy, particle masses, and optionally the momentum of the c.m. system. <>= public :: colliding_momenta <>= module function colliding_momenta (sqrts, m, p_cm) result (p) type(vector4_t), dimension(2) :: p real(default), intent(in) :: sqrts real(default), dimension(2), intent(in), optional :: m real(default), intent(in), optional :: p_cm end function colliding_momenta <>= module function colliding_momenta (sqrts, m, p_cm) result (p) type(vector4_t), dimension(2) :: p real(default), intent(in) :: sqrts real(default), dimension(2), intent(in), optional :: m real(default), intent(in), optional :: p_cm real(default), dimension(2) :: dmsq real(default) :: ch, sh real(default), dimension(2) :: E0, p0 integer, dimension(2), parameter :: sgn = [1, -1] if (abs(sqrts) < eps0) then call msg_fatal (" Colliding beams: sqrts is zero (please set sqrts)") p = vector4_null; return else if (sqrts <= 0) then call msg_fatal (" Colliding beams: sqrts is negative") p = vector4_null; return end if if (present (m)) then dmsq = sgn * (m(1)**2-m(2)**2) E0 = (sqrts + dmsq/sqrts) / 2 if (any (E0 < m)) then call msg_fatal & (" Colliding beams: beam energy is less than particle mass") p = vector4_null; return end if p0 = sgn * sqrt (E0**2 - m**2) else E0 = sqrts / 2 p0 = sgn * E0 end if if (present (p_cm)) then sh = p_cm / sqrts ch = sqrt (1 + sh**2) p = vector4_moving (E0 * ch + p0 * sh, E0 * sh + p0 * ch, 3) else p = vector4_moving (E0, p0, 3) end if end function colliding_momenta @ %def colliding_momenta @ This subroutine is for the purpose of numerical checks and comparisons. The idea is to set a number to zero if it is numerically equivalent with zero. The equivalence is established by comparing with a [[tolerance]] argument. We implement this for vectors and transformations. <>= public :: pacify <>= interface pacify module procedure pacify_vector3 module procedure pacify_vector4 module procedure pacify_LT end interface pacify <>= elemental module subroutine pacify_vector3 (p, tolerance) type(vector3_t), intent(inout) :: p real(default), intent(in) :: tolerance end subroutine pacify_vector3 elemental module subroutine pacify_vector4 (p, tolerance) type(vector4_t), intent(inout) :: p real(default), intent(in) :: tolerance end subroutine pacify_vector4 elemental module subroutine pacify_LT (LT, tolerance) type(lorentz_transformation_t), intent(inout) :: LT real(default), intent(in) :: tolerance end subroutine pacify_LT <>= elemental module subroutine pacify_vector3 (p, tolerance) type(vector3_t), intent(inout) :: p real(default), intent(in) :: tolerance where (abs (p%p) < tolerance) p%p = zero end subroutine pacify_vector3 elemental module subroutine pacify_vector4 (p, tolerance) type(vector4_t), intent(inout) :: p real(default), intent(in) :: tolerance where (abs (p%p) < tolerance) p%p = zero end subroutine pacify_vector4 elemental module subroutine pacify_LT (LT, tolerance) type(lorentz_transformation_t), intent(inout) :: LT real(default), intent(in) :: tolerance where (abs (LT%L) < tolerance) LT%L = zero end subroutine pacify_LT @ %def pacify @ <>= public :: vector_set_reshuffle <>= module subroutine vector_set_reshuffle (p1, list, p2) type(vector4_t), intent(in), dimension(:), allocatable :: p1 integer, intent(in), dimension(:), allocatable :: list type(vector4_t), intent(out), dimension(:), allocatable :: p2 end subroutine vector_set_reshuffle <>= module subroutine vector_set_reshuffle (p1, list, p2) type(vector4_t), intent(in), dimension(:), allocatable :: p1 integer, intent(in), dimension(:), allocatable :: list type(vector4_t), intent(out), dimension(:), allocatable :: p2 integer :: n, n_p n_p = size (p1) if (size (list) /= n_p) return allocate (p2 (n_p)) do n = 1, n_p p2(n) = p1(list(n)) end do end subroutine vector_set_reshuffle @ %def vector_set_reshuffle @ <>= public :: vector_set_is_cms <>= module function vector_set_is_cms (p, n_in) result (is_cms) logical :: is_cms type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: n_in end function vector_set_is_cms <>= module function vector_set_is_cms (p, n_in) result (is_cms) logical :: is_cms type(vector4_t), intent(in), dimension(:) :: p integer, intent(in) :: n_in integer :: i type(vector4_t) :: p_sum p_sum%p = 0._default do i = 1, n_in p_sum = p_sum + p(i) end do is_cms = all (abs (p_sum%p(1:3)) < tiny_07) end function vector_set_is_cms @ %def vector_set_is_cms @ <>= public :: vector4_write_set <>= module subroutine vector4_write_set (p, unit, show_mass, testflag, & check_conservation, ultra, n_in) type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), optional :: unit logical, intent(in), optional :: show_mass logical, intent(in), optional :: testflag, ultra logical, intent(in), optional :: check_conservation integer, intent(in), optional :: n_in end subroutine vector4_write_set <>= module subroutine vector4_write_set (p, unit, show_mass, testflag, & check_conservation, ultra, n_in) type(vector4_t), intent(in), dimension(:) :: p integer, intent(in), optional :: unit logical, intent(in), optional :: show_mass logical, intent(in), optional :: testflag, ultra logical, intent(in), optional :: check_conservation integer, intent(in), optional :: n_in logical :: extreme integer :: i, j real(default), dimension(0:3) :: p_tot character(len=7) :: fmt integer :: u logical :: yorn, is_test integer :: n extreme = .false.; if (present (ultra)) extreme = ultra is_test = .false.; if (present (testflag)) is_test = testflag u = given_output_unit (unit); if (u < 0) return n = 2; if (present (n_in)) n = n_in p_tot = 0 yorn = .false.; if (present (check_conservation)) yorn = check_conservation do i = 1, size (p) if (yorn .and. i > n) then forall (j=0:3) p_tot(j) = p_tot(j) - p(i)%p(j) else forall (j=0:3) p_tot(j) = p_tot(j) + p(i)%p(j) end if call vector4_write (p(i), u, show_mass=show_mass, & testflag=testflag, ultra=ultra) end do if (extreme) then call pac_fmt (fmt, FMT_19, FMT_11, testflag) else call pac_fmt (fmt, FMT_19, FMT_15, testflag) end if if (is_test) call pacify (p_tot, 1.E-9_default) if (.not. is_test) then write (u, "(A5)") 'Total: ' write (u, "(1x,A,1x," // fmt // ")") "E = ", p_tot(0) write (u, "(1x,A,3(1x," // fmt // "))") "P = ", p_tot(1:) end if end subroutine vector4_write_set @ %def vector4_write_set @ <>= public :: vector4_check_momentum_conservation <>= module subroutine vector4_check_momentum_conservation (p, n_in, unit, & abs_smallness, rel_smallness, verbose) type(vector4_t), dimension(:), intent(in) :: p integer, intent(in) :: n_in integer, intent(in), optional :: unit real(default), intent(in), optional :: abs_smallness, rel_smallness logical, intent(in), optional :: verbose end subroutine vector4_check_momentum_conservation <>= module subroutine vector4_check_momentum_conservation (p, n_in, unit, & abs_smallness, rel_smallness, verbose) type(vector4_t), dimension(:), intent(in) :: p integer, intent(in) :: n_in integer, intent(in), optional :: unit real(default), intent(in), optional :: abs_smallness, rel_smallness logical, intent(in), optional :: verbose integer :: u, i type(vector4_t) :: psum_in, psum_out logical, dimension(0:3) :: p_diff logical :: verb u = given_output_unit (unit); if (u < 0) return verb = .false.; if (present (verbose)) verb = verbose psum_in = vector4_null do i = 1, n_in psum_in = psum_in + p(i) end do psum_out = vector4_null do i = n_in + 1, size (p) psum_out = psum_out + p(i) end do p_diff = vanishes (psum_in%p - psum_out%p, & abs_smallness = abs_smallness, rel_smallness = rel_smallness) if (.not. all (p_diff)) then call msg_warning ("Momentum conservation: FAIL", unit = u) if (verb) then write (u, "(A)") "Incoming:" call vector4_write (psum_in, u) write (u, "(A)") "Outgoing:" call vector4_write (psum_out, u) end if else if (verb) then write (u, "(A)") "Momentum conservation: CHECK" end if end if end subroutine vector4_check_momentum_conservation @ %def vector4_check_momentum_conservation @ This computes the quantities \begin{align*} \langle ij \rangle &= \sqrt{|S_{ij}|} e^{i\phi_{ij}}, [ij] &= \sqrt{|S_{ij}|} e^{\i\tilde{\phi}_{ij}}, \end{align*} with $S_{ij} = \left(p_i + p_j\right)^2$. The phase space factor $\phi_{ij}$ is determined by \begin{align*} \cos\phi_{ij} &= \frac{p_i^1p_j^+ - p_j^1p_i^+}{\sqrt{p_i^+p_j^+S_{ij}}}, \sin\phi_{ij} &= \frac{p_i^2p_j^+ - p_j^2p_i^+}{\sqrt{p_i^+p_j^+S_{ij}}}. \end{align*} After $\langle ij \rangle$ has been computed according to these formulae, $[ij]$ can be obtained by using the relation $S_{ij} = \langle ij \rangle [ji]$ and taking into account that $[ij] = -[ji]$. Thus, a minus-sign has to be applied. <>= public :: spinor_product <>= module subroutine spinor_product (p1, p2, prod1, prod2) type(vector4_t), intent(in) :: p1, p2 complex(default), intent(out) :: prod1, prod2 end subroutine spinor_product <>= module subroutine spinor_product (p1, p2, prod1, prod2) type(vector4_t), intent(in) :: p1, p2 complex(default), intent(out) :: prod1, prod2 real(default) :: sij complex(default) :: phase real(default) :: pp_1, pp_2 pp_1 = p1%p(0) + p1%p(3) pp_2 = p2%p(0) + p2%p(3) sij = (p1+p2)**2 phase = cmplx ((p1%p(1)*pp_2 - p2%p(1)*pp_1)/sqrt (sij*pp_1*pp_2), & (p1%p(2)*pp_2 - p2%p(2)*pp_1)/sqrt (sij*pp_1*pp_2), & default) !!! prod1 = sqrt (sij) * phase !!! [ij] if (abs(prod1) > 0) then prod2 = - sij / prod1 else prod2 = 0 end if end subroutine spinor_product @ %def spinor_product +@ \subsection{Unit tests} Test module, followed by the corresponding implementation module. <<[[lorentz_ut.f90]]>>= <> module lorentz_ut use unit_tests use lorentz_uti <> <> contains <> end module lorentz_ut @ %def lorentz_ut @ <<[[lorentz_uti.f90]]>>= <> module lorentz_uti <> use constants, only: zero, Pi use format_defs, only: FMT_12 use lorentz <> <> contains <> end module lorentz_uti @ %def lorentz_ut @ API: driver for the unit tests below. <>= public :: lorentz_test <>= subroutine lorentz_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine lorentz_test @ %def lorentz_test @ \subsubsection{Algebra with 3-vectors} <>= call test (lorentz_1, "lorentz_1", & "Test 3-vector functionality", & u, results) <>= public :: lorentz_1 <>= subroutine lorentz_1 (u) integer, intent(in) :: u type(vector3_t) :: v3_1, v3_2 write (u, "(A)") "* Test output: lorentz_1" write (u, "(A)") "* Purpose: testing vector3_t" write (u, "(A)") write (u, "(A)") write (u, "(A)") "* Null 3-vector" write (u, "(A)") call vector3_write (vector3_null, u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Canonical 3-vector" write (u, "(A)") call vector3_write (vector3_canonical (1), u, testflag = .true.) call vector3_write (vector3_canonical (2), u, testflag = .true.) call vector3_write (vector3_canonical (3), u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Canonical moving 3-vector" write (u, "(A)") call vector3_write (vector3_moving (42._default, 1), u, testflag = .true.) call vector3_write (vector3_moving (42._default, 2), u, testflag = .true.) call vector3_write (vector3_moving (42._default, 3), u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Generic moving 3-vector" write (u, "(A)") call vector3_write (vector3_moving ([3._default, 4._default, 5._default]), & u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Simple algebra with 3-vectors" write (u, "(A)") v3_1 = vector3_moving ([3._default, 4._default, 5._default]) v3_2 = vector3_moving ([-2._default, 5._default, -1._default]) write (u, "(1x,A)") "v3_1:" call vector3_write (v3_1, u, testflag=.true.) write (u, "(1x,A)") "v3_2:" call vector3_write (v3_2, u, testflag=.true.) write (u, "(1x,A)") "-v3_1:" call vector3_write (-v3_1, u, testflag=.true.) write (u, "(1x,A)") "v3_1 / |v3_1|:" call vector3_write (direction (v3_1), u, testflag=.true.) write (u, "(1x,A," // FMT_12 // ")") "v3_1(x): ", vector3_get_component (v3_1, 1) write (u, "(1x,A," // FMT_12 // ")") "v3_1(y): ", vector3_get_component (v3_1, 2) write (u, "(1x,A," // FMT_12 // ")") "v3_1(z): ", vector3_get_component (v3_1, 3) write (u, "(1x,A)") "v3_1 + v3_2:" call vector3_write (v3_1 + v3_2, u, testflag=.true.) write (u, "(1x,A)") "v3_1 - v3_2:" call vector3_write (v3_1 - v3_2, u, testflag=.true.) write (u, "(1x,A,L1)") "v3_1 == v3_2: ", v3_1 == v3_2 write (u, "(1x,A,L1)") "v3_1 /= v3_2: ", v3_1 /= v3_2 write (u, "(1x,A)") "2 * v3_1:" call vector3_write (2._default * v3_1, u, testflag=.true.) write (u, "(1x,A)") "v3_2 / 4:" call vector3_write (v3_2 / 4, u, testflag=.true.) write (u, "(1x,A," // FMT_12 // ")") "v3_1, azimuth (radians):", azimuthal_angle (v3_1) write (u, "(1x,A," // FMT_12 // ")") "v3_1, azimuth (degrees):", & azimuthal_angle_deg (v3_1) write (u, "(1x,A," // FMT_12 // ")") "v3_1, polar (radians) :", polar_angle (v3_1) write (u, "(1x,A," // FMT_12 // ")") "v3_1, polar (degrees) :", & polar_angle_deg (v3_1) write (u, "(1x,A," // FMT_12 // ")") "v3_1, cosine polar :", & polar_angle_ct (v3_1) write (u, "(1x,A," // FMT_12 // ")") "v3_1, energy w. mass=1 :", & energy (v3_1, 1._default) write (u, "(1x,A)") "3-vector orthogonal to v3_1:" call vector3_write (create_orthogonal (v3_1), u, testflag=.true.) write (u, "(1x,A)") "unit 3-vector from v3_1:" write (u, "(A)") write (u, "(A)") "* Dot and cross product" write (u, "(A)") write (u, "(1x,A," // FMT_12 // ")") "v3_1 * v3_2: ", v3_1 * v3_2 write (u, "(1x,A," // FMT_12 // ")") "v3_1**3 : ", v3_1**3 write (u, "(1x,A)") "v3_1 x v3_2:" call vector3_write (cross_product (v3_1, v3_2), u, testflag=.true.) write (u, "(1x,A," // FMT_12 // ")") "enclosed angle (radians):", & enclosed_angle (v3_1, v3_2) write (u, "(1x,A," // FMT_12 // ")") "enclosed angle (degrees):", & enclosed_angle_deg (v3_1, v3_2) write (u, "(1x,A," // FMT_12 // ")") "cosine (enclosed angle) :", & enclosed_angle_ct (v3_1, v3_2) write (u, "(A)") write (u, "(A)") "* Test output end: lorentz_1" end subroutine lorentz_1 @ %def lorentz_1 @ \subsubsection{Algebra with 4-vectors} <>= call test(lorentz_2, "lorentz_2", & "Test 4-vector functionality", u, results) <>= public :: lorentz_2 <>= subroutine lorentz_2 (u) integer, intent(in) :: u type(vector3_t) :: v3_1, v3_2 type(vector4_t) :: v4_1, v4_2, v4_1_inv write (u, "(A)") "* Test output: lorentz_2" write (u, "(A)") "* Purpose: testing vector4_t" write (u, "(A)") write (u, "(A)") write (u, "(A)") "* Null 4-vector" write (u, "(A)") call vector4_write (vector4_null, u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Canonical 4-vector" write (u, "(A)") call vector4_write (vector4_canonical (0), u, testflag = .true.) call vector4_write (vector4_canonical (1), u, testflag = .true.) call vector4_write (vector4_canonical (2), u, testflag = .true.) call vector4_write (vector4_canonical (3), u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* 4-vector at rest with mass m = 17" write (u, "(A)") call vector4_write (vector4_at_rest (17._default), u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Canonical moving 4-vector" write (u, "(A)") call vector4_write (vector4_moving (17._default, 42._default, 1), u, testflag = .true.) call vector4_write (vector4_moving (17._default, 42._default, 2), u, testflag = .true.) call vector4_write (vector4_moving (17._default, 42._default, 3), u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Generic moving 4-vector" write (u, "(A)") v3_1 = [3._default, 4._default, 5._default] call vector4_write (vector4_moving (17._default, v3_1), u, testflag = .true.) write (u, "(A)") write (u, "(A)") "* Simple algebra with 4-vectors" write (u, "(A)") v3_2 = [-2._default, 5._default, -1._default] v4_1 = vector4_moving (8._default, v3_1) v4_2 = vector4_moving (zero, v3_2) write (u, "(1x,A)") "v4_1:" call vector4_write (v4_1, u, testflag=.true.) write (u, "(1x,A)") "v4_2:" call vector4_write (v4_2, u, testflag=.true.) write (u, "(1x,A)") "-v4_1:" call vector4_write (-v4_1, u, testflag=.true.) v4_1_inv = v4_1 call vector4_invert_direction (v4_1_inv) write (u, "(1x,A)") "v4_1, inverted direction:" call vector4_write (v4_1_inv, u, testflag=.true.) write (u, "(1x,A)") "(v4_1)_spatial / |(v4_1)_spatial|:" call vector3_write (direction (v4_1), u, testflag=.true.) write (u, "(1x,A," // FMT_12 // ")") "v4_1(E): ", energy (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1(x): ", vector4_get_component (v4_1, 1) write (u, "(1x,A," // FMT_12 // ")") "v4_1(y): ", vector4_get_component (v4_1, 2) write (u, "(1x,A," // FMT_12 // ")") "v4_1(z): ", vector4_get_component (v4_1, 3) write (u, "(1x,A)") "space_part (v4_1):" call vector3_write (space_part (v4_1), u, testflag=.true.) write (u, "(1x,A," // FMT_12 // ")") "norm space_part (v4_1): ", & space_part_norm (v4_1) write (u, "(1x,A)") "unit vector from v4_1:" call vector3_write (create_unit_vector (v4_1), u, testflag = .true.) write (u, "(1x,A)") "v4_1 + v4_2:" call vector4_write (v4_1 + v4_2, u, testflag=.true.) write (u, "(1x,A)") "v4_1 - v4_2:" call vector4_write (v4_1 - v4_2, u, testflag=.true.) write (u, "(1x,A,L1)") "v4_1 == v4_2: ", v4_1 == v4_2 write (u, "(1x,A,L1)") "v4_1 /= v4_2: ", v4_1 /= v4_2 write (u, "(1x,A)") "2 * v4_1:" call vector4_write (2._default * v4_1, u, testflag=.true.) write (u, "(1x,A)") "v4_2 / 4:" call vector4_write (v4_2 / 4, u, testflag=.true.) write (u, "(A)") write (u, "(A)") "* Angles and kinematic properties of 4-vectors" write (u, "(A)") write (u, "(1x,A," // FMT_12 // ")") "v4_1, azimuth (radians):", azimuthal_angle (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, azimuth (degrees):", & azimuthal_angle_deg (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, polar (radians) :", polar_angle (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, polar (degrees) :", & polar_angle_deg (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, cosine polar :", & polar_angle_ct (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, invariant mass :", & invariant_mass (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, invariant mass sq:", & invariant_mass_squared (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_2, invariant mass :", & invariant_mass (v4_2) write (u, "(1x,A," // FMT_12 // ")") "v4_2, invariant mass sq:", & invariant_mass_squared (v4_2) write (u, "(1x,A," // FMT_12 // ")") "v4_1, transverse mass :", & transverse_mass (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, rapidity :", & rapidity (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, pseudorapidity :", & pseudorapidity (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, pT :", & transverse_part (v4_1) write (u, "(1x,A," // FMT_12 // ")") "v4_1, pL :", & longitudinal_part (v4_1) write (u, "(A)") write (u, "(A)") "* Test output end: lorentz_2" end subroutine lorentz_2 @ %def lorentz_2 @ \subsubsection{Bilinear functions of 4-vectors} <>= call test(lorentz_3, "lorentz_3", & "Test 4-vector bilinear functions", u, results) <>= public :: lorentz_3 <>= subroutine lorentz_3 (u) integer, intent(in) :: u type(vector3_t) :: v3_1, v3_2 type(vector4_t) :: v4_1, v4_2 write (u, "(A)") "* Test output: lorentz_3" write (u, "(A)") "* Purpose: testing bilinear functions of 4-vectors" write (u, "(A)") write (u, "(A)") write (u, "(A)") "* Products and distances of 4-vectors" write (u, "(A)") v3_1 = [3._default, 4._default, 5._default] v3_2 = [-2._default, 5._default, -1._default] v4_1 = vector4_moving (8._default, v3_1) v4_2 = vector4_moving (6._default, v3_2) write (u, "(1x,A," // FMT_12 // ")") "v4_1 * v4_2: ", v4_1 * v4_2 write (u, "(1x,A," // FMT_12 // ")") "rapidity distance :", & rapidity_distance (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "pseudorapidity distance :", & pseudorapidity_distance (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "eta phi distance :", & eta_phi_distance (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "enclosed angle (radians):", & enclosed_angle (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "enclosed angle (degrees):", & enclosed_angle_deg (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "cosine (enclosed angle) :", & enclosed_angle_ct (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "rest frame theta (rad) :", & enclosed_angle_rest_frame (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "rest frame theta (deg) :", & enclosed_angle_deg_rest_frame (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "rest frame cosine(theta):", & enclosed_angle_ct_rest_frame (v4_1, v4_2) write (u, "(1x,A," // FMT_12 // ")") "v4_1_T w.r.t. v4_2 :", & transverse_part (v4_1, v4_2) write (u, "(A)") write (u, "(A)") "* Test output end: lorentz_3" end subroutine lorentz_3 @ %def lorentz_3 @ \subsubsection{Tests for Lorentz transformations} <>= call test(lorentz_4, "lorentz_4", & "Test Lorentz transformations", u, results) <>= public :: lorentz_4 <>= subroutine lorentz_4 (u) integer, intent(in) :: u type(vector3_t) :: v3_1, v3_2 type(vector4_t) :: v4 type(lorentz_transformation_t) :: LT real(default) :: tol write (u, "(A)") "* Test output: lorentz_4" write (u, "(A)") "* Purpose: testing Lorentz transformations" write (u, "(A)") write (u, "(A)") write (u, "(A)") "* Basic Lorentz transformatios" write (u, "(A)") write (u, "(1x,A)") "LT = 1:" call lorentz_transformation_write (identity, u, testflag=.true.) write (u, "(A)") write (u, "(1x,A)") "LT = space reflection:" call lorentz_transformation_write (space_reflection, u, testflag=.true.) write (u, "(A)") write (u, "(A)") "* Lorentz transformations: rotations" write (u, "(A)") v3_1 = [1._default, 2._default, 3._default] v3_2 = [-2._default, 1._default, -5._default] tol = 1.e-12_default write (u, "(1x,A)") "Rotation of Pi/4 around 1-axis, def. by cos and sin:" LT = rotation (0.707107_default, 0.707107_default, 1) call pacify (LT, tol) call lorentz_transformation_write (LT, u, testflag=.true.) write (u, "(1x,A)") "Rotation of Pi/4 around 2-axis, def. by cos and sin:" LT = rotation (0.707107_default, 0.707107_default, 2) call pacify (LT, tol) call lorentz_transformation_write (LT, u, testflag=.true.) write (u, "(1x,A)") "Rotation of Pi/4 around 3-axis, def. by cos and sin:" LT = rotation (0.707107_default, 0.707107_default, 3) call pacify (LT, tol) call lorentz_transformation_write (LT, u, testflag=.true.) write (u, "(1x,A)") "Rotation of Pi/4 around 1-axis, def. by angle:" LT = rotation (Pi/4._default, 1) call pacify (LT, tol) call lorentz_transformation_write (LT, u, testflag=.true.) write (u, "(1x,A)") "Rotation of Pi/4 around 2-axis, def. by angle:" LT = rotation (Pi/4._default, 2) call pacify (LT, tol) call lorentz_transformation_write (LT, u, testflag=.true.) write (u, "(1x,A)") "Rotation of Pi/4 around 3-axis, def. by angle:" LT = rotation (Pi/4._default, 3) call pacify (LT, tol) call lorentz_transformation_write (LT, u, testflag=.true.) write (u, "(1x,A)") "Rotation of Pi/4 around axis = (1,2,3):" call lorentz_transformation_write (rotation (0.707107_default, 0.707107_default, & normalize (v3_1)), u, testflag=.true.) write (u, "(1x,A)") "Rotation in plane to axis = (1,2,3), angle given by length of axis:" call lorentz_transformation_write (rotation (v3_1), u, testflag=.true.) write (u, "(1x,A)") "Rotation from v3_1=(1,2,3) to v3_2=(-2,1,-5):" call lorentz_transformation_write (rotation_to_2nd (v3_1,v3_2), u, testflag=.true.) write (u, "(1x,A)") "Rotation from 1-axis to v3_2=(-2,1,-5):" call lorentz_transformation_write (rotation_to_2nd (1,v3_2), u, testflag=.true.) write (u, "(1x,A)") "Rotation from 2-axis to v3_2=(-2,1,-5):" call lorentz_transformation_write (rotation_to_2nd (2,v3_2), u, testflag=.true.) write (u, "(1x,A)") "Rotation from 3-axis to v3_2=(-2,1,-5):" call lorentz_transformation_write (rotation_to_2nd (3,v3_2), u, testflag=.true.) write (u, "(A)") write (u, "(A)") "* Lorentz transformations: boosts" write (u, "(A)") write (u, "(1x,A)") "Boost from rest frame to 3-vector, mass m=10:" call lorentz_transformation_write (boost (v3_1, 10._default), u, testflag=.true.) write (u, "(1x,A)") "Boost from rest frame to 4-vector, mass m=10:" v4 = vector4_moving (42._default, v3_1) call lorentz_transformation_write (boost (v4, 10._default), u, testflag=.true.) write (u, "(1x,A)") "Boost along 1-axis, beta*gamma = 12" call lorentz_transformation_write (boost (12._default, 1), u, testflag=.true.) write (u, "(1x,A)") "Boost along 2-axis, beta*gamma = 12" call lorentz_transformation_write (boost (12._default, 2), u, testflag=.true.) write (u, "(1x,A)") "Boost along 3-axis, beta*gamma = 12" call lorentz_transformation_write (boost (12._default, 3), u, testflag=.true.) write (u, "(1x,A)") "Boost along axis=(1,2,3), beta*gamma = 12" call lorentz_transformation_write (boost (12._default, v3_1), u, testflag=.true.) write (u, "(A)") write (u, "(A)") "* Test output end: lorentz_4" end subroutine lorentz_4 @ %def lorentz_4 @ \subsubsection{Tests for additional kinematic functions and sets of 4-vectors} <>= call test(lorentz_5, "lorentz_5", & "Test additional kinematics", u, results) <>= public :: lorentz_5 <>= subroutine lorentz_5 (u) integer, intent(in) :: u type(vector4_t), dimension(2) :: p real(default), dimension(2) :: m real(default) :: sqrts type(vector4_t), dimension(8) :: tt_mom type(vector4_t), dimension(:), allocatable :: tin, tout integer, dimension(:), allocatable :: shuffle write (u, "(A)") "* Test output: lorentz_5" write (u, "(A)") "* Purpose: testing additional kinematics and sets of 4-vectors" write (u, "(A)") write (u, "(A)") write (u, "(A)") "* Colliding momenta, 13 TeV, massless" write (u, "(A)") sqrts = 13000._default p = colliding_momenta (sqrts) call vector4_write (p(1), u, testflag=.true.) call vector4_write (p(2), u, testflag=.true.) write (u, "(A)") write (u, "(A)") "* Colliding momenta, 10 GeV, massive muons" write (u, "(A)") sqrts = 10._default m = [0.1057_default, 0.1057_default] p = colliding_momenta (sqrts, m) call vector4_write (p(1), u, testflag=.true.) call vector4_write (p(2), u, testflag=.true.) write (u, "(A)") write (u, "(A)") "* Kinematical function lambda" write (u, "(A)") write (u, "(1x,A," // FMT_12 // ")") "s = 172.3**2, m1 = 4.2, m2 = 80.418:", & lambda (172.3_default**2, 4.2_default**2, 80.418_default**2) write (u, "(A)") write (u, "(A)") "* Test vector_set" write (u, "(A)") tt_mom(1) = [2.5000000000000000e+02_default, zero, zero, 2.4999999999947777e+02_default] tt_mom(2) = [2.5000000000000000e+02_default, zero, zero, -2.4999999999947777e+02_default] tt_mom(3) = [1.1557492413664579e+02_default, 3.9011599241011098e+01_default, & -6.4278142734963140e+01_default, 8.7671766153043137e+01_default] tt_mom(4) = [1.4617918132729235e+02_default, -1.0947970597860679e+02_default, & 1.5484441802571380e+01_default, -9.5525593923398418e+01_default] tt_mom(5) = [5.2637589215119526e+01_default, -4.7413198564695762e+01_default, & 1.0087885417286579e+01_default, 2.0516525153079229e+01_default] tt_mom(6) = [5.4760292922264796e+01_default, 1.5197406985690520e+01_default, & 5.1527071739328015e+01_default, -1.0615525413924287e+01_default] tt_mom(7) = [3.2415057664609684e+01_default, 7.5539389341684711e+00_default, & -1.5935831743946720e+01_default, -2.7139737100881156e+01_default] tt_mom(8) = [9.8432954734067863E+01_default, 9.5129959382432399e+01_default, & 3.1145755197238966e+00_default, 2.5092565132081496e+01_default] write (u, "(1x,A)") "Write routine for vector sets, maximal compression:" call vector4_write_set (tt_mom, u, show_mass=.true., testflag=.true., & check_conservation=.true., ultra=.true.) write (u, "(1x,A,L1)") "Vector set is CMS frame: ", vector_set_is_cms (tt_mom, 2) write (u, "(1x,A)") "Reshuffle vector set, final state inverted:" allocate (tin (8)) tin = tt_mom allocate (shuffle (8), source = [1,2,8,7,6,5,4,3]) call vector_set_reshuffle (tin, shuffle, tout) call vector4_write_set (tout, u, show_mass=.true., testflag=.true., & check_conservation=.true., ultra=.true.) write (u, "(1x,A)") "Vector set, check momentum conservation:" call vector4_check_momentum_conservation (tt_mom, 2, u, & abs_smallness = 1.e-12_default, verbose=.true.) write (u, "(A)") write (u, "(A)") "* Test output end: lorentz_5" end subroutine lorentz_5 @ %def lorentz_5 @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +This is the module file for the $M_{T2}$ calculator based on +algorithm by Han and Cheng by Tom James (DESY) August 2013. +<<[[kinematics_vars.f90]]>>= +<> +module kinematics_vars + + use kinds + use lorentz + use format_defs, only: FMT_19 +<> + +<> + +<> + +<> + + interface +<> + end interface + +end module kinematics_vars +@ %def kinematics_vars +@ +<<[[kinematics_vars_sub.f90]]>>= +<> + +submodule (kinematics_vars) kinematics_vars_s + + implicit none + +contains + +<> + +end submodule kinematics_vars_s + +@ %def kinematics_vars_s +@ +<>= + ! Calculation parameters + real(kind=default), parameter, public :: relative_precision = 0.00001, & + absolute_precision=0.0, min_mass=0.1, step=0.1 + real(kind=default), public :: prec + ! scale and precision + ! Define precision=relative_precision*scale where scale=max{Ea, Eb} + ! Don't set relative precision <0.00001 + ! If mass a < min_mass and mass b < min_mass use massless code + ! Gives massless particles a very small mass + ! scanning step size + +@ %def relative_precision prec +@ +<>= + subroutine mt2calcmassive (mt2, mn, mt2_b) + !!! Code implementation of the massive algorithm for calculating mt2 + type(mt2_t), intent(inout) :: mt2 + real(default), intent(in) :: mn + real(default) :: Ea, Eb + real(default) :: masq, mbsq, mnsq + real(default), intent(out) :: mt2_b + real(default):: deltasq0, x00, y00, dis, p2x0, p2y0, deltasqmid, & + deltasqhigh, deltasqhigh1, deltasqhigh2, deltasqhigh21, & + deltasqhigh22, deltasqlow + ! Calculation coefficients for the quadratic and quartic curves + real(default) :: a1, b1, c1, d1, e1, f1, & + a2, b2, c2, d2, e2, f2 + real(default) :: d20, d11, d21, e11, e20, e21 + real(default) :: f10, f12, f20, f21, f22 + integer:: nsolshigh, nsolslow, findhigh, nsolsmid + + print *, 'using calculation for massive visible particles.' + + !!! Allowed transverse 2-momenta for each invisible partice incloses + !!! an elliptical region on the px, py plane. + !!! To safisfy kinematic constraints, the two elliptical regions must + !!! overlap. MT2 is therefore given by the minimum initial decay mass + !!! in each branch (mt2_b) which gives overlapping elipses + !!! We therefore increase the initial decay mass in each branch (mt2_b) + !!! until the ellipses overlap - the "balanced configuration". + !!! In the balanced configuration, the two quadtratic equations + !!! can be combined into one quartic equation. + !!! We search for the point at which the two ellipses are tangent, + !!! using the Sturm sequence method and bisection + + !!! When the smaller ellipse is already inside the larger ellipse, this + !!! is called an "unbalanced configuration", and mt2 is easy to calculate. + + + deltasq0 = mt2%ma*(mt2%ma + 2*mt2%mn) + + !!! Find co-efficients at deltasq = deltasq0 for the quadratic + !!! equations that describe each ellipse + + masq = mt2%ma**2 + mbsq = mt2%mb**2 + mnsq = mt2%mn**2 + Ea = sqrt(mt2%Ea2) + Eb = sqrt(mt2%Eb2) + a1 = 1 - mt2%pax**2 / mt2%Ea2 + b1 = - mt2%pax * mt2%pay / mt2%Ea2 + c1 = 1 - mt2%pay**2 / mt2%Ea2 + d1 = - (mt2%pax*(deltasq0 - masq))/(2.d0*mt2%Ea2) + e1 = - (mt2%pay * (deltasq0 - masq))/(2.d0*mt2%Ea2) + a2 = 1 - (mt2%pbx * mt2%pbx)/(mt2%Eb2) + b2 = - (mt2%pbx * mt2%pby) / (mt2%Eb2) + c2 = 1 - (mt2%pby * mt2%pby / (mt2%Eb2)) + d2 = -mt2%pmx + ((mt2%pbx * (deltasq0 - mbsq))/(2.d0*mt2%Eb2)) + & + (mt2%pbx*((mt2%pbx*mt2%pmx) + (mt2%pby * mt2%pmy)))/(mt2%Eb2) + e2 = -mt2%pmy + (mt2%pby * (deltasq0 - mbsq))/(2.d0*mt2%Eb2) + & + (mt2%pby*((mt2%pbx*mt2%pmx) + (mt2%pby * mt2%pmy)))/(mt2%Eb2) + f2 = mt2%pmx*mt2%pmx + mt2%pmy * mt2%pmy-((deltasq0-mbsq)/(2*Eb) + & + (mt2%pbx*mt2%pmx + mt2%pby * mt2%pmy)/Eb)*((deltasq0-mbsq)/(2*Eb)+ & + ((mt2%pbx*mt2%pmx + mt2%pby * mt2%pmy)/Eb))+ mnsq + + !!! find the centre of the small ellipse + x00 = (c1*d1 - b1*e1)/(b1*b1 - a1*c1) + y00 = (a1*e1 - b1*d1)/(b1*b1 - a1*c1) + + !!! check if the large ellipse contains the small one - + !!! "unbalanced configuration" + dis = a2*x00*x00 + 2.d0*b2*x00*y00 + c2*y00*y00 + & + 2.d0*d2*x00 + 2.d0*e2*y00 + f2 + mt2_b = 0 + if (dis<0.01) then + mt2_b = sqrt(mnsq + deltasq0) + return + end if + + !!! find linear and constant terms in quadratic equations for + !!! delta = (deltasq-msq)/(2Esq) as quadratic terms do not change as we adjust delta + + d11 = -mt2%pax + e11 = -mt2%pay + f10 = mnsq + f12 = -mt2%Ea2 + d21 = (mt2%Ea2 * mt2%pbx)/(mt2%Eb2) + d20 = ((masq - mbsq)*mt2%pbx)/(2.d0*mt2%Eb2) - mt2%pmx + & + (mt2%pbx*(mt2%pbx*mt2%pmx + mt2%pby * mt2%pmy)) / mt2%Eb2 + e21 = (mt2%Ea2 * mt2%pby) / mt2%Eb2 + e20 = ((masq - mbsq) * mt2%pby)/(2.d0*mt2%Eb2) - mt2%pmy + & + (mt2%pby * (mt2%pbx*mt2%pmx + mt2%pby * mt2%pmy)) / mt2%Eb2 + f22 = -mt2%Ea2*mt2%Ea2 / mt2%Eb2 + f21 = (-2.d0*mt2%Ea2*((masq - mbsq)/(2.d0*Eb) + & + (mt2%pbx*mt2%pmx + mt2%pby * mt2%pmy)/Eb))/Eb + f20 = mnsq + mt2%pmx*mt2%pmx + mt2%pmy**2 & + - ((masq - mbsq)/(2.d0*Eb) + (mt2%pbx*mt2%pmx + & + mt2%pby * mt2%pmy)/Eb)*((masq - mbsq)/(2.d0*Eb) & + + (mt2%pbx*mt2%pmx + mt2%pby * mt2%pmy)/Eb) + + !!! Estimate upper bound of mT2 if large ellipse contains centre of small ellipse + + p2x0 = mt2%pmx - x00 + p2y0 = mt2%pmy - y00 + deltasqhigh1 = 2*Eb*sqrt(p2x0*p2x0+p2y0*p2y0+mnsq) - & + 2 * mt2%pbx * p2x0 - 2 * mt2%pby * p2y0 + mbsq + + !!! Estimate upper bound of mT2 if both ellipses enclose the origin + + deltasqhigh21 = 2.d0*Eb*sqrt(mt2%pmx*mt2%pmx + mt2%pmy * mt2%pmy+mnsq) & + - 2.d0 * mt2%pbx * mt2%pmx - 2.d0 * mt2%pby * mt2%pmy + mbsq + deltasqhigh22 = 2.d0*Ea*mn + masq + + if ( deltasqhigh21 < deltasqhigh22 ) then + deltasqhigh2 = deltasqhigh22 + else + deltasqhigh2 = deltasqhigh21 + end if + + ! Upper bound on mt2 is the smallest of these two estimates + if (deltasqhigh1 < deltasqhigh2) then + deltasqhigh = deltasqhigh1 + else + deltasqhigh = deltasqhigh2 + end if + deltasqlow=deltasq0 + if (nsolutionsmassive(deltasqlow) > 0) then + mt2_b = sqrt(mnsq + deltasqlow) + return + end if + nsolslow = nsolutionsmassive (deltasqlow) + nsolshigh = nsolutionsmassive (deltasqhigh) + if (nsolshigh==nsolslow) then + if (nsolshigh==4) then + + findhigh = findhighfunc(deltasqhigh) + + print *, 'findhigh=', findhigh + + if(findhigh==0) then + mt2_b = sqrt(deltasqlow + mnsq) + return + end if + end if + end if + + do while ((sqrt(deltasqhigh + mnsq) - sqrt(deltasqlow + mnsq)) > prec) + deltasqmid = (deltasqhigh + deltasqlow)/(2.) + nsolsmid = nsolutionsmassive(deltasqmid) + + if (nsolsmid==4) then + deltasqhigh=deltasqmid + findhigh = findhighfunc(deltasqhigh) + cycle + end if + + if (nsolsmid == nsolslow) then + deltasqlow=deltasqmid + else + deltasqhigh = deltasqmid + end if + + end do + + mt2_b = sqrt(mnsq + deltasqhigh) + contains + <> + <> + end subroutine mt2calcmassive + + subroutine mt2massless (mt2, mn, mt2_b) + !!! Code implementation of the massless algorithm for calculating mt2 + type(mt2_t), intent(inout) :: mt2 + real(default), intent(in) :: mn + real(default) :: Ea, Eb + real(default), intent(out) :: mt2_b + real(default) :: mnsq, Easq, Ebsq + real(default) :: pmissxsq, pmissysq + real(kind=default):: theta, s, c, pxtemp, pytemp, & + deltasq0, deltasqlow, deltasqhigh, deltasqlow1, deltasqlow2, & + deltasqhigh1, deltasqhigh2, & + minmass, maxmass, mass, & + deltamid, midmass, nsolsmid + real(default) :: a1, b1, c1, d1, e1, f1, & + a2, b2, c2, d2, e2, f2 + real(default) :: d20, d21, e20, e21 + real(default) :: f20, f21, f22 + integer :: nsolshigh, nsolslow, findhigh + print *, 'using calculation for massless visible particles.' + ! first rotate system so that pay=0 + theta = atan(mt2%pay / mt2%pax) + s = sin(theta) + c = cos(theta) + mnsq = mn*mn + pmissxsq = mt2%pmx**2 + pmissysq = mt2%pmy**2 + + Easq = mt2%pax**2 + mt2%pay**2 + Ebsq = (mt2%pbx * mt2%pbx) + (mt2%pby * mt2%pby) + Ea = sqrt(Easq) + Eb = sqrt(Ebsq) + + pxtemp = mt2%pax * c + mt2%pay * s + mt2%pax = pxtemp + mt2%pay = 0 + pxtemp = mt2%pbx *c + mt2%pby * s + pytemp = -s * mt2%pbx + c * mt2%pby + mt2%pbx= pxtemp + mt2%pby= pytemp + pxtemp = mt2%pmx*c + mt2%pmy*s + pytemp = -s*mt2%pmx + c * mt2%pmy + mt2%pmx = pxtemp + mt2%pmy = pytemp + + a2 = 1 - mt2%pbx * mt2%pbx / Ebsq + b2 = - mt2%pbx * mt2%pby / Ebsq + c2 = 1 - mt2%pby * mt2%pby / Ebsq + + d21 = (Easq * mt2%pbx)/Ebsq + d20 = - mt2%pmx + (mt2%pbx * (mt2%pbx * mt2%pmx + mt2%pby * mt2%pmy)) / Ebsq + e21 = (Easq * mt2%pby) / Ebsq + e20 = - mt2%pmy + (mt2%pby * (mt2%pbx * mt2%pmx + mt2%pby * mt2%pmy)) / Ebsq + f22 = -(Easq*Easq/Ebsq) + f21 = -2*Easq*(mt2%pbx * mt2%pmx + mt2%pby * mt2%pmy) / Ebsq + f20 = mnsq + pmissxsq + pmissysq - (mt2%pbx * mt2%pmx + & + mt2%pby * mt2%pmy)*(mt2%pbx * mt2%pmx + mt2%pby * mt2%pmy) / Ebsq + + deltasq0 = 0 + deltasqlow = deltasq0 + prec + nsolslow = nsolutionsmassless (deltasqlow) + + mt2_b = 0 + if (nsolslow > 1) then + mt2_b = sqrt(deltasq0 + mnsq) + return + end if + + deltasqhigh1 = (2*Eb*sqrt((mt2%pmx**2 * mt2%pmy**2) + mnsq)) & + - (2 * mt2%pbx *mt2%pmx) - (2 * mt2%pby * mt2%pmy) + + deltasqhigh2 = 2*Ea*mn + + if (deltasqhigh1 < deltasqhigh2) then + deltasqhigh = deltasqhigh2 + else + deltasqhigh = deltasqhigh1 + end if + + nsolshigh = nsolutionsmassless(deltasqhigh) + + if (nsolshigh==nsolslow) then + findhigh=0 + minmass = mn + maxmass = sqrt(mnsq + deltasqhigh) + mass = minmass + step + do while (mass < maxmass) + deltasqhigh = (mass*mass) - mnsq + nsolshigh = nsolutionsmassless(deltasqhigh) + if (nsolshigh>0) then + findhigh=1 + deltasqlow = (mass-step)*(mass-step) - mnsq + end if + if(findhigh==0) then + mt2_b = sqrt (deltasqlow + mnsq) + return + end if + end do + end if + + if (nsolslow == nsolshigh) then + mt2_b = sqrt(mnsq + deltasqlow) + return + end if + + minmass = sqrt (deltasqlow + mnsq) + maxmass = sqrt (deltasqhigh + mnsq) + do while ((maxmass - minmass) > prec) + midmass = (minmass+maxmass)/2 + nsolsmid = nsolutionsmassless(deltamid) + if (nsolsmid == nsolslow) then + minmass = midmass + else + maxmass = midmass + end if + end do + mt2_b = minmass + contains + <> + end subroutine mt2massless + +<>= + public :: mt2_t +@ +<>= + type :: mt2_t + private + real(default) :: mt2 = 0._default + real(default) :: mn = 0._default + real(default) :: ma = 0._default + real(default) :: mb = 0._default + real(default) :: Ea2 = 0._default + real(default) :: Eb2 = 0._default + real(default) :: pax = 0._default + real(default) :: pay = 0._default + real(default) :: pbx = 0._default + real(default) :: pby = 0._default + real(default) :: pmx = 0._default + real(default) :: pmy = 0._default + real(default) :: scale = 0._default + end type mt2_t + +@ %def mt2_t +@ +<>= + public :: mt2_init +<>= + module subroutine mt2_init (mt2, mn, ma, mb, Easq, Ebsq, & + pax, pay, pbx, pby, pmissx, pmissy, scale) + type(mt2_t), intent(out) :: mt2 + real(default), intent(in) :: mn, ma, mb + real(default), intent(in) :: Easq, Ebsq + real(default), intent(in) :: pax, pay, pbx, pby + real(default), intent(in) :: pmissx, pmissy, scale + end subroutine mt2_init +<>= + module subroutine mt2_init (mt2, mn, ma, mb, Easq, Ebsq, & + pax, pay, pbx, pby, pmissx, pmissy, scale) + type(mt2_t), intent(out) :: mt2 + real(default), intent(in) :: mn, ma, mb + real(default), intent(in) :: Easq, Ebsq + real(default), intent(in) :: pax, pay, pbx, pby + real(default), intent(in) :: pmissx, pmissy, scale + mt2%mn = mn + mt2%ma = ma + mt2%mb = mb + mt2%Ea2 = Easq + mt2%Eb2 = Ebsq + mt2%pax = pax + mt2%pay = pay + mt2%pbx = pbx + mt2%pby = pby + mt2%pmx = pmissx + mt2%pmy = pmissy + mt2%scale = scale + end subroutine mt2_init + +@ %def mt2_init +<>= + integer function nsolutionsmassless (dsq) + !!! calculates the number of solutions of quartic function in massless case + real*16 :: delta, a, b, & + z0, z1, z2, z3, z4, & + z0sq, z1sq, z2sq, z3sq, z4sq, & + y0, y1, y2, y3, & + x0, x1, x2, & + w0, w1, & + v0, & + t1, t2, t3, t4, t5 + real(kind=default)::deltasqlow, tempmass, maxmass, dsq + integer:: findhigh, nsolshigh, nsol + + delta = dsq / (2 * mt2%Ea2) + + !!! d1 = d11*delta seems not to be used + !!! e1 = e11*delta seems not to be used + !!! f1 = f12*delta*delta+f10 seems not to be used + d2 = d21*delta+d20 + e2 = e21*delta+e20 + f2 = f22*delta*delta+f21*delta+f20 + + if (mt2%pax > 0) then + a = Ea/Dsq + else + a = -Ea/Dsq + end if + + if (mt2%pax > 0) then + b = ((mnsq*Ea)/Dsq)-(Dsq/(4*Ea)) + else + b = Dsq/(4*Ea) - ((mnsq*Ea)/Dsq) + end if + + z4 = a*a*a2 + z3 = 2*a*b2/Ea + z2 = (2*a*a2*b+c2+2*a*d2) / mt2%Ea2 + z1 = (2*b*b2+2*e2) / (mt2%Ea2*Ea) + z0 = (a2*b*b+2*b*d2+f2)/(mt2%Ea2*mt2%Ea2) + + z0sq = z0*z0 + z1sq = z1*z1 + z2sq = z2*z2 + z3sq = z3*z3 + z4sq = z4*z4 + + y3 = 4*z4 + y2 = 3*z3 + y1 = 2*z2 + y0 = z1 + + x2 = -(z2/2 - 3*z3sq/(16*z4)) + x1 = -(3*z1/4. -z2*z3/(8*z4)) + x0 = -z0 + z1*z3/(16*z4) + + w1 = -y1 - (y3*x0*x1/x2 - y3*x0 -y2*x1)/x2 + w0 = -y0 - y3 *x0 *x1/(x2*x2)+ y2*x0/x2 + + v0 = -x0 - x2*w0*w0/(w1*w1) + x1*w0/w1 + + t1 = z4 + t2 = z4 + t3 = x2 + t4 = w1 + t5 = v0 + + !!! number of solutions depends on the number of sign changes + + nsol = signchangenegative(t1, t2, t3, t4, t5) - signchangepositive(t1, t2, t3, t4, t5) + if (nsol<0) then + nsol=0 + end if + nsolutionsmassless=nsol + end function nsolutionsmassless + +@ %def nsolutionsmassless +<>= + + integer function nsolutionsmassive ( dsq ) + !!! calculates the number of solutions of quartic function in massive case + integer:: nsol, nsolsmid + real(kind=default):: deltasqmid, dsq, delta + real*16 :: z0, z1, z2, z3, z4, & + z0sq, z1sq, z2sq, z3sq, z4sq, & + y0, y1, y2, y3, & + x0, x1, x2, & + w0, w1, & + v0, & + t1, t2, t3, t4, t5 + + delta = (dsq-masq) / (2*mt2%Ea2) + + !!! calculate quadratic co-efficients + + d1 = d11*delta + e1 = e11*delta + f1 = (f12*delta*delta)+f10 + d2 = (d21*delta)+d20 + e2 = (e21*delta)+e20 + f2 = (f22*delta*delta)+f21*delta+f20 + + !!! Calculate quartic co-efficients, divided by Ea^n to keep dimensionless + + + z0 = (-4.d0*a2*d1*d2*f1 + 4.d0*a1*d2*d2*f1 + a2*a2*f1*f1 & + + 4.d0*a2*d1*d1*f2 - 4.d0*a1*d1*d2*f2 & + - 2.d0*a1*a2*f1*f2+a1*a1*f2*f2) / (mt2%Ea2 * mt2%Ea2) + + z1 = (-8.d0*a2*d1*d2*e1 + 8.d0*a1*d2*d2*e1 + 8.d0*a2*d1*d1*e2 & + - 8.d0*a1*d1*d2*e2 - 4.d0*a2*b2*d1*f1 - 4.d0*a2*b1*d2*f1 + & + 8.d0*a1*b2*d2*f1 & + + 4.d0*a2*a2*e1*f1 - 4.d0*a1*a2*e2*f1 + 8.d0*a2*b1*d1*f2 - & + 4.d0*a1*b2*d1*f2 - 4.d0*a1*b1*d2*f2 - 4.d0*a1*a2*e1*f2 + & + 4.d0*a1*a1*e2*f2) / (mt2%Ea2*Ea) + + z2 = (4.d0*a2*c2*d1*d1 - 4.d0*a2*c1*d1*d2 - 4.d0*a1*c2*d1*d2 + & + 4.d0*a1*c1*d2*d2 - 8.d0*a2*b2*d1*e1 - 8.d0*a2*b1*d2*e1 + & + 16.d0*a1*b2*d2*e1 & + + 4.d0*a2*a2*e1*e1 + 16.d0*a2*b1*d1*e2 - 8.d0*a1*b2*d1*e2 - & + 8.d0*a1*b1*d2*e2 - 8.d0*a1*a2*e1*e2 + 4.d0*a1*a1*e2*e2 - & + 4.d0*a2*b1*b2*f1 & + + 4.d0*a1*b2*b2*f1 + 2.d0*a2*a2*c1*f1 - 2.d0*a1*a2*c2*f1 + & + 4.d0*a2*b1*b1*f2 - 4.d0*a1*b1*b2*f2 - 2.d0*a1*a2*c1*f2 + & + 2.d0*a1*a1*c2*f2) / mt2%Ea2 + + z3 = (-4*a2*b2*c1*d1 + 8*a2*b1*c2*d1 - 4*a1*b2*c2*d1 - 4*a2*b1*c1*d2 + & + 8*a1*b2*c1*d2 - 4*a1*b1*c2*d2 - 8*a2*b1*b2*e1 + 8*a1*b2*b2*e1 + & + 4*a2*a2*c1*e1 - 4*a1*a2*c2*e1 + 8*a2*b1*b1*e2 - 8*a1*b1*b2*e2 - & + 4*a1*a2*c1*e2 + 4*a1*a1*c2*e2)/Ea + + z4 = - (4.d0*a2*b1*b2*c1) + (4.d0*a1*b2*b2*c1) + (a2*a2*c1*c1) + & + (4.d0*a2*b1*b1*c2) - (4.d0*a1*b1*b2*c2) - (2.d0*a1*a2*c1*c2) + & + (a1*a1*c2*c2) + + if (z4==0) then + z4=1e-33 + end if + + z0sq = z0*z0 + z1sq = z1*z1 + z2sq = z2*z2 + z3sq = z3*z3 + z4sq = z4*z4 + + y0 = z1 + y1 = 2.d0*z2 + y2 = 3.d0*z3 + y3 = 4.d0*z4 + + x0 = - z0 + (z1*z3)/(16.d0*z4) + x1 = - (3.d0*z1/4.d0) + (z2*z3)/(8.d0*z4) + x2 = - (z2/2.d0) + (3.d0*z3sq)/(16.d0*z4) + + w0 = - y0 - ((y3*x0 *x1)/(x2*x2))+ ((y2*x0)/x2) + w1 = - y1 - ((y3*x1*x1/x2) - y3*x0 - y2*x1)/x2 + + v0 = - x0 - (x2*w0*w0)/(w1*w1) + (x1*w0/w1) + + !!! Sturm sequence coefficients of leading order + + t1 = z4 + t2 = z4 + t3 = x2 + t4 = w1 + t5 = v0 + + nsol = signchangenegative (t1, t2, t3, t4, t5) - & + signchangepositive (t1, t2, t3, t4, t5) + + !!! correction for roundoff error if it gives a negative result + if (nsol<0) then + nsol = 0 + endif + + nsolutionsmassive = nsol + end function nsolutionsmassive + +@ %def nsolutionsmassive +<>= + function findhighfunc (dsq) + real(kind=default):: x00, y00, deltasqlow, dis, & + deltasqmid, deltasqhigh, dsq + integer:: findhighfunc, nsolsmid !!! , nsolutionsmassive + + x00 = (c1*d1 - b1*e1)/(b1*b1 - a1*c1) + y00 = (a1*e1 - b1*d1)/(b1*b1 - a1*c1) + deltasqlow = (mn + mt2%ma)*(mn + mt2%ma) - mnsq + + do while ((deltasqhigh - deltasqlow) > 0.001) + + deltasqmid = (deltasqhigh + deltasqlow)/2 + nsolsmid = nsolutionsmassive(deltasqmid) + if (nsolsmid==2) then + deltasqhigh = deltasqmid + end if + if ( nsolsmid==4) then + deltasqhigh = deltasqmid + end if + if (nsolsmid==0) then + d1 = -mt2%pax * (deltasqmid - masq) / (2 * mt2%Ea2) + e1 = -mt2%pay * (deltasqmid - masq) / (2 * mt2%Ea2) + d2 = -mt2%pmx + mt2%pbx * (deltasqmid - mbsq)/(2*mt2%Eb2) + & + mt2%pbx * (mt2%pbx *mt2%pmx + mt2%pby * mt2%pmy) / mt2%Eb2 + e2 = - mt2%pmy + mt2%pby * (deltasqmid - mbsq)/(2*mt2%Eb2) & + + mt2%pby * (mt2%pbx * mt2%pmx + mt2%pby * mt2%pmy) / mt2%Eb2 + f2 = mt2%pmx*mt2%pmx + mt2%pmy**2 - ((deltasqmid - mbsq)/(2*Eb) & + + (mt2%pbx * mt2%pmx + mt2%pby * mt2%pmy)/Eb) * & + ((deltasqmid - mbsq)/(2*Eb) + (mt2%pbx * mt2%pmx + & + mt2%pby * mt2%pmy)/Eb) + mnsq + + dis = a2*x00*x00 + 2*b2*x00*y00 + c2*y00*y00 + 2*d2*x00 + & + 2*e2*y00 + f2 + + !!! Check if large ellipse contains small one + + if (dis < 0 ) then + deltasqhigh = deltasqmid + else + deltasqlow = deltasqmid + end if + end if + end do + findhighfunc=0 + + end function findhighfunc + +@ %def findhighfunc +Print input values. +<>= + public :: write_mt2_input +<>= + module subroutine write_mt2_input (mt2, u) + type(mt2_t), intent(in) :: mt2 + integer, intent(in) :: u + end subroutine write_mt2_input +<>= + module subroutine write_mt2_input (mt2, u) + type(mt2_t), intent(in) :: mt2 + integer, intent(in) :: u + + !!! prints the input variables as a check + write (u, "(1x,A," // FMT_19 // ")") 'pax =', mt2%pax * mt2%scale + write (u, "(1x,A," // FMT_19 // ")") 'pay =', mt2%pay * mt2%scale + write (u, "(1x,A," // FMT_19 // ")") 'ma =', mt2%ma * mt2%scale + + write (u, "(1x,A," // FMT_19 // ")") 'pbx =', mt2%pbx * mt2%scale + write (u, "(1x,A," // FMT_19 // ")") 'pby =', mt2%pby * mt2%scale + write (u, "(1x,A," // FMT_19 // ")") 'mb =', mt2%mb * mt2%scale + + write (u, "(1x,A," // FMT_19 // ")") 'pmissx =', mt2%pmx * mt2%scale + write (u, "(1x,A," // FMT_19 // ")") 'pmissy =', mt2%pmy * mt2%scale + write (u, "(1x,A," // FMT_19 // ")") 'mn =', mt2%mn * mt2%scale + + !!! write (u, *) 'precision = ', prec + + end subroutine write_mt2_input + +@ %def write_mt2_input +@ +<>= + public :: write_mt2_output +<>= + module subroutine write_mt2_output (mt2, scale, u) + real(default), intent(in) :: mt2, scale + integer, intent(in) :: u + end subroutine write_mt2_output +<>= + module subroutine write_mt2_output (mt2, scale, u) + real(default), intent(in) :: mt2, scale + integer, intent(in) :: u + !!! Prints the output (MT2) + ! mt2=mt2_b*scale + write (u, "(1x,A,ES10.4)") 'mt2=', mt2 * scale + + end subroutine write_mt2_output + +@ %def write_mt2_output +@ +<>= + function signchangepositive (t1, t2, t3, t4, t5) result (n_sign) + !!! calculates the number of sign changes in the sturm sequence + real*16 :: t1, t2, t3, t4, t5 + integer :: n_sign + integer :: n + n = 0 + if (t1*t2 < 0) then + n = n+1 + end if + if (t2*t3 < 0) then + n = n+1 + end if + if (t3*t4 < 0) then + n = n+1 + end if + if (t4*t5 < 0) then + n = n+1 + end if + n_sign = n + end function signchangepositive + +@ %def signchangepositive +<>= + integer function signchangenegative (t1, t2, t3, t4, t5) + !!! calculates the number of times there is no sign + !!! change in the sturm sequence + real*16 :: t1, t2, t3, t4, t5 + integer:: n + + n=0 + if((t1*t2)>0) then + n=n+1 + endif + if((t2*t3)>0) then + n=n+1 + endif + if((t3*t4)>0) then + n=n+1 + endif + if((t4*t5)>0) then + n=n+1 + endif + signchangenegative = n + end function signchangenegative + +@ %def signchangenegative +It looks like as if this function is not used in the code. +<>= + integer function scanhigh (mn, deltasqhigh) + real(default), intent(in) :: mn + real(kind=default):: tempmass, maxmass, deltasqlow, deltasqhigh, mass + integer:: nsolshigh, findhigh + mnsq = mn*mn + tempmass = mn+ma + findhigh = 0 + maxmass = sqrt(mnsq + deltasqhigh) + mass = tempmass + step + do while ( mass < maxmass) + deltasqhigh = mass*mass - mnsq + nsolshigh = nsolutionsmassive(deltasqhigh) + if (nsolshigh > 0) then + deltasqlow = (mass - step)*(mass - step) - mnsq + findhigh = 1 + exit + end if + end do + scanhigh=findhigh + + end function scanhigh + +@ %def scanhight +All this subroutine does is to decide whether to use the algorithm +for massless visible particles, or the algorithm for massive +visible particles. +<>= + public :: mt2calc +<>= + module subroutine mt2calc (mt2, mn, mt2_b) + type(mt2_t), intent(inout) :: mt2 + real(default), intent(in) :: mn + real(default), intent(out) :: mt2_b + end subroutine mt2calc +<>= + module subroutine mt2calc (mt2, mn, mt2_b) + type(mt2_t), intent(inout) :: mt2 + real(default), intent(in) :: mn + real(default), intent(out) :: mt2_b + if (mt2%ma**2 < min_mass .and. mt2%mb**2 < min_mass) then + call mt2massless (mt2, mn, mt2_b) + else + call mt2calcmassive (mt2, mn, mt2_b) + end if + end subroutine mt2calc + +@ %def mt2calc +@ This subroutine sets up the event for calculation by defining the +input variables, and setting them to a scale that aids calculation. +The output variables have been rescaled back. +<>= + public :: mt2_setevent +<>= + module subroutine mt2_setevent (mn, ma, mb, Easq, Ebsq, pax, pay, pbx, pby, & + pmissx, pmissy, scale, u) + real(default), intent(out) :: ma, mb ! mass of particles a and b + real(default), intent(out) :: mn ! invisible particle mass scaled and unscaled + real(default), intent(out) :: scale + real(default), intent(out) :: pax, pay, pbx, pby + real(default), intent(out) :: pmissx, pmissy + real(default), intent(out) :: Easq, Ebsq + integer, intent(in) :: u + end subroutine mt2_setevent +<>= + module subroutine mt2_setevent (mn, ma, mb, Easq, Ebsq, pax, pay, pbx, pby, & + pmissx, pmissy, scale, u) + real(default), intent(out) :: ma, mb ! mass of particles a and b + real(default), intent(out) :: mn ! invisible particle mass scaled and unscaled + real(default), intent(out) :: scale + real(default), intent(out) :: pax, pay, pbx, pby + ! x and y momentum of particles a and b + ! missing x and y momentum + real(default) :: Ea, Eb + type(vector4_t) :: pmissa, pa, pb + real(default), intent(out) :: pmissx, pmissy + real(default) :: masq, mbsq, mnsq, Emiss, pmissz + real(default), intent(out) :: Easq, Ebsq + real(default) :: pmissxsq, pmissysq, mn_unscaled + real*16 :: temp, scalesq, rt, relative_precision100 + integer, intent(in) :: u + + !!! Here the 8 input variables are entered. This should be read in from + !!! the syndarin file - let me know if I can help accomplish this + !!! The units of input are equal to the units of the output e.g GeV + !!! in --> GeV out, MeV in --> MeV out + + ma=100 ! total mass of visible particles in branch a + mb=100 ! total mass of visible particles in branch b + !!! 0810.5178 + !!! mT2 is invariant under longitudinal boosts => set paz = pbz = 0 + ! mass = transverse mass here!??? + + pax=40 ! total x momentum of visible partivles in branch a + pay=40 ! total y momentum of visible partivles in branch a + pbx=40 ! total x momentum of visible partivles in branch b + pby=40 ! total y momentum of visible partivles in branch b + + Emiss=0 + pmissz=0 + pmissx=20 ! Total missing x momentum + pmissy=20 ! Total missing y momentum + + pmissa = [ Emiss, pmissx, pmissy, pmissz] + + mn=0 ! starting guess for mass of invisible particle + mn_unscaled = 0 ! starting guess for mass of invisible particle + + scale=1.d0 ! scale is originally defined as 1 + masq = ma*ma + Easq = masq + pax*pax + pay*pay + Ea = sqrt(Easq) + pa = [Ea, pax, pay, 0._default] + + mbsq = mb*mb + Ebsq = mbsq + pbx*pbx + pby*pby + Eb = sqrt(Ebsq) + + pmissxsq = pmissx*pmissx + pmissysq = pmissy*pmissy + + ! set ma>=mb to keep consistency + + if (masq < mbsq) then + + temp = pax + pax = pbx + pbx = temp + + temp = pay + pay = pby + pby = temp + + temp = Ea + Ea = Eb + Eb = temp + + temp = Easq + Easq = Ebsq + Ebsq = temp + + temp = masq + masq = mbsq + mbsq = temp + + temp = ma + ma = mb + mb = temp + end if + + ! normalise to the scale + + if (Ea > Eb) then + scale = Ea/100.d0 + else + scale = Eb/100.d0 + end if + + rt=(sqrt(pmissxsq+pmissysq))/100.d0 + if (rt > scale) then + scale = (sqrt(pmissxsq+pmissysq))/100.d0 + end if + + !!! write (u, *) 'scale=', scale + scalesq = scale*scale + + ma = ma/scale + mb = mb/scale + masq = masq/scalesq + mbsq = mbsq/scalesq + pax = pax/scale + pay = pay/scale + pbx = pbx/scale + pby = pby/scale + Ea = Ea/scale + Eb = Eb/scale + + Easq = Easq/scalesq + Ebsq = Ebsq/scalesq + pmissx = pmissx/scale + pmissy = pmissy/scale + pmissxsq = pmissxsq/scalesq + pmissysq = pmissysq/scalesq + mn = mn_unscaled/scale + mnsq = mn*mn + + ! calculating precision + + relative_precision100 = relative_precision*100.d0 + if (absolute_precision > relative_precision100) then + prec = absolute_precision + else + prec = 100*relative_precision + end if + end subroutine mt2_setevent + +@ %def mt2_setevent +@ +\subsection{Unit tests} +Test module, followed by the corresponding implementation module. +<<[[kinematics_vars_ut.f90]]>>= +<> + +module kinematics_vars_ut + use unit_tests + use kinematics_vars_uti + +<> + +<> + +contains + +<> + +end module kinematics_vars_ut +@ %def kinematics_vars_ut +@ +<<[[kinematics_vars_uti.f90]]>>= +<> + +module kinematics_vars_uti + +<> + use kinematics_vars + +<> + +<> + +contains + +<> + +end module kinematics_vars_uti +@ %def kinematics_vars_ut +This has been written by Tom James as a DESY summer student in August +2013. It is a self-contained Fortran90 program for calculating +$M_{T2}$ using the Cheng-Han algorithm. +<>= + public :: kinematics_vars_test +<>= + subroutine kinematics_vars_test (u, results) + integer, intent(in) :: u + type(test_results_t), intent(inout) :: results + <> + end subroutine kinematics_vars_test + +@ %def kinematics_vars_test +@ +\subsubsection{Testing kinematic variables like MT2} +<>= + call test (kinematics_vars_1, "kinematics_vars_1", "massive mT2 calculation", & + u, results) +<>= + public :: kinematics_vars_1 +<>= + subroutine kinematics_vars_1 (u) + integer, intent(in) :: u + real(default) :: Easq, Ebsq + real(default) :: ma, mb, mn + real(default) :: pmissx, pmissy + real(default) :: mt2_b, scale + real(default) :: pax, pay, pbx, pby + type(mt2_t) :: mt2 + + write (u, "(A)") "* Test output: mt2_1" + write (u, "(A)") "* Purpose: calculate MT2 for the massive case" + write (u, "(A)") + + call mt2_setevent (mn, ma, mb, Easq, Ebsq, pax, pay, pbx, pby, & + pmissx, pmissy, scale, u) + call mt2_init (mt2, mn, ma, mb, Easq, Ebsq, pax, pay, pbx, pby, & + pmissx, pmissy, scale) + call write_mt2_input (mt2, u) + call mt2calc (mt2, mn, mt2_b) + call write_mt2_output (mt2_b, scale, u) + end subroutine kinematics_vars_1 + +@ %def kinematics_vars_1 +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Collections of Lorentz Vectors} The [[phs_point]] type is a container for an array of Lorentz vectors. This allows us to transfer Lorentz-vector arrays more freely, and to collect vector arrays of non-uniform size. <<[[phs_points.f90]]>>= <> module phs_points <> use lorentz, only: vector4_t use lorentz, only: lorentz_transformation_t use lorentz, only: sum <> <> <> <> interface <> end interface end module phs_points @ %def phs_points @ <<[[phs_points_sub.f90]]>>= <> submodule (phs_points) phs_points_s use lorentz, only: vector4_null use lorentz, only: vector4_write_set use lorentz, only: operator(==) use lorentz, only: operator(*) use lorentz, only: operator(**) implicit none contains <> end submodule phs_points_s @ %def phs_points_s @ \subsection{PHS point definition} This is a trivial container for an array of momenta. The main application is to store a non-uniform array of phase-space points. <>= public :: phs_point_t <>= type :: phs_point_t private type(vector4_t), dimension(:), allocatable :: p contains <> end type phs_point_t @ %def phs_point_t @ \subsection{PHS point: basic tools} Output. This is instrumented with options, which have to be provided by the caller. <>= procedure :: write => phs_point_write <>= module subroutine phs_point_write (phs_point, unit, show_mass, testflag, & check_conservation, ultra, n_in) class(phs_point_t), intent(in) :: phs_point integer, intent(in), optional :: unit logical, intent(in), optional :: show_mass logical, intent(in), optional :: testflag, ultra logical, intent(in), optional :: check_conservation integer, intent(in), optional :: n_in end subroutine phs_point_write <>= module subroutine phs_point_write (phs_point, unit, show_mass, testflag, & check_conservation, ultra, n_in) class(phs_point_t), intent(in) :: phs_point integer, intent(in), optional :: unit logical, intent(in), optional :: show_mass logical, intent(in), optional :: testflag, ultra logical, intent(in), optional :: check_conservation integer, intent(in), optional :: n_in if (allocated (phs_point%p)) then call vector4_write_set (phs_point%p, & unit = unit, & show_mass = show_mass, & testflag = testflag, & check_conservation = check_conservation, & ultra = ultra, & n_in = n_in) end if end subroutine phs_point_write @ %def phs_point_write @ Non-intrinsic assignment <>= public :: assignment(=) <>= interface assignment(=) module procedure phs_point_from_n module procedure phs_point_from_vector4 module procedure vector4_from_phs_point end interface @ Initialize with zero momenta but fixed size <>= pure module subroutine phs_point_from_n (phs_point, n_particles) type(phs_point_t), intent(out) :: phs_point integer, intent(in) :: n_particles end subroutine phs_point_from_n <>= pure module subroutine phs_point_from_n (phs_point, n_particles) type(phs_point_t), intent(out) :: phs_point integer, intent(in) :: n_particles allocate (phs_point%p (n_particles), source = vector4_null) end subroutine phs_point_from_n @ %def phs_point_init_from_n @ Transform from/to plain vector array <>= pure module subroutine phs_point_from_vector4 (phs_point, p) type(phs_point_t), intent(out) :: phs_point type(vector4_t), dimension(:), intent(in) :: p end subroutine phs_point_from_vector4 pure module subroutine vector4_from_phs_point (p, phs_point) class(phs_point_t), intent(in) :: phs_point type(vector4_t), dimension(:), allocatable, intent(out) :: p end subroutine vector4_from_phs_point <>= pure module subroutine phs_point_from_vector4 (phs_point, p) type(phs_point_t), intent(out) :: phs_point type(vector4_t), dimension(:), intent(in) :: p phs_point%p = p end subroutine phs_point_from_vector4 pure module subroutine vector4_from_phs_point (p, phs_point) class(phs_point_t), intent(in) :: phs_point type(vector4_t), dimension(:), allocatable, intent(out) :: p if (allocated (phs_point%p)) p = phs_point%p end subroutine vector4_from_phs_point @ %def phs_point_from_vector4 @ %def vector4_from_phs_point @ Query the size of the momentum array (assuming it is allocated). <>= public :: size <>= interface size module procedure phs_point_size end interface size <>= pure module function phs_point_size (phs_point) result (s) class(phs_point_t), intent(in) :: phs_point integer :: s end function phs_point_size <>= pure module function phs_point_size (phs_point) result (s) class(phs_point_t), intent(in) :: phs_point integer :: s if (allocated (phs_point%p)) then s = size (phs_point%p) else s = 0 end if end function phs_point_size @ %def phs_point_size @ Equality, implemented only for valid points. <>= public :: operator(==) <>= interface operator(==) module procedure phs_point_eq end interface operator(==) <>= elemental module function phs_point_eq & (phs_point_1, phs_point_2) result (flag) class(phs_point_t), intent(in) :: phs_point_1, phs_point_2 logical :: flag end function phs_point_eq <>= elemental module function phs_point_eq & (phs_point_1, phs_point_2) result (flag) class(phs_point_t), intent(in) :: phs_point_1, phs_point_2 logical :: flag if (allocated (phs_point_1%p) .and. (allocated (phs_point_2%p))) then flag = all (phs_point_1%p == phs_point_2%p) else flag = .false. end if end function phs_point_eq @ %def phs_point_eq @ Extract all momenta, as a method <>= procedure :: get => phs_point_get <>= pure module function phs_point_get (phs_point) result (p) class(phs_point_t), intent(in) :: phs_point type(vector4_t), dimension(:), allocatable :: p end function phs_point_get <>= pure module function phs_point_get (phs_point) result (p) class(phs_point_t), intent(in) :: phs_point type(vector4_t), dimension(:), allocatable :: p if (allocated (phs_point%p)) then p = phs_point%p else allocate (p (0)) end if end function phs_point_get @ %def phs_point_select @ Extract a subset of all momenta. <>= procedure :: select => phs_point_select <>= elemental module function phs_point_select (phs_point, i) result (p) class(phs_point_t), intent(in) :: phs_point integer, intent(in) :: i type(vector4_t) :: p end function phs_point_select <>= elemental module function phs_point_select (phs_point, i) result (p) class(phs_point_t), intent(in) :: phs_point integer, intent(in) :: i type(vector4_t) :: p if (allocated (phs_point%p)) then p = phs_point%p(i) else p = vector4_null end if end function phs_point_select @ %def phs_point_select @ Return the invariant mass squared for a subset of momenta <>= procedure :: get_msq => phs_point_get_msq <>= pure module function phs_point_get_msq (phs_point, iarray) result (msq) class(phs_point_t), intent(in) :: phs_point integer, dimension(:), intent(in) :: iarray real(default) :: msq end function phs_point_get_msq <>= pure module function phs_point_get_msq (phs_point, iarray) result (msq) class(phs_point_t), intent(in) :: phs_point integer, dimension(:), intent(in) :: iarray real(default) :: msq if (allocated (phs_point%p)) then msq = (sum (phs_point%p(iarray)))**2 else msq = 0 end if end function phs_point_get_msq @ %def phs_point_get_msq @ \subsection{Lorentz algebra pieces} Lorentz transformation. <>= public :: operator(*) <>= interface operator(*) module procedure prod_LT_phs_point end interface operator(*) <>= elemental module function prod_LT_phs_point (L, phs_point) result (phs_point_LT) type(lorentz_transformation_t), intent(in) :: L type(phs_point_t), intent(in) :: phs_point type(phs_point_t) :: phs_point_LT end function prod_LT_phs_point <>= elemental module function prod_LT_phs_point (L, phs_point) result (phs_point_LT) type(lorentz_transformation_t), intent(in) :: L type(phs_point_t), intent(in) :: phs_point type(phs_point_t) :: phs_point_LT if (allocated (phs_point%p)) phs_point_LT%p = L * phs_point%p end function prod_LT_phs_point @ %def prod_LT_phs_point @ Compute momentum sum, analogous to the standard [[sum]] function (mask), and additionally using an index array. <>= public :: sum <>= interface sum module procedure phs_point_sum module procedure phs_point_sum_iarray end interface sum <>= pure module function phs_point_sum (phs_point, mask) result (p) class(phs_point_t), intent(in) :: phs_point logical, dimension(:), intent(in), optional :: mask type(vector4_t) :: p end function phs_point_sum pure module function phs_point_sum_iarray (phs_point, iarray) result (p) class(phs_point_t), intent(in) :: phs_point integer, dimension(:), intent(in) :: iarray type(vector4_t) :: p end function phs_point_sum_iarray <>= pure module function phs_point_sum (phs_point, mask) result (p) class(phs_point_t), intent(in) :: phs_point logical, dimension(:), intent(in), optional :: mask type(vector4_t) :: p if (allocated (phs_point%p)) then if (present (mask)) then p = sum (phs_point%p, mask) else p = sum (phs_point%p) end if else p = vector4_null end if end function phs_point_sum pure module function phs_point_sum_iarray (phs_point, iarray) result (p) class(phs_point_t), intent(in) :: phs_point integer, dimension(:), intent(in) :: iarray type(vector4_t) :: p logical, dimension(:), allocatable :: mask integer :: i allocate (mask (size (phs_point)), source = .false.) mask(iarray) = .true. p = sum (phs_point, mask) end function phs_point_sum_iarray @ %def phs_point_sum @ \subsection{Methods for specific applications} Convenience method: compute the pair of energy fractions w.r.t.\ the specified beam energy. We assume that the momenta represent a scattering process (two incoming particles) in the c.m.\ frame. <>= procedure :: get_x => phs_point_get_x <>= pure module function phs_point_get_x (phs_point, E_beam) result (x) class(phs_point_t), intent(in) :: phs_point real(default), dimension(2) :: x real(default), intent(in) :: E_beam end function phs_point_get_x <>= pure module function phs_point_get_x (phs_point, E_beam) result (x) class(phs_point_t), intent(in) :: phs_point real(default), dimension(2) :: x real(default), intent(in) :: E_beam x = phs_point%p(1:2)%p(0) / E_beam end function phs_point_get_x @ %def phs_point_get_x @ \subsection{Unit tests} Test module, followed by the corresponding implementation module. <<[[phs_points_ut.f90]]>>= <> module phs_points_ut use unit_tests use phs_points_uti <> <> contains <> end module phs_points_ut @ %def phs_points_ut @ <<[[phs_points_uti.f90]]>>= <> module phs_points_uti <> use constants, only: zero use format_defs, only: FMT_12 use lorentz use phs_points <> <> contains <> end module phs_points_uti @ %def phs_points_ut @ API: driver for the unit tests below. <>= public :: phs_points_test <>= subroutine phs_points_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine phs_points_test @ %def phs_points_test @ \subsubsection{PHS point unit test implementation} <>= call test (phs_points_1, "phs_points_1", & "Test PHS point functionality", & u, results) <>= public :: phs_points_1 <>= subroutine phs_points_1 (u) integer, intent(in) :: u type(vector4_t), dimension(8) :: tt_mom type(phs_point_t) :: phs_p type(vector4_t) :: p_sum type(vector4_t), dimension(:), allocatable :: p_tau, p_out write (u, "(A)") "* Test output: phs_points_1" write (u, "(A)") "* Purpose: handling a 2->6 PSP" write (u, "(A)") write (u, "(A)") write (u, "(A)") "* Setting up a 2->6 off-shell top PSP" write (u, "(A)") tt_mom(1) = [2.5000000000000000e+02_default, zero, zero, 2.4999999999947775e+02_default] tt_mom(2) = [2.5000000000000000e+02_default, zero, zero, -2.4999999999947775e+02_default] tt_mom(3) = [1.1557492413664579e+02_default, 3.9011599241011098e+01_default, & -6.4278142734963140e+01_default, 8.7671766153043137e+01_default] tt_mom(4) = [1.4617918132729235e+02_default, -1.0947970597860679e+02_default, & 1.5484441802571380e+01_default, -9.5525593923398418e+01_default] tt_mom(5) = [5.2637589215119526e+01_default, -4.7413198564695762e+01_default, & 1.0087885417286579e+01_default, 2.0516525153079229e+01_default] tt_mom(6) = [5.4760292922264796e+01_default, 1.5197406985690520e+01_default, & 5.1527071739328015e+01_default, -1.0615525413924287e+01_default] tt_mom(7) = [3.2415057664609684e+01_default, 7.5539389341684711e+00_default, & -1.5935831743946720e+01_default, -2.7139737100881156e+01_default] tt_mom(8) = [9.8432954734067863e+01_default, 9.5129959382432389e+01_default, & 3.1145755197238953e+00_default, 2.5092565132081493e+01_default] phs_p = tt_mom write (u, "(A)") write (u, "(A)") "* Retrieving the size of PSP" write (u, "(A)") write (u, "(3x,A,I0)") "Size PSP = ", size (phs_p) write (u, "(A)") write (u, "(A)") "* Returning the set of 4-momenta from PSP" write (u, "(A)") p_out = phs_p%get () write (u, "(3x,A)") "set 4-mom. = " call vector4_write_set (p_out, u, testflag = .true., ultra = .true.) write (u, "(A)") write (u, "(A)") "* Sum of momenta of PSP" write (u, "(A)") p_sum = sum (phs_p) call pacify (p_sum, tolerance = 1.e-12_default) write (u, "(3x,A)") "Sum:" call p_sum%write (u) write (u, "(A)") write (u, "(A)") "* Reconstructing top/antitop candidate invariant masses from PSP" write (u, "(A)") write (u, "(3x,A," // FMT_12 // ")") "m2(top) = ", sqrt (phs_p%get_msq ([3,6,8])) write (u, "(3x,A," // FMT_12 // ")") "m2(a-top) = ", sqrt (phs_p%get_msq ([4,5,7])) write (u, "(A)") write (u, "(A)") "* Select a specific 4-vector from PSP, here for a tau" write (u, "(A)") p_tau = phs_p%select ([7]) write (u, "(3x,A)") "p(tau):" call p_tau(1)%write (u, show_mass = .true., testflag = .true.) write (u, "(A)") write (u, "(A)") "* Test output end: phs_points_1" end subroutine phs_points_1 @ %def phs_points_1 @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Special Physics functions} Here, we declare functions that are specific for the Standard Model, including QCD: fixed and running $\alpha_s$, Catani-Seymour dipole terms, loop functions, etc. To make maximum use of this, all functions, if possible, are declared elemental (or pure, if this is not possible). <<[[sm_physics.f90]]>>= <> module sm_physics <> use constants use physics_defs use lorentz <> <> <> interface <> end interface end module sm_physics @ %def sm_physics @ <<[[sm_physics_sub.f90]]>>= <> submodule (sm_physics) sm_physics_s use io_units use numeric_utils use diagnostics use permutations, only: factorial implicit none contains <> end submodule sm_physics_s @ %def sm_physics_s @ \subsection{Constants for Quantum Field Theory calculations} For loop calculations in quantum field theories, one needs the numerical values of the Riemann zeta function: \begin{align*} \zeta(2) &=\; 1.64493406684822643647241516665\ldots \; \\ \zeta(3) &=\; 1.20205690315959428539973816151\ldots \; \\ \zeta(4) &=\; 1.08232323371113819151600369654\ldots \; \\ \zeta(5) &=\; 1.03692775514336992633136548646\ldots \; \end{align*} <>= public :: zeta2, zeta3, zeta4, zeta5 <>= real(default), parameter :: & zeta2 = 1.64493406684822643647241516665_default, & zeta3 = 1.20205690315959428539973816151_default, & zeta4 = 1.08232323371113819151600369654_default, & zeta5 = 1.03692775514336992633136548646_default @ %def zeta2 zeta3 zeta4 @ The Euler-Mascheroni constant is \begin{equation*} \gamma_E = \end{equation*} <>= public :: eulerc <>= real(default), parameter :: & eulerc =0.5772156649015328606065120900824024310422_default @ %def eulerc @ \subsection{Running $\alpha_s$} Then we define the coefficients of the beta function of QCD (as a reference cf. the Particle Data Group), where $n_f$ is the number of active flavors in two different schemes: \begin{align} \beta_0 &=\; 11 - \frac23 n_f \\ \beta_1 &=\; 51 - \frac{19}{3} n_f \\ \beta_2 &=\; 2857 - \frac{5033}{9} n_f + \frac{325}{27} n_f^2 \end{align} \begin{align} b_0 &=\; \frac{1}{12 \pi} \left( 11 C_A - 2 n_f \right) \\ b_1 &=\; \frac{1}{24 \pi^2} \left( 17 C_A^2 - 5 C_A n_f - 3 C_F n_f \right) \\ b_2 &=\; \frac{1}{(4\pi)^3} \biggl( \frac{2857}{54} C_A^3 - \frac{1415}{54} * C_A^2 n_f - \frac{205}{18} C_A C_F n_f + C_F^2 n_f + \frac{79}{54} C_A n_f**2 + \frac{11}{9} C_F n_f**2 \biggr) \end{align} The functions [[sumQ2q]] and [[sumQ4q]] provide the sum of the squared and quartic electric charges of a number [[nf]] of active quark flavors. <>= public :: beta0, beta1, beta2 public :: coeff_b0, coeff_b1, coeff_b2, coeffqed_b0, coeffqed_b1 <>= pure module function beta0 (nf) real(default), intent(in) :: nf real(default) :: beta0 end function beta0 pure module function beta1 (nf) real(default), intent(in) :: nf real(default) :: beta1 end function beta1 pure module function beta2 (nf) real(default), intent(in) :: nf real(default) :: beta2 end function beta2 pure module function coeff_b0 (nf) real(default), intent(in) :: nf real(default) :: coeff_b0 end function coeff_b0 pure module function coeff_b1 (nf) real(default), intent(in) :: nf real(default) :: coeff_b1 end function coeff_b1 pure module function coeff_b2 (nf) real(default), intent(in) :: nf real(default) :: coeff_b2 end function coeff_b2 pure module function coeffqed_b0 (nf, nlep) integer, intent(in) :: nf, nlep real(default) :: n_lep, coeffqed_b0 end function coeffqed_b0 pure module function coeffqed_b1 (nf, nlep) integer, intent(in) :: nf, nlep real(default) :: n_lep, coeffqed_b1 end function coeffqed_b1 <>= pure module function beta0 (nf) real(default), intent(in) :: nf real(default) :: beta0 beta0 = 11.0_default - two/three * nf end function beta0 pure module function beta1 (nf) real(default), intent(in) :: nf real(default) :: beta1 beta1 = 51.0_default - 19.0_default/three * nf end function beta1 pure module function beta2 (nf) real(default), intent(in) :: nf real(default) :: beta2 beta2 = 2857.0_default - 5033.0_default / 9.0_default * & nf + 325.0_default/27.0_default * nf**2 end function beta2 pure module function coeff_b0 (nf) real(default), intent(in) :: nf real(default) :: coeff_b0 coeff_b0 = (11.0_default * CA - two * nf) / (12.0_default * pi) end function coeff_b0 pure module function coeff_b1 (nf) real(default), intent(in) :: nf real(default) :: coeff_b1 coeff_b1 = (17.0_default * CA**2 - five * CA * nf - three * CF * nf) / & (24.0_default * pi**2) end function coeff_b1 pure module function coeff_b2 (nf) real(default), intent(in) :: nf real(default) :: coeff_b2 coeff_b2 = (2857.0_default/54.0_default * CA**3 - & 1415.0_default/54.0_default * & CA**2 * nf - 205.0_default/18.0_default * CA*CF*nf & + 79.0_default/54.0_default * CA*nf**2 + & 11.0_default/9.0_default * CF * nf**2) / (four*pi)**3 end function coeff_b2 pure module function coeffqed_b0 (nf, nlep) integer, intent(in) :: nf, nlep real(default) :: n_lep, coeffqed_b0 n_lep = real(nlep, kind=default) coeffqed_b0 = - (three * sumQ2q (nf) + n_lep) / (three*pi) end function coeffqed_b0 pure module function coeffqed_b1 (nf, nlep) integer, intent(in) :: nf, nlep real(default) :: n_lep, coeffqed_b1 n_lep = real(nlep, kind=default) coeffqed_b1 = - (three * sumQ4q (nf) + n_lep) / (four*pi**2) end function coeffqed_b1 pure function sumQ2q (nf) integer, intent(in) :: nf real(default) :: sumQ2q select case (nf) case (0) sumQ2q = zero case (1) sumQ2q = 1.0_default/9.0_default case (2) sumQ2q = 5.0_default/9.0_default case (3) sumQ2q = 2.0_default/3.0_default case (4) sumQ2q = 10.0_default/9.0_default case (5) sumQ2q = 11.0_default/9.0_default case (6:) sumQ2q = 5.0_default/3.0_default end select end function sumQ2q pure function sumQ4q (nf) integer, intent(in) :: nf real(default) :: sumQ4q select case (nf) case (0) sumQ4q = zero case (1) sumQ4q = 1.0_default/81.0_default case (2) sumQ4q = 17.0_default/81.0_default case (3) sumQ4q = 2.0_default/9.0_default case (4) sumQ4q = 34.0_default/81.0_default case (5) sumQ4q = 35.0_default/81.0_default case (6:) sumQ4q = 17.0_default/27.0_default end select end function sumQ4q @ %def beta0 beta1 beta2 @ %def coeff_b0 coeff_b1 coeff_b2 coeffqed_b0 coeffqed_b1 @ %def sumQ2q sumQ4q @ There should be two versions of running $\alpha_s$, one which takes the scale and $\Lambda_{\text{QCD}}$ as input, and one which takes the scale and e.g. $\alpha_s(m_Z)$ as input. Here, we take the one which takes the QCD scale and scale as inputs from the PDG book. <>= public :: running_as, running_as_lam, running_alpha, running_alpha_num <>= pure module function running_as (scale, al_mz, mz, order, nf) result (ascale) real(default), intent(in) :: scale real(default), intent(in), optional :: al_mz, nf, mz integer, intent(in), optional :: order real(default) :: ascale end function running_as pure module function running_as_lam (nf, scale, lambda, order) result (ascale) real(default), intent(in) :: nf, scale real(default), intent(in), optional :: lambda integer, intent(in), optional :: order real(default) :: ascale end function running_as_lam pure module function running_alpha & (scale, al_me, me, order, nf, nlep) result (ascale) real(default), intent(in) :: scale real(default), intent(in), optional :: al_me, me integer, intent(in), optional :: order, nf, nlep real(default) :: ascale end function running_alpha pure module function running_alpha_num & (scale, al_me, me, order, nf, nlep) result (ascale) real(default), intent(in) :: scale real(default), intent(in), optional :: al_me, me integer, intent(in), optional :: order, nf, nlep real(default) :: ascale end function running_alpha_num <>= pure module function running_as (scale, al_mz, mz, order, nf) result (ascale) real(default), intent(in) :: scale real(default), intent(in), optional :: al_mz, nf, mz integer, intent(in), optional :: order integer :: ord real(default) :: az, m_z, as_log, n_f, b0, b1, b2, ascale real(default) :: as0, as1 if (present (mz)) then m_z = mz else m_z = MZ_REF end if if (present (order)) then ord = order else ord = 0 end if if (present (al_mz)) then az = al_mz else az = ALPHA_QCD_MZ_REF end if if (present (nf)) then n_f = nf else n_f = 5 end if b0 = coeff_b0 (n_f) b1 = coeff_b1 (n_f) b2 = coeff_b2 (n_f) as_log = one + b0 * az * log(scale**2/m_z**2) as0 = az / as_log as1 = as0 - as0**2 * b1/b0 * log(as_log) select case (ord) case (0) ascale = as0 case (1) ascale = as1 case (2) ascale = as1 + as0**3 * (b1**2/b0**2 * ((log(as_log))**2 - & log(as_log) + as_log - one) - b2/b0 * (as_log - one)) case default ascale = as0 end select end function running_as pure module function running_as_lam (nf, scale, lambda, order) result (ascale) real(default), intent(in) :: nf, scale real(default), intent(in), optional :: lambda integer, intent(in), optional :: order real(default) :: lambda_qcd real(default) :: as0, as1, logmul, b0, b1, b2, ascale integer :: ord if (present (lambda)) then lambda_qcd = lambda else lambda_qcd = LAMBDA_QCD_REF end if if (present (order)) then ord = order else ord = 0 end if b0 = beta0(nf) logmul = log(scale**2/lambda_qcd**2) as0 = four*pi / b0 / logmul if (ord > 0) then b1 = beta1(nf) as1 = as0 * (one - two* b1 / b0**2 * log(logmul) / logmul) end if select case (ord) case (0) ascale = as0 case (1) ascale = as1 case (2) b2 = beta2(nf) ascale = as1 + as0 * four * b1**2/b0**4/logmul**2 * & ((log(logmul) - 0.5_default)**2 + & b2*b0/8.0_default/b1**2 - five/four) case default ascale = as0 end select end function running_as_lam pure module function running_alpha & (scale, al_me, me, order, nf, nlep) result (ascale) real(default), intent(in) :: scale real(default), intent(in), optional :: al_me, me integer, intent(in), optional :: order, nf, nlep integer :: ord, n_f, n_lep real(default) :: ae, m_e, a_log, b0, b1, ascale real(default) :: a0, a1 if (present (me)) then m_e = me else m_e = ME_REF end if if (present (order)) then ord = order else ord = 0 end if if (present (al_me)) then ae = al_me else ae = ALPHA_QED_ME_REF end if if (present (nf)) then n_f = nf else n_f = 5 end if if (present (nlep)) then n_lep = nlep else n_lep = 1 end if b0 = coeffqed_b0 (n_f, n_lep) b1 = coeffqed_b1 (n_f, n_lep) a_log = one + b0 * ae * log(scale**2/m_e**2) a0 = ae / a_log a1 = ae / (a_log + ae * b1/b0 * & log((a_log + ae * b1/b0)/(one + ae * b1/b0))) select case (ord) case (0) ascale = a0 case (1) ascale = a1 case default ascale = a0 end select end function running_alpha pure module function running_alpha_num & (scale, al_me, me, order, nf, nlep) result (ascale) real(default), intent(in) :: scale real(default), intent(in), optional :: al_me, me integer, intent(in), optional :: order, nf, nlep integer, parameter :: n_steps = 20 integer :: ord, n_f, n_lep, k1 real(default), parameter :: sxth = 1._default/6._default real(default) :: ae, ascale, m_e, log_q, dlr, & b0, b1, xk0, xk1, xk2, xk3 if (present (order)) then ord = order else ord = 0 end if if (present (al_me)) then ae = al_me else ae = ALPHA_QED_ME_REF end if if (present (me)) then m_e = me else m_e = ME_REF end if if (present (nf)) then n_f = nf else n_f = 5 end if if (present (nlep)) then n_lep = nlep else n_lep = 1 end if ascale = ae log_q = log (scale**2/m_e**2) dlr = log_q / n_steps b0 = coeffqed_b0 (n_f, n_lep) b1 = coeffqed_b1 (n_f, n_lep) ! ..Solution of the evolution equation depending on ORD ! (fourth-order Runge-Kutta beyond the leading order) select case (ord) case (0) ascale = ae / (one + b0 * ae * log_q) case (1:) do k1 = 1, n_steps xk0 = dlr * beta_qed (ascale) xk1 = dlr * beta_qed (ascale + 0.5 * xk0) xk2 = dlr * beta_qed (ascale + 0.5 * xk1) xk3 = dlr * beta_qed (ascale + xk2) ascale = ascale + sxth * (xk0 + 2._default * xk1 + & 2._default * xk2 + xk3) end do end select contains pure function beta_qed (alpha) real(default), intent(in) :: alpha real(default) :: beta_qed beta_qed = - alpha**2 * (b0 + alpha * b1) end function beta_qed end function running_alpha_num @ %def running_as @ %def running_as_lam @ %def running_alpha running_alpha_num @ This routine determines the Landau pole $\Lambda^{(n_f)}_{\overline{MS}}$ for given $\alpha_s$, scale, number of flavors and order. <>= public :: lambda_qcd <>= module function lambda_qcd (as_q, q, nf, order) result (lambda) real(default), intent(in) :: as_q, q integer, intent(in) :: order, nf real(default) :: lambda end function lambda_qcd <>= module function lambda_qcd (as_q, q, nf, order) result (lambda) real(default), intent(in) :: as_q, q integer, intent(in) :: nf, order real(default) :: lambda real(default), parameter :: acc = 1e-8_default if (order == 0) then lambda = lambda_qcd_lo (as_q, q, nf) else if (order == 1) then lambda = lambda_qcd_nlo (as_q, q, nf) else if (order == 2) then lambda = lambda_qcd_nnlo (as_q, q, nf) else call msg_error ("lambda_qcd: order unknown") end if contains function lambda_qcd_lo (as_q, q, nf) result (lambda) real(default) :: lambda real(default), intent(in) :: as_q, q integer, intent(in) :: nf real(default) :: b0, t0, t1, as0, as1 b0 = coeff_b0(real(nf, default)) t1 = one/b0/as_q FIND_ROOT: do if (signal_is_pending ()) return t0 = t1 as0 = one/b0/t1 as1 = - one/b0/t1**2 t1 = (as_q-as0)/as1 + t1 if (abs(t0-t1)/t0 < acc) exit FIND_ROOT end do FIND_ROOT lambda = q * exp(-t1/two) end function lambda_qcd_lo function lambda_qcd_nlo (as_q, q, nf) result (lambda) real(default) :: lambda real(default), intent(in) :: as_q, q integer, intent(in) :: nf real(default) :: b0, b1, t0, t1, as0, as1, logt b0 = coeff_b0(real(nf, default)) b1 = coeff_b1(real(nf, default)) t1 = one/b0/as_q FIND_ROOT: do if (signal_is_pending ()) return logt = log(t1) t0 = t1 as0 = one/b0/t1 - b1/b0 * logt/(b0 * t1)**2 as1 = - one/b0/t1**2 - b1/b0**3 * (one - two*logt)/t1**3 t1 = (as_q-as0)/as1 + t1 if (abs(t0-t1)/t0 < acc) exit FIND_ROOT end do FIND_ROOT lambda = q * exp(-t1/two) end function lambda_qcd_nlo function lambda_qcd_nnlo (as_q, q, nf) result (lambda) real(default) :: lambda real(default), intent(in) :: as_q, q integer, intent(in) :: nf real(default) :: b0, b1, b2, t0, t1, as0, as1, logt b0 = coeff_b0(real(nf, default)) b1 = coeff_b1(real(nf, default)) b2 = coeff_b2(real(nf, default)) t1 = one/b0/as_q FIND_ROOT: do if (signal_is_pending ()) return logt = log(t1) t0 = t1 as0 = one/b0/t1 * (one - b1/b0**2 * logt/t1 + (b1/b0**2 * logt/t1)**2 & - (b1**2 * (logt + one) - b0*b2)/b0**4/t1**2) as1 = one/b0/t1 * (-two*b1**2 * logt**2/(b0**4 * t1**3) & + two*(b1**2 * (logt + one) - b0*b2)/(b0**4 * t1**3) & + b1 * logt/(b0**2 * t1**2) + two*b1**2 * logt/(b0**4 * t1**3) & - b1/(b0**2 * t1**2) - b1**2/(b0**4 * t1**3)) & - (b1**2 * logt**2/(b0**4 * t1**2) - (b1**2 * (logt + one) & - b0*b2)/(b0**4 * t1**2) - b1 * logt/(b0**2 * t1) + one)/(b0 * t1**2) t1 = (as_q-as0)/as1 + t1 if (abs(t0-t1)/t0 < acc) exit FIND_ROOT end do FIND_ROOT lambda = q * exp(-t1/two) end function lambda_qcd_nnlo end function lambda_qcd @ %def lambda_qcd @ \subsection{Catani-Seymour Parameters} These are fundamental constants of the Catani-Seymour dipole formalism. Since the corresponding parameters for the gluon case depend on the number of flavors which is treated as an argument, there we do have functions and not parameters. \begin{equation} \gamma_q = \gamma_{\bar q} = \frac{3}{2} C_F \qquad \gamma_g = \frac{11}{6} C_A - \frac{2}{3} T_R N_f \end{equation} \begin{equation} K_q = K_{\bar q} = \left( \frac{7}{2} - \frac{\pi^2}{6} \right) C_F \qquad K_g = \left( \frac{67}{18} - \frac{\pi^2}{6} \right) C_A - \frac{10}{9} T_R N_f \end{equation} <>= real(default), parameter, public :: gamma_q = three/two * CF, & k_q = (7.0_default/two - pi**2/6.0_default) * CF @ %def gamma_q @ <>= public :: gamma_g, k_g <>= elemental module function gamma_g (nf) result (gg) real(default), intent(in) :: nf real(default) :: gg end function gamma_g elemental module function k_g (nf) result (kg) real(default), intent(in) :: nf real(default) :: kg end function k_g <>= elemental module function gamma_g (nf) result (gg) real(default), intent(in) :: nf real(default) :: gg gg = 11.0_default/6.0_default * CA - two/three * TR * nf end function gamma_g elemental module function k_g (nf) result (kg) real(default), intent(in) :: nf real(default) :: kg kg = (67.0_default/18.0_default - pi**2/6.0_default) * CA - & 10.0_default/9.0_default * TR * nf end function k_g @ %def gamma_g @ %def k_g @ \subsection{Mathematical Functions} The dilogarithm. This simplified version is bound to double precision, and restricted to argument values less or equal to unity, so we do not need complex algebra. The wrapper converts it to default precision (which is, of course, a no-op if double=default). The routine calculates the dilogarithm through mapping on the area where there is a quickly convergent series (adapted from an F77 routine by Hans Kuijf, 1988): Map $x$ such that $x$ is not in the neighbourhood of $1$. Note that $|z|=-\ln(1-x)$ is always smaller than $1.10$, but $\frac{1.10^{19}}{19!}{\rm Bernoulli}_{19}=2.7\times 10^{-15}$. <>= public :: Li2 <>= elemental module function Li2 (x) real(default), intent(in) :: x real(default) :: Li2 end function Li2 <>= elemental module function Li2 (x) real(default), intent(in) :: x real(default) :: Li2 Li2 = real( Li2_double (real(x, kind=double)), kind=default) end function Li2 @ %def: Li2 @ <>= elemental function Li2_double (x) result (Li2) real(double), intent(in) :: x real(double) :: Li2 real(double), parameter :: pi2_6 = pi**2/6 if (abs(1-x) < tiny_07) then Li2 = pi2_6 else if (abs(1-x) < 0.5_double) then Li2 = pi2_6 - log(1-x) * log(x) - Li2_restricted (1-x) else if (abs(x) > 1.d0) then ! Li2 = 0 ! call msg_bug (" Dilogarithm called outside of defined range.") !!! Reactivate Dilogarithm identity Li2 = -pi2_6 - 0.5_default * log(-x) * log(-x) - Li2_restricted (1/x) else Li2 = Li2_restricted (x) end if contains elemental function Li2_restricted (x) result (Li2) real(double), intent(in) :: x real(double) :: Li2 real(double) :: tmp, z, z2 z = - log (1-x) z2 = z**2 ! Horner's rule for the powers z^3 through z^19 tmp = 43867._double/798._double tmp = tmp * z2 /342._double - 3617._double/510._double tmp = tmp * z2 /272._double + 7._double/6._double tmp = tmp * z2 /210._double - 691._double/2730._double tmp = tmp * z2 /156._double + 5._double/66._double tmp = tmp * z2 /110._double - 1._double/30._double tmp = tmp * z2 / 72._double + 1._double/42._double tmp = tmp * z2 / 42._double - 1._double/30._double tmp = tmp * z2 / 20._double + 1._double/6._double ! The first three terms of the power series Li2 = z2 * z * tmp / 6._double - 0.25_double * z2 + z end function Li2_restricted end function Li2_double @ %def Li2_double @ Complex digamma function. For this we use the asymptotic formula in Abramoqicz/Stegun, Eq. (6.3.18), and the recurrence formula Eq. (6.3.6): \begin{equation} \psi^{(0})(z) := \psi(z) = \frac{\Gamma'(z)}{\Gamma(z)} \end{equation} <>= public :: psic public :: psir <>= elemental module function psic (z) result (psi) complex(default), intent(in) :: z complex(default) :: psi end function psic elemental module function psir (x) result (psi) real(default), intent(in) :: x real(default) :: psi end function psir <>= elemental module function psic (z) result (psi) complex(default), intent(in) :: z complex(default) :: psi complex(default) :: shift, zz, zi, zi2 shift = 0 zz = z if (abs (aimag(zz)) < 10._default) then do while (abs (zz) < 10._default) shift = shift - 1 / zz zz = zz + 1 end do end if zi = 1/zz zi2 = zi*zi psi = shift + log(zz) - zi/2 - zi2 / 5040._default * ( 420._default + & zi2 * ( -42._default + zi2 * (20._default - 21._default * zi2))) end function psic elemental module function psir (x) result (psi) real(default), intent(in) :: x real(default) :: psi psi = real (psic (cmplx (x,0,kind=default)), kind=default) end function psir @ %def psic psir @ Complex polygamma function. For this we use the asymptotic formula in Abramoqicz/Stegun, Eq. (6.4.11), and the recurrence formula Eq. (6.4.11): \begin{equation} \psi^{(m})(z) := \frac{d^m}{dz^m} \psi(z) = \frac{d^{m+1}}{dz^{m+1}} \ln \Gamma(z) \end{equation} <>= public :: psim public :: psimr <>= elemental module function psim (z, m) result (psi) complex(default), intent(in) :: z integer, intent(in) :: m complex(default) :: psi end function psim elemental module function psimr (x, m) result (psi) real(default), intent(in) :: x integer, intent(in) :: m real(default) :: psi end function psimr <>= elemental module function psim (z, m) result (psi) complex(default), intent(in) :: z integer, intent(in) :: m complex(default) :: psi complex(default) :: shift, rec, zz, zi, zi2 real(default) :: c1, c2, c3, c4, c5, c6, c7 integer :: i if (m < 1) then psi = psic(z) else shift = 0 zz = z if (abs (aimag (zz)) < 10._default) then CHECK_ABS: do rec = (-1)**m * factorial (m) / zz**(m+1) shift = shift - rec zz = zz + 1 if (abs (zz) > 10._default) exit CHECK_ABS end do CHECK_ABS end if c1 = 1._default c2 = 1._default / 2._default c3 = 1._default / 6._default c4 = - 1._default / 30._default c5 = 1._default / 42._default c6 = - 1._default / 30._default c7 = 5._default / 66._default do i = 2, m c1 = c1 * (i-1) c2 = c2 * i c3 = c3 * (i+1) c4 = c4 * (i+3) c5 = c5 * (i+5) c6 = c6 * (i+7) c7 = c7 * (i+9) end do zi = 1/zz zi2 = zi*zi psi = shift + (-1)**(m-1) * zi**m * ( c1 + zi * ( c2 + zi * ( & c3 + zi2 * ( c4 + zi2 * ( c5 + zi2 * ( c6 + ( c7 * zi2))))))) end if end function psim elemental module function psimr (x, m) result (psi) real(default), intent(in) :: x integer, intent(in) :: m real(default) :: psi psi = real (psim (cmplx (x,0,kind=default), m), kind=default) end function psimr @ %def psim psimr @ Nielsen's generalized polylogarithms, \begin{equation*} S_{n,m}(x) = \frac{(-1)^{n+m-1}}{(n-1)!m!} \int_0^1 t^{-1} \; \ln^{n-1} t \; \ln^m (1-xt) \; dt \; , \end{equation*} adapted from the CERNLIB function [[wgplg]] for real arguments [[x]] and integer $n$ and $m$ satisfying $1 \leq n \leq 4$, $1 \leq m \leq 4$, $n+m \leq 5$, i.e. one of the functions $S_{1,1}$, $S_{1,2}$, $S_{2,1}$, $S_{1,3}$, $S_{2,2}$, $S_{3,1}$, $S_{1,4}$, $S_{2,3}$, $S_{3,2}$, $S_{4,1}$. If $x\leq1$, $S_{n,m}(x)$ is real, and the imaginary part is set to zero. <>= public :: cnielsen public :: nielsen <>= module function cnielsen (n, m, x) result (nplog) integer, intent(in) :: n, m real(default), intent(in) :: x complex(default) :: nplog end function cnielsen module function nielsen (n, m, x) result (nplog) integer, intent(in) :: n, m real(default), intent(in) :: x real(default) :: nplog end function nielsen <>= module function cnielsen (n, m, x) result (nplog) integer, intent(in) :: n, m real(default), intent(in) :: x complex(default) :: nplog real(default), parameter :: c1 = 4._default/3._default, & c2 = 1._default/3._default real(default), dimension(0:4), parameter :: & fct = [1.0_default,1.0_default,2.0_default,6.0_default,24.0_default] real(default), dimension(4,4) :: s1, cc real(default), dimension(0:30,10) :: aa complex(default), dimension(0:5) :: vv real(default), dimension(0:5) :: uu real(default) :: x1, h, alfa, b0, b1, b2, qq, rr complex(default) :: sj, sk integer, dimension(10), parameter :: & nc = [24,26,28,30,22,24,26,19,22,17] integer, dimension(31), parameter :: & index = [1,2,3,4,0,0,0,0,0,0,5,6,7,0,0,0,0,0,0,0, & 8,9,0,0,0,0,0,0,0,0,10] real(default), dimension(0:4), parameter :: & sgn = [1._default, -1._default, 1._default, -1._default, 1._default] integer :: it, j, k, l, m1, n1 if ((n<1) .or. (n>4) .or. (m<1) .or. (m>4) .or. (n+m > 5)) then call msg_fatal & ("The Nielsen dilogarithms cannot be applied for these values.") end if s1 = 0._default s1(1,1) = 1.6449340668482_default s1(1,2) = 1.2020569031596_default s1(1,3) = 1.0823232337111_default s1(1,4) = 1.0369277551434_default s1(2,1) = 1.2020569031596_default s1(2,2) = 2.7058080842778e-1_default s1(2,3) = 9.6551159989444e-2_default s1(3,1) = 1.0823232337111_default s1(3,2) = 9.6551159989444e-2_default s1(4,1) = 1.0369277551434_default cc = 0._default cc(1,1) = 1.6449340668482_default cc(1,2) = 1.2020569031596_default cc(1,3) = 1.0823232337111_default cc(1,4) = 1.0369277551434_default cc(2,2) =-1.8940656589945_default cc(2,3) =-3.0142321054407_default cc(3,1) = 1.8940656589945_default cc(3,2) = 3.0142321054407_default aa = 0._default aa( 0,1) = 0.96753215043498_default aa( 1,1) = 0.16607303292785_default aa( 2,1) = 0.02487932292423_default aa( 3,1) = 0.00468636195945_default aa( 4,1) = 0.00100162749616_default aa( 5,1) = 0.00023200219609_default aa( 6,1) = 0.00005681782272_default aa( 7,1) = 0.00001449630056_default aa( 8,1) = 0.00000381632946_default aa( 9,1) = 0.00000102990426_default aa(10,1) = 0.00000028357538_default aa(11,1) = 0.00000007938705_default aa(12,1) = 0.00000002253670_default aa(13,1) = 0.00000000647434_default aa(14,1) = 0.00000000187912_default aa(15,1) = 0.00000000055029_default aa(16,1) = 0.00000000016242_default aa(17,1) = 0.00000000004827_default aa(18,1) = 0.00000000001444_default aa(19,1) = 0.00000000000434_default aa(20,1) = 0.00000000000131_default aa(21,1) = 0.00000000000040_default aa(22,1) = 0.00000000000012_default aa(23,1) = 0.00000000000004_default aa(24,1) = 0.00000000000001_default aa( 0,2) = 0.95180889127832_default aa( 1,2) = 0.43131131846532_default aa( 2,2) = 0.10002250714905_default aa( 3,2) = 0.02442415595220_default aa( 4,2) = 0.00622512463724_default aa( 5,2) = 0.00164078831235_default aa( 6,2) = 0.00044407920265_default aa( 7,2) = 0.00012277494168_default aa( 8,2) = 0.00003453981284_default aa( 9,2) = 0.00000985869565_default aa(10,2) = 0.00000284856995_default aa(11,2) = 0.00000083170847_default aa(12,2) = 0.00000024503950_default aa(13,2) = 0.00000007276496_default aa(14,2) = 0.00000002175802_default aa(15,2) = 0.00000000654616_default aa(16,2) = 0.00000000198033_default aa(17,2) = 0.00000000060204_default aa(18,2) = 0.00000000018385_default aa(19,2) = 0.00000000005637_default aa(20,2) = 0.00000000001735_default aa(21,2) = 0.00000000000536_default aa(22,2) = 0.00000000000166_default aa(23,2) = 0.00000000000052_default aa(24,2) = 0.00000000000016_default aa(25,2) = 0.00000000000005_default aa(26,2) = 0.00000000000002_default aa( 0,3) = 0.98161027991365_default aa( 1,3) = 0.72926806320726_default aa( 2,3) = 0.22774714909321_default aa( 3,3) = 0.06809083296197_default aa( 4,3) = 0.02013701183064_default aa( 5,3) = 0.00595478480197_default aa( 6,3) = 0.00176769013959_default aa( 7,3) = 0.00052748218502_default aa( 8,3) = 0.00015827461460_default aa( 9,3) = 0.00004774922076_default aa(10,3) = 0.00001447920408_default aa(11,3) = 0.00000441154886_default aa(12,3) = 0.00000135003870_default aa(13,3) = 0.00000041481779_default aa(14,3) = 0.00000012793307_default aa(15,3) = 0.00000003959070_default aa(16,3) = 0.00000001229055_default aa(17,3) = 0.00000000382658_default aa(18,3) = 0.00000000119459_default aa(19,3) = 0.00000000037386_default aa(20,3) = 0.00000000011727_default aa(21,3) = 0.00000000003687_default aa(22,3) = 0.00000000001161_default aa(23,3) = 0.00000000000366_default aa(24,3) = 0.00000000000116_default aa(25,3) = 0.00000000000037_default aa(26,3) = 0.00000000000012_default aa(27,3) = 0.00000000000004_default aa(28,3) = 0.00000000000001_default aa( 0,4) = 1.0640521184614_default aa( 1,4) = 1.0691720744981_default aa( 2,4) = 0.41527193251768_default aa( 3,4) = 0.14610332936222_default aa( 4,4) = 0.04904732648784_default aa( 5,4) = 0.01606340860396_default aa( 6,4) = 0.00518889350790_default aa( 7,4) = 0.00166298717324_default aa( 8,4) = 0.00053058279969_default aa( 9,4) = 0.00016887029251_default aa(10,4) = 0.00005368328059_default aa(11,4) = 0.00001705923313_default aa(12,4) = 0.00000542174374_default aa(13,4) = 0.00000172394082_default aa(14,4) = 0.00000054853275_default aa(15,4) = 0.00000017467795_default aa(16,4) = 0.00000005567550_default aa(17,4) = 0.00000001776234_default aa(18,4) = 0.00000000567224_default aa(19,4) = 0.00000000181313_default aa(20,4) = 0.00000000058012_default aa(21,4) = 0.00000000018579_default aa(22,4) = 0.00000000005955_default aa(23,4) = 0.00000000001911_default aa(24,4) = 0.00000000000614_default aa(25,4) = 0.00000000000197_default aa(26,4) = 0.00000000000063_default aa(27,4) = 0.00000000000020_default aa(28,4) = 0.00000000000007_default aa(29,4) = 0.00000000000002_default aa(30,4) = 0.00000000000001_default aa( 0,5) = 0.97920860669175_default aa( 1,5) = 0.08518813148683_default aa( 2,5) = 0.00855985222013_default aa( 3,5) = 0.00121177214413_default aa( 4,5) = 0.00020722768531_default aa( 5,5) = 0.00003996958691_default aa( 6,5) = 0.00000838064065_default aa( 7,5) = 0.00000186848945_default aa( 8,5) = 0.00000043666087_default aa( 9,5) = 0.00000010591733_default aa(10,5) = 0.00000002647892_default aa(11,5) = 0.00000000678700_default aa(12,5) = 0.00000000177654_default aa(13,5) = 0.00000000047342_default aa(14,5) = 0.00000000012812_default aa(15,5) = 0.00000000003514_default aa(16,5) = 0.00000000000975_default aa(17,5) = 0.00000000000274_default aa(18,5) = 0.00000000000077_default aa(19,5) = 0.00000000000022_default aa(20,5) = 0.00000000000006_default aa(21,5) = 0.00000000000002_default aa(22,5) = 0.00000000000001_default aa( 0,6) = 0.95021851963952_default aa( 1,6) = 0.29052529161433_default aa( 2,6) = 0.05081774061716_default aa( 3,6) = 0.00995543767280_default aa( 4,6) = 0.00211733895031_default aa( 5,6) = 0.00047859470550_default aa( 6,6) = 0.00011334321308_default aa( 7,6) = 0.00002784733104_default aa( 8,6) = 0.00000704788108_default aa( 9,6) = 0.00000182788740_default aa(10,6) = 0.00000048387492_default aa(11,6) = 0.00000013033842_default aa(12,6) = 0.00000003563769_default aa(13,6) = 0.00000000987174_default aa(14,6) = 0.00000000276586_default aa(15,6) = 0.00000000078279_default aa(16,6) = 0.00000000022354_default aa(17,6) = 0.00000000006435_default aa(18,6) = 0.00000000001866_default aa(19,6) = 0.00000000000545_default aa(20,6) = 0.00000000000160_default aa(21,6) = 0.00000000000047_default aa(22,6) = 0.00000000000014_default aa(23,6) = 0.00000000000004_default aa(24,6) = 0.00000000000001_default aa( 0,7) = 0.95064032186777_default aa( 1,7) = 0.54138285465171_default aa( 2,7) = 0.13649979590321_default aa( 3,7) = 0.03417942328207_default aa( 4,7) = 0.00869027883583_default aa( 5,7) = 0.00225284084155_default aa( 6,7) = 0.00059516089806_default aa( 7,7) = 0.00015995617766_default aa( 8,7) = 0.00004365213096_default aa( 9,7) = 0.00001207474688_default aa(10,7) = 0.00000338018176_default aa(11,7) = 0.00000095632476_default aa(12,7) = 0.00000027313129_default aa(13,7) = 0.00000007866968_default aa(14,7) = 0.00000002283195_default aa(15,7) = 0.00000000667205_default aa(16,7) = 0.00000000196191_default aa(17,7) = 0.00000000058018_default aa(18,7) = 0.00000000017246_default aa(19,7) = 0.00000000005151_default aa(20,7) = 0.00000000001545_default aa(21,7) = 0.00000000000465_default aa(22,7) = 0.00000000000141_default aa(23,7) = 0.00000000000043_default aa(24,7) = 0.00000000000013_default aa(25,7) = 0.00000000000004_default aa(26,7) = 0.00000000000001_default aa( 0,8) = 0.98800011672229_default aa( 1,8) = 0.04364067609601_default aa( 2,8) = 0.00295091178278_default aa( 3,8) = 0.00031477809720_default aa( 4,8) = 0.00004314846029_default aa( 5,8) = 0.00000693818230_default aa( 6,8) = 0.00000124640350_default aa( 7,8) = 0.00000024293628_default aa( 8,8) = 0.00000005040827_default aa( 9,8) = 0.00000001099075_default aa(10,8) = 0.00000000249467_default aa(11,8) = 0.00000000058540_default aa(12,8) = 0.00000000014127_default aa(13,8) = 0.00000000003492_default aa(14,8) = 0.00000000000881_default aa(15,8) = 0.00000000000226_default aa(16,8) = 0.00000000000059_default aa(17,8) = 0.00000000000016_default aa(18,8) = 0.00000000000004_default aa(19,8) = 0.00000000000001_default aa( 0,9) = 0.95768506546350_default aa( 1,9) = 0.19725249679534_default aa( 2,9) = 0.02603370313918_default aa( 3,9) = 0.00409382168261_default aa( 4,9) = 0.00072681707110_default aa( 5,9) = 0.00014091879261_default aa( 6,9) = 0.00002920458914_default aa( 7,9) = 0.00000637631144_default aa( 8,9) = 0.00000145167850_default aa( 9,9) = 0.00000034205281_default aa(10,9) = 0.00000008294302_default aa(11,9) = 0.00000002060784_default aa(12,9) = 0.00000000522823_default aa(13,9) = 0.00000000135066_default aa(14,9) = 0.00000000035451_default aa(15,9) = 0.00000000009436_default aa(16,9) = 0.00000000002543_default aa(17,9) = 0.00000000000693_default aa(18,9) = 0.00000000000191_default aa(19,9) = 0.00000000000053_default aa(20,9) = 0.00000000000015_default aa(21,9) = 0.00000000000004_default aa(22,9) = 0.00000000000001_default aa( 0,10) = 0.99343651671347_default aa( 1,10) = 0.02225770126826_default aa( 2,10) = 0.00101475574703_default aa( 3,10) = 0.00008175156250_default aa( 4,10) = 0.00000899973547_default aa( 5,10) = 0.00000120823987_default aa( 6,10) = 0.00000018616913_default aa( 7,10) = 0.00000003174723_default aa( 8,10) = 0.00000000585215_default aa( 9,10) = 0.00000000114739_default aa(10,10) = 0.00000000023652_default aa(11,10) = 0.00000000005082_default aa(12,10) = 0.00000000001131_default aa(13,10) = 0.00000000000259_default aa(14,10) = 0.00000000000061_default aa(15,10) = 0.00000000000015_default aa(16,10) = 0.00000000000004_default aa(17,10) = 0.00000000000001_default if (x == 1._default) then nplog = s1(n,m) else if (x > 2._default .or. x < -1.0_default) then x1 = 1._default / x h = c1 * x1 + c2 alfa = h + h vv(0) = 1._default if (x < -1.0_default) then vv(1) = log(-x) else if (x > 2._default) then vv(1) = log(cmplx(-x,0._default,kind=default)) end if do l = 2, n+m vv(l) = vv(1) * vv(l-1)/l end do sk = 0._default do k = 0, m-1 m1 = m-k rr = x1**m1 / (fct(m1) * fct(n-1)) sj = 0._default do j = 0, k n1 = n+k-j l = index(10*n1+m1-10) b1 = 0._default b2 = 0._default do it = nc(l), 0, -1 b0 = aa(it,l) + alfa*b1 - b2 b2 = b1 b1 = b0 end do qq = (fct(n1-1) / fct(k-j)) * (b0 - h*b2) * rr / m1**n1 sj = sj + vv(j) * qq end do sk = sk + sgn(k) * sj end do sj = 0._default do j = 0, n-1 sj = sj + vv(j) * cc(n-j,m) end do nplog = sgn(n) * sk + sgn(m) * (sj + vv(n+m)) else if (x > 0.5_default) then x1 = 1._default - x h = c1 * x1 + c2 alfa = h + h vv(0) = 1._default uu(0) = 1._default vv(1) = log(cmplx(x1,0._default,kind=default)) uu(1) = log(x) do l = 2, m vv(l) = vv(1) * vv(l-1) / l end do do l = 2, n uu(l) = uu(1) * uu(l-1) / l end do sk = 0._default do k = 0, n-1 m1 = n-k rr = x1**m1 / fct(m1) sj = 0._default do j = 0, m-1 n1 = m-j l = index(10*n1 + m1 - 10) b1 = 0._default b2 = 0._default do it = nc(l), 0, -1 b0 = aa(it,l) + alfa*b1 - b2 b2 = b1 b1 = b0 end do qq = sgn(j) * (b0 - h*b2) * rr / m1**n1 sj = sj + vv(j) * qq end do sk = sk + uu(k) * (s1(m1,m) - sj) end do nplog = sk + sgn(m) * uu(n) * vv(m) else l = index(10*n + m - 10) h = c1 * x + c2 alfa = h + h b1 = 0._default b2 = 0._default do it = nc(l), 0, -1 b0 = aa(it,l) + alfa*b1 - b2 b2 = b1 b1 = b0 end do nplog = (b0 - h*b2) * x**m / (fct(m) * m**n) end if end function cnielsen module function nielsen (n, m, x) result (nplog) integer, intent(in) :: n, m real(default), intent(in) :: x real(default) :: nplog nplog = real (cnielsen (n, m, x)) end function nielsen @ %def cnielsen nielsen @ $\text{Li}_{n}(x) = S_{n-1,1}(x)$. <>= public :: polylog <>= module function polylog (n, x) result (plog) integer, intent(in) :: n real(default), intent(in) :: x real(default) :: plog end function polylog <>= module function polylog (n, x) result (plog) integer, intent(in) :: n real(default), intent(in) :: x real(default) :: plog plog = nielsen (n-1,1,x) end function polylog @ %def polylog @ $\text{Li}_2(x)$. <>= public :: dilog <>= module function dilog (x) result (dlog) real(default), intent(in) :: x real(default) :: dlog end function dilog <>= module function dilog (x) result (dlog) real(default), intent(in) :: x real(default) :: dlog dlog = polylog (2,x) end function dilog @ %def dilog @ $\text{Li}_3(x)$. <>= public :: trilog <>= module function trilog (x) result (tlog) real(default), intent(in) :: x real(default) :: tlog end function trilog <>= module function trilog (x) result (tlog) real(default), intent(in) :: x real(default) :: tlog tlog = polylog (3,x) end function trilog @ %def trilog @ \subsection{Loop Integrals} These functions appear in the calculation of the effective one-loop coupling of a (pseudo)scalar to a vector boson pair. <>= public :: faux <>= elemental module function faux (x) result (y) real(default), intent(in) :: x complex(default) :: y end function faux <>= elemental module function faux (x) result (y) real(default), intent(in) :: x complex(default) :: y if (1 <= x) then y = asin(sqrt(1/x))**2 else y = - 1/4.0_default * (log((1 + sqrt(1 - x))/ & (1 - sqrt(1 - x))) - cmplx (0.0_default, pi, kind=default))**2 end if end function faux @ %def faux @ <>= public :: fonehalf <>= elemental module function fonehalf (x) result (y) real(default), intent(in) :: x complex(default) :: y end function fonehalf <>= elemental module function fonehalf (x) result (y) real(default), intent(in) :: x complex(default) :: y if (abs(x) < eps0) then y = 0 else y = - 2.0_default * x * (1 + (1 - x) * faux(x)) end if end function fonehalf @ %def fonehalf @ <>= public :: fonehalf_pseudo <>= module function fonehalf_pseudo (x) result (y) real(default), intent(in) :: x complex(default) :: y end function fonehalf_pseudo <>= module function fonehalf_pseudo (x) result (y) real(default), intent(in) :: x complex(default) :: y if (abs(x) < eps0) then y = 0 else y = - 2.0_default * x * faux(x) end if end function fonehalf_pseudo @ %def fonehalf_pseudo @ <>= public :: fone <>= elemental module function fone (x) result (y) real(default), intent(in) :: x complex(default) :: y end function fone <>= elemental module function fone (x) result (y) real(default), intent(in) :: x complex(default) :: y if (abs(x) < eps0) then y = 2.0_default else y = 2.0_default + 3.0_default * x + & 3.0_default * x * (2.0_default - x) * & faux(x) end if end function fone @ %def fone @ <>= public :: gaux <>= elemental module function gaux (x) result (y) real(default), intent(in) :: x complex(default) :: y end function gaux <>= elemental module function gaux (x) result (y) real(default), intent(in) :: x complex(default) :: y if (1 <= x) then y = sqrt(x - 1) * asin(sqrt(1/x)) else y = sqrt(1 - x) * (log((1 + sqrt(1 - x)) / & (1 - sqrt(1 - x))) - & cmplx (0.0_default, pi, kind=default)) / 2.0_default end if end function gaux @ %def gaux @ <>= public :: tri_i1 <>= elemental module function tri_i1 (a,b) result (y) real(default), intent(in) :: a,b complex(default) :: y end function tri_i1 <>= elemental module function tri_i1 (a,b) result (y) real(default), intent(in) :: a,b complex(default) :: y if (a < eps0 .or. b < eps0) then y = 0 else y = a*b/2.0_default/(a-b) + a**2 * b**2/2.0_default/(a-b)**2 * & (faux(a) - faux(b)) + & a**2 * b/(a-b)**2 * (gaux(a) - gaux(b)) end if end function tri_i1 @ %def tri_i1 @ <>= public :: tri_i2 <>= elemental module function tri_i2 (a,b) result (y) real(default), intent(in) :: a,b complex(default) :: y end function tri_i2 <>= elemental module function tri_i2 (a,b) result (y) real(default), intent(in) :: a,b complex(default) :: y if (a < eps0 .or. b < eps0) then y = 0 else y = - a * b / 2.0_default / (a-b) * (faux(a) - faux(b)) end if end function tri_i2 @ %def tri_i2 @ \subsection{More on $\alpha_s$} These functions are for the running of the strong coupling constants, $\alpha_s$. <>= public :: run_b0 <>= elemental module function run_b0 (nf) result (bnull) integer, intent(in) :: nf real(default) :: bnull end function run_b0 <>= elemental module function run_b0 (nf) result (bnull) integer, intent(in) :: nf real(default) :: bnull bnull = 33.0_default - 2.0_default * nf end function run_b0 @ %def run_b0 @ <>= public :: run_b1 <>= elemental module function run_b1 (nf) result (bone) integer, intent(in) :: nf real(default) :: bone end function run_b1 <>= elemental module function run_b1 (nf) result (bone) integer, intent(in) :: nf real(default) :: bone bone = 6.0_default * (153.0_default - 19.0_default * nf)/run_b0(nf)**2 end function run_b1 @ %def run_b1 @ <>= public :: run_aa <>= elemental module function run_aa (nf) result (aaa) integer, intent(in) :: nf real(default) :: aaa end function run_aa <>= elemental module function run_aa (nf) result (aaa) integer, intent(in) :: nf real(default) :: aaa aaa = 12.0_default * PI / run_b0(nf) end function run_aa @ %def run_aa @ <>= public :: run_bb <>= elemental function run_bb (nf) result (bbb) integer, intent(in) :: nf real(default) :: bbb bbb = run_b1(nf) / run_aa(nf) end function run_bb @ %def run_bb @ \subsection{Functions for Catani-Seymour dipoles} For the automated Catani-Seymour dipole subtraction, we need the following functions. <>= public :: ff_dipole <>= pure module subroutine ff_dipole (v_ijk, y_ijk, p_ij, pp_k, p_i, p_j, p_k) type(vector4_t), intent(in) :: p_i, p_j, p_k type(vector4_t), intent(out) :: p_ij, pp_k real(default), intent(out) :: y_ijk real(default), intent(out) :: v_ijk end subroutine ff_dipole <>= pure module subroutine ff_dipole (v_ijk, y_ijk, p_ij, pp_k, p_i, p_j, p_k) type(vector4_t), intent(in) :: p_i, p_j, p_k type(vector4_t), intent(out) :: p_ij, pp_k real(default), intent(out) :: y_ijk real(default) :: z_i real(default), intent(out) :: v_ijk z_i = (p_i*p_k) / ((p_k*p_j) + (p_k*p_i)) y_ijk = (p_i*p_j) / ((p_i*p_j) + (p_i*p_k) + (p_j*p_k)) p_ij = p_i + p_j - y_ijk/(1.0_default - y_ijk) * p_k pp_k = (1.0/(1.0_default - y_ijk)) * p_k !!! We don't multiply by alpha_s right here: v_ijk = 8.0_default * PI * CF * & (2.0 / (1.0 - z_i*(1.0 - y_ijk)) - (1.0 + z_i)) end subroutine ff_dipole @ %def ff_dipole @ <>= public :: fi_dipole <>= pure module subroutine fi_dipole (v_ija, x_ija, p_ij, pp_a, p_i, p_j, p_a) type(vector4_t), intent(in) :: p_i, p_j, p_a type(vector4_t), intent(out) :: p_ij, pp_a real(default), intent(out) :: x_ija real(default), intent(out) :: v_ija end subroutine fi_dipole <>= pure module subroutine fi_dipole (v_ija, x_ija, p_ij, pp_a, p_i, p_j, p_a) type(vector4_t), intent(in) :: p_i, p_j, p_a type(vector4_t), intent(out) :: p_ij, pp_a real(default), intent(out) :: x_ija real(default) :: z_i real(default), intent(out) :: v_ija z_i = (p_i*p_a) / ((p_a*p_j) + (p_a*p_i)) x_ija = ((p_i*p_a) + (p_j*p_a) - (p_i*p_j)) & / ((p_i*p_a) + (p_j*p_a)) p_ij = p_i + p_j - (1.0_default - x_ija) * p_a pp_a = x_ija * p_a !!! We don't not multiply by alpha_s right here: v_ija = 8.0_default * PI * CF * & (2.0 / (1.0 - z_i + (1.0 - x_ija)) - (1.0 + z_i)) / x_ija end subroutine fi_dipole @ %def fi_dipole @ <>= public :: if_dipole <>= pure module subroutine if_dipole (v_kja, u_j, p_aj, pp_k, p_k, p_j, p_a) type(vector4_t), intent(in) :: p_k, p_j, p_a type(vector4_t), intent(out) :: p_aj, pp_k real(default), intent(out) :: u_j real(default), intent(out) :: v_kja end subroutine if_dipole <>= pure module subroutine if_dipole (v_kja, u_j, p_aj, pp_k, p_k, p_j, p_a) type(vector4_t), intent(in) :: p_k, p_j, p_a type(vector4_t), intent(out) :: p_aj, pp_k real(default), intent(out) :: u_j real(default) :: x_kja real(default), intent(out) :: v_kja u_j = (p_a*p_j) / ((p_a*p_j) + (p_a*p_k)) x_kja = ((p_a*p_k) + (p_a*p_j) - (p_j*p_k)) & / ((p_a*p_j) + (p_a*p_k)) p_aj = x_kja * p_a pp_k = p_k + p_j - (1.0_default - x_kja) * p_a v_kja = 8.0_default * PI * CF * & (2.0 / (1.0 - x_kja + u_j) - (1.0 + x_kja)) / x_kja end subroutine if_dipole @ %def if_dipole @ This function depends on a variable number of final state particles whose kinematics all get changed by the initial-initial dipole insertion. <>= public :: ii_dipole <>= pure module subroutine ii_dipole (v_jab, v_j, p_in, p_out, flag_1or2) type(vector4_t), dimension(:), intent(in) :: p_in type(vector4_t), dimension(size(p_in)-1), intent(out) :: p_out logical, intent(in) :: flag_1or2 real(default), intent(out) :: v_j real(default), intent(out) :: v_jab end subroutine ii_dipole <>= pure module subroutine ii_dipole (v_jab, v_j, p_in, p_out, flag_1or2) type(vector4_t), dimension(:), intent(in) :: p_in type(vector4_t), dimension(size(p_in)-1), intent(out) :: p_out logical, intent(in) :: flag_1or2 real(default), intent(out) :: v_j real(default), intent(out) :: v_jab type(vector4_t) :: p_a, p_b, p_j type(vector4_t) :: k, kk type(vector4_t) :: p_aj real(default) :: x_jab integer :: i !!! flag_1or2 decides whether this a 12 or 21 dipole if (flag_1or2) then p_a = p_in(1) p_b = p_in(2) else p_b = p_in(1) p_a = p_in(2) end if !!! We assume that the unresolved particle has always the last !!! momentum p_j = p_in(size(p_in)) x_jab = ((p_a*p_b) - (p_a*p_j) - (p_b*p_j)) / (p_a*p_b) v_j = (p_a*p_j) / (p_a * p_b) p_aj = x_jab * p_a k = p_a + p_b - p_j kk = p_aj + p_b do i = 3, size(p_in)-1 p_out(i) = p_in(i) - 2.0*((k+kk)*p_in(i))/((k+kk)*(k+kk)) * (k+kk) + & (2.0 * (k*p_in(i)) / (k*k)) * kk end do if (flag_1or2) then p_out(1) = p_aj p_out(2) = p_b else p_out(1) = p_b p_out(2) = p_aj end if v_jab = 8.0_default * PI * CF * & (2.0 / (1.0 - x_jab) - (1.0 + x_jab)) / x_jab end subroutine ii_dipole @ %def ii_dipole @ \subsection{Distributions for integrated dipoles and such} Note that the following formulae are only meaningful for $0 \leq x \leq 1$. The Dirac delta distribution, modified for Monte-Carlo sampling, centered at $x=1-\frac{\epsilon}{2}$: <>= public :: delta <>= elemental module function delta (x,eps) result (z) real(default), intent(in) :: x, eps real(default) :: z end function delta <>= elemental module function delta (x,eps) result (z) real(default), intent(in) :: x, eps real(default) :: z if (x > one - eps) then z = one / eps else z = 0 end if end function delta @ %def delta @ The $+$-distribution, $P_+(x) = \left( \frac{1}{1-x}\right)_+$, for the regularization of soft-collinear singularities. The constant part for the Monte-Carlo sampling is the integral over the splitting function divided by the weight for the WHIZARD numerical integration over the interval. <>= public :: plus_distr <>= elemental module function plus_distr (x,eps) result (plusd) real(default), intent(in) :: x, eps real(default) :: plusd end function plus_distr <>= elemental module function plus_distr (x,eps) result (plusd) real(default), intent(in) :: x, eps real(default) :: plusd if (x > one - eps) then plusd = log(eps) / eps else plusd = one / (one - x) end if end function plus_distr @ %def plus_distr @ The splitting function in $D=4$ dimensions, regularized as $+$-distributions if necessary: \begin{align} P^{qq} (x) = P^{\bar q\bar q} (x) &= \; C_F \cdot \left( \frac{1 + x^2}{1-x} \right)_+ \\ P^{qg} (x) = P^{\bar q g} (x) &= \; C_F \cdot \frac{1 + (1-x)^2}{x}\\ P^{gq} (x) = P^{g \bar q} (x) &= \; T_R \cdot \left[ x^2 + (1-x)^2 \right] \\ P^{gg} (x) &= \; 2 C_A \biggl[ \left( \frac{1}{1-x} \right)_+ + \frac{1-x}{x} - 1 + x(1-x) \biggl] \notag{}\\ &\quad + \delta(1-x) \left( \frac{11}{6} C_A - \frac{2}{3} N_f T_R \right) \end{align} Since the number of flavors summed over in the gluon splitting function might depend on the physics case under consideration, it is implemented as an input variable. <>= public :: pqq <>= elemental module function pqq (x,eps) result (pqqx) real(default), intent(in) :: x, eps real(default) :: pqqx end function pqq <>= elemental module function pqq (x,eps) result (pqqx) real(default), intent(in) :: x, eps real(default) :: pqqx if (x > (1.0_default - eps)) then pqqx = (eps - one) / two + two * log(eps) / eps - & three * (eps - one) / eps / two else pqqx = (one + x**2) / (one - x) end if pqqx = CF * pqqx end function pqq @ %def pqq @ <>= public :: pgq <>= elemental module function pgq (x) result (pgqx) real(default), intent(in) :: x real(default) :: pgqx end function pgq <>= elemental module function pgq (x) result (pgqx) real(default), intent(in) :: x real(default) :: pgqx pgqx = TR * (x**2 + (one - x)**2) end function pgq @ %def pgq @ <>= public :: pqg <>= elemental module function pqg (x) result (pqgx) real(default), intent(in) :: x real(default) :: pqgx end function pqg <>= elemental module function pqg (x) result (pqgx) real(default), intent(in) :: x real(default) :: pqgx pqgx = CF * (one + (one - x)**2) / x end function pqg @ %def pqg @ <>= public :: pgg <>= elemental module function pgg (x, nf, eps) result (pggx) real(default), intent(in) :: x, nf, eps real(default) :: pggx end function pgg <>= elemental module function pgg (x, nf, eps) result (pggx) real(default), intent(in) :: x, nf, eps real(default) :: pggx pggx = two * CA * ( plus_distr (x, eps) + (one-x)/x - one + & x*(one-x)) + delta (x, eps) * gamma_g(nf) end function pgg @ %def pgg @ For the $qq$ and $gg$ cases, there exist ``regularized'' versions of the splitting functions: \begin{align} P^{qq}_{\text{reg}} (x) &= - C_F \cdot (1 + x) \\ P^{gg}_{\text{reg}} (x) &= 2 C_A \left[ \frac{1-x}{x} - 1 + x(1-x) \right] \end{align} <>= public :: pqq_reg <>= elemental module function pqq_reg (x) result (pqqregx) real(default), intent(in) :: x real(default) :: pqqregx end function pqq_reg <>= elemental module function pqq_reg (x) result (pqqregx) real(default), intent(in) :: x real(default) :: pqqregx pqqregx = - CF * (one + x) end function pqq_reg @ %def pqq_reg @ <>= public :: pgg_reg <>= elemental module function pgg_reg (x) result (pggregx) real(default), intent(in) :: x real(default) :: pggregx end function pgg_reg <>= elemental module function pgg_reg (x) result (pggregx) real(default), intent(in) :: x real(default) :: pggregx pggregx = two * CA * ((one - x)/x - one + x*(one - x)) end function pgg_reg @ %def pgg_reg @ Here, we collect the expressions needed for integrated Catani-Seymour dipoles, and the so-called flavor kernels. We always distinguish between the ``ordinary'' Catani-Seymour version, and the one including a phase-space slicing parameter, $\alpha$. The standard flavor kernels $\overline{K}^{ab}$ are: \begin{align} \overline{K}^{qg} (x) = \overline{K}^{\bar q g} (x) & = \; P^{qg} (x) \log ((1-x)/x) + CF \times x \\ %%% \overline{K}^{gq} (x) = \overline{K}^{g \bar q} (x) & = \; P^{gq} (x) \log ((1-x)/x) + TR \times 2x(1-x) \\ %%% \overline{K}^{qq} &=\; C_F \biggl[ \left( \frac{2}{1-x} \log \frac{1-x}{x} \right)_+ - (1+x) \log ((1-x)/x) + (1-x) \biggr] \notag{}\\ &\quad - (5 - \pi^2) \cdot C_F \cdot \delta(1-x) \\ %%% \overline{K}^{gg} &=\; 2 C_A \biggl[ \left( \frac{1}{1-x} \log \frac{1-x}{x} \right)_+ + \left( \frac{1-x}{x} - 1 + x(1-x) \right) \log((1-x)/x) \biggr] \notag{}\\ &\quad - \delta(1-x) \biggl[ \left( \frac{50}{9} - \pi^2 \right) C_A - \frac{16}{9} T_R N_f \biggr] \end{align} <>= public :: kbarqg <>= module function kbarqg (x) result (kbarqgx) real(default), intent(in) :: x real(default) :: kbarqgx end function kbarqg <>= module function kbarqg (x) result (kbarqgx) real(default), intent(in) :: x real(default) :: kbarqgx kbarqgx = pqg(x) * log((one-x)/x) + CF * x end function kbarqg @ %def kbarqg @ <>= public :: kbargq <>= module function kbargq (x) result (kbargqx) real(default), intent(in) :: x real(default) :: kbargqx end function kbargq <>= module function kbargq (x) result (kbargqx) real(default), intent(in) :: x real(default) :: kbargqx kbargqx = pgq(x) * log((one-x)/x) + two * TR * x * (one - x) end function kbargq @ %def kbarqg @ <>= public :: kbarqq <>= module function kbarqq (x,eps) result (kbarqqx) real(default), intent(in) :: x, eps real(default) :: kbarqqx end function kbarqq <>= module function kbarqq (x,eps) result (kbarqqx) real(default), intent(in) :: x, eps real(default) :: kbarqqx kbarqqx = CF*(log_plus_distr(x,eps) - (one+x) * log((one-x)/x) + (one - & x) - (five - pi**2) * delta(x,eps)) end function kbarqq @ %def kbarqq @ <>= public :: kbargg <>= module function kbargg (x,eps,nf) result (kbarggx) real(default), intent(in) :: x, eps, nf real(default) :: kbarggx end function kbargg <>= module function kbargg (x,eps,nf) result (kbarggx) real(default), intent(in) :: x, eps, nf real(default) :: kbarggx kbarggx = CA * (log_plus_distr(x,eps) + two * ((one-x)/x - one + & x*(one-x) * log((1-x)/x))) - delta(x,eps) * & ((50.0_default/9.0_default - pi**2) * CA - & 16.0_default/9.0_default * TR * nf) end function kbargg @ %def kbargg @ The $\tilde{K}$ are used when two identified hadrons participate: \begin{equation} \tilde{K}^{ab} (x) = P^{ab}_{\text{reg}} (x) \cdot \log (1-x) + \delta^{ab} \mathbf{T}_a^2 \biggl[ \left( \frac{2}{1-x} \log (1-x) \right)_+ - \frac{\pi^2}{3} \delta(1-x) \biggr] \end{equation} <>= public :: ktildeqq <>= module function ktildeqq (x,eps) result (ktildeqqx) real(default), intent(in) :: x, eps real(default) :: ktildeqqx end function ktildeqq <>= module function ktildeqq (x,eps) result (ktildeqqx) real(default), intent(in) :: x, eps real(default) :: ktildeqqx ktildeqqx = pqq_reg (x) * log(one-x) + CF * ( - log2_plus_distr (x,eps) & - pi**2/three * delta(x,eps)) end function ktildeqq @ %def ktildeqq @ <>= public :: ktildeqg <>= module function ktildeqg (x,eps) result (ktildeqgx) real(default), intent(in) :: x, eps real(default) :: ktildeqgx end function ktildeqg <>= module function ktildeqg (x,eps) result (ktildeqgx) real(default), intent(in) :: x, eps real(default) :: ktildeqgx ktildeqgx = pqg (x) * log(one-x) end function ktildeqg @ %def ktildeqg @ <>= public :: ktildegq <>= module function ktildegq (x,eps) result (ktildegqx) real(default), intent(in) :: x, eps real(default) :: ktildegqx end function ktildegq <>= module function ktildegq (x,eps) result (ktildegqx) real(default), intent(in) :: x, eps real(default) :: ktildegqx ktildegqx = pgq (x) * log(one-x) end function ktildegq @ %def ktildeqg @ <>= public :: ktildegg <>= module function ktildegg (x,eps) result (ktildeggx) real(default), intent(in) :: x, eps real(default) :: ktildeggx end function ktildegg <>= module function ktildegg (x,eps) result (ktildeggx) real(default), intent(in) :: x, eps real(default) :: ktildeggx ktildeggx = pgg_reg (x) * log(one-x) + CA * ( - & log2_plus_distr (x,eps) - pi**2/three * delta(x,eps)) end function ktildegg @ %def ktildegg @ The insertion operator might not be necessary for a GOLEM interface but is demanded by the Les Houches NLO accord. It is a three-dimensional array, where the index always gives the inverse power of the DREG expansion parameter, $\epsilon$. <>= public :: insert_q <>= pure module function insert_q () result (i_q) real(default), dimension(0:2) :: i_q end function insert_q <>= pure module function insert_q () result (i_q) real(default), dimension(0:2) :: i_q i_q(0) = gamma_q + k_q - pi**2/three * CF i_q(1) = gamma_q i_q(2) = CF end function insert_q @ %def insert_q @ <>= public :: insert_g <>= pure module function insert_g (nf) result (i_g) real(default), intent(in) :: nf real(default), dimension(0:2) :: i_g end function insert_g <>= pure module function insert_g (nf) result (i_g) real(default), intent(in) :: nf real(default), dimension(0:2) :: i_g i_g(0) = gamma_g (nf) + k_g (nf) - pi**2/three * CA i_g(1) = gamma_g (nf) i_g(2) = CA end function insert_g @ %def insert_g @ For better convergence, one can exclude regions of phase space with a slicing parameter from the dipole subtraction procedure. First of all, the $K$ functions get modified: \begin{equation} K_i (\alpha) = K_i - \mathbf{T}_i^2 \log^2 \alpha + \gamma_i ( \alpha - 1 - \log\alpha) \end{equation} <>= public :: k_q_al, k_g_al <>= pure module function k_q_al (alpha) real(default), intent(in) :: alpha real(default) :: k_q_al end function k_q_al pure module function k_g_al (alpha, nf) real(default), intent(in) :: alpha, nf real(default) :: k_g_al end function k_g_al <>= pure module function k_q_al (alpha) real(default), intent(in) :: alpha real(default) :: k_q_al k_q_al = k_q - CF * (log(alpha))**2 + gamma_q * & (alpha - one - log(alpha)) end function k_q_al pure module function k_g_al (alpha, nf) real(default), intent(in) :: alpha, nf real(default) :: k_g_al k_g_al = k_g (nf) - CA * (log(alpha))**2 + gamma_g (nf) * & (alpha - one - log(alpha)) end function k_g_al @ %def k_q_al @ %def k_g_al @ The $+$-distribution, but with a phase-space slicing parameter, $\alpha$, $P_{1-\alpha}(x) = \left( \frac{1}{1-x} \right)_{1-x}$. Since we need the fatal error message here, this function cannot be elemental. <>= public :: plus_distr_al <>= module function plus_distr_al (x,alpha,eps) result (plusd_al) real(default), intent(in) :: x, eps, alpha real(default) :: plusd_al end function plus_distr_al <>= module function plus_distr_al (x,alpha,eps) result (plusd_al) real(default), intent(in) :: x, eps, alpha real(default) :: plusd_al if ((one - alpha) >= (one - eps)) then plusd_al = zero call msg_fatal ('sm_physics, plus_distr_al: alpha and epsilon chosen wrongly') elseif (x < (1.0_default - alpha)) then plusd_al = 0 else if (x > (1.0_default - eps)) then plusd_al = log(eps/alpha)/eps else plusd_al = one/(one-x) end if end function plus_distr_al @ %def plus_distr_al @ Introducing phase-space slicing parameters, these standard flavor kernels $\overline{K}^{ab}$ become: \begin{align} \overline{K}^{qg}_\alpha (x) = \overline{K}^{\bar q g}_\alpha (x) & = \; P^{qg} (x) \log (\alpha (1-x)/x) + C_F \times x \\ %%% \overline{K}^{gq}_\alpha (x) = \overline{K}^{g \bar q}_\alpha (x) & = \; P^{gq} (x) \log (\alpha (1-x)/x) + T_R \times 2x(1-x) \\ %%% \overline{K}^{qq}_\alpha &= C_F (1 - x) + P^{qq}_{\text{reg}} (x) \log \frac{\alpha(1-x)}{x} \notag{}\\ &\quad + C_F \delta (1 - x) \log^2 \alpha + C_F \left( \frac{2}{1-x} \log \frac{1-x}{x} \right)_+ \notag{}\\ &\quad - \left( \gamma_q + K_q(\alpha) - \frac56 \pi^2 C_F \right) \cdot \delta(1-x) \; C_F \Bigl[ + \frac{2}{1-x} \log \left( \frac{\alpha (2-x)}{1+\alpha-x} \right) - \theta(1 - \alpha - x) \cdot \left( \frac{2}{1-x} \log \frac{2-x}{1-x} \right) \Bigr] \\ %%% \overline{K}^{gg}_\alpha &=\; P^{gg}_{\text{reg}} (x) \log \frac{\alpha(1-x)}{x} + C_A \delta (1 - x) \log^2 \alpha \notag{}\\ &\quad + C_A \left( \frac{2}{1-x} \log \frac{1-x}{x} \right)_+ - \left( \gamma_g + K_g(\alpha) - \frac56 \pi^2 C_A \right) \cdot \delta(1-x) \; C_A \Bigl[ + \frac{2}{1-x} \log \left( \frac{\alpha (2-x)}{1+\alpha-x} \right) - \theta(1 - \alpha - x) \cdot \left( \frac{2}{1-x} \log \frac{2-x}{1-x} \right) \Bigr] \end{align} <>= public :: kbarqg_al <>= module function kbarqg_al (x,alpha,eps) result (kbarqgx) real(default), intent(in) :: x, alpha, eps real(default) :: kbarqgx end function kbarqg_al <>= module function kbarqg_al (x,alpha,eps) result (kbarqgx) real(default), intent(in) :: x, alpha, eps real(default) :: kbarqgx kbarqgx = pqg (x) * log(alpha*(one-x)/x) + CF * x end function kbarqg_al @ %def kbarqg_al @ <>= public :: kbargq_al <>= module function kbargq_al (x,alpha,eps) result (kbargqx) real(default), intent(in) :: x, alpha, eps real(default) :: kbargqx end function kbargq_al <>= module function kbargq_al (x,alpha,eps) result (kbargqx) real(default), intent(in) :: x, alpha, eps real(default) :: kbargqx kbargqx = pgq (x) * log(alpha*(one-x)/x) + two * TR * x * (one-x) end function kbargq_al @ %def kbargq_al @ <>= public :: kbarqq_al <>= module function kbarqq_al (x,alpha,eps) result (kbarqqx) real(default), intent(in) :: x, alpha, eps real(default) :: kbarqqx end function kbarqq_al <>= module function kbarqq_al (x,alpha,eps) result (kbarqqx) real(default), intent(in) :: x, alpha, eps real(default) :: kbarqqx kbarqqx = CF * (one - x) + pqq_reg(x) * log(alpha*(one-x)/x) & + CF * log_plus_distr(x,eps) & - (gamma_q + k_q_al(alpha) - CF * & five/6.0_default * pi**2 - CF * (log(alpha))**2) * & delta(x,eps) + & CF * two/(one -x)*log(alpha*(two-x)/(one+alpha-x)) if (x < (one-alpha)) then kbarqqx = kbarqqx - CF * two/(one-x) * log((two-x)/(one-x)) end if end function kbarqq_al @ %def kbarqq_al <>= public :: kbargg_al <>= module function kbargg_al (x,alpha,eps,nf) result (kbarggx) real(default), intent(in) :: x, alpha, eps, nf real(default) :: kbarggx end function kbargg_al <>= module function kbargg_al (x,alpha,eps,nf) result (kbarggx) real(default), intent(in) :: x, alpha, eps, nf real(default) :: kbarggx kbarggx = pgg_reg(x) * log(alpha*(one-x)/x) & + CA * log_plus_distr(x,eps) & - (gamma_g(nf) + k_g_al(alpha,nf) - CA * & five/6.0_default * pi**2 - CA * (log(alpha))**2) * & delta(x,eps) + & CA * two/(one -x)*log(alpha*(two-x)/(one+alpha-x)) if (x < (one-alpha)) then kbarggx = kbarggx - CA * two/(one-x) * log((two-x)/(one-x)) end if end function kbargg_al @ %def kbargg_al @ The $\tilde{K}$ flavor kernels in the presence of a phase-space slicing parameter, are: \begin{equation} \tilde{K}^{ab} (x,\alpha) = P^{qq, \text{reg}} (x) \log\frac{1-x}{\alpha} + .......... \end{equation} <>= public :: ktildeqq_al <>= module function ktildeqq_al (x,alpha,eps) result (ktildeqqx) real(default), intent(in) :: x, eps, alpha real(default) :: ktildeqqx end function ktildeqq_al <>= module function ktildeqq_al (x,alpha,eps) result (ktildeqqx) real(default), intent(in) :: x, eps, alpha real(default) :: ktildeqqx ktildeqqx = pqq_reg(x) * log((one-x)/alpha) + CF*( & - log2_plus_distr_al(x,alpha,eps) - Pi**2/three * delta(x,eps) & + (one+x**2)/(one-x) * log(min(one,(alpha/(one-x)))) & + two/(one-x) * log((one+alpha-x)/alpha)) if (x > (one-alpha)) then ktildeqqx = ktildeqqx - CF*two/(one-x)*log(two-x) end if end function ktildeqq_al @ %def ktildeqq_al @ This is a logarithmic $+$-distribution, $\left( \frac{\log((1-x)/x)}{1-x} \right)_+$. For the sampling, we need the integral over this function over the incomplete sampling interval $[0,1-\epsilon]$, which is $\log^2(x) + 2 Li_2(x) - \frac{\pi^2}{3}$. As this function is negative definite for $\epsilon > 0.1816$, we take a hard upper limit for that sampling parameter, irrespective of the fact what the user chooses. <>= public :: log_plus_distr <>= module function log_plus_distr (x,eps) result (lpd) real(default), intent(in) :: x, eps real(default) :: lpd, eps2 end function log_plus_distr <>= module function log_plus_distr (x,eps) result (lpd) real(default), intent(in) :: x, eps real(default) :: lpd, eps2 eps2 = min (eps, 0.1816_default) if (x > (1.0_default - eps2)) then lpd = ((log(eps2))**2 + two*Li2(eps2) - pi**2/three)/eps2 else lpd = two*log((one-x)/x)/(one-x) end if end function log_plus_distr @ %def log_plus_distr @ Logarithmic $+$-distribution, $2 \left( \frac{\log(1/(1-x))}{1-x} \right)_+$. <>= public :: log2_plus_distr <>= module function log2_plus_distr (x,eps) result (lpd) real(default), intent(in) :: x, eps real(default) :: lpd end function log2_plus_distr <>= module function log2_plus_distr (x,eps) result (lpd) real(default), intent(in) :: x, eps real(default) :: lpd if (x > (1.0_default - eps)) then lpd = - (log(eps))**2/eps else lpd = two*log(one/(one-x))/(one-x) end if end function log2_plus_distr @ %def log2_plus_distr @ Logarithmic $+$-distribution with phase-space slicing parameter, $2 \left( \frac{\log(1/(1-x))}{1-x} \right)_{1-\alpha}$. <>= public :: log2_plus_distr_al <>= module function log2_plus_distr_al (x,alpha,eps) result (lpd_al) real(default), intent(in) :: x, eps, alpha real(default) :: lpd_al end function log2_plus_distr_al <>= module function log2_plus_distr_al (x,alpha,eps) result (lpd_al) real(default), intent(in) :: x, eps, alpha real(default) :: lpd_al if ((one - alpha) >= (one - eps)) then lpd_al = zero call msg_fatal ('alpha and epsilon chosen wrongly') elseif (x < (one - alpha)) then lpd_al = 0 elseif (x > (1.0_default - eps)) then lpd_al = - ((log(eps))**2 - (log(alpha))**2)/eps else lpd_al = two*log(one/(one-x))/(one-x) end if end function log2_plus_distr_al @ %def log2_plus_distr_al @ \subsection{Splitting Functions} @ Analogue to the regularized distributions of the last subsection, we give here the unregularized splitting functions, relevant for the parton shower algorithm. We can use this unregularized version since there will be a cut-off $\epsilon$ that ensures that $\{z,1-z\}>\epsilon(t)$. This cut-off seperates resolvable from unresolvable emissions. [[p_xxx]] are the kernels that are summed over helicity: <>= public :: p_qqg public :: p_gqq public :: p_ggg @ $q\to q g$ <>= elemental module function p_qqg (z) result (P) real(default), intent(in) :: z real(default) :: P end function p_qqg <>= elemental module function p_qqg (z) result (P) real(default), intent(in) :: z real(default) :: P P = CF * (one + z**2) / (one - z) end function p_qqg @ $g\to q \bar{q}$ <>= elemental module function p_gqq (z) result (P) real(default), intent(in) :: z real(default) :: P end function p_gqq <>= elemental module function p_gqq (z) result (P) real(default), intent(in) :: z real(default) :: P P = TR * (z**2 + (one - z)**2) end function p_gqq @ $g\to g g$ <>= elemental module function p_ggg (z) result (P) real(default), intent(in) :: z real(default) :: P end function p_ggg <>= elemental module function p_ggg (z) result (P) real(default), intent(in) :: z real(default) :: P P = NC * ((one - z) / z + z / (one - z) + z * (one - z)) end function p_ggg @ %def p_qqg p_gqq p_ggg @ Analytically integrated splitting kernels: <>= public :: integral_over_p_qqg public :: integral_over_p_gqq public :: integral_over_p_ggg <>= pure module function integral_over_p_qqg (zmin, zmax) result (integral) real(default), intent(in) :: zmin, zmax real(default) :: integral end function integral_over_p_qqg pure module function integral_over_p_gqq (zmin, zmax) result (integral) real(default), intent(in) :: zmin, zmax real(default) :: integral end function integral_over_p_gqq pure module function integral_over_p_ggg (zmin, zmax) result (integral) real(default), intent(in) :: zmin, zmax real(default) :: integral end function integral_over_p_ggg <>= pure module function integral_over_p_qqg (zmin, zmax) result (integral) real(default), intent(in) :: zmin, zmax real(default) :: integral integral = (two / three) * (- zmax**2 + zmin**2 - & two * (zmax - zmin) + four * log((one - zmin) / (one - zmax))) end function integral_over_p_qqg pure module function integral_over_p_gqq (zmin, zmax) result (integral) real(default), intent(in) :: zmin, zmax real(default) :: integral integral = 0.5_default * ((two / three) * & (zmax**3 - zmin**3) - (zmax**2 - zmin**2) + (zmax - zmin)) end function integral_over_p_gqq pure module function integral_over_p_ggg (zmin, zmax) result (integral) real(default), intent(in) :: zmin, zmax real(default) :: integral integral = three * ((log(zmax) - two * zmax - & log(one - zmax) + zmax**2 / two - zmax**3 / three) - & (log(zmin) - zmin - zmin - log(one - zmin) + zmin**2 & / two - zmin**3 / three) ) end function integral_over_p_ggg @ %def integral_over_p_gqq integral_over_p_ggg integral_over_p_qqg @ We can also use (massless) helicity dependent splitting functions: <>= public :: p_qqg_pol @ $q_a\to q_b g_c$, the helicity of the quark is not changed by gluon emission and the gluon is preferably polarized in the branching plane ($l_c=1$): <>= elemental module function p_qqg_pol (z, l_a, l_b, l_c) result (P) real(default), intent(in) :: z integer, intent(in) :: l_a, l_b, l_c real(default) :: P end function p_qqg_pol <>= elemental module function p_qqg_pol (z, l_a, l_b, l_c) result (P) real(default), intent(in) :: z integer, intent(in) :: l_a, l_b, l_c real(default) :: P if (l_a /= l_b) then P = zero return end if if (l_c == -1) then P = one - z else P = (one + z)**2 / (one - z) end if P = P * CF end function p_qqg_pol @ \subsubsection{Mellin transforms of splitting functions} As Mellin transforms necessarily live in the complex plane, all functions are defined as complex functions: @ Splitting function $P_{qq}(N)$: <>= public :: pqqm <>= module function pqqm (n, c_f) result (pqq_m) integer, intent(in) :: n real(default), intent(in) :: c_f complex(default) :: pqq_m end function pqqm <>= module function pqqm (n, c_f) result (pqq_m) integer, intent(in) :: n real(default), intent(in) :: c_f complex(default) :: pqq_m pqq_m = three - four * (eulerc + & psic(cmplx(N+1,zero,kind=default))) + two/N/(N+1) end function pqqm @ %def pqqm @ \subsection{Top width} In order to produce sensible results, the widths have to be recomputed for each parameter and order. We start with the LO-expression for the top width given by the decay $t\,\to\,W^+,b$, cf. [[doi:10.1016/0550-3213(91)90530-B]]:\\ The analytic formula given there is \begin{equation*} \Gamma = \frac{G_F m_t^2}{16\sqrt{2}\pi} \left[\mathcal{F}_0(\varepsilon, \xi^{-1/2}) - \frac{2\alpha_s}{3\pi} \mathcal{F}_1 (\varepsilon, \xi^{-1/2})\right], \end{equation*} with \begin{align*} \mathcal{F}_0 &= \frac{\sqrt{\lambda}}{2} f_0, \\ f_0 &= 4\left[(1-\varepsilon^2)^2 + w^2(1+\varepsilon^2) - 2w^4\right], \\ \lambda = 1 + w^4 + \varepsilon^4 - 2(w^2 + \varepsilon^2 + w^2\varepsilon^2). \end{align*} Defining \begin{equation*} u_q = \frac{1 + \varepsilon^2 - w^2 - \lambda^{1/2}}{1 + \varepsilon^2 - w^2 + \lambda^{1/2}} \end{equation*} and \begin{equation*} u_w = \frac{1 - \varepsilon^2 + w^2 - \lambda^{1/2}}{1 - \varepsilon^2 + w^2 + \lambda^{1/2}} \end{equation*} the factor $\mathcal{F}_1$ can be expressed as \begin{align*} \mathcal{F}_1 = \frac{1}{2}f_0(1+\varepsilon^2-w^2) & \left[\pi^2 + 2Li_2(u_w) - 2Li_2(1-u_w) - 4Li_2(u_q) \right. \\ & -4Li_2(u_q u_w) + \log\left(\frac{1-u_q}{w^2}\right)\log(1-u_q) - \log^2(1-u_q u_w) \\ & \left.+\frac{1}{4}\log^2\left(\frac{w^2}{u_w}\right) - \log(u_w) \log\left[\frac{(1-u_q u_w)^2}{1-u_q}\right] -2\log(u_q)\log\left[(1-u_q)(1-u_q u_w)\right]\right] \\ & -\sqrt{\lambda}f_0(2\log(w) + 3\log(\varepsilon) - 2\log{\lambda}) \\ & +4(1-\varepsilon^2)\left[(1-\varepsilon^2)^2 + w^2(1+\varepsilon^2) - 4w^4\right]\log(u_w) \\ & \left[(3 - \varepsilon^2 + 11\varepsilon^4 - \varepsilon^6) + w^2(6 - 12\varepsilon^2 +2\varepsilon^4) - w^4(21 + 5\varepsilon^2) + 12w^6\right] \log(u_q) \\ & 6\sqrt{\lambda} (1-\varepsilon^2) (1 + \varepsilon^2 - w^2) \log(\varepsilon) + \sqrt{\lambda}\left[-5 + 22\varepsilon^2 - 5\varepsilon^4 - 9w^2(1+\varepsilon^2) + 6w^4\right]. \end{align*} @ <>= public :: top_width_sm_lo <>= elemental module function top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb) & result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb end function top_width_sm_lo <>= elemental module function top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb) & result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb real(default) :: kappa kappa = sqrt ((mtop**2 - (mw + mb)**2) * (mtop**2 - (mw - mb)**2)) gamma = alpha / four * mtop / (two * sinthw**2) * & vtb**2 * kappa / mtop**2 * & ((mtop**2 + mb**2) / (two * mtop**2) + & (mtop**2 - mb**2)**2 / (two * mtop**2 * mw**2) - & mw**2 / mtop**2) end function top_width_sm_lo @ %def top_width_sm_lo @ <>= public :: g_mu_from_alpha <>= elemental module function g_mu_from_alpha (alpha, mw, sinthw) result (g_mu) real(default) :: g_mu real(default), intent(in) :: alpha, mw, sinthw end function g_mu_from_alpha <>= elemental module function g_mu_from_alpha (alpha, mw, sinthw) result (g_mu) real(default) :: g_mu real(default), intent(in) :: alpha, mw, sinthw g_mu = pi * alpha / sqrt(two) / mw**2 / sinthw**2 end function g_mu_from_alpha @ %def g_mu_from_alpha @ <>= public :: alpha_from_g_mu <>= elemental module function alpha_from_g_mu (g_mu, mw, sinthw) result (alpha) real(default) :: alpha real(default), intent(in) :: g_mu, mw, sinthw end function alpha_from_g_mu <>= elemental module function alpha_from_g_mu (g_mu, mw, sinthw) result (alpha) real(default) :: alpha real(default), intent(in) :: g_mu, mw, sinthw alpha = g_mu * sqrt(two) / pi * mw**2 * sinthw**2 end function alpha_from_g_mu @ %def alpha_from_g_mu @ Cf. (3.3)-(3.7) in [[1207.5018]]. <>= public :: top_width_sm_qcd_nlo_massless_b <>= elemental module function top_width_sm_qcd_nlo_massless_b & (alpha, sinthw, vtb, mtop, mw, alphas) result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, alphas end function top_width_sm_qcd_nlo_massless_b <>= elemental module function top_width_sm_qcd_nlo_massless_b & (alpha, sinthw, vtb, mtop, mw, alphas) result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, alphas real(default) :: prefac, g_mu, w2 g_mu = g_mu_from_alpha (alpha, mw, sinthw) prefac = g_mu * mtop**3 * vtb**2 / (16 * sqrt(two) * pi) w2 = mw**2 / mtop**2 gamma = prefac * (f0 (w2) - (two * alphas) / (3 * Pi) * f1 (w2)) end function top_width_sm_qcd_nlo_massless_b @ %def top_width_sm_qcd_nlo_massless_b @ <>= public :: f0 <>= elemental module function f0 (w2) result (f) real(default) :: f real(default), intent(in) :: w2 end function f0 <>= elemental module function f0 (w2) result (f) real(default) :: f real(default), intent(in) :: w2 f = two * (one - w2)**2 * (1 + 2 * w2) end function f0 @ %def f0 @ <>= public :: f1 <>= elemental module function f1 (w2) result (f) real(default) :: f real(default), intent(in) :: w2 end function f1 <>= elemental module function f1 (w2) result (f) real(default) :: f real(default), intent(in) :: w2 f = f0 (w2) * (pi**2 + two * Li2 (w2) - two * Li2 (one - w2)) & + four * w2 * (one - w2 - two * w2**2) * log (w2) & + two * (one - w2)**2 * (five + four * w2) * log (one - w2) & - (one - w2) * (five + 9 * w2 - 6 * w2**2) end function f1 @ %def f1 @ Basically, the same as above but with $m_b$ dependence, cf. Jezabek / Kuehn 1989. <>= public :: top_width_sm_qcd_nlo_jk <>= elemental module function top_width_sm_qcd_nlo_jk & (alpha, sinthw, vtb, mtop, mw, mb, alphas) result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alphas end function top_width_sm_qcd_nlo_jk <>= elemental module function top_width_sm_qcd_nlo_jk & (alpha, sinthw, vtb, mtop, mw, mb, alphas) result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alphas real(default) :: prefac, g_mu, eps2, i_xi g_mu = g_mu_from_alpha (alpha, mw, sinthw) prefac = g_mu * mtop**3 * vtb**2 / (16 * sqrt(two) * pi) eps2 = (mb / mtop)**2 i_xi = (mw / mtop)**2 gamma = prefac * (ff0 (eps2, i_xi) - & (two * alphas) / (3 * Pi) * ff1 (eps2, i_xi)) end function top_width_sm_qcd_nlo_jk @ %def top_width_sm_qcd_nlo_jk @ Same as above, $m_b > 0$, with the slightly different implementation (2.6) of arXiv:1204.1513v1 by Campbell and Ellis. <>= public :: top_width_sm_qcd_nlo_ce <>= elemental module function top_width_sm_qcd_nlo_ce & (alpha, sinthw, vtb, mtop, mw, mb, alpha_s) result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alpha_s end function top_width_sm_qcd_nlo_ce <>= elemental module function top_width_sm_qcd_nlo_ce & (alpha, sinthw, vtb, mtop, mw, mb, alpha_s) result (gamma) real(default) :: gamma real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alpha_s real(default) :: pm, pp, p0, p3 real(default) :: yw, yp real(default) :: W0, Wp, Wm, w2 real(default) :: beta2 real(default) :: f real(default) :: g_mu, gamma0 beta2 = (mb / mtop)**2 w2 = (mw / mtop)**2 p0 = (one - w2 + beta2) / two p3 = sqrt (lambda (one, w2, beta2)) / two pp = p0 + p3 pm = p0 - p3 W0 = (one + w2 - beta2) / two Wp = W0 + p3 Wm = W0 - p3 yp = log (pp / pm) / two yw = log (Wp / Wm) / two f = (one - beta2)**2 + w2 * (one + beta2) - two * w2**2 g_mu = g_mu_from_alpha (alpha, mw, sinthw) gamma0 = g_mu * mtop**3 * vtb**2 / (8 * pi * sqrt(two)) gamma = gamma0 * alpha_s / twopi * CF * & (8 * f * p0 * (Li2(one - pm) - Li2(one - pp) - two * Li2(one - pm / pp) & + yp * log((four * p3**2) / (pp**2 * Wp)) + yw * log (pp)) & + four * (one - beta2) * ((one - beta2)**2 + w2 * (one + beta2) - four * w2**2) * yw & + (3 - beta2 + 11 * beta2**2 - beta2**3 + w2 * (6 - 12 * beta2 + two * beta2**2) & - w2**2 * (21 + 5 * beta2) + 12 * w2**3) * yp & + 8 * f * p3 * log (sqrt(w2) / (four * p3**2)) & + 6 * (one - four * beta2 + 3 * beta2**2 + w2 * (3 + beta2) - four * w2**2) * p3 * log(sqrt(beta2)) & + (5 - 22 * beta2 + 5 * beta2**2 + 9 * w2 * (one + beta2) - 6 * w2**2) * p3) end function top_width_sm_qcd_nlo_ce @ %def top_width_sm_qcd_nlo_ce @ <>= public :: ff0 <>= elemental module function ff0 (eps2, w2) result (f) real(default) :: f real(default), intent(in) :: eps2, w2 end function ff0 <>= elemental module function ff0 (eps2, w2) result (f) real(default) :: f real(default), intent(in) :: eps2, w2 f = one / two * sqrt(ff_lambda (eps2, w2)) * ff_f0 (eps2, w2) end function ff0 @ %def ff0 @ <>= public :: ff_f0 <>= elemental module function ff_f0 (eps2, w2) result (f) real(default) :: f real(default), intent(in) :: eps2, w2 end function ff_f0 <>= elemental module function ff_f0 (eps2, w2) result (f) real(default) :: f real(default), intent(in) :: eps2, w2 f = four * ((1 - eps2)**2 + w2 * (1 + eps2) - 2 * w2**2) end function ff_f0 @ %def ff_f0 @ <>= public :: ff_lambda <>= elemental module function ff_lambda (eps2, w2) result (l) real(default) :: l real(default), intent(in) :: eps2, w2 end function ff_lambda <>= elemental module function ff_lambda (eps2, w2) result (l) real(default) :: l real(default), intent(in) :: eps2, w2 l = one + w2**2 + eps2**2 - two * (w2 + eps2 + w2 * eps2) end function ff_lambda @ %def ff_lambda @ <>= public :: ff1 <>= elemental module function ff1 (eps2, w2) result (f) real(default) :: f real(default), intent(in) :: eps2, w2 end function ff1 <>= elemental module function ff1 (eps2, w2) result (f) real(default) :: f real(default), intent(in) :: eps2, w2 real(default) :: uq, uw, sq_lam, fff sq_lam = sqrt (ff_lambda (eps2, w2)) fff = ff_f0 (eps2, w2) uw = (one - eps2 + w2 - sq_lam) / & (one - eps2 + w2 + sq_lam) uq = (one + eps2 - w2 - sq_lam) / & (one + eps2 - w2 + sq_lam) f = one / two * fff * (one + eps2 - w2) * & (pi**2 + two * Li2 (uw) - two * Li2 (one - uw) - four * Li2 (uq) & - four * Li2 (uq * uw) + log ((one - uq) / w2) * log (one - uq) & - log (one - uq * uw)**2 + one / four * log (w2 / uw)**2 & - log (uw) * log ((one - uq * uw)**2 / (one - uq)) & - two * log (uq) * log ((one - uq) * (one - uq * uw))) & - sq_lam * fff * (two * log (sqrt (w2)) & + three * log (sqrt (eps2)) - two * log (sq_lam**2)) & + four * (one - eps2) * ((one - eps2)**2 + w2 * (one + eps2) & - four * w2**2) * log (uw) & + (three - eps2 + 11 * eps2**2 - eps2**3 + w2 * & (6 - 12 * eps2 + 2 * eps2**2) - w2**2 * (21 + five * eps2) & + 12 * w2**3) * log (uq) & + 6 * sq_lam * (one - eps2) * & (one + eps2 - w2) * log (sqrt (eps2)) & + sq_lam * (- five + 22 * eps2 - five * eps2**2 - 9 * w2 * & (one + eps2) + 6 * w2**2) end function ff1 @ %def ff1 @ \subsection{Unit tests} Test module, followed by the corresponding implementation module. <<[[sm_physics_ut.f90]]>>= <> module sm_physics_ut use unit_tests use sm_physics_uti <> <> contains <> end module sm_physics_ut @ %def sm_physics_ut @ <<[[sm_physics_uti.f90]]>>= <> module sm_physics_uti <> use numeric_utils use format_defs, only: FMT_15 use constants use sm_physics <> <> contains <> end module sm_physics_uti @ %def sm_physics_ut @ API: driver for the unit tests below. <>= public :: sm_physics_test <>= subroutine sm_physics_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine sm_physics_test @ %def sm_physics_test @ \subsubsection{Splitting functions} <>= call test (sm_physics_1, "sm_physics_1", & "Splitting functions", & u, results) <>= public :: sm_physics_1 <>= subroutine sm_physics_1 (u) integer, intent(in) :: u real(default) :: z = 0.75_default write (u, "(A)") "* Test output: sm_physics_1" write (u, "(A)") "* Purpose: check analytic properties" write (u, "(A)") write (u, "(A)") "* Splitting functions:" write (u, "(A)") call assert (u, vanishes (p_qqg_pol (z, +1, -1, +1)), "+-+") call assert (u, vanishes (p_qqg_pol (z, +1, -1, -1)), "+--") call assert (u, vanishes (p_qqg_pol (z, -1, +1, +1)), "-++") call assert (u, vanishes (p_qqg_pol (z, -1, +1, -1)), "-+-") !call assert (u, nearly_equal ( & !p_qqg_pol (z, +1, +1, -1) + p_qqg_pol (z, +1, +1, +1), & !p_qqg (z)), "pol sum") write (u, "(A)") write (u, "(A)") "* Test output end: sm_physics_1" end subroutine sm_physics_1 @ %def sm_physics_1 @ \subsubsection{Top width} <>= call test(sm_physics_2, "sm_physics_2", & "Top width", u, results) <>= public :: sm_physics_2 <>= subroutine sm_physics_2 (u) integer, intent(in) :: u real(default) :: mtop, mw, mz, mb, g_mu, sinthw, alpha, vtb, gamma0 real(default) :: w2, alphas, alphas_mz, gamma1 write (u, "(A)") "* Test output: sm_physics_2" write (u, "(A)") "* Purpose: Check different top width computations" write (u, "(A)") write (u, "(A)") "* Values from [[1207.5018]] (massless b)" mtop = 172.0 mw = 80.399 mz = 91.1876 mb = zero mb = 0.00001 g_mu = 1.16637E-5 sinthw = sqrt(one - mw**2 / mz**2) alpha = alpha_from_g_mu (g_mu, mw, sinthw) vtb = one w2 = mw**2 / mtop**2 write (u, "(A)") "* Check Li2 implementation" call assert_equal (u, Li2(w2), 0.2317566263959552_default, & "Li2(w2)", rel_smallness=1.0E-6_default) call assert_equal (u, Li2(one - w2), 1.038200378935867_default, & "Li2(one - w2)", rel_smallness=1.0E-6_default) write (u, "(A)") "* Check LO Width" gamma0 = top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb) call assert_equal (u, gamma0, 1.4655_default, & "top_width_sm_lo", rel_smallness=1.0E-5_default) alphas = zero gamma0 = top_width_sm_qcd_nlo_massless_b & (alpha, sinthw, vtb, mtop, mw, alphas) call assert_equal (u, gamma0, 1.4655_default, & "top_width_sm_qcd_nlo_massless_b", rel_smallness=1.0E-5_default) gamma0 = top_width_sm_qcd_nlo_jk & (alpha, sinthw, vtb, mtop, mw, mb, alphas) call assert_equal (u, gamma0, 1.4655_default, & "top_width_sm_qcd_nlo", rel_smallness=1.0E-5_default) write (u, "(A)") "* Check NLO Width" alphas_mz = 0.1202 ! MSTW2008 NLO fit alphas = running_as (mtop, alphas_mz, mz, 1, 5.0_default) gamma1 = top_width_sm_qcd_nlo_massless_b & (alpha, sinthw, vtb, mtop, mw, alphas) call assert_equal (u, gamma1, 1.3376_default, rel_smallness=1.0E-4_default) gamma1 = top_width_sm_qcd_nlo_jk & (alpha, sinthw, vtb, mtop, mw, mb, alphas) ! It would be nice to get one more significant digit but the ! expression is numerically rather unstable for mb -> 0 call assert_equal (u, gamma1, 1.3376_default, rel_smallness=1.0E-3_default) write (u, "(A)") "* Values from threshold validation (massive b)" alpha = one / 125.924 ! ee = 0.315901 ! cw = 0.881903 ! v = 240.024 mtop = 172.0 ! This is the value for M1S !!! mb = 4.2 sinthw = 0.47143 mz = 91.188 mw = 80.419 call assert_equal (u, sqrt(one - mw**2 / mz**2), sinthw, & "sinthw", rel_smallness=1.0E-6_default) write (u, "(A)") "* Check LO Width" gamma0 = top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb) call assert_equal (u, gamma0, 1.5386446_default, & "gamma0", rel_smallness=1.0E-7_default) alphas = zero gamma0 = top_width_sm_qcd_nlo_jk & (alpha, sinthw, vtb, mtop, mw, mb, alphas) call assert_equal (u, gamma0, 1.5386446_default, & "gamma0", rel_smallness=1.0E-7_default) write (u, "(A)") "* Check NLO Width" alphas_mz = 0.118 !(Z pole, NLL running to mu_h) alphas = running_as (mtop, alphas_mz, mz, 1, 5.0_default) write (u, "(A," // FMT_15 // ")") "* alphas = ", alphas gamma1 = top_width_sm_qcd_nlo_jk & (alpha, sinthw, vtb, mtop, mw, mb, alphas) write (u, "(A," // FMT_15 // ")") "* Gamma1 = ", gamma1 mb = zero gamma1 = top_width_sm_qcd_nlo_massless_b & (alpha, sinthw, vtb, mtop, mw, alphas) alphas = running_as (mtop, alphas_mz, mz, 1, 5.0_default) write (u, "(A," // FMT_15 // ")") "* Gamma1(mb=0) = ", gamma1 write (u, "(A)") write (u, "(A)") "* Test output end: sm_physics_2" end subroutine sm_physics_2 @ %def sm_physics_2 @ \subsubsection{Special functions} <>= call test (sm_physics_3, "sm_physics_3", & "Special functions", & u, results) <>= public :: sm_physics_3 <>= subroutine sm_physics_3 (u) integer, intent(in) :: u complex(default) :: z1 = (0.75_default, 1.25_default) complex(default) :: z2 = (1.33_default, 11.25_default) complex(default) :: psiz real(default) :: x1 = 0.045847700_default real(default) :: psir write (u, "(A)") "* Test output: sm_physics_3" write (u, "(A)") "* Purpose: check special functions" write (u, "(A)") write (u, "(A)") "* Complex digamma function:" write (u, "(A)") psiz = psic (z1) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z1 = ", & real(z1), aimag(z1) write (u, "(1x,A,'(',F7.5,',',F7.5,')')") " psi(z1) = ", & real(psiz), aimag(psiz) psiz = psic (z2) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z2 = ", & real(z2), aimag(z2) write (u, "(1x,A,'(',F7.5,',',F7.5,')')") " psi(z2) = ", & real(psiz), aimag(psiz) write (u, "(A)") write (u, "(A)") "* Complex polygamma function:" write (u, "(A)") psiz = psim (z1,1) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z1 = ", & real(z1), aimag(z1) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z1,1) = ", & real(psiz), aimag(psiz) psiz = psim (z2,1) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z2 = ", & real(z2), aimag(z2) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z2,1) = ", & real(psiz), aimag(psiz) write (u, "(A)") psiz = psim (z1,2) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z1 = ", & real(z1), aimag(z1) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z1,2) = ", & real(psiz), aimag(psiz) psiz = psim (z2,2) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z2 = ", & real(z2), aimag(z2) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z2,2) = ", & real(psiz), aimag(psiz) write (u, "(A)") psiz = psim (z1,3) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z1 = ", & real(z1), aimag(z1) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z1,3) = ", & real(psiz), aimag(psiz) psiz = psim (z2,3) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z2 = ", & real(z2), aimag(z2) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z2,3) = ", & real(psiz), aimag(psiz) write (u, "(A)") psiz = psim (z1,4) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z1 = ", & real(z1), aimag(z1) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z1,4) = ", & real(psiz), aimag(psiz) psiz = psim (z2,4) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z2 = ", & real(z2), aimag(z2) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z2,4) = ", & real(psiz), aimag(psiz) write (u, "(A)") psiz = psim (z1,5) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z1 = ", & real(z1), aimag(z1) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z1,5) = ", & real(psiz), aimag(psiz) psiz = psim (z2,5) write (u, "(1x,A,'(',F5.2,',',F5.2,')')") " z2 = ", & real(z2), aimag(z2) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " psi(z2,5) = ", & real(psiz), aimag(psiz) write (u, "(A)") write (u, "(A)") "* Real polygamma function:" write (u, "(A)") psir = psimr (x1,1) write (u, "(1x,A,'(',F8.5,')')") " x1 = ", x1 write (u, "(1x,A,'(',F8.4,')')") " psir = ", psir write (u, "(A)") write (u, "(A)") "* Generalized Nielsen polylogarithm:" write (u, "(A)") write (u, "(1x,A,F8.5)") " S(1,1,0) = ", & nielsen(1,1,0._default) write (u, "(1x,A,F8.5)") " S(1,1,-1) = ", & nielsen(1,1,-1._default) write (u, "(1x,A,F8.5)") " S(1,2,-1) = ", & nielsen(1,2,-1._default) write (u, "(1x,A,F8.5)") " S(2,1,-1) = ", & nielsen(2,1,-1._default) write (u, "(1x,A,F8.5)") " S(1,3,-1) = ", & nielsen(1,3,-1._default) write (u, "(1x,A,F8.5)") " S(2,2,-1) = ", & nielsen(2,2,-1._default) write (u, "(1x,A,F8.5)") " S(3,1,-1) = ", & nielsen(3,1,-1._default) write (u, "(1x,A,F8.5)") " S(1,4,-1) = ", & nielsen(1,4,-1._default) write (u, "(1x,A,F8.5)") " S(2,3,-1) = ", & nielsen(2,3,-1._default) write (u, "(1x,A,F8.5)") " S(3,2,-1) = ", & nielsen(3,2,-1._default) write (u, "(1x,A,F8.5)") " S(4,1,-1) = ", & nielsen(4,1,-1._default) write (u, "(1x,A,F8.5)") " S(1,1,0.2) = ", & nielsen(1,1,0.2_default) write (u, "(1x,A,F8.5)") " S(1,2,0.2) = ", & nielsen(1,2,0.2_default) write (u, "(1x,A,F8.5)") " S(2,1,0.2) = ", & nielsen(2,1,0.2_default) write (u, "(1x,A,F8.5)") " S(1,3,0.2) = ", & nielsen(1,3,0.2_default) write (u, "(1x,A,F8.5)") " S(2,2,0.2) = ", & nielsen(2,2,0.2_default) write (u, "(1x,A,F8.5)") " S(3,1,0.2) = ", & nielsen(3,1,0.2_default) write (u, "(1x,A,F8.5)") " S(1,4,0.2) = ", & nielsen(1,4,0.2_default) write (u, "(1x,A,F8.5)") " S(2,3,0.2) = ", & nielsen(2,3,0.2_default) write (u, "(1x,A,F8.5)") " S(3,2,0.2) = ", & nielsen(3,2,0.2_default) write (u, "(1x,A,F8.5)") " S(4,1,0.2) = ", & nielsen(4,1,0.2_default) write (u, "(1x,A,F8.5)") " S(1,1,1) = ", & nielsen(1,1,1._default) write (u, "(1x,A,F8.5)") " S(1,2,1) = ", & nielsen(1,2,1._default) write (u, "(1x,A,F8.5)") " S(2,1,1) = ", & nielsen(2,1,1._default) write (u, "(1x,A,F8.5)") " S(1,3,1) = ", & nielsen(1,3,1._default) write (u, "(1x,A,F8.5)") " S(2,2,1) = ", & nielsen(2,2,1._default) write (u, "(1x,A,F8.5)") " S(3,1,1) = ", & nielsen(3,1,1._default) write (u, "(1x,A,F8.5)") " S(1,4,1) = ", & nielsen(1,4,1._default) write (u, "(1x,A,F8.5)") " S(2,3,1) = ", & nielsen(2,3,1._default) write (u, "(1x,A,F8.5)") " S(3,2,1) = ", & nielsen(3,2,1._default) write (u, "(1x,A,F8.5)") " S(4,1,1) = ", & nielsen(4,1,1._default) write (u, "(1x,A,F8.5)") " S(1,1,0.75) = ", & nielsen(1,1,0.75_default) write (u, "(1x,A,F8.5)") " S(1,3,0.75) = ", & nielsen(1,3,0.75_default) write (u, "(1x,A,F8.5)") " S(1,4,0.75) = ", & nielsen(1,4,0.75_default) write (u, "(1x,A,F8.5)") " S(2,2,0.75) = ", & nielsen(2,2,0.75_default) write (u, "(1x,A,'(',F8.5,',',F8.5,')')") " S(1,1,2) = ", & real(cnielsen(1,1,3._default)), & aimag(cnielsen(1,1,3._default)) write (u, "(A)") write (u, "(A)") "* Dilog, trilog, polylog:" write (u, "(A)") write (u, "(1x,A,F8.5)") " Li2(0.66) = ", & dilog(0.66_default) write (u, "(1x,A,F8.5)") " Li3(0.66) = ", & trilog(0.66_default) write (u, "(1x,A,F8.5)") " Poly(4,0.66) = ", & polylog(4,0.66_default) write (u, "(A)") write (u, "(A)") "* Test output end: sm_physics_3" end subroutine sm_physics_3 @ %def sm_physics_3 @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{QCD Coupling} We provide various distinct implementations of the QCD coupling. In this module, we define an abstract data type and three implementations: fixed, running with $\alpha_s(M_Z)$ as input, and running with $\Lambda_{\text{QCD}}$ as input. We use the functions defined above in the module [[sm_physics]] but provide a common interface. Later modules may define additional implementations. <<[[sm_qcd.f90]]>>= <> module sm_qcd <> use physics_defs <> <> <> <> interface <> end interface end module sm_qcd @ %def sm_qcd @ <<[[sm_qcd_sub.f90]]>>= <> submodule (sm_qcd) sm_qcd_s use io_units use format_defs, only: FMT_12 use numeric_utils use diagnostics use md5 use sm_physics implicit none contains <> end submodule sm_qcd_s @ %def sm_qcd_s @ \subsection{Coupling: Abstract Data Type} This is the abstract version of the QCD coupling implementation. <>= public :: alpha_qcd_t <>= type, abstract :: alpha_qcd_t contains <> end type alpha_qcd_t @ %def alpha_qcd_t @ There must be an output routine. <>= procedure (alpha_qcd_write), deferred :: write <>= abstract interface subroutine alpha_qcd_write (object, unit) import class(alpha_qcd_t), intent(in) :: object integer, intent(in), optional :: unit end subroutine alpha_qcd_write end interface @ %def alpha_qcd_write @ This method computes the running coupling, given a certain scale. All parameters (reference value, order of the approximation, etc.) must be set before calling this. <>= procedure (alpha_qcd_get), deferred :: get <>= abstract interface function alpha_qcd_get (alpha_qcd, scale) result (alpha) import class(alpha_qcd_t), intent(in) :: alpha_qcd real(default), intent(in) :: scale real(default) :: alpha end function alpha_qcd_get end interface @ %def alpha_qcd_get @ \subsection{Fixed Coupling} In this version, the $\alpha_s$ value is fixed, the [[scale]] argument of the [[get]] method is ignored. There is only one parameter, the value. By default, this is the value at $M_Z$. <>= public :: alpha_qcd_fixed_t <>= type, extends (alpha_qcd_t) :: alpha_qcd_fixed_t real(default) :: val = ALPHA_QCD_MZ_REF contains <> end type alpha_qcd_fixed_t @ %def alpha_qcd_fixed_t @ Output. <>= procedure :: write => alpha_qcd_fixed_write <>= module subroutine alpha_qcd_fixed_write (object, unit) class(alpha_qcd_fixed_t), intent(in) :: object integer, intent(in), optional :: unit end subroutine alpha_qcd_fixed_write <>= module subroutine alpha_qcd_fixed_write (object, unit) class(alpha_qcd_fixed_t), intent(in) :: object integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(3x,A)") "QCD parameters (fixed coupling):" write (u, "(5x,A," // FMT_12 // ")") "alpha = ", object%val end subroutine alpha_qcd_fixed_write @ %def alpha_qcd_fixed_write @ Calculation: the scale is ignored in this case. <>= procedure :: get => alpha_qcd_fixed_get <>= module function alpha_qcd_fixed_get (alpha_qcd, scale) result (alpha) class(alpha_qcd_fixed_t), intent(in) :: alpha_qcd real(default), intent(in) :: scale real(default) :: alpha end function alpha_qcd_fixed_get <>= module function alpha_qcd_fixed_get (alpha_qcd, scale) result (alpha) class(alpha_qcd_fixed_t), intent(in) :: alpha_qcd real(default), intent(in) :: scale real(default) :: alpha alpha = alpha_qcd%val end function alpha_qcd_fixed_get @ %def alpha_qcd_fixed_get @ \subsection{Running Coupling} In this version, the $\alpha_s$ value runs relative to the value at a given reference scale. There are two parameters: the value of this scale (default: $M_Z$), the value of $\alpha_s$ at this scale, and the number of effective flavors. Furthermore, we have the order of the approximation. <>= public :: alpha_qcd_from_scale_t <>= type, extends (alpha_qcd_t) :: alpha_qcd_from_scale_t real(default) :: mu_ref = MZ_REF real(default) :: ref = ALPHA_QCD_MZ_REF integer :: order = 0 integer :: nf = 5 contains <> end type alpha_qcd_from_scale_t @ %def alpha_qcd_from_scale_t @ Output. <>= procedure :: write => alpha_qcd_from_scale_write <>= module subroutine alpha_qcd_from_scale_write (object, unit) class(alpha_qcd_from_scale_t), intent(in) :: object integer, intent(in), optional :: unit end subroutine alpha_qcd_from_scale_write <>= module subroutine alpha_qcd_from_scale_write (object, unit) class(alpha_qcd_from_scale_t), intent(in) :: object integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(3x,A)") "QCD parameters (running coupling):" write (u, "(5x,A," // FMT_12 // ")") "Scale mu = ", object%mu_ref write (u, "(5x,A," // FMT_12 // ")") "alpha(mu) = ", object%ref write (u, "(5x,A,I0)") "LL order = ", object%order write (u, "(5x,A,I0)") "N(flv) = ", object%nf end subroutine alpha_qcd_from_scale_write @ %def alpha_qcd_from_scale_write @ Calculation: here, we call the function for running $\alpha_s$ that was defined in [[sm_physics]] above. The function does not take into account thresholds, so the number of flavors should be the correct one for the chosen scale. Normally, this should be the $Z$ boson mass. <>= procedure :: get => alpha_qcd_from_scale_get <>= module function alpha_qcd_from_scale_get (alpha_qcd, scale) result (alpha) class(alpha_qcd_from_scale_t), intent(in) :: alpha_qcd real(default), intent(in) :: scale real(default) :: alpha end function alpha_qcd_from_scale_get <>= module function alpha_qcd_from_scale_get (alpha_qcd, scale) result (alpha) class(alpha_qcd_from_scale_t), intent(in) :: alpha_qcd real(default), intent(in) :: scale real(default) :: alpha alpha = running_as (scale, alpha_qcd%ref, alpha_qcd%mu_ref, & alpha_qcd%order, real (alpha_qcd%nf, kind=default)) end function alpha_qcd_from_scale_get @ %def alpha_qcd_from_scale_get @ \subsection{Running Coupling, determined by $\Lambda_{\text{QCD}}$} In this version, the inputs are the value $\Lambda_{\text{QCD}}$ and the order of the approximation. <>= public :: alpha_qcd_from_lambda_t <>= type, extends (alpha_qcd_t) :: alpha_qcd_from_lambda_t real(default) :: lambda = LAMBDA_QCD_REF integer :: order = 0 integer :: nf = 5 contains <> end type alpha_qcd_from_lambda_t @ %def alpha_qcd_from_lambda_t @ Output. <>= procedure :: write => alpha_qcd_from_lambda_write <>= module subroutine alpha_qcd_from_lambda_write (object, unit) class(alpha_qcd_from_lambda_t), intent(in) :: object integer, intent(in), optional :: unit end subroutine alpha_qcd_from_lambda_write <>= module subroutine alpha_qcd_from_lambda_write (object, unit) class(alpha_qcd_from_lambda_t), intent(in) :: object integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(3x,A)") "QCD parameters (Lambda_QCD as input):" write (u, "(5x,A," // FMT_12 // ")") "Lambda_QCD = ", object%lambda write (u, "(5x,A,I0)") "LL order = ", object%order write (u, "(5x,A,I0)") "N(flv) = ", object%nf end subroutine alpha_qcd_from_lambda_write @ %def alpha_qcd_from_lambda_write @ Calculation: here, we call the second function for running $\alpha_s$ that was defined in [[sm_physics]] above. The $\Lambda$ value should be the one that is appropriate for the chosen number of effective flavors. Again, thresholds are not incorporated. <>= procedure :: get => alpha_qcd_from_lambda_get <>= module function alpha_qcd_from_lambda_get (alpha_qcd, scale) result (alpha) class(alpha_qcd_from_lambda_t), intent(in) :: alpha_qcd real(default), intent(in) :: scale real(default) :: alpha end function alpha_qcd_from_lambda_get <>= module function alpha_qcd_from_lambda_get (alpha_qcd, scale) result (alpha) class(alpha_qcd_from_lambda_t), intent(in) :: alpha_qcd real(default), intent(in) :: scale real(default) :: alpha alpha = running_as_lam (real (alpha_qcd%nf, kind=default), scale, & alpha_qcd%lambda, alpha_qcd%order) end function alpha_qcd_from_lambda_get @ %def alpha_qcd_from_lambda_get @ \subsection{QCD Wrapper type} We could get along with a polymorphic QCD type, but a monomorphic wrapper type with a polymorphic component is easier to handle and probably safer (w.r.t.\ compiler bugs). However, we keep the object transparent, so we can set the type-specific parameters directly (by a [[dispatch]] routine). <>= public :: qcd_t <>= type :: qcd_t class(alpha_qcd_t), allocatable :: alpha character(32) :: md5sum = "" integer :: n_f = -1 contains <> end type qcd_t @ %def qcd_t @ Output. We first print the polymorphic [[alpha]] which contains a headline, then any extra components. <>= procedure :: write => qcd_write <>= module subroutine qcd_write (qcd, unit, show_md5sum) class(qcd_t), intent(in) :: qcd integer, intent(in), optional :: unit logical, intent(in), optional :: show_md5sum end subroutine qcd_write <>= module subroutine qcd_write (qcd, unit, show_md5sum) class(qcd_t), intent(in) :: qcd integer, intent(in), optional :: unit logical, intent(in), optional :: show_md5sum logical :: show_md5 integer :: u u = given_output_unit (unit); if (u < 0) return show_md5 = .true.; if (present (show_md5sum)) show_md5 = show_md5sum if (allocated (qcd%alpha)) then call qcd%alpha%write (u) else write (u, "(3x,A)") "QCD parameters (coupling undefined)" end if if (show_md5 .and. qcd%md5sum /= "") & write (u, "(5x,A,A,A)") "md5sum = '", qcd%md5sum, "'" end subroutine qcd_write @ %def qcd_write @ Compute an MD5 sum for the [[alpha_s]] setup. This is done by writing them to a temporary file, using a standard format. <>= procedure :: compute_alphas_md5sum => qcd_compute_alphas_md5sum <>= module subroutine qcd_compute_alphas_md5sum (qcd) class(qcd_t), intent(inout) :: qcd integer :: unit end subroutine qcd_compute_alphas_md5sum <>= module subroutine qcd_compute_alphas_md5sum (qcd) class(qcd_t), intent(inout) :: qcd integer :: unit if (allocated (qcd%alpha)) then unit = free_unit () open (unit, status="scratch", action="readwrite") call qcd%alpha%write (unit) rewind (unit) qcd%md5sum = md5sum (unit) close (unit) end if end subroutine qcd_compute_alphas_md5sum @ %def qcd_compute_alphas_md5sum @ @ Retrieve the MD5 sum of the qcd setup. <>= procedure :: get_md5sum => qcd_get_md5sum <>= module function qcd_get_md5sum (qcd) result (md5sum) character(32) :: md5sum class(qcd_t), intent(inout) :: qcd end function qcd_get_md5sum <>= module function qcd_get_md5sum (qcd) result (md5sum) character(32) :: md5sum class(qcd_t), intent(inout) :: qcd md5sum = qcd%md5sum end function qcd_get_md5sum @ %def qcd_get_md5sum @ \subsection{Unit tests} Test module, followed by the corresponding implementation module. <<[[sm_qcd_ut.f90]]>>= <> module sm_qcd_ut use unit_tests use sm_qcd_uti <> <> contains <> end module sm_qcd_ut @ %def sm_qcd_ut @ <<[[sm_qcd_uti.f90]]>>= <> module sm_qcd_uti <> use physics_defs, only: MZ_REF use sm_qcd <> <> contains <> end module sm_qcd_uti @ %def sm_qcd_ut @ API: driver for the unit tests below. <>= public :: sm_qcd_test <>= subroutine sm_qcd_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine sm_qcd_test @ %def sm_qcd_test @ \subsubsection{QCD Coupling} We check two different implementations of the abstract QCD coupling. <>= call test (sm_qcd_1, "sm_qcd_1", & "running alpha_s", & u, results) <>= public :: sm_qcd_1 <>= subroutine sm_qcd_1 (u) integer, intent(in) :: u type(qcd_t) :: qcd write (u, "(A)") "* Test output: sm_qcd_1" write (u, "(A)") "* Purpose: compute running alpha_s" write (u, "(A)") write (u, "(A)") "* Fixed:" write (u, "(A)") allocate (alpha_qcd_fixed_t :: qcd%alpha) call qcd%compute_alphas_md5sum () call qcd%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha_s (mz) =", & qcd%alpha%get (MZ_REF) write (u, "(1x,A,F10.7)") "alpha_s (1 TeV) =", & qcd%alpha%get (1000._default) write (u, *) deallocate (qcd%alpha) write (u, "(A)") "* Running from MZ (LO):" write (u, "(A)") allocate (alpha_qcd_from_scale_t :: qcd%alpha) call qcd%compute_alphas_md5sum () call qcd%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha_s (mz) =", & qcd%alpha%get (MZ_REF) write (u, "(1x,A,F10.7)") "alpha_s (1 TeV) =", & qcd%alpha%get (1000._default) write (u, *) write (u, "(A)") "* Running from MZ (NLO):" write (u, "(A)") select type (alpha => qcd%alpha) type is (alpha_qcd_from_scale_t) alpha%order = 1 end select call qcd%compute_alphas_md5sum () call qcd%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha_s (mz) =", & qcd%alpha%get (MZ_REF) write (u, "(1x,A,F10.7)") "alpha_s (1 TeV) =", & qcd%alpha%get (1000._default) write (u, *) write (u, "(A)") "* Running from MZ (NNLO):" write (u, "(A)") select type (alpha => qcd%alpha) type is (alpha_qcd_from_scale_t) alpha%order = 2 end select call qcd%compute_alphas_md5sum () call qcd%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha_s (mz) =", & qcd%alpha%get (MZ_REF) write (u, "(1x,A,F10.7)") "alpha_s (1 TeV) =", & qcd%alpha%get (1000._default) write (u, *) deallocate (qcd%alpha) write (u, "(A)") "* Running from Lambda_QCD (LO):" write (u, "(A)") allocate (alpha_qcd_from_lambda_t :: qcd%alpha) call qcd%compute_alphas_md5sum () call qcd%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha_s (mz) =", & qcd%alpha%get (MZ_REF) write (u, "(1x,A,F10.7)") "alpha_s (1 TeV) =", & qcd%alpha%get (1000._default) write (u, *) write (u, "(A)") "* Running from Lambda_QCD (NLO):" write (u, "(A)") select type (alpha => qcd%alpha) type is (alpha_qcd_from_lambda_t) alpha%order = 1 end select call qcd%compute_alphas_md5sum () call qcd%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha_s (mz) =", & qcd%alpha%get (MZ_REF) write (u, "(1x,A,F10.7)") "alpha_s (1 TeV) =", & qcd%alpha%get (1000._default) write (u, *) write (u, "(A)") "* Running from Lambda_QCD (NNLO):" write (u, "(A)") select type (alpha => qcd%alpha) type is (alpha_qcd_from_lambda_t) alpha%order = 2 end select call qcd%compute_alphas_md5sum () call qcd%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha_s (mz) =", & qcd%alpha%get (MZ_REF) write (u, "(1x,A,F10.7)") "alpha_s (1 TeV) =", & qcd%alpha%get (1000._default) write (u, "(A)") write (u, "(A)") "* Test output end: sm_qcd_1" end subroutine sm_qcd_1 @ %def sm_qcd_1 @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{QED Coupling} On the surface similar to the QCD coupling module but much simpler. Only a fixed QED couping $\alpha_\text{em}$ is allowed. Can be extended later if we want to enable a running of $\alpha_\text{em}$ as well. <<[[sm_qed.f90]]>>= <> module sm_qed <> use physics_defs <> <> <> <> interface <> end interface end module sm_qed @ %def sm_qed @ <<[[sm_qed_sub.f90]]>>= <> submodule (sm_qed) sm_qed_s use io_units use format_defs, only: FMT_12 use md5 use sm_physics implicit none contains <> end submodule sm_qed_s @ %def sm_qed_s @ \subsection{Coupling: Abstract Data Type} This is the abstract version of the QCD coupling implementation. <>= public :: alpha_qed_t <>= type, abstract :: alpha_qed_t contains <> end type alpha_qed_t @ %def alpha_qed_t @ There must be an output routine. <>= procedure (alpha_qed_write), deferred :: write <>= abstract interface subroutine alpha_qed_write (object, unit) import class(alpha_qed_t), intent(in) :: object integer, intent(in), optional :: unit end subroutine alpha_qed_write end interface @ %def alpha_qed_write @ This method computes the running coupling, given a certain scale. All parameters (reference value, order of the approximation, etc.) must be set before calling this. <>= procedure (alpha_qed_get), deferred :: get <>= abstract interface function alpha_qed_get (alpha_qed, scale) result (alpha) import class(alpha_qed_t), intent(in) :: alpha_qed real(default), intent(in) :: scale real(default) :: alpha end function alpha_qed_get end interface @ %def alpha_qed_get @ \subsection{Fixed Coupling} In this version, the $\alpha$ value is fixed, the [[scale]] argument of the [[get]] method is ignored. There is only one parameter, the value. The default depends on the electroweak scheme chosen in the model. <>= public :: alpha_qed_fixed_t <>= type, extends (alpha_qed_t) :: alpha_qed_fixed_t real(default) :: val = ALPHA_QED_ME_REF contains <> end type alpha_qed_fixed_t @ %def alpha_qed_fixed_t @ Output. <>= procedure :: write => alpha_qed_fixed_write <>= module subroutine alpha_qed_fixed_write (object, unit) class(alpha_qed_fixed_t), intent(in) :: object integer, intent(in), optional :: unit end subroutine alpha_qed_fixed_write <>= module subroutine alpha_qed_fixed_write (object, unit) class(alpha_qed_fixed_t), intent(in) :: object integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(3x,A)") "QED parameters (fixed coupling):" write (u, "(5x,A," // FMT_12 // ")") "alpha = ", object%val end subroutine alpha_qed_fixed_write @ %def alpha_qed_fixed_write @ Calculation: the scale is ignored in this case. <>= procedure :: get => alpha_qed_fixed_get <>= module function alpha_qed_fixed_get (alpha_qed, scale) result (alpha) class(alpha_qed_fixed_t), intent(in) :: alpha_qed real(default), intent(in) :: scale real(default) :: alpha end function alpha_qed_fixed_get <>= module function alpha_qed_fixed_get (alpha_qed, scale) result (alpha) class(alpha_qed_fixed_t), intent(in) :: alpha_qed real(default), intent(in) :: scale real(default) :: alpha alpha = alpha_qed%val end function alpha_qed_fixed_get @ %def alpha_qed_fixed_get @ \subsection{Running Coupling} In this version, the $\alpha$ value runs relative to the value at a given reference scale. There are two parameters: the value of this scale (default: $M_Z$), the value of $\alpha$ at this scale, and the number of effective flavors. Furthermore, we have the order of the approximation. <>= public :: alpha_qed_from_scale_t <>= type, extends (alpha_qed_t) :: alpha_qed_from_scale_t real(default) :: mu_ref = ME_REF real(default) :: ref = ALPHA_QED_ME_REF integer :: order = 0 integer :: nf = 5 integer :: nlep = 1 logical :: analytic = .true. contains <> end type alpha_qed_from_scale_t @ %def alpha_qed_from_scale_t @ Output. <>= procedure :: write => alpha_qed_from_scale_write <>= module subroutine alpha_qed_from_scale_write (object, unit) class(alpha_qed_from_scale_t), intent(in) :: object integer, intent(in), optional :: unit end subroutine alpha_qed_from_scale_write <>= module subroutine alpha_qed_from_scale_write (object, unit) class(alpha_qed_from_scale_t), intent(in) :: object integer, intent(in), optional :: unit integer :: u u = given_output_unit (unit); if (u < 0) return write (u, "(3x,A)") "QED parameters (running coupling):" write (u, "(5x,A," // FMT_12 // ")") "Scale mu = ", object%mu_ref write (u, "(5x,A," // FMT_12 // ")") "alpha(mu) = ", object%ref write (u, "(5x,A,I0)") "LL order = ", object%order write (u, "(5x,A,I0)") "N(flv) = ", object%nf write (u, "(5x,A,I0)") "N(lep) = ", object%nlep write (u, "(5x,A,L1)") "analytic = ", object%analytic end subroutine alpha_qed_from_scale_write @ %def alpha_qed_from_scale_write @ Calculation: here, we call the function for running $\alpha_s$ that was defined in [[sm_physics]] above. The function does not take into account thresholds, so the number of flavors should be the correct one for the chosen scale. Normally, this should be the $Z$ boson mass. <>= procedure :: get => alpha_qed_from_scale_get <>= module function alpha_qed_from_scale_get (alpha_qed, scale) result (alpha) class(alpha_qed_from_scale_t), intent(in) :: alpha_qed real(default), intent(in) :: scale real(default) :: alpha end function alpha_qed_from_scale_get <>= module function alpha_qed_from_scale_get (alpha_qed, scale) result (alpha) class(alpha_qed_from_scale_t), intent(in) :: alpha_qed real(default), intent(in) :: scale real(default) :: alpha if (alpha_qed%analytic) then alpha = running_alpha (scale, alpha_qed%ref, alpha_qed%mu_ref, & alpha_qed%order, alpha_qed%nf, alpha_qed%nlep) else alpha = running_alpha_num (scale, alpha_qed%ref, alpha_qed%mu_ref, & alpha_qed%order, alpha_qed%nf, alpha_qed%nlep) end if end function alpha_qed_from_scale_get @ %def alpha_qed_from_scale_get @ \subsection{QED type} This module is similar to [[qcd_t]], defining the type [[qed_t]]. It stores the [[alpha_qed_t]] type which is either constant or a running $\alpha$ with different options. <>= public :: qed_t <>= type :: qed_t class(alpha_qed_t), allocatable :: alpha character(32) :: md5sum = "" integer :: n_f = -1 integer :: n_lep = -1 contains <> end type qed_t @ %def qed_t Output. We first print the polymorphic [[alpha]] which contains a headline, then any extra components. <>= procedure :: write => qed_write <>= module subroutine qed_write (qed, unit, show_md5sum) class(qed_t), intent(in) :: qed integer, intent(in), optional :: unit logical, intent(in), optional :: show_md5sum end subroutine qed_write <>= module subroutine qed_write (qed, unit, show_md5sum) class(qed_t), intent(in) :: qed integer, intent(in), optional :: unit logical, intent(in), optional :: show_md5sum logical :: show_md5 integer :: u u = given_output_unit (unit); if (u < 0) return show_md5 = .true.; if (present (show_md5sum)) show_md5 = show_md5sum if (allocated (qed%alpha)) then call qed%alpha%write (u) else write (u, "(3x,A)") "QED parameters (coupling undefined)" end if if (show_md5 .and. qed%md5sum /= "") & write (u, "(5x,A,A,A)") "md5sum = '", qed%md5sum, "'" end subroutine qed_write @ % def qed_write @ Compute an MD5 sum for the [[alpha]] setup. This is done by writing them to a temporary file, using a standard format. <>= procedure :: compute_alpha_md5sum => qed_compute_alpha_md5sum <>= module subroutine qed_compute_alpha_md5sum (qed) class(qed_t), intent(inout) :: qed integer :: unit end subroutine qed_compute_alpha_md5sum <>= module subroutine qed_compute_alpha_md5sum (qed) class(qed_t), intent(inout) :: qed integer :: unit if (allocated (qed%alpha)) then unit = free_unit () open (unit, status="scratch", action="readwrite") call qed%alpha%write (unit) rewind (unit) qed%md5sum = md5sum (unit) close (unit) end if end subroutine qed_compute_alpha_md5sum @ %def qed_compute_alphas_md5sum @ @ Retrieve the MD5 sum of the qed setup. <>= procedure :: get_md5sum => qed_get_md5sum <>= module function qed_get_md5sum (qed) result (md5sum) character(32) :: md5sum class(qed_t), intent(inout) :: qed end function qed_get_md5sum <>= module function qed_get_md5sum (qed) result (md5sum) character(32) :: md5sum class(qed_t), intent(inout) :: qed md5sum = qed%md5sum end function qed_get_md5sum @ %def qed_get_md5sum @ \subsection{Unit tests} Test module, followed by the corresponding implementation module. <<[[sm_qed_ut.f90]]>>= <> module sm_qed_ut use unit_tests use sm_qed_uti <> <> contains <> end module sm_qed_ut @ %def sm_qed_ut @ <<[[sm_qed_uti.f90]]>>= <> module sm_qed_uti <> use physics_defs, only: ME_REF use sm_qed <> <> contains <> end module sm_qed_uti @ %def sm_qed_ut @ API: driver for the unit tests below. <>= public :: sm_qed_test <>= subroutine sm_qed_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine sm_qed_test @ %def sm_qed_test @ \subsubsection{QED Coupling} We check two different implementations of the abstract QED coupling. <>= call test (sm_qed_1, "sm_qed_1", & "running alpha", & u, results) <>= public :: sm_qed_1 <>= subroutine sm_qed_1 (u) integer, intent(in) :: u type(qed_t) :: qed write (u, "(A)") "* Test output: sm_qed_1" write (u, "(A)") "* Purpose: compute running alpha" write (u, "(A)") write (u, "(A)") "* Fixed:" write (u, "(A)") allocate (alpha_qed_fixed_t :: qed%alpha) call qed%compute_alpha_md5sum () call qed%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha (me) =", & qed%alpha%get (ME_REF) write (u, "(1x,A,F10.7)") "alpha (10 GeV) =", & qed%alpha%get (10._default) write (u, "(1x,A,F10.7)") "alpha (1 TeV) =", & qed%alpha%get (1000._default) write (u, *) deallocate (qed%alpha) write (u, "(A)") "* Running from me (LO):" write (u, "(A)") allocate (alpha_qed_from_scale_t :: qed%alpha) call qed%compute_alpha_md5sum () call qed%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha (me) =", & qed%alpha%get (ME_REF) write (u, "(1x,A,F10.7)") "alpha (10 GeV) =", & qed%alpha%get (10._default) write (u, "(1x,A,F10.7)") "alpha (1 TeV) =", & qed%alpha%get (1000._default) write (u, *) write (u, "(A)") "* Running from me (NLO, analytic):" write (u, "(A)") select type (alpha => qed%alpha) type is (alpha_qed_from_scale_t) alpha%order = 1 end select call qed%compute_alpha_md5sum () call qed%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha (me) =", & qed%alpha%get (ME_REF) write (u, "(1x,A,F10.7)") "alpha (10 GeV) =", & qed%alpha%get (10._default) write (u, "(1x,A,F10.7)") "alpha (1 TeV) =", & qed%alpha%get (1000._default) write (u, *) write (u, "(A)") "* Running from me (NLO, numeric):" write (u, "(A)") select type (alpha => qed%alpha) type is (alpha_qed_from_scale_t) alpha%order = 1 alpha%analytic = .false. end select call qed%compute_alpha_md5sum () call qed%write (u) write (u, *) write (u, "(1x,A,F10.7)") "alpha (me) =", & qed%alpha%get (ME_REF) write (u, "(1x,A,F10.7)") "alpha (10 GeV) =", & qed%alpha%get (10._default) write (u, "(1x,A,F10.7)") "alpha (1 TeV) =", & qed%alpha%get (1000._default) write (u, *) deallocate (qed%alpha) write (u, "(A)") write (u, "(A)") "* Test output end: sm_qed_1" end subroutine sm_qed_1 @ %def sm_qed_1 @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Shower algorithms} <<[[shower_algorithms.f90]]>>= <> module shower_algorithms <> <> <> <> interface <> end interface end module shower_algorithms @ %def shower_algorithms <<[[shower_algorithms_sub.f90]]>>= <> submodule (shower_algorithms) shower_algorithms_s use diagnostics use constants implicit none contains <> <> end submodule shower_algorithms_s @ %def shower_algorithms_s @ @ We want to generate emission variables [[x]]$\in\mathds{R}^d$ proportional to \begin{align} &\quad f(x)\; \Delta(f, h(x)) \quad\text{with}\\ \Delta(f, H) &= \exp\left\{-\int\text{d}^d x'f(x') \Theta(h(x') - H)\right\} \end{align} The [[true_function]] $f$ is however too complicated and we are only able to generate [[x]] according to the [[overestimator]] $F$. This algorithm is described in Appendix B of 0709.2092 and is proven e.g.~in 1211.7204 and hep-ph/0606275. Intuitively speaking, we overestimate the emission probability and can therefore set [[scale_max = scale]] if the emission is rejected. <>= module subroutine generate_vetoed (x, overestimator, true_function, & sudakov, inverse_sudakov, scale_min) real(default), dimension(:), intent(out) :: x !class(rng_t), intent(inout) :: rng procedure(XXX_function), pointer, intent(in) :: overestimator, true_function procedure(sudakov_p), pointer, intent(in) :: sudakov, inverse_sudakov real(default), intent(in) :: scale_min end subroutine generate_vetoed <>= module subroutine generate_vetoed (x, overestimator, true_function, & sudakov, inverse_sudakov, scale_min) real(default), dimension(:), intent(out) :: x !class(rng_t), intent(inout) :: rng procedure(XXX_function), pointer, intent(in) :: overestimator, true_function procedure(sudakov_p), pointer, intent(in) :: sudakov, inverse_sudakov real(default), intent(in) :: scale_min real(default) :: random, scale_max, scale scale_max = inverse_sudakov (one) do while (scale_max > scale_min) !call rng%generate (random) scale = inverse_sudakov (random * sudakov (scale_max)) call generate_on_hypersphere (x, overestimator, scale) !call rng%generate (random) if (random < true_function (x) / overestimator (x)) then return !!! accept x end if scale_max = scale end do end subroutine generate_vetoed @ %def generate_vetoed @ <>= subroutine generate_on_hypersphere (x, overestimator, scale) real(default), dimension(:), intent(out) :: x procedure(XXX_function), pointer, intent(in) :: overestimator real(default), intent(in) :: scale call msg_bug ("generate_on_hypersphere: not implemented") end subroutine generate_on_hypersphere @ %def generate_on_hypersphere @ <>= interface pure function XXX_function (x) import real(default) :: XXX_function real(default), dimension(:), intent(in) :: x end function XXX_function end interface interface pure function sudakov_p (x) import real(default) :: sudakov_p real(default), intent(in) :: x end function sudakov_p end interface @ \subsection{Unit tests} (Currently unused.) <>= public :: shower_algorithms_test <>= subroutine shower_algorithms_test (u, results) integer, intent(in) :: u type(test_results_t), intent(inout) :: results <> end subroutine shower_algorithms_test @ %def shower_algorithms_test @ \subsubsection{Splitting functions} <>= call test (shower_algorithms_1, "shower_algorithms_1", & "veto technique", & u, results) <>= subroutine shower_algorithms_1 (u) integer, intent(in) :: u write (u, "(A)") "* Test output: shower_algorithms_1" write (u, "(A)") "* Purpose: check veto technique" write (u, "(A)") write (u, "(A)") "* Splitting functions:" write (u, "(A)") !call assert (u, vanishes (p_qqg_pol (z, +1, -1, +1))) !call assert (u, nearly_equal ( & !p_qqg_pol (z, +1, +1, -1) + p_qqg_pol (z, +1, +1, +1), !p_qqg (z)) write (u, "(A)") write (u, "(A)") "* Test output end: shower_algorithms_1" end subroutine shower_algorithms_1 @ %def shower_algorithms_1 Index: trunk/src/physics/Makefile.am =================================================================== --- trunk/src/physics/Makefile.am (revision 8863) +++ trunk/src/physics/Makefile.am (revision 8864) @@ -1,229 +1,233 @@ ## Makefile.am -- Makefile for WHIZARD ## ## Process this file with automake to produce Makefile.in # # Copyright (C) 1999-2023 by # Wolfgang Kilian # Thorsten Ohl # Juergen Reuter # with contributions from # cf. main AUTHORS file # # WHIZARD is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # WHIZARD is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ######################################################################## ## The files in this directory implement physics definitions and functions ## for use in the WHIZARD generator. ## We create a library which is still to be combined with auxiliary libs. noinst_LTLIBRARIES = libphysics.la check_LTLIBRARIES = libphysics_ut.la libphysics_la_SOURCES = \ $(PHYSICS_MODULES) \ $(PHYSICS_SUBMODULES) PHYSICS_MODULES = \ physics_defs.f90 \ c_particles.f90 \ lorentz.f90 \ + kinematics_vars.f90 \ phs_points.f90 \ sm_physics.f90 \ sm_qcd.f90 \ sm_qed.f90 \ shower_algorithms.f90 PHYSICS_SUBMODULES = \ physics_defs_sub.f90 \ c_particles_sub.f90 \ lorentz_sub.f90 \ + kinematics_vars_sub.f90 \ phs_points_sub.f90 \ sm_physics_sub.f90 \ sm_qcd_sub.f90 \ sm_qed_sub.f90 \ shower_algorithms_sub.f90 libphysics_ut_la_SOURCES = \ sm_physics_uti.f90 sm_physics_ut.f90 \ sm_qcd_uti.f90 sm_qcd_ut.f90 \ sm_qed_uti.f90 sm_qed_ut.f90 \ lorentz_uti.f90 lorentz_ut.f90 \ + kinematics_vars_uti.f90 kinematics_vars_ut.f90 \ phs_points_uti.f90 phs_points_ut.f90 ## Omitting this would exclude it from the distribution dist_noinst_DATA = physics.nw # Modules and installation # Dump module names into file Modules execmoddir = $(fmoddir)/whizard nodist_execmod_HEADERS = \ ${PHYSICS_MODULES:.f90=.$(FCMOD)} # Submodules must not be included here libphysics_Modules = \ ${PHYSICS_MODULES:.f90=} \ ${libphysics_ut_la_SOURCES:.f90=} Modules: Makefile @for module in $(libphysics_Modules); do \ echo $$module >> $@.new; \ done @if diff $@ $@.new -q >/dev/null; then \ rm $@.new; \ else \ mv $@.new $@; echo "Modules updated"; \ fi BUILT_SOURCES = Modules ## Fortran module dependencies # Get module lists from other directories module_lists = \ ../basics/Modules \ ../utilities/Modules \ ../testing/Modules \ ../system/Modules \ ../combinatorics/Modules $(module_lists): $(MAKE) -C `dirname $@` Modules Module_dependencies.sed: $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES) Module_dependencies.sed: $(module_lists) @rm -f $@ echo 's/, *only:.*//' >> $@ echo 's/, *&//' >> $@ echo 's/, *.*=>.*//' >> $@ echo 's/$$/.lo/' >> $@ for list in $(module_lists); do \ dir="`dirname $$list`"; \ for mod in `cat $$list`; do \ echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \ done \ done DISTCLEANFILES = Module_dependencies.sed # The following line just says # include Makefile.depend # but in a portable fashion (depending on automake's AM_MAKE_INCLUDE @am__include@ @am__quote@Makefile.depend@am__quote@ Makefile.depend: Module_dependencies.sed Makefile.depend: $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES) @rm -f $@ for src in $^; do \ module="`basename $$src | sed 's/\.f[90][0358]//'`"; \ grep '^ *use ' $$src \ | grep -v '!NODEP!' \ | sed -e 's/^ *use */'$$module'.lo: /' \ -f Module_dependencies.sed; \ done > $@ DISTCLEANFILES += Makefile.depend # Fortran90 module files are generated at the same time as object files .lo.$(FCMOD): @: # touch $@ AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics ######################################################################## # For the moment, the submodule dependencies will be hard-coded physics_defs_sub.lo: physics_defs.lo c_particles_sub.lo: c_particles.lo lorentz_sub.lo: lorentz.lo +kinematics_vars_sub.lo: kinematics_vars.lo phs_points_sub.lo: phs_points.lo sm_physics_sub.lo: sm_physics.lo sm_qcd_sub.lo: sm_qcd.lo sm_qed_sub.lo: sm_qed.lo shower_algorithms_sub.lo: shower_algorithms.lo ######################################################################## ## Default Fortran compiler options ## Profiling if FC_USE_PROFILING AM_FCFLAGS += $(FCFLAGS_PROFILING) endif ## OpenMP if FC_USE_OPENMP AM_FCFLAGS += $(FCFLAGS_OPENMP) endif # MPI if FC_USE_MPI AM_FCFLAGS += $(FCFLAGS_MPI) endif ######################################################################## ## Non-standard targets and dependencies ## (Re)create F90 sources from NOWEB source. if NOWEB_AVAILABLE PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw physics.stamp: $(PRELUDE) $(srcdir)/physics.nw $(POSTLUDE) @rm -f physics.tmp @touch physics.tmp for src in $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES); do \ $(NOTANGLE) -R[[$$src]] $^ | $(CPIF) $$src; \ done @mv -f physics.tmp physics.stamp $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES): physics.stamp ## Recover from the removal of $@ @if test -f $@; then :; else \ rm -f physics.stamp; \ $(MAKE) $(AM_MAKEFLAGS) physics.stamp; \ fi endif ######################################################################## ## Non-standard cleanup tasks ## Remove sources that can be recreated using NOWEB if NOWEB_AVAILABLE maintainer-clean-noweb: -rm -f *.f90 *.c endif .PHONY: maintainer-clean-noweb ## Remove those sources also if builddir and srcdir are different if NOWEB_AVAILABLE clean-noweb: test "$(srcdir)" != "." && rm -f *.f90 *.c || true endif .PHONY: clean-noweb ## Remove F90 module files clean-local: clean-noweb -rm -f physics.stamp physics.tmp -rm -f *.$(FCMOD) if FC_SUBMODULES -rm -f *.smod *.sub endif ## Remove backup files maintainer-clean-backup: -rm -f *~ .PHONY: maintainer-clean-backup ## Register additional clean targets maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup Index: trunk/src/main/main.nw =================================================================== --- trunk/src/main/main.nw (revision 8863) +++ trunk/src/main/main.nw (revision 8864) @@ -1,2349 +1,2358 @@ % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*- % WHIZARD main code as NOWEB source \includemodulegraph{main} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Main Program} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Tools for the command line} We do not intent to be very smart here, but this module provides a few small tools that simplify dealing with the command line. The [[unquote_value]] subroutine handles an option value that begins with a single/double quote character. It swallows extra option strings until it finds a value that ends with another quote character. The returned string consists of all argument strings between quotes, concatenated by blanks (with a leading blank). Note that more complex patterns, such as quoted or embedded quotes, or multiple blanks, are not accounted for. <<[[cmdline_options.f90]]>>= <> module cmdline_options <> use diagnostics <> public :: init_options public :: no_option_value public :: get_option_value <> abstract interface subroutine msg end subroutine msg end interface procedure (msg), pointer :: print_usage => null () contains subroutine init_options (usage_msg) procedure (msg) :: usage_msg print_usage => usage_msg end subroutine init_options subroutine no_option_value (option, value) type(string_t), intent(in) :: option, value if (value /= "") then call msg_error (" Option '" // char (option) // "' should have no value") end if end subroutine no_option_value function get_option_value (i, option, value) result (string) type(string_t) :: string integer, intent(inout) :: i type(string_t), intent(in) :: option type(string_t), intent(in), optional :: value character(CMDLINE_ARG_LEN) :: arg_value integer :: arg_len, arg_status logical :: has_value if (present (value)) then has_value = value /= "" else has_value = .false. end if if (has_value) then call unquote_value (i, option, value, string) else i = i + 1 call get_command_argument (i, arg_value, arg_len, arg_status) select case (arg_status) case (0) case (-1) call msg_error (" Option value truncated: '" // arg_value // "'") case default call print_usage () call msg_fatal (" Option '" // char (option) // "' needs a value") end select select case (arg_value(1:1)) case ("-") call print_usage () call msg_fatal (" Option '" // char (option) // "' needs a value") end select call unquote_value (i, option, var_str (trim (arg_value)), string) end if end function get_option_value subroutine unquote_value (i, option, value, string) integer, intent(inout) :: i type(string_t), intent(in) :: option type(string_t), intent(in) :: value type(string_t), intent(out) :: string character(1) :: quote character(CMDLINE_ARG_LEN) :: arg_value integer :: arg_len, arg_status quote = extract (value, 1, 1) select case (quote) case ("'", '"') string = "" arg_value = extract (value, 2) arg_len = len_trim (value) APPEND_QUOTED: do if (extract (arg_value, arg_len, arg_len) == quote) then string = string // " " // extract (arg_value, 1, arg_len-1) exit APPEND_QUOTED else string = string // " " // trim (arg_value) i = i + 1 call get_command_argument (i, arg_value, arg_len, arg_status) select case (arg_status) case (0) case (-1) call msg_error (" Quoted option value truncated: '" & // char (string) // "'") case default call print_usage () call msg_fatal (" Option '" // char (option) & // "': unterminated quoted value") end select end if end do APPEND_QUOTED case default string = value end select end subroutine unquote_value end module cmdline_options @ %def init_options @ %def no_option_value @ %def get_option_value @ %def cmdline_options @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Driver program} The main program handles command options, initializes the environment, and runs WHIZARD in a particular mode (interactive, file, standard input). This is also used in the C interface: <>= integer, parameter :: CMDLINE_ARG_LEN = 1000 @ %def CMDLINE_ARG_LEN @ The actual main program: <<[[main.f90]]>>= <> program main <> use system_dependencies use diagnostics use ifiles use os_interface use rt_data, only: show_description_of_string, show_tex_descriptions use whizard use cmdline_options use features <> implicit none <> !!! (WK 02/2016) Interface for the separate external routine below interface subroutine print_usage () end subroutine print_usage end interface ! Main program variable declarations character(CMDLINE_ARG_LEN) :: arg character(2) :: option type(string_t) :: long_option, value integer :: i, j, arg_len, arg_status logical :: look_for_options logical :: interactive logical :: banner type(string_t) :: job_id, files, this, model, default_lib, library, libraries type(string_t) :: logfile, query_string type(paths_t) :: paths type(string_t) :: pack_arg, unpack_arg type(string_t), dimension(:), allocatable :: pack_args, unpack_args type(string_t), dimension(:), allocatable :: tmp_strings logical :: rebuild_library logical :: rebuild_phs, rebuild_grids, rebuild_events logical :: recompile_library type(ifile_t) :: commands type(string_t) :: command, cmdfile integer :: cmdfile_unit logical :: cmdfile_exists type(whizard_options_t), allocatable :: options type(whizard_t), allocatable, target :: whizard_instance ! Exit status logical :: quit = .false. integer :: quit_code = 0 ! Initial values look_for_options = .true. interactive = .false. job_id = "" files = "" model = "SM" default_lib = "default_lib" library = "" libraries = "" banner = .true. logging = .true. msg_level = RESULT logfile = "whizard.log" rebuild_library = .false. rebuild_phs = .false. rebuild_grids = .false. rebuild_events = .false. recompile_library = .false. call paths_init (paths) <> ! Read and process options call init_options (print_usage) i = 0 SCAN_CMDLINE: do i = i + 1 call get_command_argument (i, arg, arg_len, arg_status) select case (arg_status) case (0) case (-1) call msg_error (" Command argument truncated: '" // arg // "'") case default exit SCAN_CMDLINE end select if (look_for_options) then select case (arg(1:2)) case ("--") value = trim (arg) call split (value, long_option, "=") select case (char (long_option)) case ("--version") call no_option_value (long_option, value) call print_version (); stop case ("--help") call no_option_value (long_option, value) call print_usage (); stop case ("--prefix") paths%prefix = get_option_value (i, long_option, value) cycle scan_cmdline case ("--exec-prefix") paths%exec_prefix = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--bindir") paths%bindir = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--libdir") paths%libdir = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--includedir") paths%includedir = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--datarootdir") paths%datarootdir = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--libtool") paths%libtool = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--lhapdfdir") paths%lhapdfdir = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--check") call print_usage () call msg_fatal ("Option --check not supported & &(for unit tests, run whizard_ut instead)") case ("--show-config") call no_option_value (long_option, value) call print_features (); stop case ("--execute") command = get_option_value (i, long_option, value) call ifile_append (commands, command) cycle SCAN_CMDLINE case ("--file") cmdfile = get_option_value (i, long_option, value) inquire (file=char(cmdfile), exist=cmdfile_exists) if (cmdfile_exists) then open (newunit=cmdfile_unit, file=char(cmdfile), & action="read", status="old") call ifile_append (commands, cmdfile_unit) close (cmdfile_unit) else call msg_error & ("Sindarin file '" // char (cmdfile) // "' not found") end if cycle SCAN_CMDLINE case ("--interactive") call no_option_value (long_option, value) interactive = .true. cycle SCAN_CMDLINE case ("--job-id") job_id = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--library") library = get_option_value (i, long_option, value) libraries = libraries // " " // library cycle SCAN_CMDLINE case ("--no-library") call no_option_value (long_option, value) default_lib = "" library = "" libraries = "" cycle SCAN_CMDLINE case ("--localprefix") paths%localprefix = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--logfile") logfile = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--no-logfile") call no_option_value (long_option, value) logfile = "" cycle SCAN_CMDLINE case ("--logging") call no_option_value (long_option, value) logging = .true. cycle SCAN_CMDLINE case ("--no-logging") call no_option_value (long_option, value) logging = .false. cycle SCAN_CMDLINE case ("--query") call no_option_value (long_option, value) query_string = get_option_value (i, long_option, value) call show_description_of_string (query_string) call exit (0) case ("--generate-variables-tex") call no_option_value (long_option, value) call show_tex_descriptions () call exit (0) case ("--debug") call no_option_value (long_option, value) call set_debug_levels (get_option_value (i, long_option, value)) cycle SCAN_CMDLINE case ("--debug2") call no_option_value (long_option, value) call set_debug2_levels (get_option_value (i, long_option, value)) cycle SCAN_CMDLINE case ("--single-event") call no_option_value (long_option, value) single_event = .true. cycle SCAN_CMDLINE case ("--banner") call no_option_value (long_option, value) banner = .true. cycle SCAN_CMDLINE case ("--no-banner") call no_option_value (long_option, value) banner = .false. cycle SCAN_CMDLINE case ("--pack") pack_arg = get_option_value (i, long_option, value) if (allocated (pack_args)) then call move_alloc (from=pack_args, to=tmp_strings) allocate (pack_args (size (tmp_strings)+1)) pack_args(1:size(tmp_strings)) = tmp_strings else allocate (pack_args (1)) end if pack_args(size(pack_args)) = pack_arg cycle SCAN_CMDLINE case ("--unpack") unpack_arg = get_option_value (i, long_option, value) if (allocated (unpack_args)) then call move_alloc (from=unpack_args, to=tmp_strings) allocate (unpack_args (size (tmp_strings)+1)) unpack_args(1:size(tmp_strings)) = tmp_strings else allocate (unpack_args (1)) end if unpack_args(size(unpack_args)) = unpack_arg cycle SCAN_CMDLINE case ("--model") model = get_option_value (i, long_option, value) cycle SCAN_CMDLINE case ("--no-model") call no_option_value (long_option, value) model = "" cycle SCAN_CMDLINE case ("--rebuild") call no_option_value (long_option, value) rebuild_library = .true. rebuild_phs = .true. rebuild_grids = .true. rebuild_events = .true. cycle SCAN_CMDLINE case ("--no-rebuild") call no_option_value (long_option, value) rebuild_library = .false. recompile_library = .false. rebuild_phs = .false. rebuild_grids = .false. rebuild_events = .false. cycle SCAN_CMDLINE case ("--rebuild-library") call no_option_value (long_option, value) rebuild_library = .true. cycle SCAN_CMDLINE case ("--rebuild-phase-space") call no_option_value (long_option, value) rebuild_phs = .true. cycle SCAN_CMDLINE case ("--rebuild-grids") call no_option_value (long_option, value) rebuild_grids = .true. cycle SCAN_CMDLINE case ("--rebuild-events") call no_option_value (long_option, value) rebuild_events = .true. cycle SCAN_CMDLINE case ("--recompile") call no_option_value (long_option, value) recompile_library = .true. rebuild_grids = .true. cycle SCAN_CMDLINE case ("--write-syntax-tables") call no_option_value (long_option, value) call init_syntax_tables () call write_syntax_tables () call final_syntax_tables () stop cycle SCAN_CMDLINE case default call print_usage () call msg_fatal ("Option '" // trim (arg) // "' not recognized") end select end select select case (arg(1:1)) case ("-") j = 1 if (len_trim (arg) == 1) then look_for_options = .false. else SCAN_SHORT_OPTIONS: do j = j + 1 if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS option = "-" // arg(j:j) select case (option) case ("-V") call print_version (); stop case ("-?", "-h") call print_usage (); stop case ("-e") command = get_option_value (i, var_str (option)) call ifile_append (commands, command) cycle SCAN_CMDLINE case ("-f") cmdfile = get_option_value (i, var_str (option)) inquire (file=char(cmdfile), exist=cmdfile_exists) if (cmdfile_exists) then open (newunit=cmdfile_unit, file=char(cmdfile), & action="read", status="old") call ifile_append (commands, cmdfile_unit) close (cmdfile_unit) else call msg_error ("Sindarin file '" & // char (cmdfile) // "' not found") end if cycle SCAN_CMDLINE case ("-i") interactive = .true. cycle SCAN_SHORT_OPTIONS case ("-J") if (j == len_trim (arg)) then job_id = get_option_value (i, var_str (option)) else job_id = trim (arg(j+1:)) end if cycle SCAN_CMDLINE case ("-l") if (j == len_trim (arg)) then library = get_option_value (i, var_str (option)) else library = trim (arg(j+1:)) end if libraries = libraries // " " // library cycle SCAN_CMDLINE case ("-L") if (j == len_trim (arg)) then logfile = get_option_value (i, var_str (option)) else logfile = trim (arg(j+1:)) end if cycle SCAN_CMDLINE case ("-m") if (j < len_trim (arg)) call msg_fatal & ("Option '" // option // "' needs a value") model = get_option_value (i, var_str (option)) cycle SCAN_CMDLINE case ("-q") call no_option_value (long_option, value) query_string = get_option_value (i, long_option, value) call show_description_of_string (query_string) call exit (0) case ("-r") rebuild_library = .true. rebuild_phs = .true. rebuild_grids = .true. rebuild_events = .true. cycle SCAN_SHORT_OPTIONS case default call print_usage () call msg_fatal & ("Option '" // option // "' not recognized") end select end do SCAN_SHORT_OPTIONS end if case default files = files // " " // trim (arg) end select else files = files // " " // trim (arg) end if end do SCAN_CMDLINE ! Overall initialization if (logfile /= "") call logfile_init (logfile) if (banner) call msg_banner () allocate (options) allocate (whizard_instance) if (.not. quit) then ! Set options and initialize the whizard object options%job_id = job_id if (allocated (pack_args)) then options%pack_args = pack_args else allocate (options%pack_args (0)) end if if (allocated (unpack_args)) then options%unpack_args = unpack_args else allocate (options%unpack_args (0)) end if options%preload_model = model options%default_lib = default_lib options%preload_libraries = libraries options%rebuild_library = rebuild_library options%recompile_library = recompile_library options%rebuild_phs = rebuild_phs options%rebuild_grids = rebuild_grids options%rebuild_events = rebuild_events <> call whizard_instance%init (options, paths, logfile) call mask_term_signals () end if ! Run commands given on the command line if (.not. quit .and. ifile_get_length (commands) > 0) then call whizard_instance%process_ifile (commands, quit, quit_code) end if if (.not. quit) then ! Process commands from standard input if (.not. interactive .and. files == "") then call whizard_instance%process_stdin (quit, quit_code) ! ... or process commands from file else files = trim (adjustl (files)) SCAN_FILES: do while (files /= "") call split (files, this, " ") call whizard_instance%process_file (this, quit, quit_code) if (quit) exit SCAN_FILES end do SCAN_FILES end if end if ! Enter an interactive shell if requested if (.not. quit .and. interactive) then call whizard_instance%shell (quit_code) end if ! Overall finalization call ifile_final (commands) deallocate (options) call whizard_instance%final () deallocate (whizard_instance) <> call terminate_now_if_signal () call release_term_signals () call msg_terminate (quit_code = quit_code) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains subroutine print_version () print "(A)", "WHIZARD " // WHIZARD_VERSION print "(A)", "Copyright (C) 1999-2023 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter" print "(A)", " --------------------------------------- " print "(A)", "This is free software; see the source for copying conditions. There is NO" print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." print * end subroutine print_version end program main !!! (WK 02/2016) !!! Separate subroutine, because this becomes a procedure pointer target !!! Internal procedures as targets are not supported by some compilers. subroutine print_usage () use system_dependencies, only: WHIZARD_VERSION print "(A)", "WHIZARD " // WHIZARD_VERSION print "(A)", "Usage: whizard [OPTIONS] [FILE]" print "(A)", "Run WHIZARD with the command list taken from FILE(s)" print "(A)", "Options for resetting default directories and tools" & // "(GNU naming conventions):" print "(A)", " --prefix DIR" print "(A)", " --exec-prefix DIR" print "(A)", " --bindir DIR" print "(A)", " --libdir DIR" print "(A)", " --includedir DIR" print "(A)", " --datarootdir DIR" print "(A)", " --libtool LOCAL_LIBTOOL" print "(A)", " --lhapdfdir DIR (PDF sets directory)" print "(A)", "Other options:" print "(A)", "-h, --help display this help and exit" print "(A)", " --banner display banner at startup (default)" print "(A)", " --debug AREA switch on debug output for AREA." print "(A)", " AREA can be one of Whizard's src dirs or 'all'" print "(A)", " --debug2 AREA switch on more verbose debug output for AREA." print "(A)", " --single-event only compute one phase-space point (for debugging)" print "(A)", "-e, --execute CMDS execute SINDARIN CMDS before reading FILE(s)" print "(A)", "-f, --file CMDFILE execute SINDARIN from CMDFILE before reading FILE(s)" print "(A)", "-i, --interactive run interactively after reading FILE(s)" print "(A)", "-J, --job-id STRING set job ID to STRING (default: empty)" print "(A)", "-l, --library LIB preload process library NAME" print "(A)", " --localprefix DIR" print "(A)", " search in DIR for local models (default: ~/.whizard)" print "(A)", "-L, --logfile FILE write log to FILE (default: 'whizard.log'" print "(A)", " --logging switch on logging at startup (default)" print "(A)", "-m, --model NAME preload model NAME (default: 'SM')" print "(A)", " --no-banner do not display banner at startup" print "(A)", " --no-library do not preload process library" print "(A)", " --no-logfile do not write a logfile" print "(A)", " --no-logging switch off logging at startup" print "(A)", " --no-model do not preload a model" print "(A)", " --no-rebuild do not force rebuilding" print "(A)", " --pack DIR tar/gzip DIR after job" print "(A)", "-q, --query VARIABLE display documentation of VARIABLE" print "(A)", "-r, --rebuild rebuild all (see below)" print "(A)", " --rebuild-library" print "(A)", " rebuild process code library" print "(A)", " --rebuild-phase-space" print "(A)", " rebuild phase-space configuration" print "(A)", " --rebuild-grids rebuild integration grids" print "(A)", " --rebuild-events rebuild event samples" print "(A)", " --recompile recompile process code" print "(A)", " --show-config show build-time configuration" print "(A)", " --unpack FILE untar/gunzip FILE before job" print "(A)", "-V, --version output version information and exit" print "(A)", " --write-syntax-tables" print "(A)", " write the internal syntax tables to files and exit" print "(A)", "- further options are taken as filenames" print * print "(A)", "With no FILE, read standard input." end subroutine print_usage @ %def main @ \clearpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Driver program for the unit tests} This is a variant of the above main program that takes unit-test names as command-line options and runs those tests. <<[[main_ut.f90]]>>= <> program main_ut <> use unit_tests use io_units use system_dependencies use diagnostics use os_interface use cmdline_options use model_testbed !NODEP! <> <> implicit none <> !!! (WK 02/2016) Interface for the separate external routine below interface subroutine print_usage () end subroutine print_usage end interface ! Main program variable declarations character(CMDLINE_ARG_LEN) :: arg character(2) :: option type(string_t) :: long_option, value integer :: i, j, arg_len, arg_status logical :: look_for_options logical :: banner type(string_t) :: check, checks type(test_results_t) :: test_results logical :: success ! Exit status integer :: quit_code = 0 ! Initial values look_for_options = .true. banner = .true. logging = .false. msg_level = RESULT check = "" checks = "" <> ! Read and process options call init_options (print_usage) i = 0 SCAN_CMDLINE: do i = i + 1 call get_command_argument (i, arg, arg_len, arg_status) select case (arg_status) case (0) case (-1) call msg_error (" Command argument truncated: '" // arg // "'") case default exit SCAN_CMDLINE end select if (look_for_options) then select case (arg(1:2)) case ("--") value = trim (arg) call split (value, long_option, "=") select case (char (long_option)) case ("--version") call no_option_value (long_option, value) call print_version (); stop case ("--help") call no_option_value (long_option, value) call print_usage (); stop case ("--banner") call no_option_value (long_option, value) banner = .true. cycle SCAN_CMDLINE case ("--no-banner") call no_option_value (long_option, value) banner = .false. cycle SCAN_CMDLINE case ("--check") check = get_option_value (i, long_option, value) checks = checks // " " // check cycle SCAN_CMDLINE case ("--debug") call no_option_value (long_option, value) call set_debug_levels (get_option_value (i, long_option, value)) cycle SCAN_CMDLINE case ("--debug2") call no_option_value (long_option, value) call set_debug2_levels (get_option_value (i, long_option, value)) cycle SCAN_CMDLINE case default call print_usage () call msg_fatal ("Option '" // trim (arg) // "' not recognized") end select end select select case (arg(1:1)) case ("-") j = 1 if (len_trim (arg) == 1) then look_for_options = .false. else SCAN_SHORT_OPTIONS: do j = j + 1 if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS option = "-" // arg(j:j) select case (option) case ("-V") call print_version (); stop case ("-?", "-h") call print_usage (); stop case default call print_usage () call msg_fatal & ("Option '" // option // "' not recognized") end select end do SCAN_SHORT_OPTIONS end if case default call print_usage () call msg_fatal ("Option '" // trim (arg) // "' not recognized") end select else call print_usage () call msg_fatal ("Option '" // trim (arg) // "' not recognized") end if end do SCAN_CMDLINE ! Overall initialization if (banner) call msg_banner () ! Run any self-checks (and no commands) if (checks /= "") then checks = trim (adjustl (checks)) RUN_CHECKS: do while (checks /= "") call split (checks, check, " ") call whizard_check (check, test_results) end do RUN_CHECKS call test_results%wrapup (6, success) if (.not. success) quit_code = 7 end if <> call msg_terminate (quit_code = quit_code) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains subroutine print_version () print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)" print "(A)", "Copyright (C) 1999-2023 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter" print "(A)", " --------------------------------------- " print "(A)", "This is free software; see the source for copying conditions. There is NO" print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." print * end subroutine print_version <> end program main_ut !!! (WK 02/2016) !!! Separate subroutine, because this becomes a procedure pointer target !!! Internal procedures as targets are not supported by some compilers. subroutine print_usage () use system_dependencies, only: WHIZARD_VERSION print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)" print "(A)", "Usage: whizard_ut [OPTIONS] [FILE]" print "(A)", "Run WHIZARD unit tests as given on the command line" print "(A)", "Options:" print "(A)", "-h, --help display this help and exit" print "(A)", " --banner display banner at startup (default)" print "(A)", " --no-banner do not display banner at startup" print "(A)", " --debug AREA switch on debug output for AREA." print "(A)", " AREA can be one of Whizard's src dirs or 'all'" print "(A)", " --debug2 AREA switch on more verbose debug output for AREA." print "(A)", "-V, --version output version information and exit" print "(A)", " --check TEST run unit test TEST" end subroutine print_usage @ %def main_ut @ <>= @ <>= @ @ MPI init. <>= call MPI_init () <>= call MPI_finalize () @ %def MPI_init MPI_finalize <>= @ Every rebuild action is forbidden for the slave workers except [[rebuild_grids]], which is handled correctly inside the corresponding integration object. <>= if (.not. mpi_is_comm_master ()) then options%rebuild_library = .false. options%recompile_library = .false. options%rebuild_phs = .false. options%rebuild_events = .false. end if @ \subsection{Self-tests} For those self-tests, we need some auxiliary routines that provide an enviroment. The environment depends on things that are not available at the level of the module that we want to test. \subsubsection{Testbed for event I/O} This subroutine prepares a test process with a single event. All objects are allocated via anonymous pointers, because we want to recover the pointers and delete the objects in a separate procedure. <>= subroutine prepare_eio_test (event, unweighted, n_alt, sample_norm) use variables, only: var_list_t use model_data use process, only: process_t use instances, only: process_instance_t use processes_ut, only: prepare_test_process use event_base use events class(generic_event_t), intent(inout), pointer :: event logical, intent(in), optional :: unweighted integer, intent(in), optional :: n_alt type(string_t), intent(in), optional :: sample_norm type(model_data_t), pointer :: model type(var_list_t) :: var_list type(string_t) :: sample_normalization type(process_t), pointer :: proc type(process_instance_t), pointer :: process_instance allocate (model) call model%init_test () allocate (proc) allocate (process_instance) call prepare_test_process (proc, process_instance, model, & run_id = var_str ("run_test")) call process_instance%setup_event_data () call model%final () deallocate (model) allocate (event_t :: event) select type (event) type is (event_t) if (present (unweighted)) then call var_list%append_log (& var_str ("?unweighted"), unweighted, & intrinsic = .true.) else call var_list%append_log (& var_str ("?unweighted"), .true., & intrinsic = .true.) end if if (present (sample_norm)) then sample_normalization = sample_norm else sample_normalization = var_str ("auto") end if call var_list%append_string (& var_str ("$sample_normalization"), & sample_normalization, intrinsic = .true.) call event%basic_init (var_list, n_alt) call event%connect (process_instance, proc%get_model_ptr ()) call var_list%final () end select end subroutine prepare_eio_test @ %def prepare_eio_test @ Recover those pointers, finalize the objects and deallocate. <>= subroutine cleanup_eio_test (event) use model_data use process, only: process_t use instances, only: process_instance_t use processes_ut, only: cleanup_test_process use event_base use events class(generic_event_t), intent(inout), pointer :: event type(process_t), pointer :: proc type(process_instance_t), pointer :: process_instance select type (event) type is (event_t) proc => event%get_process_ptr () process_instance => event%get_process_instance_ptr () call cleanup_test_process (proc, process_instance) deallocate (process_instance) deallocate (proc) call event%final () end select deallocate (event) end subroutine cleanup_eio_test @ %def cleanup_eio_test_event @ Assign those procedures to appropriate pointers (module variables) in the [[eio_base]] module, so they can be called as if they were module procedures. <>= use eio_base_ut, only: eio_prepare_test use eio_base_ut, only: eio_cleanup_test <>= eio_prepare_test => prepare_eio_test eio_cleanup_test => cleanup_eio_test @ \subsubsection{Any Model} This procedure reads any model from file and, optionally, assigns a var-list pointer. If the model pointer is still null, we allocate the model object first, with concrete type [[model_t]]. This is a service for modules which do just have access to the [[model_data_t]] base type. <>= subroutine prepare_whizard_model (model, name, vars) <> use os_interface use model_data use var_base use models class(model_data_t), intent(inout), pointer :: model type(string_t), intent(in) :: name class(vars_t), pointer, intent(out), optional :: vars type(os_data_t) :: os_data call syntax_model_file_init () call os_data%init () if (.not. associated (model)) allocate (model_t :: model) select type (model) type is (model_t) call model%read (name // ".mdl", os_data) if (present (vars)) then vars => model%get_var_list_ptr () end if end select end subroutine prepare_whizard_model @ %def prepare_whizard_model @ Cleanup after use. Includes deletion of the model-file syntax. <>= subroutine cleanup_whizard_model (model) use model_data use models class(model_data_t), intent(inout), target :: model call model%final () call syntax_model_file_final () end subroutine cleanup_whizard_model @ %def cleanup_whizard_model @ Assign those procedures to appropriate pointers (module variables) in the [[model_testbed]] module, so they can be called as if they were module procedures. <>= prepare_model => prepare_whizard_model cleanup_model => cleanup_whizard_model @ \subsubsection{Fallback model: hadrons} Some event format tests require the hadronic SM implementation, which has to be read from file. We provide the functionality here, so the tests do not depend on model I/O. <>= subroutine prepare_fallback_model (model) use model_data class(model_data_t), intent(inout), pointer :: model call prepare_whizard_model (model, var_str ("SM_hadrons")) end subroutine prepare_fallback_model @ %def prepare_fallback_model @ Assign those procedures to appropriate pointers (module variables) in the [[eio_base]] module, so they can be called as if they were module procedures. <>= use eio_base_ut, only: eio_prepare_fallback_model use eio_base_ut, only: eio_cleanup_fallback_model <>= eio_prepare_fallback_model => prepare_fallback_model eio_cleanup_fallback_model => cleanup_model @ \subsubsection{Access to the test random-number generator} This generator is not normally available for the dispatcher. We assign an additional dispatch routine to the hook in the [[dispatch]] module which will be checked before the default rule. <>= use dispatch_rng, only: dispatch_rng_factory_fallback use dispatch_rng_ut, only: dispatch_rng_factory_test <>= dispatch_rng_factory_fallback => dispatch_rng_factory_test @ \subsubsection{Access to the test structure functions} These are not normally available for the dispatcher. We assign an additional dispatch routine to the hook in the [[dispatch]] module which will be checked before the default rule. <>= use dispatch_beams, only: dispatch_sf_data_extra use dispatch_ut, only: dispatch_sf_data_test <>= dispatch_sf_data_extra => dispatch_sf_data_test @ \subsubsection{Procedure for Checking} This is for developers only, but needs a well-defined interface. <>= subroutine whizard_check (check, results) type(string_t), intent(in) :: check type(test_results_t), intent(inout) :: results type(os_data_t) :: os_data integer :: u call os_data%init () u = free_unit () open (u, file="whizard_check." // char (check) // ".log", & action="write", status="replace") call msg_message (repeat ('=', 76), 0) call msg_message ("Running self-test: " // char (check), 0) call msg_message (repeat ('-', 76), 0) <> select case (char (check)) <> case ("all") <> case default call msg_fatal ("Self-test '" // char (check) // "' not implemented.") end select close (u) end subroutine whizard_check @ %def whizard_check @ \subsection{Unit test references} \subsubsection{Formats} <>= use formats_ut, only: format_test <>= case ("formats") call format_test (u, results) <>= call format_test (u, results) @ \subsubsection{Numeric utilities} <>= use numeric_utils_ut, only: numeric_utils_test <>= case ("numeric_utils") call numeric_utils_test (u, results) <>= call numeric_utils_test (u, results) @ \subsubsection{Binary Tree} <>= use binary_tree_ut, only: binary_tree_test <>= case ("binary_tree") call binary_tree_test (u, results) <>= call binary_tree_test (u, results) @ \subsubsection{Array List} <>= use array_list_ut, only: array_list_test <>= case ("array_list") call array_list_test (u, results) <>= call array_list_test (u, results) @ \subsubsection{Iterator} <>= use iterator_ut, only: iterator_test <>= case ("iterator") call iterator_test (u, results) <>= call iterator_test (u, results) @ \subsubsection{MD5} <>= use md5_ut, only: md5_test <>= case ("md5") call md5_test (u, results) <>= call md5_test (u, results) @ \subsubsection{OS Interface} <>= use os_interface_ut, only: os_interface_test <>= case ("os_interface") call os_interface_test (u, results) <>= call os_interface_test (u, results) @ \subsubsection{Sorting} <>= use sorting_ut, only: sorting_test <>= case ("sorting") call sorting_test (u, results) <>= call sorting_test (u, results) @ \subsubsection{Grids} <>= use grids_ut, only: grids_test <>= case ("grids") call grids_test (u, results) <>= call grids_test (u, results) @ \subsubsection{Solver} <>= use solver_ut, only: solver_test <>= case ("solver") call solver_test (u, results) <>= call solver_test (u, results) @ \subsubsection{CPU Time} <>= use cputime_ut, only: cputime_test <>= case ("cputime") call cputime_test (u, results) <>= call cputime_test (u, results) @ \subsubsection{Lorentz algebra} <>= use lorentz_ut, only: lorentz_test <>= case ("lorentz") call lorentz_test (u, results) <>= call lorentz_test (u, results) @ +\subsection{Kinematics variables} +<>= + use kinematics_vars_ut, only: kinematics_vars_test +<>= + case ("kinematics_vars") + call kinematics_vars_test (u, results) +<>= + call kinematics_vars_test (u, results) +@ \subsubsection{PHS points} <>= use phs_points_ut, only: phs_points_test <>= case ("phs_points") call phs_points_test (u, results) <>= call phs_points_test (u, results) @ \subsubsection{SM QCD} <>= use sm_qcd_ut, only: sm_qcd_test <>= case ("sm_qcd") call sm_qcd_test (u, results) <>= call sm_qcd_test (u, results) @ \subsubsection{SM QED} <>= use sm_qed_ut, only: sm_qed_test <>= case ("sm_qed") call sm_qed_test (u, results) <>= call sm_qed_test (u, results) @ \subsubsection{SM physics} <>= use sm_physics_ut, only: sm_physics_test <>= case ("sm_physics") call sm_physics_test (u, results) <>= call sm_physics_test (u, results) @ \subsubsection{Electron PDFs} <>= use electron_pdfs_ut, only: electron_pdfs_test <>= case ("electron_pdfs") call electron_pdfs_test (u, results) <>= call electron_pdfs_test (u, results) @ \subsubsection{Lexers} <>= use lexers_ut, only: lexer_test <>= case ("lexers") call lexer_test (u, results) <>= call lexer_test (u, results) @ \subsubsection{Parser} <>= use parser_ut, only: parse_test <>= case ("parser") call parse_test (u, results) <>= call parse_test (u, results) @ \subsubsection{XML} <>= use xml_ut, only: xml_test <>= case ("xml") call xml_test (u, results) <>= call xml_test (u, results) @ \subsubsection{Colors} <>= use colors_ut, only: color_test <>= case ("colors") call color_test (u, results) <>= call color_test (u, results) @ \subsubsection{State matrices} <>= use state_matrices_ut, only: state_matrix_test <>= case ("state_matrices") call state_matrix_test (u, results) <>= call state_matrix_test (u, results) @ \subsubsection{Analysis} <>= use analysis_ut, only: analysis_test <>= case ("analysis") call analysis_test (u, results) <>= call analysis_test (u, results) @ \subsubsection{Particles} <>= use particles_ut, only: particles_test <>= case ("particles") call particles_test (u, results) <>= call particles_test (u, results) @ \subsubsection{Models} <>= use models_ut, only: models_test <>= case ("models") call models_test (u, results) <>= call models_test (u, results) @ \subsubsection{Auto Components} <>= use auto_components_ut, only: auto_components_test <>= case ("auto_components") call auto_components_test (u, results) <>= call auto_components_test (u, results) @ \subsubsection{Radiation Generator} <>= use radiation_generator_ut, only: radiation_generator_test <>= case ("radiation_generator") call radiation_generator_test (u, results) <>= call radiation_generator_test (u, results) @ \subsection{BLHA} <>= use blha_ut, only: blha_test <>= case ("blha") call blha_test (u, results) <>= call blha_test (u, results) @ \subsubsection{Evaluators} <>= use evaluators_ut, only: evaluator_test <>= case ("evaluators") call evaluator_test (u, results) <>= call evaluator_test (u, results) @ \subsubsection{Expressions} <>= use eval_trees_ut, only: expressions_test <>= case ("expressions") call expressions_test (u, results) <>= call expressions_test (u, results) @ \subsubsection{Resonances} <>= use resonances_ut, only: resonances_test <>= case ("resonances") call resonances_test (u, results) <>= call resonances_test (u, results) @ \subsubsection{PHS Trees} <>= use phs_trees_ut, only: phs_trees_test <>= case ("phs_trees") call phs_trees_test (u, results) <>= call phs_trees_test (u, results) @ \subsubsection{PHS Forests} <>= use phs_forests_ut, only: phs_forests_test <>= case ("phs_forests") call phs_forests_test (u, results) <>= call phs_forests_test (u, results) @ \subsubsection{Beams} <>= use beams_ut, only: beams_test <>= case ("beams") call beams_test (u, results) <>= call beams_test (u, results) @ \subsubsection{$su(N)$ Algebra} <>= use su_algebra_ut, only: su_algebra_test <>= case ("su_algebra") call su_algebra_test (u, results) <>= call su_algebra_test (u, results) @ \subsubsection{Bloch Vectors} <>= use bloch_vectors_ut, only: bloch_vectors_test <>= case ("bloch_vectors") call bloch_vectors_test (u, results) <>= call bloch_vectors_test (u, results) @ \subsubsection{Polarizations} <>= use polarizations_ut, only: polarizations_test <>= case ("polarizations") call polarizations_test (u, results) <>= call polarizations_test (u, results) @ \subsubsection{SF Aux} <>= use sf_aux_ut, only: sf_aux_test <>= case ("sf_aux") call sf_aux_test (u, results) <>= call sf_aux_test (u, results) @ \subsubsection{SF Mappings} <>= use sf_mappings_ut, only: sf_mappings_test <>= case ("sf_mappings") call sf_mappings_test (u, results) <>= call sf_mappings_test (u, results) @ \subsubsection{SF Base} <>= use sf_base_ut, only: sf_base_test <>= case ("sf_base") call sf_base_test (u, results) <>= call sf_base_test (u, results) @ \subsubsection{SF PDF Builtin} <>= use sf_pdf_builtin_ut, only: sf_pdf_builtin_test <>= case ("sf_pdf_builtin") call sf_pdf_builtin_test (u, results) <>= call sf_pdf_builtin_test (u, results) @ \subsubsection{SF LHAPDF} <>= use sf_lhapdf_ut, only: sf_lhapdf_test <>= case ("sf_lhapdf") call sf_lhapdf_test (u, results) <>= call sf_lhapdf_test (u, results) @ \subsubsection{SF ISR} <>= use sf_isr_ut, only: sf_isr_test <>= case ("sf_isr") call sf_isr_test (u, results) <>= call sf_isr_test (u, results) @ \subsubsection{SF EPA} <>= use sf_epa_ut, only: sf_epa_test <>= case ("sf_epa") call sf_epa_test (u, results) <>= call sf_epa_test (u, results) @ \subsubsection{SF EWA} <>= use sf_ewa_ut, only: sf_ewa_test <>= case ("sf_ewa") call sf_ewa_test (u, results) <>= call sf_ewa_test (u, results) @ \subsubsection{SF CIRCE1} <>= use sf_circe1_ut, only: sf_circe1_test <>= case ("sf_circe1") call sf_circe1_test (u, results) <>= call sf_circe1_test (u, results) @ \subsubsection{SF CIRCE2} <>= use sf_circe2_ut, only: sf_circe2_test <>= case ("sf_circe2") call sf_circe2_test (u, results) <>= call sf_circe2_test (u, results) @ \subsubsection{SF Gaussian} <>= use sf_gaussian_ut, only: sf_gaussian_test <>= case ("sf_gaussian") call sf_gaussian_test (u, results) <>= call sf_gaussian_test (u, results) @ \subsubsection{SF Beam Events} <>= use sf_beam_events_ut, only: sf_beam_events_test <>= case ("sf_beam_events") call sf_beam_events_test (u, results) <>= call sf_beam_events_test (u, results) @ \subsubsection{SF EScan} <>= use sf_escan_ut, only: sf_escan_test <>= case ("sf_escan") call sf_escan_test (u, results) <>= call sf_escan_test (u, results) @ \subsubsection{PHS Base} <>= use phs_base_ut, only: phs_base_test <>= case ("phs_base") call phs_base_test (u, results) <>= call phs_base_test (u, results) @ \subsubsection{PHS None} <>= use phs_none_ut, only: phs_none_test <>= case ("phs_none") call phs_none_test (u, results) <>= call phs_none_test (u, results) @ \subsubsection{PHS Single} <>= use phs_single_ut, only: phs_single_test <>= case ("phs_single") call phs_single_test (u, results) <>= call phs_single_test (u, results) @ \subsubsection{PHS Rambo} <>= use phs_rambo_ut, only: phs_rambo_test <>= case ("phs_rambo") call phs_rambo_test (u, results) <>= call phs_rambo_test (u, results) @ \subsubsection{PHS Wood} <>= use phs_wood_ut, only: phs_wood_test use phs_wood_ut, only: phs_wood_vis_test <>= case ("phs_wood") call phs_wood_test (u, results) case ("phs_wood_vis") call phs_wood_vis_test (u, results) <>= call phs_wood_test (u, results) call phs_wood_vis_test (u, results) @ \subsubsection{PHS FKS Generator} <>= use phs_fks_ut, only: phs_fks_generator_test <>= case ("phs_fks_generator") call phs_fks_generator_test (u, results) <>= call phs_fks_generator_test (u, results) @ \subsubsection{FKS regions} <>= use fks_regions_ut, only: fks_regions_test <>= case ("fks_regions") call fks_regions_test (u, results) <>= call fks_regions_test (u, results) @ \subsubsection{Real subtraction} <>= use real_subtraction_ut, only: real_subtraction_test <>= case ("real_subtraction") call real_subtraction_test (u, results) <>= call real_subtraction_test (u, results) @ \subsubsection{RECOLA} <>= use prc_recola_ut, only: prc_recola_test <>= case ("prc_recola") call prc_recola_test (u, results) <>= call prc_recola_test (u, results) @ \subsubsection{RNG Base} <>= use rng_base_ut, only: rng_base_test <>= case ("rng_base") call rng_base_test (u, results) <>= call rng_base_test (u, results) @ \subsubsection{RNG Tao} <>= use rng_tao_ut, only: rng_tao_test <>= case ("rng_tao") call rng_tao_test (u, results) <>= call rng_tao_test (u, results) @ \subsubsection{RNG Stream} <>= use rng_stream_ut, only: rng_stream_test <>= case ("rng_stream") call rng_stream_test (u, results) <>= call rng_stream_test (u, results) @ \subsubsection{Selectors} <>= use selectors_ut, only: selectors_test <>= case ("selectors") call selectors_test (u, results) <>= call selectors_test (u, results) @ \subsubsection{VEGAS} <>= use vegas_ut, only: vegas_test <>= case ("vegas") call vegas_test (u, results) <>= call vegas_test (u, results) @ \subsubsection{VAMP2} <>= use vamp2_ut, only: vamp2_test <>= case ("vamp2") call vamp2_test (u, results) <>= call vamp2_test (u, results) @ \subsubsection{MCI Base} <>= use mci_base_ut, only: mci_base_test <>= case ("mci_base") call mci_base_test (u, results) <>= call mci_base_test (u, results) @ \subsubsection{MCI None} <>= use mci_none_ut, only: mci_none_test <>= case ("mci_none") call mci_none_test (u, results) <>= call mci_none_test (u, results) @ \subsubsection{MCI Midpoint} <>= use mci_midpoint_ut, only: mci_midpoint_test <>= case ("mci_midpoint") call mci_midpoint_test (u, results) <>= call mci_midpoint_test (u, results) @ \subsubsection{MCI VAMP} <>= use mci_vamp_ut, only: mci_vamp_test <>= case ("mci_vamp") call mci_vamp_test (u, results) <>= call mci_vamp_test (u, results) @ \subsubsection{MCI VAMP2} <>= use mci_vamp2_ut, only: mci_vamp2_test <>= case ("mci_vamp2") call mci_vamp2_test (u, results) <>= call mci_vamp2_test (u, results) @ \subsubsection{Integration Results} <>= use integration_results_ut, only: integration_results_test <>= case ("integration_results") call integration_results_test (u, results) <>= call integration_results_test (u, results) @ \subsubsection{PRCLib Interfaces} <>= use prclib_interfaces_ut, only: prclib_interfaces_test <>= case ("prclib_interfaces") call prclib_interfaces_test (u, results) <>= call prclib_interfaces_test (u, results) @ \subsubsection{Particle Specifiers} <>= use particle_specifiers_ut, only: particle_specifiers_test <>= case ("particle_specifiers") call particle_specifiers_test (u, results) <>= call particle_specifiers_test (u, results) @ \subsubsection{Process Libraries} <>= use process_libraries_ut, only: process_libraries_test <>= case ("process_libraries") call process_libraries_test (u, results) <>= call process_libraries_test (u, results) @ \subsubsection{PRCLib Stacks} <>= use prclib_stacks_ut, only: prclib_stacks_test <>= case ("prclib_stacks") call prclib_stacks_test (u, results) <>= call prclib_stacks_test (u, results) @ \subsubsection{HepMC} <>= use hepmc_interface_ut, only: hepmc_interface_test <>= case ("hepmc") call hepmc_interface_test (u, results) <>= call hepmc_interface_test (u, results) @ \subsubsection{LCIO} <>= use lcio_interface_ut, only: lcio_interface_test <>= case ("lcio") call lcio_interface_test (u, results) <>= call lcio_interface_test (u, results) @ \subsubsection{Jets} <>= use jets_ut, only: jets_test <>= case ("jets") call jets_test (u, results) <>= call jets_test (u, results) @ \subsection{LHA User Process WHIZARD} <>= use whizard_lha_ut, only: whizard_lha_test <>= case ("whizard_lha") call whizard_lha_test (u, results) <>= call whizard_lha_test (u, results) @ \subsection{Pythia8} <>= use pythia8_ut, only: pythia8_test <>= case ("pythia8") call pythia8_test (u, results) <>= call pythia8_test (u, results) @ \subsubsection{PDG Arrays} <>= use pdg_arrays_ut, only: pdg_arrays_test <>= case ("pdg_arrays") call pdg_arrays_test (u, results) <>= call pdg_arrays_test (u, results) @ \subsubsection{interactions} <>= use interactions_ut, only: interaction_test <>= case ("interactions") call interaction_test (u, results) <>= call interaction_test (u, results) @ \subsubsection{SLHA} <>= use slha_interface_ut, only: slha_test <>= case ("slha_interface") call slha_test (u, results) <>= call slha_test (u, results) @ \subsubsection{Cascades} <>= use cascades_ut, only: cascades_test <>= case ("cascades") call cascades_test (u, results) <>= call cascades_test (u, results) @ \subsubsection{Cascades2 lexer} <>= use cascades2_lexer_ut, only: cascades2_lexer_test <>= case ("cascades2_lexer") call cascades2_lexer_test (u, results) <>= call cascades2_lexer_test (u, results) @ \subsubsection{Cascades2} <>= use cascades2_ut, only: cascades2_test <>= case ("cascades2") call cascades2_test (u, results) <>= call cascades2_test (u, results) @ \subsubsection{PRC Test} <>= use prc_test_ut, only: prc_test_test <>= case ("prc_test") call prc_test_test (u, results) <>= call prc_test_test (u, results) @ \subsubsection{PRC Template ME} <>= use prc_template_me_ut, only: prc_template_me_test <>= case ("prc_template_me") call prc_template_me_test (u, results) <>= call prc_template_me_test (u, results) @ \subsubsection{PRC OMega} <>= use prc_omega_ut, only: prc_omega_test use prc_omega_ut, only: prc_omega_diags_test <>= case ("prc_omega") call prc_omega_test (u, results) case ("prc_omega_diags") call prc_omega_diags_test (u, results) <>= call prc_omega_test (u, results) call prc_omega_diags_test (u, results) @ \subsubsection{Parton States} <>= use parton_states_ut, only: parton_states_test <>= case ("parton_states") call parton_states_test (u, results) <>= call parton_states_test (u, results) @ \subsubsection{Subevt Expr} <>= use expr_tests_ut, only: subevt_expr_test <>= case ("subevt_expr") call subevt_expr_test (u, results) <>= call subevt_expr_test (u, results) @ \subsubsection{Processes} <>= use processes_ut, only: processes_test <>= case ("processes") call processes_test (u, results) <>= call processes_test (u, results) @ \subsubsection{Process Stacks} <>= use process_stacks_ut, only: process_stacks_test <>= case ("process_stacks") call process_stacks_test (u, results) <>= call process_stacks_test (u, results) @ \subsubsection{Event Transforms} <>= use event_transforms_ut, only: event_transforms_test <>= case ("event_transforms") call event_transforms_test (u, results) <>= call event_transforms_test (u, results) @ \subsubsection{Resonance Insertion Transform} <>= use resonance_insertion_ut, only: resonance_insertion_test <>= case ("resonance_insertion") call resonance_insertion_test (u, results) <>= call resonance_insertion_test (u, results) @ \subsubsection{Recoil Kinematics} <>= use recoil_kinematics_ut, only: recoil_kinematics_test <>= case ("recoil_kinematics") call recoil_kinematics_test (u, results) <>= call recoil_kinematics_test (u, results) @ \subsubsection{ISR Handler} <>= use isr_epa_handler_ut, only: isr_handler_test <>= case ("isr_handler") call isr_handler_test (u, results) <>= call isr_handler_test (u, results) @ \subsubsection{EPA Handler} <>= use isr_epa_handler_ut, only: epa_handler_test <>= case ("epa_handler") call epa_handler_test (u, results) <>= call epa_handler_test (u, results) @ \subsubsection{Decays} <>= use decays_ut, only: decays_test <>= case ("decays") call decays_test (u, results) <>= call decays_test (u, results) @ \subsubsection{Shower} <>= use shower_ut, only: shower_test <>= case ("shower") call shower_test (u, results) <>= call shower_test (u, results) @ \subsubsection{Events} <>= use events_ut, only: events_test <>= case ("events") call events_test (u, results) <>= call events_test (u, results) @ \subsubsection{HEP Events} <>= use hep_events_ut, only: hep_events_test <>= case ("hep_events") call hep_events_test (u, results) <>= call hep_events_test (u, results) @ \subsubsection{EIO Data} <>= use eio_data_ut, only: eio_data_test <>= case ("eio_data") call eio_data_test (u, results) <>= call eio_data_test (u, results) @ \subsubsection{EIO Base} <>= use eio_base_ut, only: eio_base_test <>= case ("eio_base") call eio_base_test (u, results) <>= call eio_base_test (u, results) @ \subsubsection{EIO Direct} <>= use eio_direct_ut, only: eio_direct_test <>= case ("eio_direct") call eio_direct_test (u, results) <>= call eio_direct_test (u, results) @ \subsubsection{EIO Raw} <>= use eio_raw_ut, only: eio_raw_test <>= case ("eio_raw") call eio_raw_test (u, results) <>= call eio_raw_test (u, results) @ \subsubsection{EIO Checkpoints} <>= use eio_checkpoints_ut, only: eio_checkpoints_test <>= case ("eio_checkpoints") call eio_checkpoints_test (u, results) <>= call eio_checkpoints_test (u, results) @ \subsubsection{EIO LHEF} <>= use eio_lhef_ut, only: eio_lhef_test <>= case ("eio_lhef") call eio_lhef_test (u, results) <>= call eio_lhef_test (u, results) @ \subsubsection{EIO HepMC} <>= use eio_hepmc_ut, only: eio_hepmc_test <>= case ("eio_hepmc") call eio_hepmc_test (u, results) <>= call eio_hepmc_test (u, results) @ \subsubsection{EIO LCIO} <>= use eio_lcio_ut, only: eio_lcio_test <>= case ("eio_lcio") call eio_lcio_test (u, results) <>= call eio_lcio_test (u, results) @ \subsubsection{EIO StdHEP} <>= use eio_stdhep_ut, only: eio_stdhep_test <>= case ("eio_stdhep") call eio_stdhep_test (u, results) <>= call eio_stdhep_test (u, results) @ \subsubsection{EIO ASCII} <>= use eio_ascii_ut, only: eio_ascii_test <>= case ("eio_ascii") call eio_ascii_test (u, results) <>= call eio_ascii_test (u, results) @ \subsubsection{EIO Weights} <>= use eio_weights_ut, only: eio_weights_test <>= case ("eio_weights") call eio_weights_test (u, results) <>= call eio_weights_test (u, results) @ \subsubsection{EIO Dump} <>= use eio_dump_ut, only: eio_dump_test <>= case ("eio_dump") call eio_dump_test (u, results) <>= call eio_dump_test (u, results) @ \subsubsection{Iterations} <>= use iterations_ut, only: iterations_test <>= case ("iterations") call iterations_test (u, results) <>= call iterations_test (u, results) @ \subsubsection{Beam Structures} <>= use beam_structures_ut, only: beam_structures_test <>= case ("beam_structures") call beam_structures_test (u, results) <>= call beam_structures_test (u, results) @ \subsubsection{RT Data} <>= use rt_data_ut, only: rt_data_test <>= case ("rt_data") call rt_data_test (u, results) <>= call rt_data_test (u, results) @ \subsubsection{Dispatch} <>= use dispatch_ut, only: dispatch_test <>= case ("dispatch") call dispatch_test (u, results) <>= call dispatch_test (u, results) @ \subsubsection{Dispatch RNG} <>= use dispatch_rng_ut, only: dispatch_rng_test <>= case ("dispatch_rng") call dispatch_rng_test (u, results) <>= call dispatch_rng_test (u, results) @ \subsubsection{Dispatch MCI} <>= use dispatch_mci_ut, only: dispatch_mci_test <>= case ("dispatch_mci") call dispatch_mci_test (u, results) <>= call dispatch_mci_test (u, results) @ \subsubsection{Dispatch PHS} <>= use dispatch_phs_ut, only: dispatch_phs_test <>= case ("dispatch_phs") call dispatch_phs_test (u, results) <>= call dispatch_phs_test (u, results) @ \subsubsection{Dispatch transforms} <>= use dispatch_transforms_ut, only: dispatch_transforms_test <>= case ("dispatch_transforms") call dispatch_transforms_test (u, results) <>= call dispatch_transforms_test (u, results) @ \subsubsection{Shower partons} <>= use shower_base_ut, only: shower_base_test <>= case ("shower_base") call shower_base_test (u, results) <>= call shower_base_test (u, results) @ \subsubsection{Process Configurations} <>= use process_configurations_ut, only: process_configurations_test <>= case ("process_configurations") call process_configurations_test (u, results) <>= call process_configurations_test (u, results) @ \subsubsection{Compilations} <>= use compilations_ut, only: compilations_test use compilations_ut, only: compilations_static_test <>= case ("compilations") call compilations_test (u, results) case ("compilations_static") call compilations_static_test (u, results) <>= call compilations_test (u, results) call compilations_static_test (u, results) @ \subsubsection{Integrations} <>= use integrations_ut, only: integrations_test use integrations_ut, only: integrations_history_test <>= case ("integrations") call integrations_test (u, results) case ("integrations_history") call integrations_history_test (u, results) <>= call integrations_test (u, results) call integrations_history_test (u, results) @ \subsubsection{Event Streams} <>= use event_streams_ut, only: event_streams_test <>= case ("event_streams") call event_streams_test (u, results) <>= call event_streams_test (u, results) @ \subsubsection{Restricted Subprocesses} <>= use restricted_subprocesses_ut, only: restricted_subprocesses_test <>= case ("restricted_subprocesses") call restricted_subprocesses_test (u, results) <>= call restricted_subprocesses_test (u, results) @ \subsubsection{Simulations} <>= use simulations_ut, only: simulations_test <>= case ("simulations") call simulations_test (u, results) <>= call simulations_test (u, results) @ \subsubsection{Commands} <>= use commands_ut, only: commands_test <>= case ("commands") call commands_test (u, results) <>= call commands_test (u, results) @ \subsubsection{$ttV$ formfactors} <>= use ttv_formfactors_ut, only: ttv_formfactors_test <>= case ("ttv_formfactors") call ttv_formfactors_test (u, results) <>= call ttv_formfactors_test (u, results) @ \subsubsection{API} <>= use api_ut, only: api_test <>= case ("api") call api_test (u, results) <>= call api_test (u, results) @ \subsubsection{API/HepMC} <>= use api_hepmc_ut, only: api_hepmc_test <>= case ("api_hepmc") call api_hepmc_test (u, results) <>= call api_hepmc_test (u, results) @ \subsubsection{API/LCIO} <>= use api_lcio_ut, only: api_lcio_test <>= case ("api_lcio") call api_lcio_test (u, results) <>= call api_lcio_test (u, results) Index: trunk/tests/unit_tests/kinematics_vars.sh =================================================================== --- trunk/tests/unit_tests/kinematics_vars.sh (revision 0) +++ trunk/tests/unit_tests/kinematics_vars.sh (revision 8864) @@ -0,0 +1,4 @@ +#!/bin/sh +### Check WHIZARD module kinematics_vars +echo "Running script $0" +exec ./run_whizard_ut.sh --check kinematics_vars Index: trunk/tests/unit_tests/Makefile.am =================================================================== --- trunk/tests/unit_tests/Makefile.am (revision 8863) +++ trunk/tests/unit_tests/Makefile.am (revision 8864) @@ -1,456 +1,457 @@ ## Makefile.am -- Makefile for executable WHIZARD test scripts ## ## Process this file with automake to produce Makefile.in ## ######################################################################## # # Copyright (C) 1999-2023 by # Wolfgang Kilian # Thorsten Ohl # Juergen Reuter # with contributions from # cf. main AUTHORS file # # WHIZARD is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # WHIZARD is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ######################################################################## WHIZARD_UT_DRIVER = run_whizard_ut.sh WHIZARD_C_TEST_DRIVER = run_whizard_c_test.sh WHIZARD_CC_TEST_DRIVER = run_whizard_cc_test.sh UNIT_TESTS = \ analysis.run \ commands.run \ pdg_arrays.run \ expressions.run \ beams.run \ su_algebra.run \ bloch_vectors.run \ polarizations.run \ numeric_utils.run \ binary_tree.run \ array_list.run \ iterator.run \ md5.run \ cputime.run \ lexers.run \ parser.run \ color.run \ os_interface.run \ evaluators.run \ formats.run \ sorting.run \ grids.run \ solver.run \ state_matrices.run \ interactions.run \ xml.run \ lorentz.run \ + kinematics_vars.run \ phs_points.run \ sm_qcd.run \ sm_qed.run \ sm_physics.run \ electron_pdfs.run \ models.run \ auto_components.run \ radiation_generator.run \ blha.run \ particles.run \ beam_structures.run \ sf_aux.run \ sf_mappings.run \ sf_base.run \ sf_pdf_builtin.run \ sf_isr.run \ sf_epa.run \ sf_ewa.run \ sf_circe1.run \ sf_circe2.run \ sf_gaussian.run \ sf_beam_events.run \ sf_escan.run \ phs_base.run \ phs_none.run \ phs_single.run \ phs_rambo.run \ resonances.run \ phs_trees.run \ phs_forests.run \ phs_wood.run \ phs_fks_generator.run \ fks_regions.run \ real_subtraction.run \ rng_base.run \ rng_tao.run \ rng_stream.run \ selectors.run \ vegas.run \ vamp2.run \ mci_base.run \ mci_none.run \ mci_midpoint.run \ mci_vamp.run \ mci_vamp2.run \ integration_results.run \ prclib_interfaces.run \ particle_specifiers.run \ process_libraries.run \ prclib_stacks.run \ slha_interface.run \ prc_test.run \ prc_template_me.run \ parton_states.run \ subevt_expr.run \ processes.run \ process_stacks.run \ cascades.run \ cascades2_lexer.run \ cascades2.run \ event_transforms.run \ resonance_insertion.run \ recoil_kinematics.run \ isr_handler.run \ epa_handler.run \ decays.run \ shower.run \ shower_base.run \ events.run \ hep_events.run \ whizard_lha.run \ pythia8.run \ eio_data.run \ eio_base.run \ eio_direct.run \ eio_raw.run \ eio_checkpoints.run \ eio_lhef.run \ eio_stdhep.run \ eio_ascii.run \ eio_weights.run \ eio_dump.run \ iterations.run \ rt_data.run \ dispatch.run \ dispatch_rng.run \ dispatch_mci.run \ dispatch_phs.run \ dispatch_transforms.run \ process_configurations.run \ event_streams.run \ integrations.run \ ttv_formfactors.run XFAIL_UNIT_TESTS = UNIT_TESTS_REQ_EV_ANA = \ phs_wood_vis.run \ prc_omega_diags.run \ integrations_history.run UNIT_TESTS_REQ_FASTJET = \ jets.run UNIT_TESTS_REQ_HEPMC2 = \ hepmc2.run \ eio_hepmc2.run \ api_hepmc2.run UNIT_TESTS_REQ_HEPMC3 = \ hepmc3.run \ eio_hepmc3.run \ api_hepmc3.run UNIT_TESTS_REQ_LCIO = \ lcio.run \ eio_lcio.run \ api_lcio.run UNIT_TESTS_REQ_OCAML = \ prc_omega.run \ compilations.run \ compilations_static.run \ restricted_subprocesses.run \ simulations.run \ api.run \ api_c.run \ api_cc.run UNIT_TESTS_REQ_RECOLA = \ prc_recola.run UNIT_TESTS_REQ_LHAPDF5 = \ sf_lhapdf5.run UNIT_TESTS_REQ_LHAPDF6 = \ sf_lhapdf6.run TEST_DRIVERS_RUN = \ $(UNIT_TESTS) \ $(UNIT_TESTS_REQ_HEPMC2) \ $(UNIT_TESTS_REQ_HEPMC3) \ $(UNIT_TESTS_REQ_LCIO) \ $(UNIT_TESTS_REQ_FASTJET) \ $(UNIT_TESTS_REQ_LHAPDF5) \ $(UNIT_TESTS_REQ_LHAPDF6) \ $(UNIT_TESTS_REQ_OCAML) \ $(UNIT_TESTS_REQ_RECOLA) TEST_DRIVERS_SH = $(TEST_DRIVERS_RUN:.run=.sh) ######################################################################## TESTS = XFAIL_TESTS = TESTS_SRC = UNIT_TESTS += $(UNIT_TESTS_REQ_FASTJET) UNIT_TESTS += $(UNIT_TESTS_REQ_HEPMC2) UNIT_TESTS += $(UNIT_TESTS_REQ_HEPMC3) UNIT_TESTS += $(UNIT_TESTS_REQ_LCIO) UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF5) UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF6) UNIT_TESTS += $(UNIT_TESTS_REQ_OCAML) UNIT_TESTS += $(UNIT_TESTS_REQ_EV_ANA) UNIT_TESTS += $(UNIT_TESTS_REQ_RECOLA) TESTS += $(UNIT_TESTS) XFAIL_TESTS += $(XFAIL_UNIT_TESTS) EXTRA_DIST = $(TEST_DRIVERS_SH) $(TESTS_SRC) ######################################################################## # Force building the whizard_ut executable in the main src directory. # This depends on the unit-test libraries which will be built recursively. WHIZARD_UT = ../../src/whizard_ut $(TEST_DRIVERS_RUN): $(WHIZARD_UT) $(WHIZARD_UT): $(MAKE) -C ../../src check ######################################################################## # Force building the whizard_c_test executable in the main src directory. # This depends on the unit-test libraries which will be built recursively. WHIZARD_C_TEST = ../../src/whizard_c_test $(TEST_DRIVERS_RUN): $(WHIZARD_C_TEST) $(WHIZARD_C_TEST): $(WHIZARD_UT) ######################################################################## # Force building the whizard_c_test executable in the main src directory. # This depends on the unit-test libraries which will be built recursively. WHIZARD_CC_TEST = ../../src/whizard_cc_test $(TEST_DRIVERS_RUN): $(WHIZARD_CC_TEST) $(WHIZARD_CC_TEST): $(WHIZARD_C_TEST) ######################################################################## VPATH = $(srcdir) SUFFIXES = .sh .run .sh.run: @rm -f $@ @cp $< $@ @chmod +x $@ sf_beam_events.run: test_beam_events.dat test_beam_events.dat: $(top_builddir)/share/beam-sim/test_beam_events.dat cp $< $@ cascades2_lexer.run: cascades2_lexer_1.fds cascades2_lexer_1.fds: $(top_srcdir)/share/tests/cascades2_lexer_1.fds cp $< $@ cascades2.run: cascades2_1.fds cascades2_2.fds cascades2_1.fds: $(top_srcdir)/share/tests/cascades2_1.fds cp $< $@ cascades2_2.fds: $(top_srcdir)/share/tests/cascades2_2.fds cp $< $@ WT_OCAML_NATIVE_EXT=opt if MPOST_AVAILABLE commands.run: gamelan.sty sps1ap_decays.slha gamelan.sty: $(top_builddir)/src/gamelan/gamelan.sty cp $< $@ $(top_builddir)/src/gamelan/gamelan.sty: $(MAKE) -C $(top_builddir)/src/gamelan gamelan.sty else commands.run: sps1ap_decays.slha endif sps1ap_decays.slha: $(top_builddir)/share/susy/sps1ap_decays.slha cp $< $@ if OCAML_AVAILABLE UFO_TAG_FILE = __init__.py UFO_MODELPATH = ../models/UFO models.run: $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE) $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE) $(MAKE) -C $(UFO_MODELPATH)/SM all endif BUILT_SOURCES = \ TESTFLAG \ HEPMC2_FLAG \ HEPMC3_FLAG \ LCIO_FLAG \ FASTJET_FLAG \ LHAPDF5_FLAG \ LHAPDF6_FLAG \ EVENT_ANALYSIS_FLAG \ OCAML_FLAG \ RECOLA_FLAG \ PYTHIA6_FLAG \ PYTHIA8_FLAG \ STATIC_FLAG \ ref-output \ err-output # If this file is found in the working directory, WHIZARD # will use the paths for the uninstalled version (source/build tree), # otherwise it uses the installed version TESTFLAG: touch $@ FASTJET_FLAG: if FASTJET_AVAILABLE touch $@ endif HEPMC2_FLAG: if HEPMC2_AVAILABLE touch $@ endif HEPMC3_FLAG: if HEPMC3_AVAILABLE touch $@ endif LCIO_FLAG: if LCIO_AVAILABLE touch $@ endif LHAPDF5_FLAG: if LHAPDF5_AVAILABLE touch $@ endif LHAPDF6_FLAG: if LHAPDF6_AVAILABLE touch $@ endif OCAML_FLAG: if OCAML_AVAILABLE touch $@ endif RECOLA_FLAG: if RECOLA_AVAILABLE touch $@ endif PYTHIA6_FLAG: if PYTHIA6_AVAILABLE touch $@ endif PYTHIA8_FLAG: if PYTHIA8_AVAILABLE touch $@ endif EVENT_ANALYSIS_FLAG: if EVENT_ANALYSIS_AVAILABLE touch $@ endif STATIC_FLAG: if STATIC_AVAILABLE touch $@ endif # The reference output files are in the source directory. Copy them here. ref-output: $(top_srcdir)/share/tests/unit_tests/ref-output mkdir -p ref-output for f in $ # Thorsten Ohl # Juergen Reuter # with contributions from # cf. main AUTHORS file # # WHIZARD is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # WHIZARD is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ######################################################################## EXTRA_DIST = \ $(TESTSUITE_MACROS) $(TESTSUITES_M4) $(TESTSUITES_SIN) \ $(TESTSUITE_TOOLS) \ $(REF_OUTPUT_FILES) \ cascades2_1.fds \ cascades2_2.fds \ cascades2_lexer_1.fds \ ext_tests_nmssm/nmssm.slha \ functional_tests/structure_2_inc.sin functional_tests/testproc_3.phs \ functional_tests/susyhit.in \ functional_tests/ufo_5_test.slha TESTSUITE_MACROS = testsuite.m4 TESTSUITE_TOOLS = \ check-debug-output.py \ check-debug-output-hadro.py \ check-hepmc-weights.py \ compare-histograms.py \ compare-integrals.py \ compare-integrals-multi.py \ compare-methods.py REF_OUTPUT_FILES = \ extra_integration_results.dat \ $(REF_OUTPUT_FILES_BASE) $(REF_OUTPUT_FILES_DOUBLE) \ $(REF_OUTPUT_FILES_PREC) $(REF_OUTPUT_FILES_EXT) \ $(REF_OUTPUT_FILES_QUAD) REF_OUTPUT_FILES_BASE = \ unit_tests/ref-output/analysis_1.ref \ unit_tests/ref-output/api_1.ref \ unit_tests/ref-output/api_2.ref \ unit_tests/ref-output/api_3.ref \ unit_tests/ref-output/api_4.ref \ unit_tests/ref-output/api_5.ref \ unit_tests/ref-output/api_6.ref \ unit_tests/ref-output/api_7.ref \ unit_tests/ref-output/api_8.ref \ unit_tests/ref-output/api_c_1.ref \ unit_tests/ref-output/api_c_2.ref \ unit_tests/ref-output/api_c_3.ref \ unit_tests/ref-output/api_c_4.ref \ unit_tests/ref-output/api_c_5.ref \ unit_tests/ref-output/api_cc_1.ref \ unit_tests/ref-output/api_cc_2.ref \ unit_tests/ref-output/api_cc_3.ref \ unit_tests/ref-output/api_cc_4.ref \ unit_tests/ref-output/api_cc_5.ref \ unit_tests/ref-output/api_hepmc2_1.ref \ unit_tests/ref-output/api_hepmc2_cc_1.ref \ unit_tests/ref-output/api_hepmc3_1.ref \ unit_tests/ref-output/api_hepmc3_cc_1.ref \ unit_tests/ref-output/api_lcio_1.ref \ unit_tests/ref-output/api_lcio_cc_1.ref \ unit_tests/ref-output/array_list_1.ref \ unit_tests/ref-output/auto_components_1.ref \ unit_tests/ref-output/auto_components_2.ref \ unit_tests/ref-output/auto_components_3.ref \ unit_tests/ref-output/beam_1.ref \ unit_tests/ref-output/beam_2.ref \ unit_tests/ref-output/beam_3.ref \ unit_tests/ref-output/beam_structures_1.ref \ unit_tests/ref-output/beam_structures_2.ref \ unit_tests/ref-output/beam_structures_3.ref \ unit_tests/ref-output/beam_structures_4.ref \ unit_tests/ref-output/beam_structures_5.ref \ unit_tests/ref-output/beam_structures_6.ref \ unit_tests/ref-output/binary_tree_1.ref \ unit_tests/ref-output/blha_1.ref \ unit_tests/ref-output/blha_2.ref \ unit_tests/ref-output/blha_3.ref \ unit_tests/ref-output/bloch_vectors_1.ref \ unit_tests/ref-output/bloch_vectors_2.ref \ unit_tests/ref-output/bloch_vectors_3.ref \ unit_tests/ref-output/bloch_vectors_4.ref \ unit_tests/ref-output/bloch_vectors_5.ref \ unit_tests/ref-output/bloch_vectors_6.ref \ unit_tests/ref-output/bloch_vectors_7.ref \ unit_tests/ref-output/cascades2_1.ref \ unit_tests/ref-output/cascades2_2.ref \ unit_tests/ref-output/cascades2_lexer_1.ref \ unit_tests/ref-output/cascades_1.ref \ unit_tests/ref-output/cascades_2.ref \ unit_tests/ref-output/color_1.ref \ unit_tests/ref-output/color_2.ref \ unit_tests/ref-output/commands_1.ref \ unit_tests/ref-output/commands_2.ref \ unit_tests/ref-output/commands_3.ref \ unit_tests/ref-output/commands_4.ref \ unit_tests/ref-output/commands_5.ref \ unit_tests/ref-output/commands_6.ref \ unit_tests/ref-output/commands_7.ref \ unit_tests/ref-output/commands_8.ref \ unit_tests/ref-output/commands_9.ref \ unit_tests/ref-output/commands_10.ref \ unit_tests/ref-output/commands_11.ref \ unit_tests/ref-output/commands_12.ref \ unit_tests/ref-output/commands_13.ref \ unit_tests/ref-output/commands_14.ref \ unit_tests/ref-output/commands_15.ref \ unit_tests/ref-output/commands_16.ref \ unit_tests/ref-output/commands_17.ref \ unit_tests/ref-output/commands_18.ref \ unit_tests/ref-output/commands_19.ref \ unit_tests/ref-output/commands_20.ref \ unit_tests/ref-output/commands_21.ref \ unit_tests/ref-output/commands_22.ref \ unit_tests/ref-output/commands_23.ref \ unit_tests/ref-output/commands_24.ref \ unit_tests/ref-output/commands_25.ref \ unit_tests/ref-output/commands_26.ref \ unit_tests/ref-output/commands_27.ref \ unit_tests/ref-output/commands_28.ref \ unit_tests/ref-output/commands_29.ref \ unit_tests/ref-output/commands_30.ref \ unit_tests/ref-output/commands_31.ref \ unit_tests/ref-output/commands_32.ref \ unit_tests/ref-output/commands_33.ref \ unit_tests/ref-output/commands_34.ref \ unit_tests/ref-output/compilations_1.ref \ unit_tests/ref-output/compilations_2.ref \ unit_tests/ref-output/compilations_3.ref \ unit_tests/ref-output/compilations_static_1.ref \ unit_tests/ref-output/compilations_static_2.ref \ unit_tests/ref-output/cputime_1.ref \ unit_tests/ref-output/cputime_2.ref \ unit_tests/ref-output/decays_1.ref \ unit_tests/ref-output/decays_2.ref \ unit_tests/ref-output/decays_3.ref \ unit_tests/ref-output/decays_4.ref \ unit_tests/ref-output/decays_5.ref \ unit_tests/ref-output/decays_6.ref \ unit_tests/ref-output/dispatch_1.ref \ unit_tests/ref-output/dispatch_2.ref \ unit_tests/ref-output/dispatch_7.ref \ unit_tests/ref-output/dispatch_8.ref \ unit_tests/ref-output/dispatch_10.ref \ unit_tests/ref-output/dispatch_11.ref \ unit_tests/ref-output/dispatch_mci_1.ref \ unit_tests/ref-output/dispatch_phs_1.ref \ unit_tests/ref-output/dispatch_phs_2.ref \ unit_tests/ref-output/dispatch_rng_1.ref \ unit_tests/ref-output/dispatch_transforms_1.ref \ unit_tests/ref-output/dispatch_transforms_2.ref \ unit_tests/ref-output/eio_ascii_1.ref \ unit_tests/ref-output/eio_ascii_2.ref \ unit_tests/ref-output/eio_ascii_3.ref \ unit_tests/ref-output/eio_ascii_4.ref \ unit_tests/ref-output/eio_ascii_5.ref \ unit_tests/ref-output/eio_ascii_6.ref \ unit_tests/ref-output/eio_ascii_7.ref \ unit_tests/ref-output/eio_ascii_8.ref \ unit_tests/ref-output/eio_ascii_9.ref \ unit_tests/ref-output/eio_ascii_10.ref \ unit_tests/ref-output/eio_ascii_11.ref \ unit_tests/ref-output/eio_base_1.ref \ unit_tests/ref-output/eio_checkpoints_1.ref \ unit_tests/ref-output/eio_data_1.ref \ unit_tests/ref-output/eio_data_2.ref \ unit_tests/ref-output/eio_direct_1.ref \ unit_tests/ref-output/eio_dump_1.ref \ unit_tests/ref-output/eio_hepmc2_1.ref \ unit_tests/ref-output/eio_hepmc2_2.ref \ unit_tests/ref-output/eio_hepmc2_3.ref \ unit_tests/ref-output/eio_hepmc3_1.ref \ unit_tests/ref-output/eio_hepmc3_2.ref \ unit_tests/ref-output/eio_hepmc3_3.ref \ unit_tests/ref-output/eio_lcio_1.ref \ unit_tests/ref-output/eio_lcio_2.ref \ unit_tests/ref-output/eio_lhef_1.ref \ unit_tests/ref-output/eio_lhef_2.ref \ unit_tests/ref-output/eio_lhef_3.ref \ unit_tests/ref-output/eio_lhef_4.ref \ unit_tests/ref-output/eio_lhef_5.ref \ unit_tests/ref-output/eio_lhef_6.ref \ unit_tests/ref-output/eio_raw_1.ref \ unit_tests/ref-output/eio_raw_2.ref \ unit_tests/ref-output/eio_stdhep_1.ref \ unit_tests/ref-output/eio_stdhep_2.ref \ unit_tests/ref-output/eio_stdhep_3.ref \ unit_tests/ref-output/eio_stdhep_4.ref \ unit_tests/ref-output/eio_weights_1.ref \ unit_tests/ref-output/eio_weights_2.ref \ unit_tests/ref-output/eio_weights_3.ref \ unit_tests/ref-output/electron_pdfs_1.ref \ unit_tests/ref-output/electron_pdfs_2.ref \ unit_tests/ref-output/electron_pdfs_3.ref \ unit_tests/ref-output/electron_pdfs_4.ref \ unit_tests/ref-output/electron_pdfs_5.ref \ unit_tests/ref-output/electron_pdfs_6.ref \ unit_tests/ref-output/epa_handler_1.ref \ unit_tests/ref-output/epa_handler_2.ref \ unit_tests/ref-output/epa_handler_3.ref \ unit_tests/ref-output/evaluator_1.ref \ unit_tests/ref-output/evaluator_2.ref \ unit_tests/ref-output/evaluator_3.ref \ unit_tests/ref-output/evaluator_4.ref \ unit_tests/ref-output/event_streams_1.ref \ unit_tests/ref-output/event_streams_2.ref \ unit_tests/ref-output/event_streams_3.ref \ unit_tests/ref-output/event_streams_4.ref \ unit_tests/ref-output/event_transforms_1.ref \ unit_tests/ref-output/events_1.ref \ unit_tests/ref-output/events_2.ref \ unit_tests/ref-output/events_3.ref \ unit_tests/ref-output/events_4.ref \ unit_tests/ref-output/events_5.ref \ unit_tests/ref-output/events_6.ref \ unit_tests/ref-output/events_7.ref \ unit_tests/ref-output/expressions_1.ref \ unit_tests/ref-output/expressions_2.ref \ unit_tests/ref-output/expressions_3.ref \ unit_tests/ref-output/expressions_4.ref \ unit_tests/ref-output/fks_regions_1.ref \ unit_tests/ref-output/fks_regions_2.ref \ unit_tests/ref-output/fks_regions_3.ref \ unit_tests/ref-output/fks_regions_4.ref \ unit_tests/ref-output/fks_regions_5.ref \ unit_tests/ref-output/fks_regions_6.ref \ unit_tests/ref-output/fks_regions_7.ref \ unit_tests/ref-output/fks_regions_8.ref \ unit_tests/ref-output/format_1.ref \ unit_tests/ref-output/grids_1.ref \ unit_tests/ref-output/grids_2.ref \ unit_tests/ref-output/grids_3.ref \ unit_tests/ref-output/grids_4.ref \ unit_tests/ref-output/grids_5.ref \ unit_tests/ref-output/hep_events_1.ref \ unit_tests/ref-output/hepmc2_interface_1.ref \ unit_tests/ref-output/hepmc3_interface_1.ref \ unit_tests/ref-output/integration_results_1.ref \ unit_tests/ref-output/integration_results_2.ref \ unit_tests/ref-output/integration_results_3.ref \ unit_tests/ref-output/integration_results_4.ref \ unit_tests/ref-output/integration_results_5.ref \ unit_tests/ref-output/integrations_1.ref \ unit_tests/ref-output/integrations_2.ref \ unit_tests/ref-output/integrations_3.ref \ unit_tests/ref-output/integrations_4.ref \ unit_tests/ref-output/integrations_5.ref \ unit_tests/ref-output/integrations_6.ref \ unit_tests/ref-output/integrations_7.ref \ unit_tests/ref-output/integrations_8.ref \ unit_tests/ref-output/integrations_9.ref \ unit_tests/ref-output/integrations_history_1.ref \ unit_tests/ref-output/interaction_1.ref \ unit_tests/ref-output/isr_handler_1.ref \ unit_tests/ref-output/isr_handler_2.ref \ unit_tests/ref-output/isr_handler_3.ref \ unit_tests/ref-output/iterations_1.ref \ unit_tests/ref-output/iterations_2.ref \ unit_tests/ref-output/iterator_1.ref \ unit_tests/ref-output/jets_1.ref \ + unit_tests/ref-output/kinematics_vars_1.ref \ unit_tests/ref-output/lcio_interface_1.ref \ unit_tests/ref-output/lexer_1.ref \ unit_tests/ref-output/lorentz_1.ref \ unit_tests/ref-output/lorentz_2.ref \ unit_tests/ref-output/lorentz_3.ref \ unit_tests/ref-output/lorentz_4.ref \ unit_tests/ref-output/lorentz_5.ref \ unit_tests/ref-output/mci_base_1.ref \ unit_tests/ref-output/mci_base_2.ref \ unit_tests/ref-output/mci_base_3.ref \ unit_tests/ref-output/mci_base_4.ref \ unit_tests/ref-output/mci_base_5.ref \ unit_tests/ref-output/mci_base_6.ref \ unit_tests/ref-output/mci_base_7.ref \ unit_tests/ref-output/mci_base_8.ref \ unit_tests/ref-output/mci_midpoint_1.ref \ unit_tests/ref-output/mci_midpoint_2.ref \ unit_tests/ref-output/mci_midpoint_3.ref \ unit_tests/ref-output/mci_midpoint_4.ref \ unit_tests/ref-output/mci_midpoint_5.ref \ unit_tests/ref-output/mci_midpoint_6.ref \ unit_tests/ref-output/mci_midpoint_7.ref \ unit_tests/ref-output/mci_none_1.ref \ unit_tests/ref-output/mci_vamp2_1.ref \ unit_tests/ref-output/mci_vamp2_2.ref \ unit_tests/ref-output/mci_vamp2_3.ref \ unit_tests/ref-output/mci_vamp_1.ref \ unit_tests/ref-output/mci_vamp_2.ref \ unit_tests/ref-output/mci_vamp_3.ref \ unit_tests/ref-output/mci_vamp_4.ref \ unit_tests/ref-output/mci_vamp_5.ref \ unit_tests/ref-output/mci_vamp_6.ref \ unit_tests/ref-output/mci_vamp_7.ref \ unit_tests/ref-output/mci_vamp_8.ref \ unit_tests/ref-output/mci_vamp_9.ref \ unit_tests/ref-output/mci_vamp_10.ref \ unit_tests/ref-output/mci_vamp_11.ref \ unit_tests/ref-output/mci_vamp_12.ref \ unit_tests/ref-output/mci_vamp_13.ref \ unit_tests/ref-output/mci_vamp_14.ref \ unit_tests/ref-output/mci_vamp_15.ref \ unit_tests/ref-output/mci_vamp_16.ref \ unit_tests/ref-output/md5_1.ref \ unit_tests/ref-output/models_1.ref \ unit_tests/ref-output/models_2.ref \ unit_tests/ref-output/models_3.ref \ unit_tests/ref-output/models_4.ref \ unit_tests/ref-output/models_5.ref \ unit_tests/ref-output/models_6.ref \ unit_tests/ref-output/models_7.ref \ unit_tests/ref-output/models_8.ref \ unit_tests/ref-output/models_9.ref \ unit_tests/ref-output/models_10.ref \ unit_tests/ref-output/numeric_utils_1.ref \ unit_tests/ref-output/numeric_utils_2.ref \ unit_tests/ref-output/os_interface_1.ref \ unit_tests/ref-output/parse_1.ref \ unit_tests/ref-output/particle_specifiers_1.ref \ unit_tests/ref-output/particle_specifiers_2.ref \ unit_tests/ref-output/particles_1.ref \ unit_tests/ref-output/particles_2.ref \ unit_tests/ref-output/particles_3.ref \ unit_tests/ref-output/particles_4.ref \ unit_tests/ref-output/particles_5.ref \ unit_tests/ref-output/particles_6.ref \ unit_tests/ref-output/particles_7.ref \ unit_tests/ref-output/particles_8.ref \ unit_tests/ref-output/particles_9.ref \ unit_tests/ref-output/parton_states_1.ref \ unit_tests/ref-output/pdg_arrays_1.ref \ unit_tests/ref-output/pdg_arrays_2.ref \ unit_tests/ref-output/pdg_arrays_3.ref \ unit_tests/ref-output/pdg_arrays_4.ref \ unit_tests/ref-output/pdg_arrays_5.ref \ unit_tests/ref-output/phs_base_1.ref \ unit_tests/ref-output/phs_base_2.ref \ unit_tests/ref-output/phs_base_3.ref \ unit_tests/ref-output/phs_base_4.ref \ unit_tests/ref-output/phs_base_5.ref \ unit_tests/ref-output/phs_fks_generator_1.ref \ unit_tests/ref-output/phs_fks_generator_2.ref \ unit_tests/ref-output/phs_fks_generator_3.ref \ unit_tests/ref-output/phs_fks_generator_4.ref \ unit_tests/ref-output/phs_fks_generator_5.ref \ unit_tests/ref-output/phs_fks_generator_6.ref \ unit_tests/ref-output/phs_fks_generator_7.ref \ unit_tests/ref-output/phs_forest_1.ref \ unit_tests/ref-output/phs_forest_2.ref \ unit_tests/ref-output/phs_none_1.ref \ unit_tests/ref-output/phs_points_1.ref \ unit_tests/ref-output/phs_rambo_1.ref \ unit_tests/ref-output/phs_rambo_2.ref \ unit_tests/ref-output/phs_rambo_3.ref \ unit_tests/ref-output/phs_rambo_4.ref \ unit_tests/ref-output/phs_single_1.ref \ unit_tests/ref-output/phs_single_2.ref \ unit_tests/ref-output/phs_single_3.ref \ unit_tests/ref-output/phs_single_4.ref \ unit_tests/ref-output/phs_tree_1.ref \ unit_tests/ref-output/phs_tree_2.ref \ unit_tests/ref-output/phs_wood_1.ref \ unit_tests/ref-output/phs_wood_2.ref \ unit_tests/ref-output/phs_wood_3.ref \ unit_tests/ref-output/phs_wood_4.ref \ unit_tests/ref-output/phs_wood_5.ref \ unit_tests/ref-output/phs_wood_6.ref \ unit_tests/ref-output/phs_wood_vis_1.ref \ unit_tests/ref-output/polarization_1.ref \ unit_tests/ref-output/polarization_2.ref \ unit_tests/ref-output/prc_omega_1.ref \ unit_tests/ref-output/prc_omega_2.ref \ unit_tests/ref-output/prc_omega_3.ref \ unit_tests/ref-output/prc_omega_4.ref \ unit_tests/ref-output/prc_omega_5.ref \ unit_tests/ref-output/prc_omega_6.ref \ unit_tests/ref-output/prc_omega_diags_1.ref \ unit_tests/ref-output/prc_recola_1.ref \ unit_tests/ref-output/prc_recola_2.ref \ unit_tests/ref-output/prc_template_me_1.ref \ unit_tests/ref-output/prc_template_me_2.ref \ unit_tests/ref-output/prc_test_1.ref \ unit_tests/ref-output/prc_test_2.ref \ unit_tests/ref-output/prc_test_3.ref \ unit_tests/ref-output/prc_test_4.ref \ unit_tests/ref-output/prclib_interfaces_1.ref \ unit_tests/ref-output/prclib_interfaces_2.ref \ unit_tests/ref-output/prclib_interfaces_3.ref \ unit_tests/ref-output/prclib_interfaces_4.ref \ unit_tests/ref-output/prclib_interfaces_5.ref \ unit_tests/ref-output/prclib_interfaces_6.ref \ unit_tests/ref-output/prclib_interfaces_7.ref \ unit_tests/ref-output/prclib_stacks_1.ref \ unit_tests/ref-output/prclib_stacks_2.ref \ unit_tests/ref-output/process_configurations_1.ref \ unit_tests/ref-output/process_configurations_2.ref \ unit_tests/ref-output/process_libraries_1.ref \ unit_tests/ref-output/process_libraries_2.ref \ unit_tests/ref-output/process_libraries_3.ref \ unit_tests/ref-output/process_libraries_4.ref \ unit_tests/ref-output/process_libraries_5.ref \ unit_tests/ref-output/process_libraries_6.ref \ unit_tests/ref-output/process_libraries_7.ref \ unit_tests/ref-output/process_libraries_8.ref \ unit_tests/ref-output/process_stacks_1.ref \ unit_tests/ref-output/process_stacks_2.ref \ unit_tests/ref-output/process_stacks_3.ref \ unit_tests/ref-output/process_stacks_4.ref \ unit_tests/ref-output/processes_1.ref \ unit_tests/ref-output/processes_2.ref \ unit_tests/ref-output/processes_3.ref \ unit_tests/ref-output/processes_4.ref \ unit_tests/ref-output/processes_5.ref \ unit_tests/ref-output/processes_6.ref \ unit_tests/ref-output/processes_7.ref \ unit_tests/ref-output/processes_8.ref \ unit_tests/ref-output/processes_9.ref \ unit_tests/ref-output/processes_10.ref \ unit_tests/ref-output/processes_11.ref \ unit_tests/ref-output/processes_12.ref \ unit_tests/ref-output/processes_13.ref \ unit_tests/ref-output/processes_14.ref \ unit_tests/ref-output/processes_15.ref \ unit_tests/ref-output/processes_16.ref \ unit_tests/ref-output/processes_17.ref \ unit_tests/ref-output/processes_18.ref \ unit_tests/ref-output/processes_19.ref \ unit_tests/ref-output/radiation_generator_1.ref \ unit_tests/ref-output/radiation_generator_2.ref \ unit_tests/ref-output/radiation_generator_3.ref \ unit_tests/ref-output/radiation_generator_4.ref \ unit_tests/ref-output/real_subtraction_1.ref \ unit_tests/ref-output/recoil_kinematics_1.ref \ unit_tests/ref-output/recoil_kinematics_2.ref \ unit_tests/ref-output/recoil_kinematics_3.ref \ unit_tests/ref-output/recoil_kinematics_4.ref \ unit_tests/ref-output/recoil_kinematics_5.ref \ unit_tests/ref-output/recoil_kinematics_6.ref \ unit_tests/ref-output/resonance_insertion_1.ref \ unit_tests/ref-output/resonance_insertion_2.ref \ unit_tests/ref-output/resonance_insertion_3.ref \ unit_tests/ref-output/resonance_insertion_4.ref \ unit_tests/ref-output/resonance_insertion_5.ref \ unit_tests/ref-output/resonance_insertion_6.ref \ unit_tests/ref-output/resonances_1.ref \ unit_tests/ref-output/resonances_2.ref \ unit_tests/ref-output/resonances_3.ref \ unit_tests/ref-output/resonances_4.ref \ unit_tests/ref-output/resonances_5.ref \ unit_tests/ref-output/resonances_6.ref \ unit_tests/ref-output/resonances_7.ref \ unit_tests/ref-output/restricted_subprocesses_1.ref \ unit_tests/ref-output/restricted_subprocesses_2.ref \ unit_tests/ref-output/restricted_subprocesses_3.ref \ unit_tests/ref-output/restricted_subprocesses_4.ref \ unit_tests/ref-output/restricted_subprocesses_5.ref \ unit_tests/ref-output/restricted_subprocesses_6.ref \ unit_tests/ref-output/rng_base_1.ref \ unit_tests/ref-output/rng_base_2.ref \ unit_tests/ref-output/rng_stream_1.ref \ unit_tests/ref-output/rng_stream_2.ref \ unit_tests/ref-output/rng_stream_3.ref \ unit_tests/ref-output/rng_tao_1.ref \ unit_tests/ref-output/rng_tao_2.ref \ unit_tests/ref-output/rt_data_1.ref \ unit_tests/ref-output/rt_data_2.ref \ unit_tests/ref-output/rt_data_3.ref \ unit_tests/ref-output/rt_data_4.ref \ unit_tests/ref-output/rt_data_5.ref \ unit_tests/ref-output/rt_data_6.ref \ unit_tests/ref-output/rt_data_7.ref \ unit_tests/ref-output/rt_data_8.ref \ unit_tests/ref-output/rt_data_9.ref \ unit_tests/ref-output/rt_data_10.ref \ unit_tests/ref-output/rt_data_11.ref \ unit_tests/ref-output/selectors_1.ref \ unit_tests/ref-output/selectors_2.ref \ unit_tests/ref-output/sf_aux_1.ref \ unit_tests/ref-output/sf_aux_2.ref \ unit_tests/ref-output/sf_aux_3.ref \ unit_tests/ref-output/sf_aux_4.ref \ unit_tests/ref-output/sf_base_1.ref \ unit_tests/ref-output/sf_base_2.ref \ unit_tests/ref-output/sf_base_3.ref \ unit_tests/ref-output/sf_base_4.ref \ unit_tests/ref-output/sf_base_5.ref \ unit_tests/ref-output/sf_base_6.ref \ unit_tests/ref-output/sf_base_7.ref \ unit_tests/ref-output/sf_base_8.ref \ unit_tests/ref-output/sf_base_9.ref \ unit_tests/ref-output/sf_base_10.ref \ unit_tests/ref-output/sf_base_11.ref \ unit_tests/ref-output/sf_base_12.ref \ unit_tests/ref-output/sf_base_13.ref \ unit_tests/ref-output/sf_base_14.ref \ unit_tests/ref-output/sf_beam_events_1.ref \ unit_tests/ref-output/sf_beam_events_2.ref \ unit_tests/ref-output/sf_beam_events_3.ref \ unit_tests/ref-output/sf_circe1_1.ref \ unit_tests/ref-output/sf_circe1_2.ref \ unit_tests/ref-output/sf_circe1_3.ref \ unit_tests/ref-output/sf_circe2_1.ref \ unit_tests/ref-output/sf_circe2_2.ref \ unit_tests/ref-output/sf_circe2_3.ref \ unit_tests/ref-output/sf_epa_1.ref \ unit_tests/ref-output/sf_epa_2.ref \ unit_tests/ref-output/sf_epa_3.ref \ unit_tests/ref-output/sf_epa_4.ref \ unit_tests/ref-output/sf_epa_5.ref \ unit_tests/ref-output/sf_escan_1.ref \ unit_tests/ref-output/sf_escan_2.ref \ unit_tests/ref-output/sf_ewa_1.ref \ unit_tests/ref-output/sf_ewa_2.ref \ unit_tests/ref-output/sf_ewa_3.ref \ unit_tests/ref-output/sf_ewa_4.ref \ unit_tests/ref-output/sf_ewa_5.ref \ unit_tests/ref-output/sf_gaussian_1.ref \ unit_tests/ref-output/sf_gaussian_2.ref \ unit_tests/ref-output/sf_isr_1.ref \ unit_tests/ref-output/sf_isr_2.ref \ unit_tests/ref-output/sf_isr_3.ref \ unit_tests/ref-output/sf_isr_4.ref \ unit_tests/ref-output/sf_isr_5.ref \ unit_tests/ref-output/sf_lhapdf5_1.ref \ unit_tests/ref-output/sf_lhapdf5_2.ref \ unit_tests/ref-output/sf_lhapdf5_3.ref \ unit_tests/ref-output/sf_lhapdf6_1.ref \ unit_tests/ref-output/sf_lhapdf6_2.ref \ unit_tests/ref-output/sf_lhapdf6_3.ref \ unit_tests/ref-output/sf_mappings_1.ref \ unit_tests/ref-output/sf_mappings_2.ref \ unit_tests/ref-output/sf_mappings_3.ref \ unit_tests/ref-output/sf_mappings_4.ref \ unit_tests/ref-output/sf_mappings_5.ref \ unit_tests/ref-output/sf_mappings_6.ref \ unit_tests/ref-output/sf_mappings_7.ref \ unit_tests/ref-output/sf_mappings_8.ref \ unit_tests/ref-output/sf_mappings_9.ref \ unit_tests/ref-output/sf_mappings_10.ref \ unit_tests/ref-output/sf_mappings_11.ref \ unit_tests/ref-output/sf_mappings_12.ref \ unit_tests/ref-output/sf_mappings_13.ref \ unit_tests/ref-output/sf_mappings_14.ref \ unit_tests/ref-output/sf_mappings_15.ref \ unit_tests/ref-output/sf_mappings_16.ref \ unit_tests/ref-output/sf_pdf_builtin_1.ref \ unit_tests/ref-output/sf_pdf_builtin_2.ref \ unit_tests/ref-output/sf_pdf_builtin_3.ref \ unit_tests/ref-output/shower_1.ref \ unit_tests/ref-output/shower_2.ref \ unit_tests/ref-output/shower_base_1.ref \ unit_tests/ref-output/simulations_1.ref \ unit_tests/ref-output/simulations_2.ref \ unit_tests/ref-output/simulations_3.ref \ unit_tests/ref-output/simulations_4.ref \ unit_tests/ref-output/simulations_5.ref \ unit_tests/ref-output/simulations_6.ref \ unit_tests/ref-output/simulations_7.ref \ unit_tests/ref-output/simulations_8.ref \ unit_tests/ref-output/simulations_9.ref \ unit_tests/ref-output/simulations_10.ref \ unit_tests/ref-output/simulations_11.ref \ unit_tests/ref-output/simulations_12.ref \ unit_tests/ref-output/simulations_13.ref \ unit_tests/ref-output/simulations_14.ref \ unit_tests/ref-output/simulations_15.ref \ unit_tests/ref-output/slha_1.ref \ unit_tests/ref-output/slha_2.ref \ unit_tests/ref-output/sm_physics_1.ref \ unit_tests/ref-output/sm_physics_2.ref \ unit_tests/ref-output/sm_physics_3.ref \ unit_tests/ref-output/sm_qcd_1.ref \ unit_tests/ref-output/sm_qed_1.ref \ unit_tests/ref-output/solver_1.ref \ unit_tests/ref-output/sorting_1.ref \ unit_tests/ref-output/state_matrix_1.ref \ unit_tests/ref-output/state_matrix_2.ref \ unit_tests/ref-output/state_matrix_3.ref \ unit_tests/ref-output/state_matrix_4.ref \ unit_tests/ref-output/state_matrix_5.ref \ unit_tests/ref-output/state_matrix_6.ref \ unit_tests/ref-output/state_matrix_7.ref \ unit_tests/ref-output/su_algebra_1.ref \ unit_tests/ref-output/su_algebra_2.ref \ unit_tests/ref-output/su_algebra_3.ref \ unit_tests/ref-output/su_algebra_4.ref \ unit_tests/ref-output/subevt_expr_1.ref \ unit_tests/ref-output/subevt_expr_2.ref \ unit_tests/ref-output/ttv_formfactors_1.ref \ unit_tests/ref-output/ttv_formfactors_2.ref \ unit_tests/ref-output/vamp2_1.ref \ unit_tests/ref-output/vamp2_2.ref \ unit_tests/ref-output/vamp2_3.ref \ unit_tests/ref-output/vamp2_4.ref \ unit_tests/ref-output/vamp2_5.ref \ unit_tests/ref-output/vegas_1.ref \ unit_tests/ref-output/vegas_2.ref \ unit_tests/ref-output/vegas_3.ref \ unit_tests/ref-output/vegas_4.ref \ unit_tests/ref-output/vegas_5.ref \ unit_tests/ref-output/vegas_6.ref \ unit_tests/ref-output/vegas_7.ref \ unit_tests/ref-output/whizard_lha_1.ref \ unit_tests/ref-output/xml_1.ref \ unit_tests/ref-output/xml_2.ref \ unit_tests/ref-output/xml_3.ref \ unit_tests/ref-output/xml_4.ref \ functional_tests/ref-output/alphas.ref \ functional_tests/ref-output/analyze_1.ref \ functional_tests/ref-output/analyze_2.ref \ functional_tests/ref-output/analyze_3.ref \ functional_tests/ref-output/analyze_4.ref \ functional_tests/ref-output/analyze_5.ref \ functional_tests/ref-output/analyze_6.ref \ functional_tests/ref-output/beam_events_1.ref \ functional_tests/ref-output/beam_events_4.ref \ functional_tests/ref-output/beam_setup_1.ref \ functional_tests/ref-output/beam_setup_2.ref \ functional_tests/ref-output/beam_setup_3.ref \ functional_tests/ref-output/beam_setup_4.ref \ functional_tests/ref-output/bjet_cluster.ref \ functional_tests/ref-output/br_redef_1.ref \ functional_tests/ref-output/cascades2_phs_1.ref \ functional_tests/ref-output/cascades2_phs_2.ref \ functional_tests/ref-output/circe1_1.ref \ functional_tests/ref-output/circe1_2.ref \ functional_tests/ref-output/circe1_3.ref \ functional_tests/ref-output/circe1_6.ref \ functional_tests/ref-output/circe1_10.ref \ functional_tests/ref-output/circe1_errors_1.ref \ functional_tests/ref-output/circe2_1.ref \ functional_tests/ref-output/circe2_2.ref \ functional_tests/ref-output/circe2_3.ref \ functional_tests/ref-output/cmdline_1.ref \ functional_tests/ref-output/colors.ref \ functional_tests/ref-output/colors_hgg.ref \ functional_tests/ref-output/cuts.ref \ functional_tests/ref-output/decay_err_1.ref \ functional_tests/ref-output/decay_err_2.ref \ functional_tests/ref-output/decay_err_3.ref \ functional_tests/ref-output/energy_scan_1.ref \ functional_tests/ref-output/ep_3.ref \ functional_tests/ref-output/epa_1.ref \ functional_tests/ref-output/epa_2.ref \ functional_tests/ref-output/epa_3.ref \ functional_tests/ref-output/epa_4.ref \ functional_tests/ref-output/event_dump_1.ref \ functional_tests/ref-output/event_dump_2.ref \ functional_tests/ref-output/event_eff_1.ref \ functional_tests/ref-output/event_eff_2.ref \ functional_tests/ref-output/event_failed_1.ref \ functional_tests/ref-output/event_weights_1.ref \ functional_tests/ref-output/event_weights_2.ref \ functional_tests/ref-output/ewa_4.ref \ functional_tests/ref-output/extpar.ref \ functional_tests/ref-output/fatal.ref \ functional_tests/ref-output/fatal_beam_decay.ref \ functional_tests/ref-output/fks_res_2.ref \ functional_tests/ref-output/flvsum_1.ref \ functional_tests/ref-output/gaussian_1.ref \ functional_tests/ref-output/gaussian_2.ref \ functional_tests/ref-output/hadronize_1.ref \ functional_tests/ref-output/hepmc_1.ref \ functional_tests/ref-output/hepmc_2.ref \ functional_tests/ref-output/hepmc_3.ref \ functional_tests/ref-output/hepmc_4.ref \ functional_tests/ref-output/hepmc_5.ref \ functional_tests/ref-output/hepmc_6.ref \ functional_tests/ref-output/hepmc_7.ref \ functional_tests/ref-output/hepmc_9.ref \ functional_tests/ref-output/hepmc_10.ref \ functional_tests/ref-output/isr_1.ref \ functional_tests/ref-output/isr_epa_1.ref \ functional_tests/ref-output/jets_xsec.ref \ functional_tests/ref-output/job_id_1.ref \ functional_tests/ref-output/job_id_2.ref \ functional_tests/ref-output/job_id_3.ref \ functional_tests/ref-output/job_id_4.ref \ functional_tests/ref-output/lcio_1.ref \ functional_tests/ref-output/lcio_3.ref \ functional_tests/ref-output/lcio_4.ref \ functional_tests/ref-output/lcio_5.ref \ functional_tests/ref-output/lcio_6.ref \ functional_tests/ref-output/lcio_8.ref \ functional_tests/ref-output/lcio_9.ref \ functional_tests/ref-output/lcio_10.ref \ functional_tests/ref-output/lcio_11.ref \ functional_tests/ref-output/lhef_1.ref \ functional_tests/ref-output/lhef_2.ref \ functional_tests/ref-output/lhef_3.ref \ functional_tests/ref-output/lhef_4.ref \ functional_tests/ref-output/lhef_5.ref \ functional_tests/ref-output/lhef_6.ref \ functional_tests/ref-output/lhef_9.ref \ functional_tests/ref-output/lhef_10.ref \ functional_tests/ref-output/lhef_11.ref \ functional_tests/ref-output/libraries_1.ref \ functional_tests/ref-output/libraries_2.ref \ functional_tests/ref-output/libraries_4.ref \ functional_tests/ref-output/method_ovm_1.ref \ functional_tests/ref-output/mlm_matching_fsr.ref \ functional_tests/ref-output/mlm_pythia6_isr.ref \ functional_tests/ref-output/model_change_1.ref \ functional_tests/ref-output/model_change_2.ref \ functional_tests/ref-output/model_change_3.ref \ functional_tests/ref-output/model_scheme_1.ref \ functional_tests/ref-output/model_test.ref \ functional_tests/ref-output/mssmtest_1.ref \ functional_tests/ref-output/mssmtest_2.ref \ functional_tests/ref-output/mssmtest_3.ref \ functional_tests/ref-output/multi_comp_4.ref \ functional_tests/ref-output/nlo_1.ref \ functional_tests/ref-output/nlo_2.ref \ functional_tests/ref-output/nlo_6.ref \ functional_tests/ref-output/nlo_decay_1.ref \ functional_tests/ref-output/observables_1.ref \ functional_tests/ref-output/openloops_1.ref \ functional_tests/ref-output/openloops_2.ref \ functional_tests/ref-output/openloops_4.ref \ functional_tests/ref-output/openloops_5.ref \ functional_tests/ref-output/openloops_6.ref \ functional_tests/ref-output/openloops_7.ref \ functional_tests/ref-output/openloops_8.ref \ functional_tests/ref-output/openloops_9.ref \ functional_tests/ref-output/openloops_10.ref \ functional_tests/ref-output/openloops_11.ref \ functional_tests/ref-output/pack_1.ref \ functional_tests/ref-output/parton_shower_1.ref \ functional_tests/ref-output/photon_isolation_1.ref \ functional_tests/ref-output/photon_isolation_2.ref \ functional_tests/ref-output/polarized_1.ref \ functional_tests/ref-output/process_log.ref \ functional_tests/ref-output/pythia6_1.ref \ functional_tests/ref-output/pythia6_2.ref \ functional_tests/ref-output/pythia8_1.ref \ functional_tests/ref-output/pythia8_2.ref \ functional_tests/ref-output/qcdtest_4.ref \ functional_tests/ref-output/qcdtest_5.ref \ functional_tests/ref-output/qcdtest_6.ref \ functional_tests/ref-output/qedtest_1.ref \ functional_tests/ref-output/qedtest_2.ref \ functional_tests/ref-output/qedtest_5.ref \ functional_tests/ref-output/qedtest_6.ref \ functional_tests/ref-output/qedtest_7.ref \ functional_tests/ref-output/qedtest_8.ref \ functional_tests/ref-output/qedtest_9.ref \ functional_tests/ref-output/qedtest_10.ref \ functional_tests/ref-output/rambo_vamp_1.ref \ functional_tests/ref-output/rambo_vamp_2.ref \ functional_tests/ref-output/real_partition_1.ref \ functional_tests/ref-output/rebuild_2.ref \ functional_tests/ref-output/rebuild_3.ref \ functional_tests/ref-output/rebuild_4.ref \ functional_tests/ref-output/recola_1.ref \ functional_tests/ref-output/recola_2.ref \ functional_tests/ref-output/recola_3.ref \ functional_tests/ref-output/recola_4.ref \ functional_tests/ref-output/recola_5.ref \ functional_tests/ref-output/recola_6.ref \ functional_tests/ref-output/recola_7.ref \ functional_tests/ref-output/recola_8.ref \ functional_tests/ref-output/recola_9.ref \ functional_tests/ref-output/resonances_5.ref \ functional_tests/ref-output/resonances_6.ref \ functional_tests/ref-output/resonances_7.ref \ functional_tests/ref-output/resonances_8.ref \ functional_tests/ref-output/resonances_9.ref \ functional_tests/ref-output/resonances_12.ref \ functional_tests/ref-output/restrictions.ref \ functional_tests/ref-output/reweight_1.ref \ functional_tests/ref-output/reweight_2.ref \ functional_tests/ref-output/reweight_3.ref \ functional_tests/ref-output/reweight_4.ref \ functional_tests/ref-output/reweight_5.ref \ functional_tests/ref-output/reweight_6.ref \ functional_tests/ref-output/reweight_7.ref \ functional_tests/ref-output/reweight_8.ref \ functional_tests/ref-output/reweight_9.ref \ functional_tests/ref-output/reweight_10.ref \ functional_tests/ref-output/select_1.ref \ functional_tests/ref-output/select_2.ref \ functional_tests/ref-output/show_1.ref \ functional_tests/ref-output/show_2.ref \ functional_tests/ref-output/show_3.ref \ functional_tests/ref-output/show_4.ref \ functional_tests/ref-output/show_5.ref \ functional_tests/ref-output/shower_err_1.ref \ functional_tests/ref-output/sm_cms_1.ref \ functional_tests/ref-output/smtest_1.ref \ functional_tests/ref-output/smtest_3.ref \ functional_tests/ref-output/smtest_4.ref \ functional_tests/ref-output/smtest_5.ref \ functional_tests/ref-output/smtest_6.ref \ functional_tests/ref-output/smtest_7.ref \ functional_tests/ref-output/smtest_9.ref \ functional_tests/ref-output/smtest_10.ref \ functional_tests/ref-output/smtest_11.ref \ functional_tests/ref-output/smtest_12.ref \ functional_tests/ref-output/smtest_13.ref \ functional_tests/ref-output/smtest_14.ref \ functional_tests/ref-output/smtest_15.ref \ functional_tests/ref-output/smtest_16.ref \ functional_tests/ref-output/smtest_17.ref \ functional_tests/ref-output/spincor_1.ref \ functional_tests/ref-output/static_1.ref \ functional_tests/ref-output/static_2.ref \ functional_tests/ref-output/stdhep_1.ref \ functional_tests/ref-output/stdhep_2.ref \ functional_tests/ref-output/stdhep_3.ref \ functional_tests/ref-output/stdhep_4.ref \ functional_tests/ref-output/stdhep_5.ref \ functional_tests/ref-output/stdhep_6.ref \ functional_tests/ref-output/structure_1.ref \ functional_tests/ref-output/structure_2.ref \ functional_tests/ref-output/structure_3.ref \ functional_tests/ref-output/structure_4.ref \ functional_tests/ref-output/structure_5.ref \ functional_tests/ref-output/structure_6.ref \ functional_tests/ref-output/structure_7.ref \ functional_tests/ref-output/structure_8.ref \ functional_tests/ref-output/susyhit.ref \ functional_tests/ref-output/template_me_1.ref \ functional_tests/ref-output/template_me_2.ref \ functional_tests/ref-output/testproc_1.ref \ functional_tests/ref-output/testproc_2.ref \ functional_tests/ref-output/testproc_3.ref \ functional_tests/ref-output/testproc_4.ref \ functional_tests/ref-output/testproc_5.ref \ functional_tests/ref-output/testproc_6.ref \ functional_tests/ref-output/testproc_7.ref \ functional_tests/ref-output/testproc_8.ref \ functional_tests/ref-output/testproc_9.ref \ functional_tests/ref-output/testproc_10.ref \ functional_tests/ref-output/testproc_11.ref \ functional_tests/ref-output/ufo_1.ref \ functional_tests/ref-output/ufo_2.ref \ functional_tests/ref-output/ufo_3.ref \ functional_tests/ref-output/ufo_4.ref \ functional_tests/ref-output/ufo_5.ref \ functional_tests/ref-output/ufo_6.ref \ functional_tests/ref-output/user_prc_threshold_1.ref \ functional_tests/ref-output/user_prc_threshold_2.ref \ functional_tests/ref-output/vamp2_1.ref \ functional_tests/ref-output/vamp2_2.ref \ functional_tests/ref-output/vamp2_3.ref \ functional_tests/ref-output/vars.ref \ ext_tests_nlo/ref-output/nlo_ee4j.ref \ ext_tests_nlo/ref-output/nlo_ee4t.ref \ ext_tests_nlo/ref-output/nlo_ee5j.ref \ ext_tests_nlo/ref-output/nlo_eejj.ref \ ext_tests_nlo/ref-output/nlo_eejjj.ref \ ext_tests_nlo/ref-output/nlo_eett.ref \ ext_tests_nlo/ref-output/nlo_eetth.ref \ ext_tests_nlo/ref-output/nlo_eetthh.ref \ ext_tests_nlo/ref-output/nlo_eetthj.ref \ ext_tests_nlo/ref-output/nlo_eetthz.ref \ ext_tests_nlo/ref-output/nlo_eettwjj.ref \ ext_tests_nlo/ref-output/nlo_eettww.ref \ ext_tests_nlo/ref-output/nlo_eettz.ref \ ext_tests_nlo/ref-output/nlo_eettzj.ref \ ext_tests_nlo/ref-output/nlo_eettzjj.ref \ ext_tests_nlo/ref-output/nlo_eettzz.ref \ ext_tests_nlo/ref-output/nlo_ppzj_real_partition.ref \ ext_tests_nlo/ref-output/nlo_pptttt.ref \ ext_tests_nlo/ref-output/nlo_ppw.ref \ ext_tests_nlo/ref-output/nlo_ppz.ref \ ext_tests_nlo/ref-output/nlo_ppzj_sim_1.ref \ ext_tests_nlo/ref-output/nlo_ppzj_sim_2.ref \ ext_tests_nlo/ref-output/nlo_ppzj_sim_3.ref \ ext_tests_nlo/ref-output/nlo_ppzj_sim_4.ref \ ext_tests_nlo/ref-output/nlo_ppzw.ref \ ext_tests_nlo/ref-output/nlo_ppzz.ref \ ext_tests_nlo/ref-output/nlo_ppee_ew.ref \ ext_tests_nlo/ref-output/nlo_pphee_ew.ref \ ext_tests_nlo/ref-output/nlo_pphjj_ew.ref \ ext_tests_nlo/ref-output/nlo_pphz_ew.ref \ ext_tests_nlo/ref-output/nlo_ppllll_ew.ref \ ext_tests_nlo/ref-output/nlo_ppllnn_ew.ref \ ext_tests_nlo/ref-output/nlo_pptt_ew.ref \ ext_tests_nlo/ref-output/nlo_pptj_ew.ref \ ext_tests_nlo/ref-output/nlo_ppwhh_ew.ref \ ext_tests_nlo/ref-output/nlo_ppww_ew.ref \ ext_tests_nlo/ref-output/nlo_ppwzh_ew.ref \ ext_tests_nlo/ref-output/nlo_ppz_ew.ref \ ext_tests_nlo/ref-output/nlo_ppzzz_ew.ref # Reference files that depend on the numerical precision REF_OUTPUT_FILES_DOUBLE = \ functional_tests/ref-output-double/beam_events_2.ref \ functional_tests/ref-output-double/beam_events_3.ref \ functional_tests/ref-output-double/beam_setup_5.ref \ functional_tests/ref-output-double/circe1_4.ref \ functional_tests/ref-output-double/circe1_5.ref \ functional_tests/ref-output-double/circe1_7.ref \ functional_tests/ref-output-double/circe1_8.ref \ functional_tests/ref-output-double/circe1_9.ref \ functional_tests/ref-output-double/circe1_photons_1.ref \ functional_tests/ref-output-double/circe1_photons_2.ref \ functional_tests/ref-output-double/circe1_photons_3.ref \ functional_tests/ref-output-double/circe1_photons_4.ref \ functional_tests/ref-output-double/circe1_photons_5.ref \ functional_tests/ref-output-double/colors_2.ref \ functional_tests/ref-output-double/defaultcuts.ref \ functional_tests/ref-output-double/ep_1.ref \ functional_tests/ref-output-double/ep_2.ref \ functional_tests/ref-output-double/ewa_1.ref \ functional_tests/ref-output-double/ewa_2.ref \ functional_tests/ref-output-double/ewa_3.ref \ functional_tests/ref-output-double/fks_res_1.ref \ functional_tests/ref-output-double/fks_res_3.ref \ functional_tests/ref-output-double/helicity.ref \ functional_tests/ref-output-double/hepmc_8.ref \ functional_tests/ref-output-double/ilc.ref \ functional_tests/ref-output-double/isr_2.ref \ functional_tests/ref-output-double/isr_3.ref \ functional_tests/ref-output-double/isr_4.ref \ functional_tests/ref-output-double/isr_5.ref \ functional_tests/ref-output-double/isr_6.ref \ functional_tests/ref-output-double/lcio_2.ref \ functional_tests/ref-output-double/lcio_7.ref \ functional_tests/ref-output-double/lcio_12.ref \ functional_tests/ref-output-double/lhapdf5.ref \ functional_tests/ref-output-double/lhapdf6.ref \ functional_tests/ref-output-double/lhef_7.ref \ functional_tests/ref-output-double/mlm_matching_isr.ref \ functional_tests/ref-output-double/multi_comp_1.ref \ functional_tests/ref-output-double/multi_comp_2.ref \ functional_tests/ref-output-double/multi_comp_3.ref \ functional_tests/ref-output-double/testproc_12.ref \ functional_tests/ref-output-double/nlo_3.ref \ functional_tests/ref-output-double/nlo_4.ref \ functional_tests/ref-output-double/nlo_5.ref \ functional_tests/ref-output-double/nlo_7.ref \ functional_tests/ref-output-double/nlo_8.ref \ functional_tests/ref-output-double/nlo_9.ref \ functional_tests/ref-output-double/nlo_10.ref \ functional_tests/ref-output-double/observables_2.ref \ functional_tests/ref-output-double/openloops_3.ref \ functional_tests/ref-output-double/openloops_12.ref \ functional_tests/ref-output-double/openloops_13.ref \ functional_tests/ref-output-double/openloops_14.ref \ functional_tests/ref-output-double/parton_shower_2.ref \ functional_tests/ref-output-double/pdf_builtin.ref \ functional_tests/ref-output-double/powheg_1.ref \ functional_tests/ref-output-double/powheg_2.ref \ functional_tests/ref-output-double/pythia6_3.ref \ functional_tests/ref-output-double/pythia6_4.ref \ functional_tests/ref-output-double/qcdtest_1.ref \ functional_tests/ref-output-double/qcdtest_2.ref \ functional_tests/ref-output-double/qcdtest_3.ref \ functional_tests/ref-output-double/qedtest_3.ref \ functional_tests/ref-output-double/qedtest_4.ref \ functional_tests/ref-output-double/resonances_1.ref \ functional_tests/ref-output-double/resonances_2.ref \ functional_tests/ref-output-double/resonances_3.ref \ functional_tests/ref-output-double/resonances_4.ref \ functional_tests/ref-output-double/resonances_10.ref \ functional_tests/ref-output-double/resonances_11.ref \ functional_tests/ref-output-double/resonances_13.ref \ functional_tests/ref-output-double/resonances_14.ref \ functional_tests/ref-output-double/resonances_15.ref \ functional_tests/ref-output-double/smtest_2.ref \ functional_tests/ref-output-double/smtest_8.ref \ functional_tests/ref-output-double/tauola_1.ref \ functional_tests/ref-output-double/tauola_2.ref \ functional_tests/ref-output-double/tauola_3.ref REF_OUTPUT_FILES_PREC = \ functional_tests/ref-output-prec/beam_setup_5.ref \ functional_tests/ref-output-prec/circe1_9.ref \ functional_tests/ref-output-prec/circe1_photons_1.ref \ functional_tests/ref-output-prec/circe1_photons_2.ref \ functional_tests/ref-output-prec/circe1_photons_3.ref \ functional_tests/ref-output-prec/circe1_photons_4.ref \ functional_tests/ref-output-prec/circe1_photons_5.ref \ functional_tests/ref-output-prec/colors_2.ref \ functional_tests/ref-output-prec/defaultcuts.ref \ functional_tests/ref-output-prec/ep_1.ref \ functional_tests/ref-output-prec/ep_2.ref \ functional_tests/ref-output-prec/ewa_1.ref \ functional_tests/ref-output-prec/fks_res_1.ref \ functional_tests/ref-output-prec/fks_res_3.ref \ functional_tests/ref-output-prec/helicity.ref \ functional_tests/ref-output-prec/ilc.ref \ functional_tests/ref-output-prec/lhapdf5.ref \ functional_tests/ref-output-prec/lhapdf6.ref \ functional_tests/ref-output-prec/lhef_7.ref \ functional_tests/ref-output-prec/multi_comp_1.ref \ functional_tests/ref-output-prec/multi_comp_2.ref \ functional_tests/ref-output-prec/multi_comp_3.ref \ functional_tests/ref-output-prec/testproc_12.ref \ functional_tests/ref-output-prec/nlo_3.ref \ functional_tests/ref-output-prec/nlo_4.ref \ functional_tests/ref-output-prec/parton_shower_2.ref \ functional_tests/ref-output-prec/pdf_builtin.ref \ functional_tests/ref-output-prec/qcdtest_1.ref \ functional_tests/ref-output-prec/qcdtest_2.ref \ functional_tests/ref-output-prec/qcdtest_3.ref \ functional_tests/ref-output-prec/qedtest_3.ref \ functional_tests/ref-output-prec/qedtest_4.ref \ functional_tests/ref-output-prec/smtest_2.ref \ functional_tests/ref-output-prec/smtest_8.ref REF_OUTPUT_FILES_EXT = \ functional_tests/ref-output-ext/beam_events_2.ref \ functional_tests/ref-output-ext/beam_events_3.ref \ functional_tests/ref-output-ext/circe1_4.ref \ functional_tests/ref-output-ext/circe1_5.ref \ functional_tests/ref-output-ext/circe1_7.ref \ functional_tests/ref-output-ext/circe1_8.ref \ functional_tests/ref-output-ext/ewa_2.ref \ functional_tests/ref-output-ext/ewa_3.ref \ functional_tests/ref-output-ext/hepmc_8.ref \ functional_tests/ref-output-ext/isr_2.ref \ functional_tests/ref-output-ext/isr_3.ref \ functional_tests/ref-output-ext/isr_4.ref \ functional_tests/ref-output-ext/isr_5.ref \ functional_tests/ref-output-ext/isr_6.ref \ functional_tests/ref-output-ext/lcio_2.ref \ functional_tests/ref-output-ext/lcio_7.ref \ functional_tests/ref-output-ext/lcio_12.ref \ functional_tests/ref-output-ext/mlm_matching_isr.ref \ functional_tests/ref-output-ext/nlo_5.ref \ functional_tests/ref-output-ext/nlo_7.ref \ functional_tests/ref-output-ext/nlo_8.ref \ functional_tests/ref-output-ext/nlo_9.ref \ functional_tests/ref-output-ext/nlo_10.ref \ functional_tests/ref-output-ext/observables_2.ref \ functional_tests/ref-output-ext/openloops_3.ref \ functional_tests/ref-output-ext/openloops_12.ref \ functional_tests/ref-output-ext/openloops_13.ref \ functional_tests/ref-output-ext/openloops_14.ref \ functional_tests/ref-output-ext/powheg_1.ref \ functional_tests/ref-output-ext/powheg_2.ref \ functional_tests/ref-output-ext/pythia6_3.ref \ functional_tests/ref-output-ext/pythia6_4.ref \ functional_tests/ref-output-ext/resonances_1.ref \ functional_tests/ref-output-ext/resonances_2.ref \ functional_tests/ref-output-ext/resonances_3.ref \ functional_tests/ref-output-ext/resonances_4.ref \ functional_tests/ref-output-ext/resonances_10.ref \ functional_tests/ref-output-ext/resonances_11.ref \ functional_tests/ref-output-ext/resonances_13.ref \ functional_tests/ref-output-ext/resonances_14.ref \ functional_tests/ref-output-ext/resonances_15.ref \ functional_tests/ref-output-ext/tauola_1.ref \ functional_tests/ref-output-ext/tauola_2.ref \ functional_tests/ref-output-ext/tauola_3.ref REF_OUTPUT_FILES_QUAD = \ functional_tests/ref-output-quad/beam_events_2.ref \ functional_tests/ref-output-quad/beam_events_3.ref \ functional_tests/ref-output-quad/circe1_4.ref \ functional_tests/ref-output-quad/circe1_5.ref \ functional_tests/ref-output-quad/circe1_7.ref \ functional_tests/ref-output-quad/circe1_8.ref \ functional_tests/ref-output-quad/ewa_2.ref \ functional_tests/ref-output-quad/ewa_3.ref \ functional_tests/ref-output-quad/hepmc_8.ref \ functional_tests/ref-output-quad/isr_2.ref \ functional_tests/ref-output-quad/isr_3.ref \ functional_tests/ref-output-quad/isr_4.ref \ functional_tests/ref-output-quad/isr_5.ref \ functional_tests/ref-output-quad/isr_6.ref \ functional_tests/ref-output-quad/lcio_2.ref \ functional_tests/ref-output-quad/lcio_7.ref \ functional_tests/ref-output-quad/lcio_12.ref \ functional_tests/ref-output-quad/mlm_matching_isr.ref \ functional_tests/ref-output-quad/nlo_5.ref \ functional_tests/ref-output-quad/nlo_7.ref \ functional_tests/ref-output-quad/nlo_8.ref \ functional_tests/ref-output-quad/nlo_9.ref \ functional_tests/ref-output-quad/nlo_10.ref \ functional_tests/ref-output-quad/observables_2.ref \ functional_tests/ref-output-quad/openloops_3.ref \ functional_tests/ref-output-quad/openloops_12.ref \ functional_tests/ref-output-quad/openloops_13.ref \ functional_tests/ref-output-quad/openloops_14.ref \ functional_tests/ref-output-quad/powheg_1.ref \ functional_tests/ref-output-quad/powheg_2.ref \ functional_tests/ref-output-quad/pythia6_3.ref \ functional_tests/ref-output-quad/pythia6_4.ref \ functional_tests/ref-output-quad/resonances_1.ref \ functional_tests/ref-output-quad/resonances_2.ref \ functional_tests/ref-output-quad/resonances_3.ref \ functional_tests/ref-output-quad/resonances_4.ref \ functional_tests/ref-output-quad/resonances_10.ref \ functional_tests/ref-output-quad/resonances_11.ref \ functional_tests/ref-output-quad/resonances_13.ref \ functional_tests/ref-output-quad/resonances_14.ref \ functional_tests/ref-output-quad/resonances_15.ref \ functional_tests/ref-output-quad/tauola_1.ref \ functional_tests/ref-output-quad/tauola_2.ref \ functional_tests/ref-output-quad/tauola_3.ref TESTSUITES_M4 = \ $(MISC_TESTS_M4) \ $(EXT_MSSM_M4) \ $(EXT_NMSSM_M4) TESTSUITES_SIN = \ $(MISC_TESTS_SIN) \ $(EXT_ILC_SIN) \ $(EXT_MSSM_SIN) \ $(EXT_NMSSM_SIN) \ $(EXT_SHOWER_SIN) \ $(EXT_NLO_SIN) \ $(EXT_NLO_ADD_SIN) MISC_TESTS_M4 = MISC_TESTS_SIN = \ functional_tests/alphas.sin \ functional_tests/analyze_1.sin \ functional_tests/analyze_2.sin \ functional_tests/analyze_3.sin \ functional_tests/analyze_4.sin \ functional_tests/analyze_5.sin \ functional_tests/analyze_6.sin \ functional_tests/beam_events_1.sin \ functional_tests/beam_events_2.sin \ functional_tests/beam_events_3.sin \ functional_tests/beam_events_4.sin \ functional_tests/beam_setup_1.sin \ functional_tests/beam_setup_2.sin \ functional_tests/beam_setup_3.sin \ functional_tests/beam_setup_4.sin \ functional_tests/beam_setup_5.sin \ functional_tests/bjet_cluster.sin \ functional_tests/br_redef_1.sin \ functional_tests/cascades2_phs_1.sin \ functional_tests/cascades2_phs_2.sin \ functional_tests/circe1_1.sin \ functional_tests/circe1_2.sin \ functional_tests/circe1_3.sin \ functional_tests/circe1_4.sin \ functional_tests/circe1_5.sin \ functional_tests/circe1_6.sin \ functional_tests/circe1_7.sin \ functional_tests/circe1_8.sin \ functional_tests/circe1_9.sin \ functional_tests/circe1_10.sin \ functional_tests/circe1_errors_1.sin \ functional_tests/circe1_photons_1.sin \ functional_tests/circe1_photons_2.sin \ functional_tests/circe1_photons_3.sin \ functional_tests/circe1_photons_4.sin \ functional_tests/circe1_photons_5.sin \ functional_tests/circe2_1.sin \ functional_tests/circe2_2.sin \ functional_tests/circe2_3.sin \ functional_tests/cmdline_1.sin \ functional_tests/cmdline_1_a.sin \ functional_tests/cmdline_1_b.sin \ functional_tests/colors.sin \ functional_tests/colors_2.sin \ functional_tests/colors_hgg.sin \ functional_tests/cuts.sin \ functional_tests/decay_err_1.sin \ functional_tests/decay_err_2.sin \ functional_tests/decay_err_3.sin \ functional_tests/defaultcuts.sin \ functional_tests/empty.sin \ functional_tests/energy_scan_1.sin \ functional_tests/ep_1.sin \ functional_tests/ep_2.sin \ functional_tests/ep_3.sin \ functional_tests/epa_1.sin \ functional_tests/epa_2.sin \ functional_tests/epa_3.sin \ functional_tests/epa_4.sin \ functional_tests/event_dump_1.sin \ functional_tests/event_dump_2.sin \ functional_tests/event_eff_1.sin \ functional_tests/event_eff_2.sin \ functional_tests/event_failed_1.sin \ functional_tests/event_weights_1.sin \ functional_tests/event_weights_2.sin \ functional_tests/ewa_1.sin \ functional_tests/ewa_2.sin \ functional_tests/ewa_3.sin \ functional_tests/ewa_4.sin \ functional_tests/extpar.sin \ functional_tests/fatal.sin \ functional_tests/fatal_beam_decay.sin \ functional_tests/fks_res_1.sin \ functional_tests/fks_res_2.sin \ functional_tests/fks_res_3.sin \ functional_tests/flvsum_1.sin \ functional_tests/gaussian_1.sin \ functional_tests/gaussian_2.sin \ functional_tests/hadronize_1.sin \ functional_tests/helicity.sin \ functional_tests/hepmc_1.sin \ functional_tests/hepmc_2.sin \ functional_tests/hepmc_3.sin \ functional_tests/hepmc_4.sin \ functional_tests/hepmc_5.sin \ functional_tests/hepmc_6.sin \ functional_tests/hepmc_7.sin \ functional_tests/hepmc_8.sin \ functional_tests/hepmc_9.sin \ functional_tests/hepmc_10.sin \ functional_tests/ilc.sin \ functional_tests/isr_1.sin \ functional_tests/isr_2.sin \ functional_tests/isr_3.sin \ functional_tests/isr_4.sin \ functional_tests/isr_5.sin \ functional_tests/isr_6.sin \ functional_tests/isr_epa_1.sin \ functional_tests/jets_xsec.sin \ functional_tests/job_id_1.sin \ functional_tests/job_id_2.sin \ functional_tests/job_id_3.sin \ functional_tests/job_id_4.sin \ functional_tests/lcio_1.sin \ functional_tests/lcio_2.sin \ functional_tests/lcio_3.sin \ functional_tests/lcio_4.sin \ functional_tests/lcio_5.sin \ functional_tests/lcio_6.sin \ functional_tests/lcio_7.sin \ functional_tests/lcio_8.sin \ functional_tests/lcio_9.sin \ functional_tests/lcio_10.sin \ functional_tests/lcio_11.sin \ functional_tests/lcio_12.sin \ functional_tests/lhapdf5.sin \ functional_tests/lhapdf6.sin \ functional_tests/lhef_1.sin \ functional_tests/lhef_2.sin \ functional_tests/lhef_3.sin \ functional_tests/lhef_4.sin \ functional_tests/lhef_5.sin \ functional_tests/lhef_6.sin \ functional_tests/lhef_7.sin \ functional_tests/lhef_8.sin \ functional_tests/lhef_9.sin \ functional_tests/lhef_10.sin \ functional_tests/lhef_11.sin \ functional_tests/libraries_1.sin \ functional_tests/libraries_2.sin \ functional_tests/libraries_3.sin \ functional_tests/libraries_4.sin \ functional_tests/method_ovm_1.sin \ functional_tests/mlm_matching_fsr.sin \ functional_tests/mlm_matching_isr.sin \ functional_tests/mlm_pythia6_isr.sin \ functional_tests/model_change_1.sin \ functional_tests/model_change_2.sin \ functional_tests/model_change_3.sin \ functional_tests/model_scheme_1.sin \ functional_tests/model_test.sin \ functional_tests/mssmtest_1.sin \ functional_tests/mssmtest_2.sin \ functional_tests/mssmtest_3.sin \ functional_tests/multi_comp_1.sin \ functional_tests/multi_comp_2.sin \ functional_tests/multi_comp_3.sin \ functional_tests/multi_comp_4.sin \ functional_tests/nlo_1.sin \ functional_tests/nlo_2.sin \ functional_tests/nlo_3.sin \ functional_tests/nlo_4.sin \ functional_tests/nlo_5.sin \ functional_tests/nlo_6.sin \ functional_tests/nlo_7.sin \ functional_tests/nlo_8.sin \ functional_tests/nlo_9.sin \ functional_tests/nlo_10.sin \ functional_tests/nlo_decay_1.sin \ functional_tests/observables_1.sin \ functional_tests/observables_2.sin \ functional_tests/openloops_1.sin \ functional_tests/openloops_2.sin \ functional_tests/openloops_3.sin \ functional_tests/openloops_4.sin \ functional_tests/openloops_5.sin \ functional_tests/openloops_6.sin \ functional_tests/openloops_7.sin \ functional_tests/openloops_8.sin \ functional_tests/openloops_9.sin \ functional_tests/openloops_10.sin \ functional_tests/openloops_11.sin \ functional_tests/openloops_12.sin \ functional_tests/openloops_13.sin \ functional_tests/openloops_14.sin \ functional_tests/pack_1.sin \ functional_tests/parton_shower_1.sin \ functional_tests/parton_shower_2.sin \ functional_tests/pdf_builtin.sin \ functional_tests/photon_isolation_1.sin \ functional_tests/photon_isolation_2.sin \ functional_tests/polarized_1.sin \ functional_tests/powheg_1.sin \ functional_tests/powheg_2.sin \ functional_tests/process_log.sin \ functional_tests/pythia6_1.sin \ functional_tests/pythia6_2.sin \ functional_tests/pythia6_3.sin \ functional_tests/pythia6_4.sin \ functional_tests/pythia8_1.sin \ functional_tests/pythia8_2.sin \ functional_tests/qcdtest_1.sin \ functional_tests/qcdtest_2.sin \ functional_tests/qcdtest_3.sin \ functional_tests/qcdtest_4.sin \ functional_tests/qcdtest_5.sin \ functional_tests/qcdtest_6.sin \ functional_tests/qedtest_1.sin \ functional_tests/qedtest_2.sin \ functional_tests/qedtest_3.sin \ functional_tests/qedtest_4.sin \ functional_tests/qedtest_5.sin \ functional_tests/qedtest_6.sin \ functional_tests/qedtest_7.sin \ functional_tests/qedtest_8.sin \ functional_tests/qedtest_9.sin \ functional_tests/qedtest_10.sin \ functional_tests/rambo_vamp_1.sin \ functional_tests/rambo_vamp_2.sin \ functional_tests/real_partition_1.sin \ functional_tests/rebuild_1.sin \ functional_tests/rebuild_2.sin \ functional_tests/rebuild_3.sin \ functional_tests/rebuild_4.sin \ functional_tests/rebuild_5.sin \ functional_tests/recola_1.sin \ functional_tests/recola_2.sin \ functional_tests/recola_3.sin \ functional_tests/recola_4.sin \ functional_tests/recola_5.sin \ functional_tests/recola_6.sin \ functional_tests/recola_7.sin \ functional_tests/recola_8.sin \ functional_tests/recola_9.sin \ functional_tests/resonances_1.sin \ functional_tests/resonances_2.sin \ functional_tests/resonances_3.sin \ functional_tests/resonances_4.sin \ functional_tests/resonances_5.sin \ functional_tests/resonances_6.sin \ functional_tests/resonances_7.sin \ functional_tests/resonances_8.sin \ functional_tests/resonances_9.sin \ functional_tests/resonances_10.sin \ functional_tests/resonances_11.sin \ functional_tests/resonances_12.sin \ functional_tests/resonances_13.sin \ functional_tests/resonances_14.sin \ functional_tests/resonances_15.sin \ functional_tests/restrictions.sin \ functional_tests/reweight_1.sin \ functional_tests/reweight_2.sin \ functional_tests/reweight_3.sin \ functional_tests/reweight_4.sin \ functional_tests/reweight_5.sin \ functional_tests/reweight_6.sin \ functional_tests/reweight_7.sin \ functional_tests/reweight_8.sin \ functional_tests/reweight_9.sin \ functional_tests/reweight_10.sin \ functional_tests/select_1.sin \ functional_tests/select_2.sin \ functional_tests/show_1.sin \ functional_tests/show_2.sin \ functional_tests/show_3.sin \ functional_tests/show_4.sin \ functional_tests/show_5.sin \ functional_tests/shower_err_1.sin \ functional_tests/sm_cms_1.sin \ functional_tests/smtest_1.sin \ functional_tests/smtest_2.sin \ functional_tests/smtest_3.sin \ functional_tests/smtest_4.sin \ functional_tests/smtest_5.sin \ functional_tests/smtest_6.sin \ functional_tests/smtest_7.sin \ functional_tests/smtest_8.sin \ functional_tests/smtest_9.sin \ functional_tests/smtest_10.sin \ functional_tests/smtest_11.sin \ functional_tests/smtest_12.sin \ functional_tests/smtest_13.sin \ functional_tests/smtest_14.sin \ functional_tests/smtest_15.sin \ functional_tests/smtest_16.sin \ functional_tests/smtest_17.sin \ functional_tests/spincor_1.sin \ functional_tests/static_1.exe.sin \ functional_tests/static_1.sin \ functional_tests/static_2.exe.sin \ functional_tests/static_2.sin \ functional_tests/stdhep_1.sin \ functional_tests/stdhep_2.sin \ functional_tests/stdhep_3.sin \ functional_tests/stdhep_4.sin \ functional_tests/stdhep_5.sin \ functional_tests/stdhep_6.sin \ functional_tests/structure_1.sin \ functional_tests/structure_2.sin \ functional_tests/structure_3.sin \ functional_tests/structure_4.sin \ functional_tests/structure_5.sin \ functional_tests/structure_6.sin \ functional_tests/structure_7.sin \ functional_tests/structure_8.sin \ functional_tests/susyhit.sin \ functional_tests/tauola_1.sin \ functional_tests/tauola_2.sin \ functional_tests/tauola_3.sin \ functional_tests/template_me_1.sin \ functional_tests/template_me_2.sin \ functional_tests/testproc_1.sin \ functional_tests/testproc_2.sin \ functional_tests/testproc_3.sin \ functional_tests/testproc_4.sin \ functional_tests/testproc_5.sin \ functional_tests/testproc_6.sin \ functional_tests/testproc_7.sin \ functional_tests/testproc_8.sin \ functional_tests/testproc_9.sin \ functional_tests/testproc_10.sin \ functional_tests/testproc_11.sin \ functional_tests/testproc_12.sin \ functional_tests/ufo_1.sin \ functional_tests/ufo_2.sin \ functional_tests/ufo_3.sin \ functional_tests/ufo_4.sin \ functional_tests/ufo_5.sin \ functional_tests/ufo_6.sin \ functional_tests/user_prc_threshold_1.sin \ functional_tests/user_prc_threshold_2.sin \ functional_tests/vamp2_1.sin \ functional_tests/vamp2_2.sin \ functional_tests/vamp2_3.sin \ functional_tests/vars.sin EXT_MSSM_M4 = \ ext_tests_mssm/mssm_ext-aa.m4 \ ext_tests_mssm/mssm_ext-bb.m4 \ ext_tests_mssm/mssm_ext-bt.m4 \ ext_tests_mssm/mssm_ext-dd.m4 \ ext_tests_mssm/mssm_ext-dd2.m4 \ ext_tests_mssm/mssm_ext-ddckm.m4 \ ext_tests_mssm/mssm_ext-dg.m4 \ ext_tests_mssm/mssm_ext-ee.m4 \ ext_tests_mssm/mssm_ext-ee2.m4 \ ext_tests_mssm/mssm_ext-en.m4 \ ext_tests_mssm/mssm_ext-ga.m4 \ ext_tests_mssm/mssm_ext-gg.m4 \ ext_tests_mssm/mssm_ext-gw.m4 \ ext_tests_mssm/mssm_ext-gz.m4 \ ext_tests_mssm/mssm_ext-tn.m4 \ ext_tests_mssm/mssm_ext-tt.m4 \ ext_tests_mssm/mssm_ext-ug.m4 \ ext_tests_mssm/mssm_ext-uu.m4 \ ext_tests_mssm/mssm_ext-uu2.m4 \ ext_tests_mssm/mssm_ext-uuckm.m4 \ ext_tests_mssm/mssm_ext-wa.m4 \ ext_tests_mssm/mssm_ext-ww.m4 \ ext_tests_mssm/mssm_ext-wz.m4 \ ext_tests_mssm/mssm_ext-za.m4 \ ext_tests_mssm/mssm_ext-zz.m4 EXT_NMSSM_M4 = \ ext_tests_nmssm/nmssm_ext-aa.m4 \ ext_tests_nmssm/nmssm_ext-bb1.m4 \ ext_tests_nmssm/nmssm_ext-bb2.m4 \ ext_tests_nmssm/nmssm_ext-bt.m4 \ ext_tests_nmssm/nmssm_ext-dd1.m4 \ ext_tests_nmssm/nmssm_ext-dd2.m4 \ ext_tests_nmssm/nmssm_ext-ee1.m4 \ ext_tests_nmssm/nmssm_ext-ee2.m4 \ ext_tests_nmssm/nmssm_ext-en.m4 \ ext_tests_nmssm/nmssm_ext-ga.m4 \ ext_tests_nmssm/nmssm_ext-gg.m4 \ ext_tests_nmssm/nmssm_ext-gw.m4 \ ext_tests_nmssm/nmssm_ext-gz.m4 \ ext_tests_nmssm/nmssm_ext-qg.m4 \ ext_tests_nmssm/nmssm_ext-tn.m4 \ ext_tests_nmssm/nmssm_ext-tt1.m4 \ ext_tests_nmssm/nmssm_ext-tt2.m4 \ ext_tests_nmssm/nmssm_ext-uu1.m4 \ ext_tests_nmssm/nmssm_ext-uu2.m4 \ ext_tests_nmssm/nmssm_ext-wa.m4 \ ext_tests_nmssm/nmssm_ext-ww1.m4 \ ext_tests_nmssm/nmssm_ext-ww2.m4 \ ext_tests_nmssm/nmssm_ext-wz.m4 \ ext_tests_nmssm/nmssm_ext-za.m4 \ ext_tests_nmssm/nmssm_ext-zz1.m4 \ ext_tests_nmssm/nmssm_ext-zz2.m4 EXT_MSSM_SIN = $(EXT_MSSM_M4:.m4=.sin) EXT_NMSSM_SIN = $(EXT_NMSSM_M4:.m4=.sin) EXT_ILC_SIN = \ ext_tests_ilc/ilc_settings.sin \ ext_tests_ilc/ilc_top_pair_360.sin \ ext_tests_ilc/ilc_top_pair_500.sin \ ext_tests_ilc/ilc_vbf_higgs_360.sin \ ext_tests_ilc/ilc_vbf_higgs_500.sin \ ext_tests_ilc/ilc_vbf_no_higgs_360.sin \ ext_tests_ilc/ilc_vbf_no_higgs_500.sin \ ext_tests_ilc/ilc_higgs_strahlung_360.sin \ ext_tests_ilc/ilc_higgs_strahlung_500.sin \ ext_tests_ilc/ilc_higgs_strahlung_background_360.sin \ ext_tests_ilc/ilc_higgs_strahlung_background_500.sin \ ext_tests_ilc/ilc_higgs_coupling_360.sin \ ext_tests_ilc/ilc_higgs_coupling_500.sin \ ext_tests_ilc/ilc_higgs_coupling_background_360.sin \ ext_tests_ilc/ilc_higgs_coupling_background_500.sin EXT_SHOWER_SIN = \ ext_tests_shower/shower_1_norad.sin \ ext_tests_shower/shower_2_aall.sin \ ext_tests_shower/shower_3_bb.sin \ ext_tests_shower/shower_3_jj.sin \ ext_tests_shower/shower_3_qqqq.sin \ ext_tests_shower/shower_3_tt.sin \ ext_tests_shower/shower_3_z_nu.sin \ ext_tests_shower/shower_3_z_tau.sin \ ext_tests_shower/shower_4_ee.sin \ ext_tests_shower/shower_5.sin \ ext_tests_shower/shower_6.sin EXT_NLO_SIN = \ ext_tests_nlo/nlo_ee4b.sin \ ext_tests_nlo/nlo_ee4j.sin \ ext_tests_nlo/nlo_ee4t.sin \ ext_tests_nlo/nlo_ee4tj.sin \ ext_tests_nlo/nlo_ee5j.sin \ ext_tests_nlo/nlo_eebb.sin \ ext_tests_nlo/nlo_eebbj.sin \ ext_tests_nlo/nlo_eebbjj.sin \ ext_tests_nlo/nlo_eejj.sin \ ext_tests_nlo/nlo_eejjj.sin \ ext_tests_nlo/nlo_eett.sin \ ext_tests_nlo/nlo_eetta.sin \ ext_tests_nlo/nlo_eettaa.sin \ ext_tests_nlo/nlo_eettah.sin \ ext_tests_nlo/nlo_eettaj.sin \ ext_tests_nlo/nlo_eettajj.sin \ ext_tests_nlo/nlo_eettaz.sin \ ext_tests_nlo/nlo_eettbb.sin \ ext_tests_nlo/nlo_eetth.sin \ ext_tests_nlo/nlo_eetthh.sin \ ext_tests_nlo/nlo_eetthj.sin \ ext_tests_nlo/nlo_eetthjj.sin \ ext_tests_nlo/nlo_eetthz.sin \ ext_tests_nlo/nlo_eettj.sin \ ext_tests_nlo/nlo_eettjj.sin \ ext_tests_nlo/nlo_eettjjj.sin \ ext_tests_nlo/nlo_eettwjj.sin \ ext_tests_nlo/nlo_eettww.sin \ ext_tests_nlo/nlo_eettz.sin \ ext_tests_nlo/nlo_eettzj.sin \ ext_tests_nlo/nlo_eettzjj.sin \ ext_tests_nlo/nlo_eettzz.sin \ ext_tests_nlo/nlo_ppzj_real_partition.sin \ ext_tests_nlo/nlo_pptttt.sin \ ext_tests_nlo/nlo_ppw.sin \ ext_tests_nlo/nlo_ppz.sin \ ext_tests_nlo/nlo_ppzj_sim_1.sin \ ext_tests_nlo/nlo_ppzj_sim_2.sin \ ext_tests_nlo/nlo_ppzj_sim_3.sin \ ext_tests_nlo/nlo_ppzj_sim_4.sin \ ext_tests_nlo/nlo_ppzw.sin \ ext_tests_nlo/nlo_ppzz.sin \ ext_tests_nlo/nlo_ppee_ew.sin \ ext_tests_nlo/nlo_pphee_ew.sin \ ext_tests_nlo/nlo_pphjj_ew.sin \ ext_tests_nlo/nlo_pphz_ew.sin \ ext_tests_nlo/nlo_ppllll_ew.sin \ ext_tests_nlo/nlo_ppllnn_ew.sin \ ext_tests_nlo/nlo_pptj_ew.sin \ ext_tests_nlo/nlo_ppwhh_ew.sin \ ext_tests_nlo/nlo_ppww_ew.sin \ ext_tests_nlo/nlo_ppwzh_ew.sin \ ext_tests_nlo/nlo_ppz_ew.sin \ ext_tests_nlo/nlo_ppzzz_ew.sin \ ext_tests_nlo/nlo_ppeej_ew.sin \ ext_tests_nlo/nlo_ppevj_ew.sin \ ext_tests_nlo/nlo_pptt_ew.sin \ ext_tests_nlo/nlo_settings.sin \ ext_tests_nlo/nlo_settings_ew.sin EXT_NLO_ADD_SIN = \ ext_tests_nlo_add/nlo_decay_tbw.sin \ ext_tests_nlo_add/nlo_fks_delta_i_ppee.sin \ ext_tests_nlo_add/nlo_fks_delta_o_eejj.sin \ ext_tests_nlo_add/nlo_jets.sin \ ext_tests_nlo_add/nlo_methods_gosam.sin \ ext_tests_nlo_add/nlo_qq_powheg.sin \ ext_tests_nlo_add/nlo_threshold_factorized.sin \ ext_tests_nlo_add/nlo_threshold.sin \ ext_tests_nlo_add/nlo_tt_powheg_sudakov.sin \ ext_tests_nlo_add/nlo_tt_powheg.sin \ ext_tests_nlo_add/nlo_tt.sin \ ext_tests_nlo_add/nlo_uu_powheg.sin \ ext_tests_nlo_add/nlo_uu.sin all-local: $(TESTSUITES_SIN) if M4_AVAILABLE SUFFIXES = .m4 .sin .m4.sin: case "$@" in \ */*) \ mkdir -p `sed 's,/.[^/]*$$,,g' <<< "$@"` ;; \ esac $(M4) $(srcdir)/$(TESTSUITE_MACROS) $< > $@ endif M4_AVAILABLE Index: trunk/share/tests/unit_tests/ref-output/kinematics_vars_1.ref =================================================================== --- trunk/share/tests/unit_tests/ref-output/kinematics_vars_1.ref (revision 0) +++ trunk/share/tests/unit_tests/ref-output/kinematics_vars_1.ref (revision 8864) @@ -0,0 +1,13 @@ +* Test output: mt2_1 +* Purpose: calculate MT2 for the massive case + + pax = 4.000000000000E+01 + pay = 4.000000000000E+01 + ma = 1.000000000000E+02 + pbx = 4.000000000000E+01 + pby = 4.000000000000E+01 + mb = 1.000000000000E+02 + pmissx = 2.000000000000E+01 + pmissy = 2.000000000000E+01 + mn = 0.000000000000E+00 + mt2=1.0793E+02 Index: trunk/ChangeLog =================================================================== --- trunk/ChangeLog (revision 8863) +++ trunk/ChangeLog (revision 8864) @@ -1,2362 +1,2365 @@ ChangeLog -- Summary of changes to the WHIZARD package Use svn log to see detailed changes. Version 3.1.0.1 +2023-02-22 + Infrastructure for calculation of kinematic MT2 variable + 2023-02-17 Bug fix UFO interface: correct parentheses in rational functions ################################################################## 2022-12-14 RELEASE: version 3.1.0 2022-12-12 Bug fix Pythia8 interface: production vertices, shower history O'Mega support for epsilon tensor color structures 2023-01-27 Support for loop-induced processes 2022-11-30 O'Mega support for general SU(N) color representations 2022-11-07 Modernize configure checks for Python versions v3.10+ 2022-10-21 General POWHEG matching with optional NLO real phase space partitioning 2022-09-26 Bug fix: accept negative scale values in SLHA block header 2022-08-08 Numerical stability of testsuite for Apple M1 processors 2022-08-07 Technically allow for muons as CIRCE2 beam spectra 2022-06-22 POWHEG matching for Drell-Yan and similar processes 2022-06-12 Add unit tests for Lorentz and phase-space modules 2022-05-09 Massive eikonals: Numeric robustness at ultrahigh energies 2022-04-20 Bug fix for VAMP2 event generation with indefinite samples ################################################################## 2022-04-06 RELEASE: version 3.0.3 2022-04-05 POWHEG matching for single flavor hadron collisions 2022-03-31 NLO EW processes with massless leptons and jets (i.e. jet clustering and photon recombination) supported NLO EW for massive initial leptons validated 2022-03-27 Complete implementation/validation of NLL electron PDFs 2022-02-22 Bug fix: correct normalization for CIRCE2+EPA+polarization 2022-02-21 WHIZARD core now uses Fortran modules and submodules 2022-01-27 Infrastructure for POWHEG matching for hadron collisions 2021-12-16 Event files can be written/read also for decay processes Implementation of running QED coupling alpha 2021-12-10 Independent variations of renormalization/factorization scale ################################################################## 2021-11-23 RELEASE: version 3.0.2 2021-11-19 Support for a wide class of mixed NLO QCD/EW processes 2021-11-18 Add pp processes for NLO EW corrections to testsuite 2021-11-11 Output numerically critical values with LCIO 2.17+ as double 2021-11-05 Minor refactoring on phase space points and kinematics 2021-10-21 NLO (QCD) differential distributions supported for full lepton collider setup: polarization, QED ISR, beamstrahlung 2021-10-15 SINDARIN now has a sum and product function of expressions, SINDARIN supports observables defined on full (sub)events First application: transverse mass Bug fix: 2HDM did not allow H+, H- as external particles 2021-10-14 CT18 PDFs included (NLO, NNLO) 2021-09-30 Bug fix: keep non-recombined photons in the event record 2021-09-13 Modular NLO event generation with real partition 2021-08-20 Bug fix: correctly reading in NLO fixed order events 2021-08-06 Generalize optional partitioning of the NLO real phase space ################################################################## 2021-07-08 RELEASE: version 3.0.1 2021-07-06 MPI parallelization now comes with two incarnations: - standard MPI parallelization ("simple", default) - MPI with load balancer ("load") 2021-07-05 Bug fix for C++17 default compilers w/ HepMC3/ROOT interface 2021-07-02 Improvement for POWHEG matching: - implement massless recoil case - enable reading in existing POWHEG grids - support kinematic cuts at generator level 2021-07-01 Distinguish different cases of photons in NLO EW corrections 2021-06-21 Option to keep negative PDF entries or set them zero 2021-05-31 Full LCIO MC production files can be properly recasted 2021-05-24 Use defaults for UFO models without propagators.py 2021-05-21 Bug fix: prevent invalid code for UFO models containing hyphens 2021-05-20 UFO files with scientific notation float constants allowed UFO files: max. n-arity of vertices bound by process multiplicity ################################################################## 2021-04-27 RELEASE: version 3.0.0 2021-04-20 Minimal required OCaml version is now 4.05.0. Bug fix for tau polarization from stau decays 2021-04-19 NLO EW splitting functions and collinear remnants completed Photon recombination implemented 2021-04-14 Bug fix for vertices/status codes with HepMC2/3 event format 2021-04-08 Correct Lorentz statistics for UFO model with Majorana fermions 2021-04-06 Bug fix for rare script failure in system_dependencies.f90.in Kappa factor for quartic Higgs coupling in SM_ac(_CKM) model 2021-04-04 Support for UFO extensions in SMEFTSim 3.0 2021-02-25 Enable VAMP and VAMP2 channel equivalences for NLO integrations 2021-02-04 Bug fix if user does not set a prefix at configuration 2020-12-10 Generalize NLO calculations to non-CMS lab frames 2020-12-08 Bug fix in expanded p-wave form factor for top threshold 2020-12-06 Patch for macOS Big Sur shared library handling due to libtool; the patch also demands gcc/gfortran 11.0/10.3/9.4/8.5 2020-12-04 O'Mega only inserts non-vanishing couplings from UFO models 2020-11-21 Bug fix for fractional hypercharges in UFO models 2020-11-11 Enable PYTHIA6 settings for eh collisions (enable-pythia6_eh) 2020-11-09 Correct flavor assignment for NLO fixed-order events 2020-11-05 Bug fix for ISR handler not working with unstable particles 2020-10-08 Bug fix in LHAPDF interface for photon PDFs 2020-10-07 Bug fix for structure function setup with asymmetric beams 2020-10-02 Python/Cython layer for WHIZARD API 2020-09-30 Allow mismatches of Python and name attributes in UFO models 2020-09-26 Support for negative PDG particles from certain UFO models 2020-09-24 Allow for QNUMBERS blocks in BSM SLHA files 2020-09-22 Full support for compilation with clang(++) on Darwin/macOS More documentation in the manual Minor clean-ups 2020-09-16 Bug fix enables reading LCIO events with LCIO v2.15+ ################################################################## 2020-09-16 RELEASE: version 2.8.5 2020-09-11 Bug fix for H->tau tau transverse polarization with PYTHIA6 (thanks to Junping Tian / Akiya Miyamoto) 2020-09-09 Fix a long standing bug (since 2.0) in the calculation of color factors when particles of different color were combined in a particle class. NB: O'Mega never produced a wrong number, it only declared all processes as invalid. 2020-09-08 Enable Openloops matrix element equivalences for optimization 2020-09-02 Compatibility fix for PYTHIA v8.301+ interface 2020-09-01 Support exclusive jet clustering in ee for Fastjet interface ################################################################## 2020-08-30 RELEASE: version 3.0.0_beta 2020-08-27 Major revision of NLO distributions and events for processes with structure functions: - Use parton momenta/flavors (instead of beams) for events - Bug fix for Lorentz boosts and Lorentz frames of momenta - Bug fix: apply cuts to virtual NLO component in correct frame - Correctly assign ISR radiation momenta in data structures - Refactoring on quantum numbers for NLO event data structures - Functional tests for hadron collider NLO distributions - many minor bug fixes regarding NLO hadron collider physics 2020-08-11 Bug fix for linking problem with OpenMPI 2020-08-07 New WHIZARD API: WHIZARD can be externally linked as a library, added examples for Fortran, C, C++ programs ################################################################## 2020-07-08 RELEASE: version 2.8.4 2020-07-07 Bug fix: steering of UFO Majorana models from WHIZARD ################################################################## 2020-07-06 Combined integration also for hadron collider processes at NLO 2020-07-05 Bug fix: correctly steer e+e- FastJet clustering algorithms Major revision of NLO differential distributions and events: - Correctly assign quantum numbers to NLO fixed-order events - Correctly assign weights to NLO fixed-order events for combined simulation - Cut all NLO fixed-order subevents in event groups individually - Only allow "sigma" normalization for NLO fixed-order events - Use correct PDF setup for NLO counter events - Several technical fixes and updates of the NLO testsuite ################################################################## 2020-07-03 RELEASE: version 2.8.3 2020-07-02 Feature-complete UFO implementation for Majorana fermions 2020-06-22 Running width scheme supported for O'Mega matrix elements 2020-06-20 Adding H-s-s coupling to SM_Higgs(_CKM) models 2020-06-17 Completion of ILC 2->6 fermion extended test suite 2020-06-15 Bug fix: PYTHIA6/Tauola, correctly assign tau spins for stau decays 2020-06-09 Bug fix: correctly update calls for additional VAMP/2 iterations Bug fix: correct assignment for tau spins from PYTHIA6 interface 2020-06-04 Bug fix: cascades2 tree merge with empty subtree(s) 2020-05-31 Switch $epa_mode for different EPA implementations 2020-05-26 Bug fix: spin information transferred for resonance histories 2020-04-13 HepMC: correct weighted events for non-xsec event normalizations 2020-04-04 Improved HepMC3 interface: HepMC3 Root/RootTree interface 2020-03-24 ISR: Fix on-shell kinematics for events with ?isr_handler=true (set ?isr_handler_keep_mass=false for old behavior) 2020-03-11 Beam masses are correctly passed to hard matrix element for CIRCE2 EPA with polarized beams: double-counting corrected ################################################################## 2020-03-03 RELEASE: version 3.0.0_alpha 2020-02-25 Bug fix: Scale and alphas can be retrieved from internal event format to external formats 2020-02-17 Bug fix: ?keep_failed_events now forces output of actual event data Bug fix: particle-set reconstruction (rescanning events w/o radiation) 2020-01-28 Bug fix for left-over EPA parameter epa_e_max (replaced by epa_q_max) 2020-01-23 Bug fix for real components of NLO QCD 2->1 processes 2020-01-22 Bug fix: correct random number sequencing during parallel MPI event generation with rng_stream 2020-01-21 Consistent distribution of events during parallel MPI event generation 2020-01-20 Bug fix for configure setup for automake v1.16+ 2020-01-18 General SLHA parameter files for UFO models supported 2020-01-08 Bug fix: correctly register RECOLA processes with flavor sums 2019-12-19 Support for UFO customized propagators O'Mega unit tests for fermion-number violating interactions 2019-12-10 For distribution building: check for graphviz/dot version 2.40 or newer 2019-11-21 Bug fix: alternate setups now work correctly Infrastructure for accessing alpha_QED event-by-event Guard against tiny numbers that break ASCII event output Enable inverse hyperbolic functions as SINDARIN observables Remove old compiler bug workarounds 2019-11-20 Allow quoted -e argument, implemented -f option 2019-11-19 Bug fix: resonance histories now work also with UFO models Fix in numerical precision of ASCII VAMP2 grids 2019-11-06 Add squared matrix elements to the LCIO event header 2019-11-05 Do not include RNG state in MD5 sum for CIRCE1/2 2019-11-04 Full CIRCE2 ILC 250 and 500 GeV beam spectra added Minor update on LCIO event header information 2019-10-30 NLO QCD for final states completed When using Openloops, v2.1.1+ mandatory 2019-10-25 Binary grid files for VAMP2 integrator ################################################################## 2019-10-24 RELEASE: version 2.8.2 2019-10-20 Bug fix for HepMC linker flags 2019-10-19 Support for spin-2 particles from UFO files 2019-09-27 LCIO event format allows rescan and alternate weights 2019-09-24 Compatibility fix for OCaml v4.08.0+ ################################################################## 2019-09-21 RELEASE: version 2.8.1 2019-09-19 Carriage return characters in UFO models can be parsed Mathematica symbols in UFO models possible Unused/undefined parameters in UFO models handled 2019-09-13 New extended NLO test suite for ee and pp processes 2019-09-09 Photon isolation (separation of perturbative and fragmentation part a la Frixione) 2019-09-05 Major progress on NLO QCD for hadron collisions: - correctly assign flavor structures for alpha regions - fix crossing of particles for initial state splittings - correct assignment for PDF factors for real subtractions - fix kinematics for collinear splittings - bug fix for integrated virtual subtraction terms 2019-09-03 b and c jet selection in cuts and analysis 2019-08-27 Support for Intel MPI 2019-08-20 Complete (preliminary) HepMC3 support (incl. backwards HepMC2 write/read mode) 2019-08-08 Bug fix: handle carriage returns in UFO files (non-Unix OS) ################################################################## 2019-08-07 RELEASE: version 2.8.0 2019-07-31 Complete WHIZARD UFO interface: - general Lorentz structures - matrix element support for general color factors - missing features: Majorana fermions and SLHA 2019-07-20 Make WHIZARD compatible with OCaml 4.08.0+ 2019-07-19 Fix version testing for LHAPDF 6.2.3 and newer Minimal required OCaml version is now 4.02.3. 2019-04-18 Correctly generate ordered FKS tuples for alpha regions from all possible underlying Born processes 2019-04-08 Extended O'Mega/Recola matrix element test suite 2019-03-29 Correct identical particle symmetry factors for FKS subtraction 2019-03-28 Correct assertion of spin-correlated matrix elements for hadron collisions 2019-03-27 Bug fix for cut-off parameter delta_i for collinear plus/minus regions ################################################################## 2019-03-27 RELEASE: version 2.7.1 2019-02-19 Further infrastructure for HepMC3 interface (v3.01.00) 2019-02-07 Explicit configure option for using debugging options Bug fix for performance by removing unnecessary debug operations 2019-01-29 Bug fix for DGLAP remnants with cut-off parameter delta_i 2019-01-24 Radiative decay neu2 -> neu1 A added to MSSM_Hgg model ################################################################## 2019-01-21 RELEASE: version 2.7.0 2018-12-18 Support RECOLA for integrated und unintegrated subtractions 2018-12-11 FCNC top-up sector in model SM_top_anom 2018-12-05 Use libtirpc instead of SunRPC on Arch Linux etc. 2018-11-30 Display rescaling factor for weighted event samples with cuts 2018-11-29 Reintroduce check against different masses in flavor sums Bug fix for wrong couplings in the Littlest Higgs model(s) 2018-11-22 Bug fix for rescanning events with beam structure 2018-11-09 Major refactoring of internal process data 2018-11-02 PYTHIA8 interface 2018-10-29 Flat phase space parametrization with RAMBO (on diet) implemented 2018-10-17 Revise extended test suite 2018-09-27 Process container for RECOLA processes 2018-09-15 Fixes by M. Berggren for PYTHIA6 interface 2018-09-14 First fixes after HepForge modernization ################################################################## 2018-08-23 RELEASE: version 2.6.4 2018-08-09 Infrastructure to check colored subevents 2018-07-10 Infrastructure for running WHIZARD in batch mode 2018-07-04 MPI available from distribution tarball 2018-06-03 Support Intel Fortran Compiler under MAC OS X 2018-05-07 FKS slicing parameter delta_i (initial state) implementend 2018-05-03 Refactor structure function assignment for NLO 2018-05-02 FKS slicing parameter xi_cut, delta_0 implemented 2018-04-20 Workspace subdirectory for process integration (grid/phs files) Packing/unpacking of files at job end/start Exporting integration results from scan loops 2018-04-13 Extended QCD NLO test suite 2018-04-09 Bug fix for Higgs Singlet Extension model 2018-04-06 Workspace subdirectory for process generation and compilation --job-id option for creating job-specific names 2018-03-20 Bug fix for color flow matching in hadron collisions with identical initial state quarks 2018-03-08 Structure functions quantum numbers correctly assigned for NLO 2018-02-24 Configure setup includes 'pgfortran' and 'flang' 2018-02-21 Include spin-correlated matrix elements in interactions 2018-02-15 Separate module for QED ISR structure functions ################################################################## 2018-02-10 RELEASE: version 2.6.3 2018-02-08 Improvements in memory management for PS generation 2018-01-31 Partial refactoring: quantum number assigment NLO Initial-state QCD splittings for hadron collisions 2018-01-25 Bug fix for weighted events with VAMP2 2018-01-17 Generalized interface for Recola versions 1.3+ and 2.1+ 2018-01-15 Channel equivalences also for VAMP2 integrator 2018-01-12 Fix for OCaml compiler 4.06 (and newer) 2017-12-19 RECOLA matrix elements with flavor sums can be integrated 2017-12-18 Bug fix for segmentation fault in empty resonance histories 2017-12-16 Fixing a bug in PYTHIA6 PYHEPC routine by omitting CMShowers from transferral between PYTHIA and WHIZARD event records 2017-12-15 Event index for multiple processes in event file correct ################################################################## 2017-12-13 RELEASE: version 2.6.2 2017-12-07 User can set offset in event numbers 2017-11-29 Possibility to have more than one RECOLA process in one file 2017-11-23 Transversal/mixed (and unitarized) dim-8 operators 2017-11-16 epa_q_max replaces epa_e_max (trivial factor 2) 2017-11-15 O'Mega matrix element compilation silent now 2017-11-14 Complete expanded P-wave form factor for top threshold 2017-11-10 Incoming particles can be accessed in SINDARIN 2017-11-08 Improved handling of resonance insertion, additional parameters 2017-11-04 Added Higgs-electron coupling (SM_Higgs) ################################################################## 2017-11-03 RELEASE: version 2.6.1 2017-10-20 More than 5 NLO components possible at same time 2017-10-19 Gaussian cutoff for shower resonance matching 2017-10-12 Alternative (more efficient) method to generate phase space file 2017-10-11 Bug fix for shower resonance histories for processes with multiple components 2017-09-25 Bug fix for process libraries in shower resonance histories 2017-09-21 Correctly generate pT distribution for EPA remnants 2017-09-20 Set branching ratios for unstable particles also by hand 2017-09-14 Correctly generate pT distribution for ISR photons ################################################################## 2017-09-08 RELEASE: version 2.6.0 2017-09-05 Bug fix for initial state NLO QCD flavor structures Real and virtual NLO QCD hadron collider processes work with internal interactions 2017-09-04 Fully validated MPI integration and event generation 2017-09-01 Resonance histories for shower: full support Bug fix in O'Mega model constraints O'Mega allows to output a parsable form of the DAG 2017-08-24 Resonance histories in events for transferral to parton shower (e.g. in ee -> jjjj) 2017-08-01 Alpha version of HepMC v3 interface (not yet really functional) 2017-07-31 Beta version for RECOLA OLP support 2017-07-06 Radiation generator fix for LHC processes 2017-06-30 Fix bug for NLO with structure functions and/or polarization 2017-06-23 Collinear limit for QED corrections works 2017-06-17 POWHEG grids generated already during integration 2017-06-12 Soft limit for QED corrections works 2017-05-16 Beta version of full MPI parallelization (VAMP2) Check consistency of POWHEG grid files Logfile config-summary.log for configure summary 2017-05-12 Allow polarization in top threshold 2017-05-09 Minimal demand automake 1.12.2 Silent rules for make procedures 2017-05-07 Major fix for POWHEG damping Correctly initialize FKS ISR phasespace ################################################################## 2017-05-06 RELEASE: version 2.5.0 2017-05-05 Full UFO support (SM-like models) Fixed-beam ISR FKS phase space 2017-04-26 QED splittings in radiation generator 2017-04-10 Retire deprecated O'Mega vertex cache files ################################################################## 2017-03-24 RELEASE: version 2.4.1 2017-03-16 Distinguish resonance charge in phase space channels Keep track of resonance histories in phase space Complex mass scheme default for OpenLoops amplitudes 2017-03-13 Fix helicities for polarized OpenLoops calculations 2017-03-09 Possibility to advance RNG state in rng_stream 2017-03-04 General setup for partitioning real emission phase space 2017-03-06 Bug fix on rescan command for converting event files 2017-02-27 Alternative multi-channel VEGAS implementation VAMP2: serial backbone for MPI setup Smoothstep top threshold matching 2017-02-25 Single-beam structure function with s-channel mapping supported Safeguard against invalid process libraries 2017-02-16 Radiation generator for photon emission 2017-02-10 Fixes for NLO QCD processes (color correlations) 2017-01-16 LCIO variable takes precedence over LCIO_DIR 2017-01-13 Alternative random number generator rng_stream (cf. L'Ecuyer et al.) 2017-01-01 Fix for multi-flavor BLHA tree matrix elements 2016-12-31 Grid path option for VAMP grids 2016-12-28 Alpha version of Recola OLP support 2016-12-27 Dalitz plots for FKS phase space 2016-12-14 NLO multi-flavor events possible 2016-12-09 LCIO event header information added 2016-12-02 Alpha version of RECOLA interface Bug fix for generator status in LCIO ################################################################## 2016-11-28 RELEASE: version 2.4.0 2016-11-24 Bug fix for OpenLoops interface: EW scheme is set by WHIZARD Bug fixes for top threshold implementation 2016-11-11 Refactoring of dispatching 2016-10-18 Bug fix for LCIO output 2016-10-10 First implementation for collinear soft terms 2016-10-06 First full WHIZARD models from UFO files 2016-10-05 WHIZARD does not support legacy gcc 4.7.4 any longer 2016-09-30 Major refactoring of process core and NLO components 2016-09-23 WHIZARD homogeneous entity: discarding subconfigures for CIRCE1/2, O'Mega, VAMP subpackages; these are reconstructable by script projectors 2016-09-06 Introduce main configure summary 2016-08-26 Fix memory leak in event generation ################################################################## 2016-08-25 RELEASE: version 2.3.1 2016-08-19 Bug fix for EW-scheme dependence of gluino propagators 2016-08-01 Beta version of complex mass scheme support 2016-07-26 Fix bug in POWHEG damping for the matching ################################################################## 2016-07-21 RELEASE: version 2.3.0 2016-07-20 UFO file support (alpha version) in O'Mega 2016-07-13 New (more) stable of WHIZARD GUI Support for EW schemes for OpenLoops Factorized NLO top decays for threshold model 2016-06-15 Passing factorization scale to PYTHIA6 Adding charge and neutral observables 2016-06-14 Correcting angular distribution/tweaked kinematics in non-collinear structure functions splittings 2016-05-10 Include (Fortran) TAUOLA/PHOTOS for tau decays via PYTHIA6 (backwards validation of LC CDR/TDR samples) 2016-04-27 Within OpenLoops virtuals: support for Collier library 2016-04-25 O'Mega vertex tables only loaded at first usage 2016-04-21 New CJ15 PDF parameterizations added 2016-04-21 Support for hadron collisions at NLO QCD 2016-04-05 Support for different (parameter) schemes in model files 2016-03-31 Correct transferral of lifetime/vertex from PYTHIA/TAUOLA into the event record 2016-03-21 New internal implementation of polarization via Bloch vectors, remove pointer constructions 2016-03-13 Extension of cascade syntax for processes: exclude propagators/vertices etc. possible 2016-02-24 Full support for OpenLoops QCD NLO matrix elements, inclusion in test suite 2016-02-12 Substantial progress on QCD NLO support 2016-02-02 Automated resonance mapping for FKS subtraction 2015-12-17 New BSM model WZW for diphoton resonances ################################################################## 2015-11-22 RELEASE: version 2.2.8 2015-11-21 Bug fix for fixed-order NLO events 2015-11-20 Anomalous FCNC top-charm vertices 2015-11-19 StdHEP output via HEPEVT/HEPEV4 supported 2015-11-18 Full set of electroweak dim-6 operators included 2015-10-22 Polarized one-loop amplitudes supported 2015-10-21 Fixes for event formats for showered events 2015-10-14 Callback mechanism for event output 2015-09-22 Bypass matrix elements in pure event sample rescans StdHep frozen final version v5.06.01 included internally 2015-09-21 configure option --with-precision to demand 64bit, 80bit, or 128bit Fortran and bind C precision types 2015-09-07 More extensive tests of NLO infrastructure and POWHEG matching 2015-09-01 NLO decay infrastructure User-defined squared matrix elements Inclusive FastJet algorithm plugin Numerical improvement for small boosts ################################################################## 2015-08-11 RELEASE: version 2.2.7 2015-08-10 Infrastructure for damped POWHEG Massive emitters in POWHEG Born matrix elements via BLHA GoSam filters via SINDARIN Minor running coupling bug fixes Fixed-order NLO events 2015-08-06 CT14 PDFs included (LO, NLO, NNLL) 2015-07-07 Revalidation of ILC WHIZARD-PYTHIA event chain Extended test suite for showered events Alpha version of massive FSR for POWHEG 2015-06-09 Fix memory leak in interaction for long cascades Catch mismatch between beam definition and CIRCE2 spectrum 2015-06-08 Automated POWHEG matching: beta version Infrastructure for GKS matching Alpha version of fixed-order NLO events CIRCE2 polarization averaged spectra with explicitly polarized beams 2015-05-12 Abstract matching type: OO structure for matching/merging 2015-05-07 Bug fix in event record WHIZARD-PYTHIA6 transferral Gaussian beam spectra for lepton colliders ################################################################## 2015-05-02 RELEASE: version 2.2.6 2015-05-01 Models for (unitarized) tensor resonances in VBS 2015-04-28 Bug fix in channel weights for event generation. 2015-04-18 Improved event record transfer WHIZARD/PYTHIA6 2015-03-19 POWHEG matching: alpha version ################################################################## 2015-02-27 RELEASE: version 2.2.5 2015-02-26 Abstract types for quantum numbers 2015-02-25 Read-in of StdHEP events, self-tests 2015-02-22 Bug fix for mother-daughter relations in showered/hadronized events 2015-02-20 Projection on polarization in intermediate states 2015-02-13 Correct treatment of beam remnants in event formats (also LC remnants) ################################################################## 2015-02-06 RELEASE: version 2.2.4 2015-02-06 Bug fix in event output 2015-02-05 LCIO event format supported 2015-01-30 Including state matrices in WHIZARD's internal IO Versioning for WHIZARD's internal IO Libtool update from 2.4.3 to 2.4.5 LCIO event output (beta version) 2015-01-27 Progress on NLO integration Fixing a bug for multiple processes in a single event file when using beam event files 2015-01-19 Bug fix for spin correlations evaluated in the rest frame of the mother particle 2015-01-17 Regression fix for statically linked processes from SARAH and FeynRules 2015-01-10 NLO: massive FKS emitters supported (experimental) 2015-01-06 MMHT2014 PDF sets included 2015-01-05 Handling mass degeneracies in auto_decays 2014-12-19 Fixing bug in rescan of event files ################################################################## 2014-11-30 RELEASE: version 2.2.3 2014-11-29 Beta version of LO continuum/NLL-threshold matched top threshold model for e+e- physics 2014-11-28 More internal refactoring: disentanglement of module dependencies 2014-11-21 OVM: O'Mega Virtual Machine, bytecode instructions instead of compiled Fortran code 2014-11-01 Higgs Singlet extension model included 2014-10-18 Internal restructuring of code; half-way WHIZARD main code file disassembled 2014-07-09 Alpha version of NLO infrastructure ################################################################## 2014-07-06 RELEASE: version 2.2.2 2014-07-05 CIRCE2: correlated LC beam spectra and GuineaPig Interface to LC machine parameters 2014-07-01 Reading LHEF for decayed/factorized/showered/ hadronized events 2014-06-25 Configure support for GoSAM/Ninja/Form/QGraf 2014-06-22 LHAPDF6 interface 2014-06-18 Module for automatic generation of radiation and loop infrastructure code 2014-06-11 Improved internal directory structure ################################################################## 2014-06-03 RELEASE: version 2.2.1 2014-05-30 Extensions of internal PDG arrays 2014-05-26 FastJet interface 2014-05-24 CJ12 PDFs included 2014-05-20 Regression fix for external models (via SARAH or FeynRules) ################################################################## 2014-05-18 RELEASE: version 2.2.0 2014-04-11 Multiple components: inclusive process definitions, syntax: process A + B + ... 2014-03-13 Improved PS mappings for e+e- ISR ILC TDR and CLIC spectra included in CIRCE1 2014-02-23 New models: AltH w\ Higgs for exclusion purposes, SM_rx for Dim 6-/Dim-8 operators, SSC for general strong interactions (w/ Higgs), and NoH_rx (w\ Higgs) 2014-02-14 Improved s-channel mapping, new on-shell production mapping (e.g. Drell-Yan) 2014-02-03 PRE-RELEASE: version 2.2.0_beta 2014-01-26 O'Mega: Feynman diagram generation possible (again) 2013-12-16 HOPPET interface for b parton matching 2013-11-15 PRE-RELEASE: version 2.2.0_alpha-4 2013-10-27 LHEF standards 1.0/2.0/3.0 implemented 2013-10-15 PRE-RELEASE: version 2.2.0_alpha-3 2013-10-02 PRE-RELEASE: version 2.2.0_alpha-2 2013-09-25 PRE-RELEASE: version 2.2.0_alpha-1 2013-09-12 PRE-RELEASE: version 2.2.0_alpha 2013-09-03 General 2HDM implemented 2013-08-18 Rescanning/recalculating events 2013-06-07 Reconstruction of complete event from 4-momenta possible 2013-05-06 Process library stacks 2013-05-02 Process stacks 2013-04-29 Single-particle phase space module 2013-04-26 Abstract interface for random number generator 2013-04-24 More object-orientation on modules Midpoint-rule integrator 2013-04-05 Object-oriented integration and event generation 2013-03-12 Processes recasted object-oriented: MEs, scales, structure functions First infrastructure for general Lorentz structures 2013-01-17 Object-orientated reworking of library and process core, more variable internal structure, unit tests 2012-12-14 Update Pythia version to 6.4.27 2012-12-04 Fix the phase in HAZ vertices 2012-11-21 First O'Mega unit tests, some infrastructure 2012-11-13 Bug fix in anom. HVV Lorentz structures ################################################################## 2012-09-18 RELEASE: version 2.1.1 2012-09-11 Model MSSM_Hgg with Hgg and HAA vertices 2012-09-10 First version of implementation of multiple interactions in WHIZARD 2012-09-05 Infrastructure for internal CKKW matching 2012-09-02 C, C++, Python API 2012-07-19 Fixing particle numbering in HepMC format ################################################################## 2012-06-15 RELEASE: version 2.1.0 2012-06-14 Analytical and kT-ordered shower officially released PYTHIA interface officially released 2012-05-09 Intrisince PDFs can be used for showering 2012-05-04 Anomalous Higgs couplings a la hep-ph/9902321 ################################################################## 2012-03-19 RELEASE: version 2.0.7 2012-03-15 Run IDs are available now More event variables in analysis Modified raw event format (compatibility mode exists) 2012-03-12 Bug fix in decay-integration order MLM matching steered completely internally now 2012-03-09 Special phase space mapping for narrow resonances decaying to 4-particle final states with far off-shell intermediate states Running alphas from PDF collaborations with builtin PDFs 2012-02-16 Bug fix in cascades decay infrastructure 2012-02-04 WHIZARD documentation compatible with TeXLive 2011 2012-02-01 Bug fix in FeynRules interface with --prefix flag 2012-01-29 Bug fix with name clash of O'Mega variable names 2012-01-27 Update internal PYTHIA to version 6.4.26 Bug fix in LHEF output 2012-01-21 Catching stricter automake 1.11.2 rules 2011-12-23 Bug fix in decay cascade setup 2011-12-20 Bug fix in helicity selection rules 2011-12-16 Accuracy goal reimplemented 2011-12-14 WHIZARD compatible with TeXLive 2011 2011-12-09 Option --user-target added ################################################################## 2011-12-07 RELEASE: version 2.0.6 2011-12-07 Bug fixes in SM_top_anom Added missing entries to HepMC format 2011-12-06 Allow to pass options to O'Mega Bug fix for HEPEVT block for showered/hadronized events 2011-12-01 Reenabled user plug-in for external code for cuts, structure functions, routines etc. 2011-11-29 Changed model SM_Higgs for Higgs phenomenology 2011-11-25 Supporting a Y, (B-L) Z' model 2011-11-23 Make WHIZARD compatible for MAC OS X Lion/XCode 4 2011-09-25 WHIZARD paper published: Eur.Phys.J. C71 (2011) 1742 2011-08-16 Model SM_QCD: QCD with one EW insertion 2011-07-19 Explicit output channel for dvips avoids printing 2011-07-10 Test suite for WHIZARD unit tests 2011-07-01 Commands for matrix element tests More OpenMP parallelization of kinematics Added unit tests 2011-06-23 Conversion of CIRCE2 from F77 to F90, major clean-up 2011-06-14 Conversion of CIRCE1 from F77 to F90 2011-06-10 OpenMP parallelization of channel kinematics (by Matthias Trudewind) 2011-05-31 RELEASE: version 1.97 2011-05-24 Minor bug fixes: update grids and elsif statement. ################################################################## 2011-05-10 RELEASE: version 2.0.5 2011-05-09 Fixed bug in final state flavor sums Minor improvements on phase-space setup 2011-05-05 Minor bug fixes 2011-04-15 WHIZARD as a precompiled 64-bit binary available 2011-04-06 Wall clock instead of cpu time for time estimates 2011-04-05 Major improvement on the phase space setup 2011-04-02 OpenMP parallelization for helicity loop in O'Mega matrix elements 2011-03-31 Tools for relocating WHIZARD and use in batch environments 2011-03-29 Completely static builds possible, profiling options 2011-03-28 Visualization of integration history 2011-03-27 Fixed broken K-matrix implementation 2011-03-23 Including the GAMELAN manual in the distribution 2011-01-26 WHIZARD analysis can handle hadronized event files 2011-01-17 MSTW2008 and CT10 PDF sets included 2010-12-23 Inclusion of NMSSM with Hgg couplings 2010-12-21 Advanced options for integration passes 2010-11-16 WHIZARD supports CTEQ6 and possibly other PDFs directly; data files included in the distribution ################################################################## 2010-10-26 RELEASE: version 2.0.4 2010-10-06 Bug fix in MSSM implementation 2010-10-01 Update to libtool 2.4 2010-09-29 Support for anomalous top couplings (form factors etc.) Bug fix for running gauge Yukawa SUSY couplings 2010-09-28 RELEASE: version 1.96 2010-09-21 Beam remnants and pT spectra for lepton collider re-enabled Restructuring subevt class 2010-09-16 Shower and matching are disabled by default PYTHIA as a conditional on these two options 2010-09-14 Possibility to read in beam spectra re-enabled (e.g. Guinea Pig) 2010-09-13 Energy scan as (pseudo-) structure functions re-implemented 2010-09-10 CIRCE2 included again in WHIZARD 2 and validated 2010-09-02 Re-implementation of asymmetric beam energies and collision angles, e-p collisions work, inclusion of a HERA DIS test case ################################################################## 2010-10-18 RELEASE: version 2.0.3 2010-08-08 Bug in CP-violating anomalous triple TGCs fixed 2010-08-06 Solving backwards compatibility problem with O'Caml 3.12.0 2010-07-12 Conserved quantum numbers speed up O'Mega code generation 2010-07-07 Attaching full ISR/FSR parton shower and MPI/ISR module Added SM model containing Hgg, HAA, HAZ vertices 2010-07-02 Matching output available as LHEF and STDHEP 2010-06-30 Various bug fixes, missing files, typos 2010-06-26 CIRCE1 completely re-enabled Chaining structure functions supported 2010-06-25 Partial support for conserved quantum numbers in O'Mega 2010-06-21 Major upgrade of the graphics package: error bars, smarter SINDARIN steering, documentation, and all that... 2010-06-17 MLM matching with PYTHIA shower included 2010-06-16 Added full CIRCE1 and CIRCE2 versions including full documentation and miscellanea to the trunk 2010-06-12 User file management supported, improved variable and command structure 2010-05-24 Improved handling of variables in local command lists 2010-05-20 PYTHIA interface re-enabled 2010-05-19 ASCII file formats for interfacing ROOT and gnuplot in data analysis ################################################################## 2010-05-18 RELEASE: version 2.0.2 2010-05-14 Reimplementation of visualization of phase space channels Minor bug fixes 2010-05-12 Improved phase space - elimination of redundancies 2010-05-08 Interface for polarization completed: polarized beams etc. 2010-05-06 Full quantum numbers appear in process log Integration results are usable as user variables Communication with external programs 2010-05-05 Split module commands into commands, integration, simulation modules 2010-05-04 FSR+ISR for the first time connected to the WHIZARD 2 core ################################################################## 2010-04-25 RELEASE: version 2.0.1 2010-04-23 Automatic compile and integrate if simulate is called Minor bug fixes in O'Mega 2010-04-21 Checkpointing for event generation Flush statements to use WHIZARD inside a pipe 2010-04-20 Reimplementation of signal handling in WGIZARD 2.0 2010-04-19 VAMP is now a separately configurable and installable unit of WHIZARD, included VAMP self-checks Support again compilation in quadruple precision 2010-04-06 Allow for logarithmic plots in GAMELAN, reimplement the possibility to set the number of bins 2010-04-15 Improvement on time estimates for event generation ################################################################## 2010-04-12 RELEASE: version 2.0.0 2010-04-09 Per default, the code for the amplitudes is subdivided to allow faster compiler optimization More advanced and unified and straightforward command language syntax Final bug fixes 2010-04-07 Improvement on SINDARIN syntax; printf, sprintf function thorugh a C interface 2010-04-05 Colorizing DAGs instead of model vertices: speed boost in colored code generation 2010-03-31 Generalized options for normalization of weighted and unweighted events Grid and weight histories added again to log files Weights can be used in analyses 2010-03-28 Cascade decays completely implemented including color and spin correlations 2010-03-07 Added new WHIZARD header with logo 2010-03-05 Removed conflict in O'Mega amplitudes between flavour sums and cascades StdHEP interface re-implemented 2010-03-03 RELEASE: version 2.0.0rc3 Several bug fixes for preventing abuse in input files OpenMP support for amplitudes Reimplementation of WHIZARD 1 HEPEVT ASCII event formats FeynRules interface successfully passed MSSM test 2010-02-26 Eliminating ghost gluons from multi-gluon amplitudes 2010-02-25 RELEASE: version 1.95 HEPEVT format from WHIZARD 1 re-implemented in WHIZARD 2 2010-02-23 Running alpha_s implemented in the FeynRules interface 2010-02-19 MSSM (semi-) automatized self-tests finalized 2010-02-17 RELEASE: version 1.94 2010-02-16 Closed memory corruption in WHIZARD 1 Fixed problems of old MadGraph and CompHep drivers with modern compilers Uncolored vertex selection rules for colored amplitudes in O'Mega 2010-02-15 Infrastructure for color correlation computation in O'Mega finished Forbidden processes are warned about, but treated as non-fatal 2010-02-14 Color correlation computation in O'Mega finalized 2010-02-10 Improving phase space mappings for identical particles in initial and final states Introduction of more extended multi-line error message 2010-02-08 First O'Caml code for computation of color correlations in O'Mega 2010-02-07 First MLM matching with e+ e- -> jets ################################################################## 2010-02-06 RELEASE: version 2.0.0rc2 2010-02-05 Reconsidered the Makefile structure and more extended tests Catch a crash between WHIZARD and O'Mega for forbidden processes Tensor products of arbitrary color structures in jet definitions 2010-02-04 Color correlation computation in O'Mega finalized ################################################################## 2010-02-03 RELEASE: version 2.0.0rc1 ################################################################## 2010-01-31 Reimplemented numerical helicity selection rules Phase space functionality of version 1 restored and improved 2009-12-05 NMSSM validated with FeynRules in WHIZARD 1 (Felix Braam) 2009-12-04 RELEASE: version 2.0.0alpha ################################################################## 2009-04-16 RELEASE: version 1.93 2009-04-15 Clean-up of Makefiles and configure scripts Reconfiguration of BSM model implementation extended supersymmetric models 2008-12-23 New model NMSSM (Felix Braam) SLHA2 added Bug in LHAPDF interface fixed 2008-08-16 Bug fixed in K matrix implementation Gravitino option in the MSSM added 2008-03-20 Improved color and flavor sums ################################################################## 2008-03-12 RELEASE: version 1.92 LHEF (Les Houches Event File) format added Fortran 2003 command-line interface (if supported by the compiler) Automated interface to colored models More bug fixes and workarounds for compiler compatibility ################################################################## 2008-03-06 RELEASE: version 1.91 New model K-matrix (resonances and anom. couplings in WW scattering) EWA spectrum Energy-scan pseudo spectrum Preliminary parton shower module (only from final-state quarks) Cleanup and improvements of configure process Improvements for O'Mega parameter files Quadruple precision works again More plotting options: lines, symbols, errors Documentation with PDF bookmarks enabled Various bug fixes 2007-11-29 New model UED ################################################################## 2007-11-23 RELEASE: version 1.90 O'Mega now part of the WHIZARD tree Madgraph/CompHEP disabled by default (but still usable) Support for LHAPDF (preliminary) Added new models: SMZprime, SM_km, Template Improved compiler recognition and compatibility Minor bug fixes ################################################################## 2006-06-15 RELEASE: version 1.51 Support for anomaly-type Higgs couplings (to gluon and photon/Z) Support for spin 3/2 and spin 2 New models: Little Higgs (4 versions), toy models for extra dimensions and gravitinos Fixes to the whizard.nw source documentation to run through LaTeX Intel 9.0 bug workaround (deallocation of some arrays) 2006-05-15 O'Mega RELEASE: version 0.11 merged JRR's O'Mega extensions ################################################################## 2006-02-07 RELEASE: version 1.50 To avoid confusion: Mention outdated manual example in BUGS file O'Mega becomes part of the WHIZARD generator 2006-02-02 [bug fix update] Bug fix: spurious error when writing event files for weighted events Bug fix: 'r' option for omega produced garbage for some particle names Workaround for ifort90 bug (crash when compiling whizard_event) Workaround for ifort90 bug (crash when compiling hepevt_common) 2006-01-27 Added process definition files for MSSM 2->2 processes Included beam recoil for EPA (T.Barklow) Updated STDHEP byte counts (for STDHEP 5.04.02) Fixed STDHEP compatibility (avoid linking of incomplete .so libs) Fixed issue with comphep requiring Xlibs on Opteron Fixed issue with ifort 8.x on Opteron (compiling 'signal' interface) Fixed color-flow code: was broken for omega with option 'c' and 'w' Workaround hacks for g95 compatibility 2005-11-07 O'Mega RELEASE: version 0.10 O'Mega, merged JRR's and WK's color hack for WHiZard O'Mega, EXPERIMENTAL: cache fusion tables (required for colors a la JRR/WK) O'Mega, make JRR's MSSM official ################################################################## 2005-10-25 RELEASE: version 1.43 Minor fixes in MSSM couplings (Higgs/3rd gen squarks). This should be final, since the MSSM results agree now completely with Madgraph and Sherpa User-defined lower and upper limits for split event file count Allow for counters (events, bytes) exceeding $2^{31}$ Revised checksum treatment and implementation (now MD5) Bug fix: missing process energy scale in raw event file ################################################################## 2005-09-30 RELEASE: version 1.42 Graphical display of integration history ('make history') Allow for switching off signals even if supported (configure option) 2005-09-29 Revised phase space generation code, in particular for flavor sums Negative cut and histogram codes use initial beams instead of initial parton momenta. This allows for computing, e.g., E_miss Support constant-width and zero-width options for O'Mega Width options now denoted by w:X (X=f,c,z). f option obsolescent Bug fix: colorized code: flipped indices could screw up result Bug fix: O'Mega with 'c' and 'w:f' option together (still some problem) Bug fix: dvips on systems where dvips defaults to lpr Bug fix: integer overflow if too many events are requested 2005-07-29 Allow for 2 -> 1 processes (if structure functions are on) 2005-07-26 Fixed and expanded the 'test' matrix element: Unit matrix element with option 'u' / default: normalized phase space ################################################################## 2005-07-15 RELEASE: version 1.41 Bug fix: no result for particle decay processes with width=0 Bug fix: line breaks in O'Mega files with color decomposition 2005-06-02 New self-tests (make test-QED / test-QCD / test-SM) check lists of 2->2 processes Bug fix: HELAS calling convention for wwwwxx and jwwwxx (4W-Vertex) 2005-05-25 Revised Makefile structure Eliminated obsolete references to ISAJET/SUSY (superseded by SLHA) 2005-05-19 Support for color in O'Mega (using color flow decomposition) New model QCD Parameter file changes that correspond to replaced SM module in O'Mega Bug fixes in MSSM (O'Mega) parameter file 2005-05-18 New event file formats, useful for LHC applications: ATHENA and Les Houches Accord (external fragmentation) Naive (i.e., leading 1/N) color factor now implemented both for incoming and outgoing partons 2005-01-26 include missing HELAS files for bundle pgf90 compatibility issues [note: still internal error in pgf90] ################################################################## 2004-12-13 RELEASE: version 1.40 compatibility fix: preprocessor marks in helas code now commented out minor bug fix: format string in madgraph source 2004-12-03 support for arbitray beam energies and directions allow for pT kick in structure functions bug fix: rounding error could result in zero cross section (compiler-dependent) 2004-10-07 simulate decay processes list fraction (of total width/cross section) instead of efficiency in process summary new cut/analysis parameters AA, AAD, CTA: absolute polar angle 2004-10-04 Replaced Madgraph I by Madgraph II. Main improvement: model no longer hardcoded introduced parameter reset_seed_each_process (useful for debugging) bug fix: color initialization for some processes was undefined 2004-09-21 don't compile unix_args module if it is not required ################################################################## 2004-09-20 RELEASE: version 1.30 g95 compatibility issues resolved some (irrelevant) memory leaks closed removed obsolete warning in circe1 manual update (essentially) finished 2004-08-03 O'Mega RELEASE: version 0.9 O'Mega, src/trie.mli, src/trie.ml: make interface compatible with the O'Caml 3.08 library (remains compatible with older versions). Implementation of unused functions still incomplete. 2004-07-26 minor fixes and improvements in make process 2004-06-29 workarounds for new Intel compiler bugs ... no rebuild of madgraph/comphep executables after 'make clean' bug fix in phase space routine: wrong energy for massive initial particles bug fix in (new) model interface: name checks for antiparticles pre-run checks for comphep improved ww-strong model file extended Model files particle name fixes, chep SM vertices included 2004-06-22 O'Mega RELEASE: version 0.8 O'Mega MSSM: sign of W+/W-/A and W+/W-/Z couplings 2004-05-05 Fixed bug in PDFLIB interface: p+pbar was initialized as p+p (ThO) NAG compiler: set number of continuation lines to 200 as default Extended format for cross section summary; appears now in whizard.out Fixed 'bundle' feature 2004-04-28 Fixed compatibility with revised O'Mega SM_ac model Fixed problem with x=0 or x=1 when calling PDFLIB (ThO) Fixed bug in comphep module: Vtb was overlooked ################################################################## 2004-04-15 RELEASE: version 1.28 Fixed bug: Color factor was missing for O'Mega processes with four quarks and more Manual partially updated 2004-04-08 Support for grid files in binary format New default value show_histories=F (reduce output file size) Revised phase space switches: removed annihilation_lines, removed s_channel_resonance, changed meaning of extra_off_shell_lines, added show_deleted_channels Bug fixed which lead to omission of some phase space channels Color flow guessed only if requested by guess_color_flow 2004-03-10 New model interface: Only one model name specified in whizard.prc All model-dependent files reside in conf/models (modellib removed) 2004-03-03 Support for input/output in SUSY Les Houches Accord format Split event files if requested Support for overall time limit Support for CIRCE and CIRCE2 generator mode Support for reading beam events from file 2004-02-05 Fixed compiler problems with Intel Fortran 7.1 and 8.0 Support for catching signals ################################################################## 2003-08-06 RELEASE: version 1.27 User-defined PDF libraries as an alternative to the standard PDFLIB 2003-07-23 Revised phase space module: improved mappings for massless particles, equivalences of phase space channels are exploited Improved mapping for PDF (hadron colliders) Madgraph module: increased max number of color flows from 250 to 1000 ################################################################## 2003-06-23 RELEASE: version 1.26 CIRCE2 support Fixed problem with 'TC' integer kind [Intel compiler complained] 2003-05-28 Support for drawing histograms of grids Bug fixes for MSSM definitions ################################################################## 2003-05-22 RELEASE: version 1.25 Experimental MSSM support with ISAJET interface Improved capabilities of generating/analyzing weighted events Optional drawing phase space diagrams using FeynMF ################################################################## 2003-01-31 RELEASE: version 1.24 A few more fixes and workarounds (Intel and Lahey compiler) 2003-01-15 Fixes and workarounds needed for WHIZARD to run with Intel compiler Command-line option interface for the Lahey compiler Bug fix: problem with reading whizard.phs ################################################################## 2002-12-10 RELEASE: version 1.23 Command-line options (on some systems) Allow for initial particles in the event record, ordered: [beams, initials] - [remnants] - outgoing partons Support for PYTHIA 6.2: Les Houches external process interface String pythia_parameters can be up to 1000 characters long Select color flow states in (internal) analysis Bug fix in color flow content of raw event files Support for transversal polarization of fermion beams Cut codes: PHI now for absolute azimuthal angle, DPHI for distance 'Test' matrix elements optionally respect polarization User-defined code can be inserted for spectra, structure functions and fragmentation Time limits can be specified for adaptation and simulation User-defined file names and file directory Initial weights in input file no longer supported Bug fix in MadGraph (wave function counter could overflow) Bug fix: Gamelan (graphical analysis) was not built if noweb absent ################################################################## 2002-03-16 RELEASE: version 1.22 Allow for beam remnants in the event record 2002-03-01 Handling of aliases in whizard.prc fixed (aliases are whole tokens) 2002-02-28 Optimized phase space handling routines (total execution time reduced by 20-60%, depending on process) ################################################################## 2002-02-26 RELEASE: version 1.21 Fixed ISR formula (ISR was underestimated in previous versions). New version includes ISR in leading-log approximation up to third order. Parameter ISR_sqrts renamed to ISR_scale. ################################################################## 2002-02-19 RELEASE: version 1.20 New process-generating method 'test' (dummy matrix element) Compatibility with autoconf 2.50 and current O'Mega version 2002-02-05 Prevent integration channels from being dropped (optionally) New internal mapping for structure functions improves performance Old whizard.phx file deleted after recompiling (could cause trouble) 2002-01-24 Support for user-defined cuts and matrix element reweighting STDHEP output now written by write_events_format=20 (was 3) 2002-01-16 Improved structure function handling; small changes in user interface: new parameter structured_beams in &process_input parameter fixed_energy in &beam_input removed Support for multiple initial states Eta-phi (cone) cut possible (hadron collider applications) Fixed bug: Whizard library was not always recompiled when necessary Fixed bug: Default cuts were insufficient in some cases Fixed bug: Unusable phase space mappings generated in some cases 2001-12-06 Reorganized document source 2001-12-05 Preliminary CIRCE2 support (no functionality yet) 2001-11-27 Intel compiler support (does not yet work because of compiler bugs) New cut and analysis mode cos-theta* and related Fixed circular jetset_interface dependency warning Some broadcast routines removed (parallel support disabled anyway) Minor shifts in cleanup targets (Makefiles) Modified library search, check for pdflib8* 2001-08-06 Fixed bug: I/O unit number could be undefined when reading phase space Fixed bug: Unitialized variable could cause segfault when event generation was disabled Fixed bug: Undefined subroutine in CIRCE replacement module Enabled feature: TGCs in O'Mega (not yet CompHEP!) matrix elements (CompHEP model sm-GF #5, O'Mega model SM_ac) Fixed portability issue: Makefile did rely on PWD environment variable Fixed portability issue: PYTHIA library search ambiguity resolved 2001-08-01 Default whizard.prc and whizard.in depend on activated modules Fixed bug: TEX=latex was not properly enabled when making plots 2001-07-20 Fixed output settings in PERL script calls Cache enabled in various configure checks 2001-07-13 Support for multiple processes in a single WHIZARD run. The integrations are kept separate, but the generated events are mixed The whizard.evx format has changed (incompatible), including now the color flow information for PYTHIA fragmentation Output files are now process-specific, except for the event file Phase space file whizard.phs (if present) is used only as input, program-generated phase space is now in whizard.phx 2001-07-10 Bug fix: Undefined parameters in parameters_SM_ac.f90 removed 2001-07-04 Bug fix: Compiler options for the case OMEGA is disabled Small inconsistencies in whizard.out format fixed 2001-07-01 Workaround for missing PDFLIB dummy routines in PYTHIA library ################################################################## 2001-06-30 RELEASE: version 1.13 Default path /cern/pro/lib in configure script 2001-06-20 New fragmentation option: Interface for PYTHIA with full color flow information, beam remnants etc. 2001-06-18 Severe bug fixed in madgraph interface: 3-gluon coupling was missing Enabled color flow information in madgraph 2001-06-11 VAMP interface module rewritten Revised output format: Multiple VAMP iterations count as one WHIZARD iteration in integration passes 1 and 3 Improved message and error handling Bug fix in VAMP: handle exceptional cases in rebinning_weights 2001-05-31 new parameters for grid adaptation: accuracy_goal and efficiency_goal ################################################################## 2001-05-29 RELEASE: version 1.12 bug fixes (compilation problems): deleted/modified unused functions 2001-05-16 diagram selection improved and documented 2001-05-06 allow for disabling packages during configuration 2001-05-03 slight changes in whizard.out format; manual extended ################################################################## 2001-04-20 RELEASE: version 1.11 fixed some configuration and compilation problems (PDFLIB etc.) 2001-04-18 linked PDFLIB: support for quark/gluon structure functions 2001-04-05 parameter interface written by PERL script SM_ac model file: fixed error in continuation line 2001-03-13 O'Mega, O'Caml 3.01: incompatible changes O'Mega, src/trie.mli: add covariance annotation to T.t This breaks O'Caml 3.00, but is required for O'Caml 3.01. O'Mega, many instances: replace `sig include Module.T end' by `Module.T', since the bug is fixed in O'Caml 3.01 2001-02-28 O'Mega, src/model.mli: new field Model.vertices required for model functors, will retire Model.fuse2, Model.fuse3, Model.fusen soon. ################################################################## 2001-03-27 RELEASE: version 1.10 reorganized the modules as libraries linked PYTHIA: support for parton fragmentation 2000-12-14 fixed some configuration problems (if noweb etc. are absent) ################################################################## 2000-12-01 RELEASE of first public version: version 1.00beta