Page MenuHomeHEPForge
Files F3343885

No OneTemporary
Actions

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
Index: trunk/ChangeLog
===================================================================
--- trunk/ChangeLog (revision 8819)
+++ trunk/ChangeLog (revision 8820)
@@ -1,2308 +1,2311 @@
ChangeLog -- Summary of changes to the WHIZARD package
Use svn log to see detailed changes.
Version 3.0.2+
+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
Index: trunk/src/events/events.nw
===================================================================
--- trunk/src/events/events.nw (revision 8819)
+++ trunk/src/events/events.nw (revision 8820)
@@ -1,19881 +1,19881 @@
%% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: event handling objects
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Generic Event Handling}
\includemodulegraph{events}
Event records allow the MC to communicate with the outside world. The
event record should exhibit the observable contents of a physical
event. We should be able to read and write events. The actual
implementation of the event need not be defined yet, for that purpose.
We have the following basic modules:
\begin{description}
\item[event\_base]
Abstract base type for event records. The base type contains a
reference to a [[particle_set_t]] object as the event core, and it
holds some data that we should always expect, such as the squared
matrix element and event weight.
\item[eio\_data]
Transparent container for the metadata of an event sample.
\item[eio\_base]
Abstract base type for event-record input and output. The
implementations of this base type represent specific event I/O
formats.
\end{description}
These are the implementation modules:
\begin{description}
\item[eio\_checkpoints]
Auxiliary output format. The only purpose is to provide screen
diagnostics during event output.
\item[eio\_callback]
Auxiliary output format. The only purpose is to execute a callback
procedure, so we have a hook for external access during event output.
\item[eio\_weights]
Print some event summary data, no details. The main use is for
testing purposes.
\item[eio\_dump]
Dump the contents of WHIZARD's [[particle_set]] internal record,
using the [[write]] method of that record as-is. The main use if for
testing purposes.
\item[hep\_common]
Implements traditional HEP common blocks that are (still) used by
some of the event I/O formats below.
\item[hepmc\_interface]
Access particle objects of the HepMC package. Functional only if this
package is linked. The interface is working both for HepMC2 and HepMC3.
\item[lcio\_interface]
Access objects of the LCIO package. Functional only if this
package is linked.
\item[hep\_events]
Interface between the event record and the common blocks.
\item[eio\_ascii]
Collection of event output formats that write ASCII files.
\item[eio\_lhef]
LHEF for input and output.
\item[eio\_stdhep]
Support for the StdHEP format (binary, machine-independent).
\item[eio\_hepmc]
Support for the HepMC format (C++).
\item[eio\_lcio]
Support for the LCIO format (C++).
\end{description}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Generic Event Handling}
We introduce events first in form of an abstract type, together with
some utilities. Abstract events can be used by other modules, in
particular event I/O, without introducing an explicit dependency on
the event implementation.
<<[[event_base.f90]]>>=
<<File header>>
module event_base
<<Use kinds>>
use kinds, only: i64
<<Use strings>>
use model_data
use particles
<<Standard module head>>
<<Event base: public>>
<<Event base: parameters>>
<<Event base: types>>
<<Event base: interfaces>>
interface
<<Event base: sub interfaces>>
end interface
end module event_base
@ %def event_base
@
<<[[event_base_sub.f90]]>>=
<<File header>>
submodule (event_base) event_base_s
use io_units
use string_utils, only: lower_case
use diagnostics
implicit none
contains
<<Event base: procedures>>
end submodule event_base_s
@ %def event_base_s
@
\subsection{generic event type}
<<Event base: public>>=
public :: generic_event_t
<<Event base: types>>=
type, abstract :: generic_event_t
!private
logical :: particle_set_is_valid = .false.
type(particle_set_t), pointer :: particle_set => null ()
logical :: sqme_ref_known = .false.
real(default) :: sqme_ref = 0
logical :: sqme_prc_known = .false.
real(default) :: sqme_prc = 0
logical :: weight_ref_known = .false.
real(default) :: weight_ref = 0
logical :: weight_prc_known = .false.
real(default) :: weight_prc = 0
logical :: excess_prc_known = .false.
real(default) :: excess_prc = 0
logical :: n_dropped_known = .false.
integer :: n_dropped = 0
integer :: n_alt = 0
logical :: sqme_alt_known = .false.
real(default), dimension(:), allocatable :: sqme_alt
logical :: weight_alt_known = .false.
real(default), dimension(:), allocatable :: weight_alt
contains
<<Event base: generic event: TBP>>
end type generic_event_t
@ %def generic_event_t
@
\subsection{Initialization}
This determines the number of alternate weights and sqme values.
<<Event base: generic event: TBP>>=
procedure :: base_init => generic_event_init
<<Event base: sub interfaces>>=
module subroutine generic_event_init (event, n_alt)
class(generic_event_t), intent(out) :: event
integer, intent(in) :: n_alt
end subroutine generic_event_init
<<Event base: procedures>>=
module subroutine generic_event_init (event, n_alt)
class(generic_event_t), intent(out) :: event
integer, intent(in) :: n_alt
event%n_alt = n_alt
allocate (event%sqme_alt (n_alt))
allocate (event%weight_alt (n_alt))
end subroutine generic_event_init
@ %def generic_event_init
@
\subsection{Access particle set}
The particle set is the core of the event. We allow access to it via
a pointer, and we maintain the information whether the particle set
is valid, i.e., has been filled with meaningful data.
<<Event base: generic event: TBP>>=
procedure :: has_valid_particle_set => generic_event_has_valid_particle_set
procedure :: accept_particle_set => generic_event_accept_particle_set
procedure :: discard_particle_set => generic_event_discard_particle_set
<<Event base: sub interfaces>>=
module function generic_event_has_valid_particle_set (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_has_valid_particle_set
module subroutine generic_event_accept_particle_set (event)
class(generic_event_t), intent(inout) :: event
end subroutine generic_event_accept_particle_set
module subroutine generic_event_discard_particle_set (event)
class(generic_event_t), intent(inout) :: event
end subroutine generic_event_discard_particle_set
<<Event base: procedures>>=
module function generic_event_has_valid_particle_set (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%particle_set_is_valid
end function generic_event_has_valid_particle_set
module subroutine generic_event_accept_particle_set (event)
class(generic_event_t), intent(inout) :: event
event%particle_set_is_valid = .true.
end subroutine generic_event_accept_particle_set
module subroutine generic_event_discard_particle_set (event)
class(generic_event_t), intent(inout) :: event
event%particle_set_is_valid = .false.
end subroutine generic_event_discard_particle_set
@ %def generic_event_has_valid_particle_set
@ %def generic_event_accept_particle_set
@ %def generic_event_discard_particle_set
@
These procedures deal with the particle set directly. Return the pointer:
<<Event base: generic event: TBP>>=
procedure :: get_particle_set_ptr => generic_event_get_particle_set_ptr
<<Event base: sub interfaces>>=
module function generic_event_get_particle_set_ptr (event) result (ptr)
class(generic_event_t), intent(in) :: event
type(particle_set_t), pointer :: ptr
end function generic_event_get_particle_set_ptr
<<Event base: procedures>>=
module function generic_event_get_particle_set_ptr (event) result (ptr)
class(generic_event_t), intent(in) :: event
type(particle_set_t), pointer :: ptr
ptr => event%particle_set
end function generic_event_get_particle_set_ptr
@ %def generic_event_get_particle_set_ptr
@
Let it point to some existing particle set:
<<Event base: generic event: TBP>>=
procedure :: link_particle_set => generic_event_link_particle_set
<<Event base: sub interfaces>>=
module subroutine generic_event_link_particle_set (event, particle_set)
class(generic_event_t), intent(inout) :: event
type(particle_set_t), intent(in), target :: particle_set
end subroutine generic_event_link_particle_set
<<Event base: procedures>>=
module subroutine generic_event_link_particle_set (event, particle_set)
class(generic_event_t), intent(inout) :: event
type(particle_set_t), intent(in), target :: particle_set
event%particle_set => particle_set
call event%accept_particle_set ()
end subroutine generic_event_link_particle_set
@ %def generic_event_link_particle_set
@
\subsection{Access sqme and weight}
There are several incarnations: the current value, a reference value,
alternate values.
<<Event base: generic event: TBP>>=
procedure :: sqme_prc_is_known => generic_event_sqme_prc_is_known
procedure :: sqme_ref_is_known => generic_event_sqme_ref_is_known
procedure :: sqme_alt_is_known => generic_event_sqme_alt_is_known
procedure :: weight_prc_is_known => generic_event_weight_prc_is_known
procedure :: weight_ref_is_known => generic_event_weight_ref_is_known
procedure :: weight_alt_is_known => generic_event_weight_alt_is_known
procedure :: excess_prc_is_known => generic_event_excess_prc_is_known
<<Event base: sub interfaces>>=
module function generic_event_sqme_prc_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_sqme_prc_is_known
module function generic_event_sqme_ref_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_sqme_ref_is_known
module function generic_event_sqme_alt_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_sqme_alt_is_known
module function generic_event_weight_prc_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_weight_prc_is_known
module function generic_event_weight_ref_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_weight_ref_is_known
module function generic_event_weight_alt_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_weight_alt_is_known
module function generic_event_excess_prc_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_excess_prc_is_known
<<Event base: procedures>>=
module function generic_event_sqme_prc_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%sqme_prc_known
end function generic_event_sqme_prc_is_known
module function generic_event_sqme_ref_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%sqme_ref_known
end function generic_event_sqme_ref_is_known
module function generic_event_sqme_alt_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%sqme_alt_known
end function generic_event_sqme_alt_is_known
module function generic_event_weight_prc_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%weight_prc_known
end function generic_event_weight_prc_is_known
module function generic_event_weight_ref_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%weight_ref_known
end function generic_event_weight_ref_is_known
module function generic_event_weight_alt_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%weight_alt_known
end function generic_event_weight_alt_is_known
module function generic_event_excess_prc_is_known (event) result (flag)
class(generic_event_t), intent(in) :: event
logical :: flag
flag = event%excess_prc_known
end function generic_event_excess_prc_is_known
@ %def generic_event_sqme_prc_is_known
@ %def generic_event_sqme_ref_is_known
@ %def generic_event_sqme_alt_is_known
@ %def generic_event_weight_prc_is_known
@ %def generic_event_weight_ref_is_known
@ %def generic_event_weight_alt_is_known
@ %def generic_event_excess_prc_is_known
@
<<Event base: generic event: TBP>>=
procedure :: get_n_alt => generic_event_get_n_alt
<<Event base: sub interfaces>>=
module function generic_event_get_n_alt (event) result (n)
class(generic_event_t), intent(in) :: event
integer :: n
end function generic_event_get_n_alt
<<Event base: procedures>>=
module function generic_event_get_n_alt (event) result (n)
class(generic_event_t), intent(in) :: event
integer :: n
n = event%n_alt
end function generic_event_get_n_alt
@ %def generic_event_get_n_alt
@
<<Event base: generic event: TBP>>=
procedure :: get_sqme_prc => generic_event_get_sqme_prc
procedure :: get_sqme_ref => generic_event_get_sqme_ref
generic :: get_sqme_alt => &
generic_event_get_sqme_alt_0, generic_event_get_sqme_alt_1
procedure :: generic_event_get_sqme_alt_0
procedure :: generic_event_get_sqme_alt_1
procedure :: get_weight_prc => generic_event_get_weight_prc
procedure :: get_weight_ref => generic_event_get_weight_ref
generic :: get_weight_alt => &
generic_event_get_weight_alt_0, generic_event_get_weight_alt_1
procedure :: generic_event_get_weight_alt_0
procedure :: generic_event_get_weight_alt_1
procedure :: get_n_dropped => generic_event_get_n_dropped
procedure :: get_excess_prc => generic_event_get_excess_prc
<<Event base: sub interfaces>>=
module function generic_event_get_sqme_prc (event) result (sqme)
class(generic_event_t), intent(in) :: event
real(default) :: sqme
end function generic_event_get_sqme_prc
module function generic_event_get_sqme_ref (event) result (sqme)
class(generic_event_t), intent(in) :: event
real(default) :: sqme
end function generic_event_get_sqme_ref
module function generic_event_get_sqme_alt_0 (event, i) result (sqme)
class(generic_event_t), intent(in) :: event
integer, intent(in) :: i
real(default) :: sqme
end function generic_event_get_sqme_alt_0
module function generic_event_get_sqme_alt_1 (event) result (sqme)
class(generic_event_t), intent(in) :: event
real(default), dimension(event%n_alt) :: sqme
end function generic_event_get_sqme_alt_1
module function generic_event_get_weight_prc (event) result (weight)
class(generic_event_t), intent(in) :: event
real(default) :: weight
end function generic_event_get_weight_prc
module function generic_event_get_weight_ref (event) result (weight)
class(generic_event_t), intent(in) :: event
real(default) :: weight
end function generic_event_get_weight_ref
module function generic_event_get_weight_alt_0 (event, i) result (weight)
class(generic_event_t), intent(in) :: event
integer, intent(in) :: i
real(default) :: weight
end function generic_event_get_weight_alt_0
module function generic_event_get_weight_alt_1 (event) result (weight)
class(generic_event_t), intent(in) :: event
real(default), dimension(event%n_alt) :: weight
end function generic_event_get_weight_alt_1
module function generic_event_get_excess_prc (event) result (excess)
class(generic_event_t), intent(in) :: event
real(default) :: excess
end function generic_event_get_excess_prc
module function generic_event_get_n_dropped (event) result (n_dropped)
class(generic_event_t), intent(in) :: event
integer :: n_dropped
end function generic_event_get_n_dropped
<<Event base: procedures>>=
module function generic_event_get_sqme_prc (event) result (sqme)
class(generic_event_t), intent(in) :: event
real(default) :: sqme
if (event%sqme_prc_known) then
sqme = event%sqme_prc
else
sqme = 0
end if
end function generic_event_get_sqme_prc
module function generic_event_get_sqme_ref (event) result (sqme)
class(generic_event_t), intent(in) :: event
real(default) :: sqme
if (event%sqme_ref_known) then
sqme = event%sqme_ref
else
sqme = 0
end if
end function generic_event_get_sqme_ref
module function generic_event_get_sqme_alt_0 (event, i) result (sqme)
class(generic_event_t), intent(in) :: event
integer, intent(in) :: i
real(default) :: sqme
if (event%sqme_alt_known) then
sqme = event%sqme_alt(i)
else
sqme = 0
end if
end function generic_event_get_sqme_alt_0
module function generic_event_get_sqme_alt_1 (event) result (sqme)
class(generic_event_t), intent(in) :: event
real(default), dimension(event%n_alt) :: sqme
sqme = event%sqme_alt
end function generic_event_get_sqme_alt_1
module function generic_event_get_weight_prc (event) result (weight)
class(generic_event_t), intent(in) :: event
real(default) :: weight
if (event%weight_prc_known) then
weight = event%weight_prc
else
weight = 0
end if
end function generic_event_get_weight_prc
module function generic_event_get_weight_ref (event) result (weight)
class(generic_event_t), intent(in) :: event
real(default) :: weight
if (event%weight_ref_known) then
weight = event%weight_ref
else
weight = 0
end if
end function generic_event_get_weight_ref
module function generic_event_get_weight_alt_0 (event, i) result (weight)
class(generic_event_t), intent(in) :: event
integer, intent(in) :: i
real(default) :: weight
if (event%weight_alt_known) then
weight = event%weight_alt(i)
else
weight = 0
end if
end function generic_event_get_weight_alt_0
module function generic_event_get_weight_alt_1 (event) result (weight)
class(generic_event_t), intent(in) :: event
real(default), dimension(event%n_alt) :: weight
weight = event%weight_alt
end function generic_event_get_weight_alt_1
module function generic_event_get_excess_prc (event) result (excess)
class(generic_event_t), intent(in) :: event
real(default) :: excess
if (event%excess_prc_known) then
excess = event%excess_prc
else
excess = 0
end if
end function generic_event_get_excess_prc
module function generic_event_get_n_dropped (event) result (n_dropped)
class(generic_event_t), intent(in) :: event
integer :: n_dropped
if (event%n_dropped_known) then
n_dropped = event%n_dropped
else
n_dropped = 0
end if
end function generic_event_get_n_dropped
@ %def generic_event_get_sqme_prc
@ %def generic_event_get_sqme_ref
@ %def generic_event_get_sqme_alt
@ %def generic_event_get_weight_prc
@ %def generic_event_get_weight_ref
@ %def generic_event_get_weight_alt
@ %def generic_event_get_n_dropped
@ %def generic_event_get_excess_prc
@
<<Event base: generic event: TBP>>=
procedure :: set_sqme_prc => generic_event_set_sqme_prc
procedure :: set_sqme_ref => generic_event_set_sqme_ref
procedure :: set_sqme_alt => generic_event_set_sqme_alt
procedure :: set_weight_prc => generic_event_set_weight_prc
procedure :: set_weight_ref => generic_event_set_weight_ref
procedure :: set_weight_alt => generic_event_set_weight_alt
procedure :: set_excess_prc => generic_event_set_excess_prc
procedure :: set_n_dropped => generic_event_set_n_dropped
<<Event base: sub interfaces>>=
module subroutine generic_event_set_sqme_prc (event, sqme)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: sqme
end subroutine generic_event_set_sqme_prc
module subroutine generic_event_set_sqme_ref (event, sqme)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: sqme
end subroutine generic_event_set_sqme_ref
module subroutine generic_event_set_sqme_alt (event, sqme)
class(generic_event_t), intent(inout) :: event
real(default), dimension(:), intent(in) :: sqme
end subroutine generic_event_set_sqme_alt
module subroutine generic_event_set_weight_prc (event, weight)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: weight
end subroutine generic_event_set_weight_prc
module subroutine generic_event_set_weight_ref (event, weight)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: weight
end subroutine generic_event_set_weight_ref
module subroutine generic_event_set_weight_alt (event, weight)
class(generic_event_t), intent(inout) :: event
real(default), dimension(:), intent(in) :: weight
end subroutine generic_event_set_weight_alt
module subroutine generic_event_set_excess_prc (event, excess)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: excess
end subroutine generic_event_set_excess_prc
module subroutine generic_event_set_n_dropped (event, n_dropped)
class(generic_event_t), intent(inout) :: event
integer, intent(in) :: n_dropped
end subroutine generic_event_set_n_dropped
<<Event base: procedures>>=
module subroutine generic_event_set_sqme_prc (event, sqme)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: sqme
event%sqme_prc = sqme
event%sqme_prc_known = .true.
end subroutine generic_event_set_sqme_prc
module subroutine generic_event_set_sqme_ref (event, sqme)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: sqme
event%sqme_ref = sqme
event%sqme_ref_known = .true.
end subroutine generic_event_set_sqme_ref
module subroutine generic_event_set_sqme_alt (event, sqme)
class(generic_event_t), intent(inout) :: event
real(default), dimension(:), intent(in) :: sqme
event%sqme_alt = sqme
event%sqme_alt_known = .true.
end subroutine generic_event_set_sqme_alt
module subroutine generic_event_set_weight_prc (event, weight)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: weight
event%weight_prc = weight
event%weight_prc_known = .true.
end subroutine generic_event_set_weight_prc
module subroutine generic_event_set_weight_ref (event, weight)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: weight
event%weight_ref = weight
event%weight_ref_known = .true.
end subroutine generic_event_set_weight_ref
module subroutine generic_event_set_weight_alt (event, weight)
class(generic_event_t), intent(inout) :: event
real(default), dimension(:), intent(in) :: weight
event%weight_alt = weight
event%weight_alt_known = .true.
end subroutine generic_event_set_weight_alt
module subroutine generic_event_set_excess_prc (event, excess)
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: excess
event%excess_prc = excess
event%excess_prc_known = .true.
end subroutine generic_event_set_excess_prc
module subroutine generic_event_set_n_dropped (event, n_dropped)
class(generic_event_t), intent(inout) :: event
integer, intent(in) :: n_dropped
event%n_dropped = n_dropped
event%n_dropped_known = .true.
end subroutine generic_event_set_n_dropped
@ %def generic_event_set_sqme_prc
@ %def generic_event_set_sqme_ref
@ %def generic_event_set_sqme_alt
@ %def generic_event_set_weight_prc
@ %def generic_event_set_weight_ref
@ %def generic_event_set_weight_alt
@ %def generic_event_set_n_dropped
@
Set the appropriate entry directly.
<<Event base: generic event: TBP>>=
procedure :: set => generic_event_set
<<Event base: sub interfaces>>=
module subroutine generic_event_set (event, &
weight_ref, weight_prc, weight_alt, &
excess_prc, n_dropped, &
sqme_ref, sqme_prc, sqme_alt)
class(generic_event_t), intent(inout) :: event
real(default), intent(in), optional :: weight_ref, weight_prc
real(default), intent(in), optional :: sqme_ref, sqme_prc
real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
real(default), intent(in), optional :: excess_prc
integer, intent(in), optional :: n_dropped
end subroutine generic_event_set
<<Event base: procedures>>=
module subroutine generic_event_set (event, &
weight_ref, weight_prc, weight_alt, &
excess_prc, n_dropped, &
sqme_ref, sqme_prc, sqme_alt)
class(generic_event_t), intent(inout) :: event
real(default), intent(in), optional :: weight_ref, weight_prc
real(default), intent(in), optional :: sqme_ref, sqme_prc
real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
real(default), intent(in), optional :: excess_prc
integer, intent(in), optional :: n_dropped
if (present (sqme_prc)) then
call event%set_sqme_prc (sqme_prc)
end if
if (present (sqme_ref)) then
call event%set_sqme_ref (sqme_ref)
end if
if (present (sqme_alt)) then
call event%set_sqme_alt (sqme_alt)
end if
if (present (weight_prc)) then
call event%set_weight_prc (weight_prc)
end if
if (present (weight_ref)) then
call event%set_weight_ref (weight_ref)
end if
if (present (weight_alt)) then
call event%set_weight_alt (weight_alt)
end if
if (present (excess_prc)) then
call event%set_excess_prc (excess_prc)
end if
if (present (n_dropped)) then
call event%set_n_dropped (n_dropped)
end if
end subroutine generic_event_set
@ %def generic_event_set
@
\subsection{Pure Virtual Methods}
These procedures can only implemented in the concrete implementation.
Output (verbose, depending on parameters).
<<Event base: generic event: TBP>>=
procedure (generic_event_write), deferred :: write
<<Event base: interfaces>>=
abstract interface
subroutine generic_event_write (object, unit, &
show_process, show_transforms, &
show_decay, verbose, testflag)
import
class(generic_event_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_process
logical, intent(in), optional :: show_transforms
logical, intent(in), optional :: show_decay
logical, intent(in), optional :: verbose
logical, intent(in), optional :: testflag
end subroutine generic_event_write
end interface
@ %def generic_event_write
@
Generate an event, based on a selector index [[i_mci]], and optionally on an
extra set of random numbers [[r]]. For the main bunch of random numbers that
the generator needs, the event object should contain its own generator.
<<Event base: generic event: TBP>>=
procedure (generic_event_generate), deferred :: generate
<<Event base: interfaces>>=
abstract interface
subroutine generic_event_generate (event, i_mci, r, i_nlo)
import
class(generic_event_t), intent(inout) :: event
integer, intent(in) :: i_mci
real(default), dimension(:), intent(in), optional :: r
integer, intent(in), optional :: i_nlo
end subroutine generic_event_generate
end interface
@ %def event_generate
@
Alternative : inject a particle set that is supposed to represent the hard
process.
How this determines the event, is dependent on the event structure,
therefore this is a deferred method.
<<Event base: generic event: TBP>>=
procedure (generic_event_set_hard_particle_set), deferred :: &
set_hard_particle_set
<<Event base: interfaces>>=
abstract interface
subroutine generic_event_set_hard_particle_set (event, particle_set)
import
class(generic_event_t), intent(inout) :: event
type(particle_set_t), intent(in) :: particle_set
end subroutine generic_event_set_hard_particle_set
end interface
@ %def generic_event_set_hard_particle_set
@ Event index handlers.
<<Event base: generic event: TBP>>=
procedure (generic_event_set_index), deferred :: set_index
procedure (generic_event_handler), deferred :: reset_index
procedure (generic_event_increment_index), deferred :: increment_index
@
<<Event base: interfaces>>=
abstract interface
subroutine generic_event_set_index (event, index)
import
class(generic_event_t), intent(inout) :: event
integer, intent(in) :: index
end subroutine generic_event_set_index
end interface
abstract interface
subroutine generic_event_handler (event)
import
class(generic_event_t), intent(inout) :: event
end subroutine generic_event_handler
end interface
abstract interface
subroutine generic_event_increment_index (event, offset)
import
class(generic_event_t), intent(inout) :: event
integer, intent(in), optional :: offset
end subroutine generic_event_increment_index
end interface
@ %def generic_event_set_index
@ %def generic_event_increment_index
@ %def generic_event_handler
@ Evaluate any expressions associated with the event. No argument needed.
<<Event base: generic event: TBP>>=
procedure (generic_event_handler), deferred :: evaluate_expressions
@
Select internal parameters
<<Event base: generic event: TBP>>=
procedure (generic_event_select), deferred :: select
<<Event base: interfaces>>=
abstract interface
subroutine generic_event_select (event, i_mci, i_term, channel)
import
class(generic_event_t), intent(inout) :: event
integer, intent(in) :: i_mci, i_term, channel
end subroutine generic_event_select
end interface
@ %def generic_event_select
@ Return a pointer to the model for the currently active process.
<<Event base: generic event: TBP>>=
procedure (generic_event_get_model_ptr), deferred :: get_model_ptr
<<Event base: interfaces>>=
abstract interface
function generic_event_get_model_ptr (event) result (model)
import
class(generic_event_t), intent(in) :: event
class(model_data_t), pointer :: model
end function generic_event_get_model_ptr
end interface
@ %def generic_event_get_model_ptr
@ Return data used by external event formats.
<<Event base: generic event: TBP>>=
procedure (generic_event_has_index), deferred :: has_index
procedure (generic_event_get_index), deferred :: get_index
procedure (generic_event_get_fac_scale), deferred :: get_fac_scale
procedure (generic_event_get_alpha_s), deferred :: get_alpha_s
procedure (generic_event_get_sqrts), deferred :: get_sqrts
procedure (generic_event_get_polarization), deferred :: get_polarization
procedure (generic_event_get_beam_file), deferred :: get_beam_file
procedure (generic_event_get_process_name), deferred :: &
get_process_name
<<Event base: interfaces>>=
abstract interface
function generic_event_has_index (event) result (flag)
import
class(generic_event_t), intent(in) :: event
logical :: flag
end function generic_event_has_index
end interface
abstract interface
function generic_event_get_index (event) result (index)
import
class(generic_event_t), intent(in) :: event
integer :: index
end function generic_event_get_index
end interface
abstract interface
function generic_event_get_fac_scale (event) result (fac_scale)
import
class(generic_event_t), intent(in) :: event
real(default) :: fac_scale
end function generic_event_get_fac_scale
end interface
abstract interface
function generic_event_get_alpha_s (event) result (alpha_s)
import
class(generic_event_t), intent(in) :: event
real(default) :: alpha_s
end function generic_event_get_alpha_s
end interface
abstract interface
function generic_event_get_sqrts (event) result (sqrts)
import
class(generic_event_t), intent(in) :: event
real(default) :: sqrts
end function generic_event_get_sqrts
end interface
abstract interface
function generic_event_get_polarization (event) result (pol)
import
class(generic_event_t), intent(in) :: event
real(default), dimension(:), allocatable :: pol
end function generic_event_get_polarization
end interface
abstract interface
function generic_event_get_beam_file (event) result (file)
import
class(generic_event_t), intent(in) :: event
type(string_t) :: file
end function generic_event_get_beam_file
end interface
abstract interface
function generic_event_get_process_name (event) result (name)
import
class(generic_event_t), intent(in) :: event
type(string_t) :: name
end function generic_event_get_process_name
end interface
@ %def generic_event_get_index
@ %def generic_event_get_fac_scale
@ %def generic_event_get_alpha_s
@ %def generic_event_get_sqrts
@ %def generic_event_get_polarization
@ %def generic_event_get_beam_file
@ %def generic_event_get_process_name
@ Set data used by external event formats.
<<Event base: generic event: TBP>>=
procedure (generic_event_set_alpha_qcd_forced), deferred :: &
set_alpha_qcd_forced
procedure (generic_event_set_scale_forced), deferred :: &
set_scale_forced
<<Event base: interfaces>>=
abstract interface
subroutine generic_event_set_alpha_qcd_forced (event, alpha_qcd)
import
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: alpha_qcd
end subroutine generic_event_set_alpha_qcd_forced
end interface
abstract interface
subroutine generic_event_set_scale_forced (event, scale)
import
class(generic_event_t), intent(inout) :: event
real(default), intent(in) :: scale
end subroutine generic_event_set_scale_forced
end interface
@ %def generic_event_set_alpha_qcd_forced
@ %def generic_event_set_scale_forced
@
\subsection{Utilities}
Applying this, current event contents are marked as incomplete but
are not deleted. In particular, the initialization is kept.
<<Event base: generic event: TBP>>=
procedure :: reset_contents => generic_event_reset_contents
procedure :: base_reset_contents => generic_event_reset_contents
<<Event base: sub interfaces>>=
module subroutine generic_event_reset_contents (event)
class(generic_event_t), intent(inout) :: event
end subroutine generic_event_reset_contents
<<Event base: procedures>>=
module subroutine generic_event_reset_contents (event)
class(generic_event_t), intent(inout) :: event
call event%discard_particle_set ()
event%sqme_ref_known = .false.
event%sqme_prc_known = .false.
event%sqme_alt_known = .false.
event%weight_ref_known = .false.
event%weight_prc_known = .false.
event%weight_alt_known = .false.
event%excess_prc_known = .false.
end subroutine generic_event_reset_contents
@ %def generic_event_reset_contents
@ Pacify particle set.
<<Event base: generic event: TBP>>=
procedure :: pacify_particle_set => generic_event_pacify_particle_set
<<Event base: sub interfaces>>=
module subroutine generic_event_pacify_particle_set (event)
class(generic_event_t), intent(inout) :: event
end subroutine generic_event_pacify_particle_set
<<Event base: procedures>>=
module subroutine generic_event_pacify_particle_set (event)
class(generic_event_t), intent(inout) :: event
if (event%has_valid_particle_set ()) call pacify (event%particle_set)
end subroutine generic_event_pacify_particle_set
@ %def generic_event_pacify_particle_set
@
\subsection{Event normalization}
The parameters for event normalization. For unweighted events,
[[NORM_UNIT]] is intended as default, while for weighted events, it is
[[NORM_SIGMA]].
Note: the unit test for this is in [[eio_data_2]] below.
<<Event base: parameters>>=
integer, parameter, public :: NORM_UNDEFINED = 0
integer, parameter, public :: NORM_UNIT = 1
integer, parameter, public :: NORM_N_EVT = 2
integer, parameter, public :: NORM_SIGMA = 3
integer, parameter, public :: NORM_S_N = 4
@ %def NORM_UNDEFINED NORM_UNIT NORM_N_EVT NORM_SIGMA NORM_S_N
@ These functions translate between the user representation and the
internal one.
<<Event base: public>>=
public :: event_normalization_mode
public :: event_normalization_string
<<Event base: sub interfaces>>=
module function event_normalization_mode (string, unweighted) result (mode)
integer :: mode
type(string_t), intent(in) :: string
logical, intent(in) :: unweighted
end function event_normalization_mode
module function event_normalization_string (norm_mode) result (string)
integer, intent(in) :: norm_mode
type(string_t) :: string
end function event_normalization_string
<<Event base: procedures>>=
module function event_normalization_mode (string, unweighted) result (mode)
integer :: mode
type(string_t), intent(in) :: string
logical, intent(in) :: unweighted
select case (lower_case (char (string)))
case ("auto")
if (unweighted) then
mode = NORM_UNIT
else
mode = NORM_SIGMA
end if
case ("1")
mode = NORM_UNIT
case ("1/n")
mode = NORM_N_EVT
case ("sigma")
mode = NORM_SIGMA
case ("sigma/n")
mode = NORM_S_N
case default
call msg_fatal ("Event normalization: unknown value '" &
// char (string) // "'")
end select
end function event_normalization_mode
module function event_normalization_string (norm_mode) result (string)
integer, intent(in) :: norm_mode
type(string_t) :: string
select case (norm_mode)
case (NORM_UNDEFINED); string = "[undefined]"
case (NORM_UNIT); string = "'1'"
case (NORM_N_EVT); string = "'1/n'"
case (NORM_SIGMA); string = "'sigma'"
case (NORM_S_N); string = "'sigma/n'"
case default; string = "???"
end select
end function event_normalization_string
@ %def event_normalization_mode
@ %def event_normalization_string
@ We place this here as a generic helper, so we can update event
weights whenever we need, not just in connection with an event sample
data object.
<<Event base: public>>=
public :: event_normalization_update
<<Event base: sub interfaces>>=
module subroutine event_normalization_update &
(weight, sigma, n, mode_new, mode_old)
real(default), intent(inout) :: weight
real(default), intent(in) :: sigma
integer, intent(in) :: n
integer, intent(in) :: mode_new, mode_old
end subroutine event_normalization_update
<<Event base: procedures>>=
module subroutine event_normalization_update &
(weight, sigma, n, mode_new, mode_old)
real(default), intent(inout) :: weight
real(default), intent(in) :: sigma
integer, intent(in) :: n
integer, intent(in) :: mode_new, mode_old
if (mode_new /= mode_old) then
if (sigma > 0 .and. n > 0) then
weight = weight / factor (mode_old) * factor (mode_new)
else
call msg_fatal ("Event normalization update: null sample")
end if
end if
contains
function factor (mode)
real(default) :: factor
integer, intent(in) :: mode
select case (mode)
case (NORM_UNIT); factor = 1._default
case (NORM_N_EVT); factor = 1._default / n
case (NORM_SIGMA); factor = sigma
case (NORM_S_N); factor = sigma / n
case default
call msg_fatal ("Event normalization update: undefined mode")
end select
end function factor
end subroutine event_normalization_update
@ %def event_normalization_update
@
\subsection{Callback container}
This derived type contains a callback procedure that can
be executed during event I/O. The callback procedure is given the
event object (with class [[generic_event]]) and an event index.
This is a simple wrapper. The object is abstract, so the the actual
procedure is introduced by overriding the deferred one. We use the
PASS attribute, so we may supplement runtime data in the callback object
if desired.
<<Event base: public>>=
public :: event_callback_t
<<Event base: types>>=
type, abstract :: event_callback_t
private
contains
procedure(event_callback_write), deferred :: write
procedure(event_callback_proc), deferred :: proc
end type event_callback_t
@ %def event_callback_t
@ Identify the callback procedure in output
<<Event base: interfaces>>=
abstract interface
subroutine event_callback_write (event_callback, unit)
import
class(event_callback_t), intent(in) :: event_callback
integer, intent(in), optional :: unit
end subroutine event_callback_write
end interface
@ %def event_callback_write
@ This is the procedure interface.
<<Event base: interfaces>>=
abstract interface
subroutine event_callback_proc (event_callback, i, event)
import
class(event_callback_t), intent(in) :: event_callback
integer(i64), intent(in) :: i
class(generic_event_t), intent(in) :: event
end subroutine event_callback_proc
end interface
@ %def event_callback_proc
@ A dummy implementation for testing and fallback.
<<Event base: public>>=
public :: event_callback_nop_t
<<Event base: types>>=
type, extends (event_callback_t) :: event_callback_nop_t
private
contains
procedure :: write => event_callback_nop_write
procedure :: proc => event_callback_nop
end type event_callback_nop_t
@ %def event_callback_t
<<Event base: sub interfaces>>=
module subroutine event_callback_nop_write (event_callback, unit)
class(event_callback_nop_t), intent(in) :: event_callback
integer, intent(in), optional :: unit
end subroutine event_callback_nop_write
module subroutine event_callback_nop (event_callback, i, event)
class(event_callback_nop_t), intent(in) :: event_callback
integer(i64), intent(in) :: i
class(generic_event_t), intent(in) :: event
end subroutine event_callback_nop
<<Event base: procedures>>=
module subroutine event_callback_nop_write (event_callback, unit)
class(event_callback_nop_t), intent(in) :: event_callback
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "NOP"
end subroutine event_callback_nop_write
module subroutine event_callback_nop (event_callback, i, event)
class(event_callback_nop_t), intent(in) :: event_callback
integer(i64), intent(in) :: i
class(generic_event_t), intent(in) :: event
end subroutine event_callback_nop
@ %def event_callback_nop_write
@ %def event_callback_nop
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Event Handle}
This module defines an abstract base type that allows us to communicate any
type of event record within the program. The concrete extensions are expected
to consist of pointers, such as the C pointers for HepMC or LCIO events, so
the communication object is a very light-weight one.
<<[[event_handles.f90]]>>=
<<File header>>
module event_handles
<<Standard module head>>
<<Event handle: public>>
<<Event handle: types>>
end module event_handles
@ %def event_handles
@
There is only one abstract type.
<<Event handle: public>>=
public :: event_handle_t
<<Event handle: types>>=
type, abstract :: event_handle_t
end type event_handle_t
@ %def event_handle_t
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Event Sample Data}
We define a simple and transparent container for (meta)data that are
associated with an event sample.
<<[[eio_data.f90]]>>=
<<File header>>
module eio_data
<<Use kinds>>
<<Use strings>>
use event_base
<<Standard module head>>
<<EIO data: public>>
<<EIO data: types>>
interface
<<EIO data: sub interfaces>>
end interface
end module eio_data
@ %def eio_data
@
<<[[eio_data_sub.f90]]>>=
<<File header>>
submodule (eio_data) eio_data_s
use io_units
use numeric_utils
use diagnostics
implicit none
contains
<<EIO data: procedures>>
end submodule eio_data_s
@ %def eio_data_s
@
\subsection{Event Sample Data}
These are data that apply to an event sample as a whole. They are
given in an easily portable form (no fancy structure) and are used for
initializing event formats.
There are two MD5 sums here. [[md5sum_proc]] depends only on the
definition of the contributing processes. A sample with matching
checksum can be rescanned with modified model parameters, beam
structure etc, to recalculate observables. [[md5sum_config]] includes
all relevant data. Rescanning a sample with matching checksum will
produce identical observables. (A third checksum might be added which
depends on the event sample itself. This is not needed, so far.)
If alternate weights are part of the event sample ([[n_alt]] nonzero),
there is a configuration MD5 sum for each of them.
<<EIO data: public>>=
public :: event_sample_data_t
<<EIO data: types>>=
type :: event_sample_data_t
character(32) :: md5sum_prc = ""
character(32) :: md5sum_cfg = ""
logical :: unweighted = .true.
logical :: negative_weights = .false.
integer :: norm_mode = NORM_UNDEFINED
integer :: n_beam = 0
integer, dimension(2) :: pdg_beam = 0
real(default), dimension(2) :: energy_beam = 0
integer :: n_proc = 0
integer :: n_evt = 0
integer :: nlo_multiplier = 1
integer :: split_n_evt = 0
integer :: split_n_kbytes = 0
integer :: split_index = 0
real(default) :: total_cross_section = 0
integer, dimension(:), allocatable :: proc_num_id
integer :: n_alt = 0
character(32), dimension(:), allocatable :: md5sum_alt
real(default), dimension(:), allocatable :: cross_section
real(default), dimension(:), allocatable :: error
contains
<<EIO data: event sample data: TBP>>
end type event_sample_data_t
@ %def event_sample_data_t
@ Initialize: allocate for the number of processes
<<EIO data: event sample data: TBP>>=
procedure :: init => event_sample_data_init
<<EIO data: sub interfaces>>=
module subroutine event_sample_data_init (data, n_proc, n_alt)
class(event_sample_data_t), intent(out) :: data
integer, intent(in) :: n_proc
integer, intent(in), optional :: n_alt
end subroutine event_sample_data_init
<<EIO data: procedures>>=
module subroutine event_sample_data_init (data, n_proc, n_alt)
class(event_sample_data_t), intent(out) :: data
integer, intent(in) :: n_proc
integer, intent(in), optional :: n_alt
data%n_proc = n_proc
allocate (data%proc_num_id (n_proc), source = 0)
allocate (data%cross_section (n_proc), source = 0._default)
allocate (data%error (n_proc), source = 0._default)
if (present (n_alt)) then
data%n_alt = n_alt
allocate (data%md5sum_alt (n_alt))
data%md5sum_alt = ""
end if
end subroutine event_sample_data_init
@ %def event_sample_data_init
@ Output.
<<EIO data: event sample data: TBP>>=
procedure :: write => event_sample_data_write
<<EIO data: sub interfaces>>=
module subroutine event_sample_data_write (data, unit)
class(event_sample_data_t), intent(in) :: data
integer, intent(in), optional :: unit
end subroutine event_sample_data_write
<<EIO data: procedures>>=
module subroutine event_sample_data_write (data, unit)
class(event_sample_data_t), intent(in) :: data
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "Event sample properties:"
write (u, "(3x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
write (u, "(3x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
write (u, "(3x,A,L1)") "unweighted = ", data%unweighted
write (u, "(3x,A,L1)") "negative weights = ", data%negative_weights
write (u, "(3x,A,A)") "normalization = ", &
char (event_normalization_string (data%norm_mode))
write (u, "(3x,A,I0)") "number of beams = ", data%n_beam
write (u, "(5x,A,2(1x,I19))") "PDG = ", &
data%pdg_beam(:data%n_beam)
write (u, "(5x,A,2(1x,ES19.12))") "Energy = ", &
data%energy_beam(:data%n_beam)
if (data%n_evt > 0) then
write (u, "(3x,A,I0)") "number of events = ", data%n_evt
end if
if (.not. vanishes (data%total_cross_section)) then
write (u, "(3x,A,ES19.12)") "total cross sec. = ", &
data%total_cross_section
end if
write (u, "(3x,A,I0)") "num of processes = ", data%n_proc
do i = 1, data%n_proc
write (u, "(3x,A,I0)") "Process #", data%proc_num_id (i)
select case (data%n_beam)
case (1)
write (u, "(5x,A,ES19.12)") "Width = ", data%cross_section(i)
case (2)
write (u, "(5x,A,ES19.12)") "CSec = ", data%cross_section(i)
end select
write (u, "(5x,A,ES19.12)") "Error = ", data%error(i)
end do
if (data%n_alt > 0) then
write (u, "(3x,A,I0)") "num of alt wgt = ", data%n_alt
do i = 1, data%n_alt
write (u, "(5x,A,A,A,1x,I0)") "MD5 sum (cfg) = '", &
data%md5sum_alt(i), "'", i
end do
end if
end subroutine event_sample_data_write
@ %def event_sample_data_write
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_data_ut.f90]]>>=
<<File header>>
module eio_data_ut
use unit_tests
use eio_data_uti
<<Standard module head>>
<<EIO data: public test>>
contains
<<EIO data: test driver>>
end module eio_data_ut
@ %def eio_data_ut
@
<<[[eio_data_uti.f90]]>>=
<<File header>>
module eio_data_uti
<<Use kinds>>
<<Use strings>>
use event_base
use eio_data
<<Standard module head>>
<<EIO data: test declarations>>
contains
<<EIO data: tests>>
end module eio_data_uti
@ %def eio_data_ut
@ API: driver for the unit tests below.
<<EIO data: public test>>=
public :: eio_data_test
<<EIO data: test driver>>=
subroutine eio_data_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO data: execute tests>>
end subroutine eio_data_test
@ %def eio_data_test
@
\subsubsection{Event Sample Data}
Print the contents of a sample data block.
<<EIO data: execute tests>>=
call test (eio_data_1, "eio_data_1", &
"event sample data", &
u, results)
<<EIO data: test declarations>>=
public :: eio_data_1
<<EIO data: tests>>=
subroutine eio_data_1 (u)
integer, intent(in) :: u
type(event_sample_data_t) :: data
write (u, "(A)") "* Test output: eio_data_1"
write (u, "(A)") "* Purpose: display event sample data"
write (u, "(A)")
write (u, "(A)") "* Decay process, one component"
write (u, "(A)")
call data%init (1, 1)
data%n_beam = 1
data%pdg_beam(1) = 25
data%energy_beam(1) = 125
data%norm_mode = NORM_UNIT
data%proc_num_id = [42]
data%cross_section = [1.23e-4_default]
data%error = 5e-6_default
data%md5sum_prc = "abcdefghijklmnopabcdefghijklmnop"
data%md5sum_cfg = "12345678901234561234567890123456"
data%md5sum_alt(1) = "uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu"
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Scattering process, two components"
write (u, "(A)")
call data%init (2)
data%n_beam = 2
data%pdg_beam = [2212, -2212]
data%energy_beam = [8._default, 10._default]
data%norm_mode = NORM_SIGMA
data%proc_num_id = [12, 34]
data%cross_section = [100._default, 88._default]
data%error = [1._default, 0.1_default]
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_data_1"
end subroutine eio_data_1
@ %def eio_data_1
@
\subsubsection{Event Normalization}
Check the functions for translating modes and updating weights.
<<EIO data: execute tests>>=
call test (eio_data_2, "eio_data_2", &
"event normalization", &
u, results)
<<EIO data: test declarations>>=
public :: eio_data_2
<<EIO data: tests>>=
subroutine eio_data_2 (u)
integer, intent(in) :: u
type(string_t) :: s
logical :: unweighted
real(default) :: w, w0, sigma
integer :: n
write (u, "(A)") "* Test output: eio_data_2"
write (u, "(A)") "* Purpose: handle event normalization"
write (u, "(A)")
write (u, "(A)") "* Normalization strings"
write (u, "(A)")
s = "auto"
unweighted = .true.
write (u, "(1x,A,1x,L1,1x,A)") char (s), unweighted, &
char (event_normalization_string &
(event_normalization_mode (s, unweighted)))
s = "AUTO"
unweighted = .false.
write (u, "(1x,A,1x,L1,1x,A)") char (s), unweighted, &
char (event_normalization_string &
(event_normalization_mode (s, unweighted)))
unweighted = .true.
s = "1"
write (u, "(2(1x,A))") char (s), char (event_normalization_string &
(event_normalization_mode (s, unweighted)))
s = "1/n"
write (u, "(2(1x,A))") char (s), char (event_normalization_string &
(event_normalization_mode (s, unweighted)))
s = "Sigma"
write (u, "(2(1x,A))") char (s), char (event_normalization_string &
(event_normalization_mode (s, unweighted)))
s = "sigma/N"
write (u, "(2(1x,A))") char (s), char (event_normalization_string &
(event_normalization_mode (s, unweighted)))
write (u, "(A)")
write (u, "(A)") "* Normalization update"
write (u, "(A)")
sigma = 5
n = 2
w0 = 1
w = w0
call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_UNIT)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_UNIT)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_UNIT)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_S_N, NORM_UNIT)
write (u, "(2(F6.3))") w0, w
write (u, *)
w0 = 0.5
w = w0
call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_N_EVT)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_N_EVT)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_N_EVT)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_S_N, NORM_N_EVT)
write (u, "(2(F6.3))") w0, w
write (u, *)
w0 = 5.0
w = w0
call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_SIGMA)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_SIGMA)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_SIGMA)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_S_N, NORM_SIGMA)
write (u, "(2(F6.3))") w0, w
write (u, *)
w0 = 2.5
w = w0
call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_S_N)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_S_N)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_S_N)
write (u, "(2(F6.3))") w0, w
w = w0
call event_normalization_update (w, sigma, n, NORM_S_N, NORM_S_N)
write (u, "(2(F6.3))") w0, w
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_data_2"
end subroutine eio_data_2
@ %def eio_data_2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Abstract I/O Handler}
This module defines an abstract object for event I/O and the
associated methods.
There are [[output]] and [[input]] methods which
write or read a single event from/to the I/O stream, respectively.
The I/O stream itself may be a file, a common block, or an externally
linked structure, depending on the concrete implementation.
A [[write]] method prints the current content of the
implementation-dependent event record in human-readable form.
The [[init_in]]/[[init_out]] and [[final]] prepare
and finalize the I/O stream, respectively. There is also a
[[switch_inout]] method which turns an input stream into an output
stream where events can be appended.
Optionally, output files can be split in chunks of well-defined size. The
[[split_out]] method takes care of this.
<<[[eio_base.f90]]>>=
<<File header>>
module eio_base
use kinds, only: i64
<<Use strings>>
use model_data
use event_base
use event_handles, only: event_handle_t
use eio_data
<<Standard module head>>
<<EIO base: public>>
<<EIO base: types>>
<<EIO base: interfaces>>
interface
<<EIO base: sub interfaces>>
end interface
end module eio_base
@ %def eio_base
@
<<[[eio_base_sub.f90]]>>=
<<File header>>
submodule (eio_base) eio_base_s
use io_units
use diagnostics
implicit none
contains
<<EIO base: procedures>>
end submodule eio_base_s
@ %def eio_base_s
@
\subsection{Type}
We can assume that most implementations will need the file extension as a
fixed string and, if they support file splitting, the current file index.
The fallback model is useful for implementations that are able to read
unknown files which may contain hadrons etc., not in the current
hard-interaction model.
<<EIO base: public>>=
public :: eio_t
<<EIO base: types>>=
type, abstract :: eio_t
type(string_t) :: sample
type(string_t) :: extension
type(string_t) :: filename
logical :: has_file = .false.
logical :: split = .false.
integer :: split_n_evt = 0
integer :: split_n_kbytes = 0
integer :: split_index = 0
integer :: split_count = 0
class(model_data_t), pointer :: fallback_model => null ()
contains
<<EIO base: eio: TBP>>
end type eio_t
@ %def eio_t
@ Write to screen. If possible, this should display the contents of the
current event, i.e., the last one that was written or read.
<<EIO base: eio: TBP>>=
procedure (eio_write), deferred :: write
<<EIO base: interfaces>>=
abstract interface
subroutine eio_write (object, unit)
import
class(eio_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_write
end interface
@ %def eio_write
@ Finalize. This should write/read footer data and close input/output
channels.
<<EIO base: eio: TBP>>=
procedure (eio_final), deferred :: final
<<EIO base: interfaces>>=
abstract interface
subroutine eio_final (object)
import
class(eio_t), intent(inout) :: object
end subroutine eio_final
end interface
@ %def eio_final
@ Determine splitting parameters from the event sample data.
<<EIO base: eio: TBP>>=
procedure :: set_splitting => eio_set_splitting
<<EIO base: sub interfaces>>=
module subroutine eio_set_splitting (eio, data)
class(eio_t), intent(inout) :: eio
type(event_sample_data_t), intent(in) :: data
end subroutine eio_set_splitting
<<EIO base: procedures>>=
module subroutine eio_set_splitting (eio, data)
class(eio_t), intent(inout) :: eio
type(event_sample_data_t), intent(in) :: data
eio%split = data%split_n_evt > 0 .or. data%split_n_kbytes > 0
if (eio%split) then
eio%split_n_evt = data%split_n_evt
eio%split_n_kbytes = data%split_n_kbytes
eio%split_index = data%split_index
eio%split_count = 0
end if
end subroutine eio_set_splitting
@ %def eio_set_splitting
@ Update the byte count and check if it has increased. We use integer
division to determine the number of [[n_kbytes]] blocks that are in
the event file.
<<EIO base: eio: TBP>>=
procedure :: update_split_count => eio_update_split_count
<<EIO base: sub interfaces>>=
module subroutine eio_update_split_count (eio, increased)
class(eio_t), intent(inout) :: eio
logical, intent(out) :: increased
end subroutine eio_update_split_count
<<EIO base: procedures>>=
module subroutine eio_update_split_count (eio, increased)
class(eio_t), intent(inout) :: eio
logical, intent(out) :: increased
integer :: split_count_old
if (eio%split_n_kbytes > 0) then
split_count_old = eio%split_count
eio%split_count = eio%file_size_kbytes () / eio%split_n_kbytes
increased = eio%split_count > split_count_old
end if
end subroutine eio_update_split_count
@ %def eio_update_split_count
@ Generate a filename, taking a possible split index into account.
<<EIO base: eio: TBP>>=
procedure :: set_filename => eio_set_filename
<<EIO base: sub interfaces>>=
module subroutine eio_set_filename (eio)
class(eio_t), intent(inout) :: eio
end subroutine eio_set_filename
<<EIO base: procedures>>=
module subroutine eio_set_filename (eio)
class(eio_t), intent(inout) :: eio
character(32) :: buffer
if (eio%split) then
write (buffer, "(I0,'.')") eio%split_index
eio%filename = eio%sample // "." // trim (buffer) // eio%extension
eio%has_file = .true.
else
eio%filename = eio%sample // "." // eio%extension
eio%has_file = .true.
end if
end subroutine eio_set_filename
@ %def eio_set_filename
@ Set the fallback model.
<<EIO base: eio: TBP>>=
procedure :: set_fallback_model => eio_set_fallback_model
<<EIO base: sub interfaces>>=
module subroutine eio_set_fallback_model (eio, model)
class(eio_t), intent(inout) :: eio
class(model_data_t), intent(in), target :: model
end subroutine eio_set_fallback_model
<<EIO base: procedures>>=
module subroutine eio_set_fallback_model (eio, model)
class(eio_t), intent(inout) :: eio
class(model_data_t), intent(in), target :: model
eio%fallback_model => model
end subroutine eio_set_fallback_model
@ %def eio_set_fallback_model
@ Initialize for output. We provide process names. This should
open an event file if appropriate and write header data. Some methods
may require event sample data.
<<EIO base: eio: TBP>>=
procedure (eio_init_out), deferred :: init_out
<<EIO base: interfaces>>=
abstract interface
subroutine eio_init_out (eio, sample, data, success, extension)
import
class(eio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
type(string_t), intent(in), optional :: extension
end subroutine eio_init_out
end interface
@ %def eio_init_out
@ Initialize for input. We provide process names. This should open an event
file if appropriate and read header data. The [[md5sum]] can be used to check
the integrity of the configuration, it it provides a checksum to compare with.
In case the extension has changed the extension is also given as an argument.
The [[data]] argument is [[intent(inout)]]: we may read part of it and
keep other parts and/or check them against the data in the file.
<<EIO base: eio: TBP>>=
procedure (eio_init_in), deferred :: init_in
<<EIO base: interfaces>>=
abstract interface
subroutine eio_init_in (eio, sample, data, success, extension)
import
class(eio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
type(string_t), intent(in), optional :: extension
end subroutine eio_init_in
end interface
@ %def eio_init_in
@ Re-initialize for output. This should change the status of any event file
from input to output and position it for appending new events.
<<EIO base: eio: TBP>>=
procedure (eio_switch_inout), deferred :: switch_inout
<<EIO base: interfaces>>=
abstract interface
subroutine eio_switch_inout (eio, success)
import
class(eio_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_switch_inout
end interface
@ %def eio_switch_inout
@ This is similar: split the output, i.e., close the current file and open a
new one. The default implementation does nothing. For the feature to work,
an implementation must override this.
<<EIO base: eio: TBP>>=
procedure :: split_out => eio_split_out
<<EIO base: sub interfaces>>=
module subroutine eio_split_out (eio)
class(eio_t), intent(inout) :: eio
end subroutine eio_split_out
<<EIO base: procedures>>=
module subroutine eio_split_out (eio)
class(eio_t), intent(inout) :: eio
end subroutine eio_split_out
@ %def eio_split_out
@ Determine the file size in kilobytes. More exactly, determine the
size in units of 1024 storage units, as returned by the INQUIRE statement.
The implementation returns zero if there is no file. The
[[has_file]] flag is set by the [[set_filename]] method, so we can be
confident that the [[inquire]] call is meaningful. If this algorithm
doesn't apply for a particular format, we still can override the
procedure.
<<EIO base: eio: TBP>>=
procedure :: file_size_kbytes => eio_file_size_kbytes
<<EIO base: sub interfaces>>=
module function eio_file_size_kbytes (eio) result (kbytes)
class(eio_t), intent(in) :: eio
integer :: kbytes
end function eio_file_size_kbytes
<<EIO base: procedures>>=
module function eio_file_size_kbytes (eio) result (kbytes)
class(eio_t), intent(in) :: eio
integer :: kbytes
integer(i64) :: bytes
if (eio%has_file) then
inquire (file = char (eio%filename), size = bytes)
if (bytes > 0) then
kbytes = bytes / 1024
else
kbytes = 0
end if
else
kbytes = 0
end if
end function eio_file_size_kbytes
@ %def eio_file_size_kbytes
@ Output an event. All data can be taken from the [[event]] record.
The index [[i_prc]] identifies the process among the processes that
are contained in the current sample. The [[reading]] flag, if present,
indicates that the event was read from file, not generated.
The [[passed]] flag tells us that this event has passed the selection
criteria. Depending on the event format, we may choose to skip events
that have not passed.
<<EIO base: eio: TBP>>=
procedure (eio_output), deferred :: output
<<EIO base: interfaces>>=
abstract interface
subroutine eio_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
import
class(eio_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_output
end interface
@ %def eio_output
@ Input an event. This should fill all event data that cannot be inferred
from the associated process.
The input is broken down into two parts. First we read the [[i_prc]]
index. So we know which process to expect in the subsequent event.
If we have reached end of file, we also will know.
Then, we read the event itself.
The parameter [[iostat]] is supposed to be set as the Fortran standard
requires, negative for EOF and positive for error.
<<EIO base: eio: TBP>>=
procedure (eio_input_i_prc), deferred :: input_i_prc
procedure (eio_input_event), deferred :: input_event
<<EIO base: interfaces>>=
abstract interface
subroutine eio_input_i_prc (eio, i_prc, iostat)
import
class(eio_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_input_i_prc
end interface
abstract interface
subroutine eio_input_event (eio, event, iostat, event_handle)
import
class(eio_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_input_event
end interface
@ %def eio_input
@
<<EIO base: eio: TBP>>=
procedure (eio_skip), deferred :: skip
<<EIO base: interfaces>>=
abstract interface
subroutine eio_skip (eio, iostat)
import
class(eio_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_skip
end interface
@ %def eio_skip
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_base_ut.f90]]>>=
<<File header>>
module eio_base_ut
use unit_tests
use eio_base_uti
<<Standard module head>>
<<EIO base: public test>>
<<EIO base: public test auxiliary>>
contains
<<EIO base: test driver>>
end module eio_base_ut
@ %def eio_base_ut
@
<<[[eio_base_uti.f90]]>>=
<<File header>>
module eio_base_uti
<<Use kinds>>
<<Use strings>>
use io_units
use lorentz
use model_data
use particles
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO base: public test auxiliary>>
<<EIO base: test declarations>>
<<EIO base: test types>>
<<EIO base: test variables>>
contains
<<EIO base: tests>>
<<EIO base: test auxiliary>>
end module eio_base_uti
@ %def eio_base_ut
@ API: driver for the unit tests below.
<<EIO base: public test>>=
public :: eio_base_test
<<EIO base: test driver>>=
subroutine eio_base_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO base: execute tests>>
end subroutine eio_base_test
@ %def eio_base_test
@ The caller has to provide procedures that prepare and cleanup the test
environment. They depend on modules that are not available here.
<<EIO base: test types>>=
abstract interface
subroutine eio_prepare_event (event, unweighted, n_alt, sample_norm)
import
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
end subroutine eio_prepare_event
end interface
abstract interface
subroutine eio_cleanup_event (event)
import
class(generic_event_t), intent(inout), pointer :: event
end subroutine eio_cleanup_event
end interface
@ We store pointers to the test-environment handlers as module variables.
This allows us to call them from the test routines themselves, which don't
allow for extra arguments.
<<EIO base: public test auxiliary>>=
public :: eio_prepare_test, eio_cleanup_test
<<EIO base: test types>>=
procedure(eio_prepare_event), pointer :: eio_prepare_test => null ()
procedure(eio_cleanup_event), pointer :: eio_cleanup_test => null ()
@ %def eio_prepare_test eio_cleanup_test
@ Similarly, for the fallback (hadron) model that some eio tests require:
<<EIO base: test types>>=
abstract interface
subroutine eio_prepare_model (model)
import
class(model_data_t), intent(inout), pointer :: model
end subroutine eio_prepare_model
end interface
abstract interface
subroutine eio_cleanup_model (model)
import
class(model_data_t), intent(inout), target :: model
end subroutine eio_cleanup_model
end interface
<<EIO base: public test auxiliary>>=
public :: eio_prepare_fallback_model, eio_cleanup_fallback_model
<<EIO base: test variables>>=
procedure(eio_prepare_model), pointer :: eio_prepare_fallback_model => null ()
procedure(eio_cleanup_model), pointer :: eio_cleanup_fallback_model => null ()
@ %def eio_prepare_fallback_model eio_cleanup_fallback_model
@
\subsubsection{Test type for event I/O}
The contents simulate the contents of an external file. We have the
[[sample]] string as the file name and the array of momenta
[[event_p]] as the list of events. The
second index is the event index. The [[event_i]] component is the pointer
to the current event, [[event_n]] is the total number of stored events.
<<EIO base: test types>>=
type, extends (eio_t) :: eio_test_t
integer :: event_n = 0
integer :: event_i = 0
integer :: i_prc = 0
type(vector4_t), dimension(:,:), allocatable :: event_p
contains
<<EIO base: eio test: TBP>>
end type eio_test_t
@ %def eio_test_t
@ Write to screen. Pretend that this is an actual event format.
<<EIO base: eio test: TBP>>=
procedure :: write => eio_test_write
<<EIO base: test auxiliary>>=
subroutine eio_test_write (object, unit)
class(eio_test_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "Test event stream"
if (object%event_i /= 0) then
write (u, "(1x,A,I0,A)") "Event #", object%event_i, ":"
do i = 1, size (object%event_p, 1)
call vector4_write (object%event_p(i, object%event_i), u)
end do
end if
end subroutine eio_test_write
@ %def eio_test_write
@ Finalizer. For the test case, we just reset the event count,
but keep the stored ``events''. For the real implementations, the events
would be stored on an external medium, so we would delete the object
contents.
<<EIO base: eio test: TBP>>=
procedure :: final => eio_test_final
<<EIO base: test auxiliary>>=
subroutine eio_test_final (object)
class(eio_test_t), intent(inout) :: object
object%event_i = 0
end subroutine eio_test_final
@ %def eio_test_final
@ Initialization: We store the process IDs and the energy from the beam-data
object. We also allocate the momenta (i.e., the simulated event record) for a
fixed maximum size of 10 events, 2 momenta each. There is only a single
process.
<<EIO base: eio test: TBP>>=
procedure :: init_out => eio_test_init_out
<<EIO base: test auxiliary>>=
subroutine eio_test_init_out (eio, sample, data, success, extension)
class(eio_test_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
type(string_t), intent(in), optional :: extension
eio%sample = sample
eio%event_n = 0
eio%event_i = 0
allocate (eio%event_p (2, 10))
if (present (success)) success = .true.
end subroutine eio_test_init_out
@ %def eio_test_init_out
@ Initialization for input. Nothing to do for the test type.
<<EIO base: eio test: TBP>>=
procedure :: init_in => eio_test_init_in
<<EIO base: test auxiliary>>=
subroutine eio_test_init_in (eio, sample, data, success, extension)
class(eio_test_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
type(string_t), intent(in), optional :: extension
if (present (success)) success = .true.
end subroutine eio_test_init_in
@ %def eio_test_init_in
@ Switch from output to input. Again, nothing to do for the test type.
<<EIO base: eio test: TBP>>=
procedure :: switch_inout => eio_test_switch_inout
<<EIO base: test auxiliary>>=
subroutine eio_test_switch_inout (eio, success)
class(eio_test_t), intent(inout) :: eio
logical, intent(out), optional :: success
if (present (success)) success = .true.
end subroutine eio_test_switch_inout
@ %def eio_test_switch_inout
@ Output. Increment the event counter and store the momenta of the current
event.
<<EIO base: eio test: TBP>>=
procedure :: output => eio_test_output
<<EIO base: test auxiliary>>=
subroutine eio_test_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_test_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
integer, intent(in) :: i_prc
type(particle_set_t), pointer :: pset
type(particle_t) :: prt
eio%event_n = eio%event_n + 1
eio%event_i = eio%event_n
eio%i_prc = i_prc
pset => event%get_particle_set_ptr ()
prt = pset%get_particle (3)
eio%event_p(1, eio%event_i) = prt%get_momentum ()
prt = pset%get_particle (4)
eio%event_p(2, eio%event_i) = prt%get_momentum ()
end subroutine eio_test_output
@ %def eio_test_output
@ Input. Increment the event counter and retrieve the momenta of the current
event. For the test case, we do not actually modify the current event.
<<EIO base: eio test: TBP>>=
procedure :: input_i_prc => eio_test_input_i_prc
procedure :: input_event => eio_test_input_event
<<EIO base: test auxiliary>>=
subroutine eio_test_input_i_prc (eio, i_prc, iostat)
class(eio_test_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
i_prc = eio%i_prc
iostat = 0
end subroutine eio_test_input_i_prc
subroutine eio_test_input_event (eio, event, iostat, event_handle)
class(eio_test_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
eio%event_i = eio%event_i + 1
iostat = 0
end subroutine eio_test_input_event
@ %def eio_test_input_i_prc
@ %def eio_test_input_event
@
<<EIO base: eio test: TBP>>=
procedure :: skip => eio_test_skip
<<EIO base: test auxiliary>>=
subroutine eio_test_skip (eio, iostat)
class(eio_test_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_test_skip
@ %def eio_test_skip
@
\subsubsection{Test I/O methods}
<<EIO base: execute tests>>=
call test (eio_base_1, "eio_base_1", &
"read and write event contents", &
u, results)
<<EIO base: test declarations>>=
public :: eio_base_1
<<EIO base: tests>>=
subroutine eio_base_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
class(eio_t), allocatable :: eio
integer :: i_prc, iostat
type(string_t) :: sample
write (u, "(A)") "* Test output: eio_base_1"
write (u, "(A)") "* Purpose: generate and read/write an event"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_test1"
allocate (eio_test_t :: eio)
call eio%init_out (sample)
call event%generate (1, [0._default, 0._default])
call eio%output (event, 42)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* Re-read the event"
write (u, "(A)")
call eio%init_in (sample)
call eio%input_i_prc (i_prc, iostat)
call eio%input_event (event, iostat)
call eio%write (u)
write (u, "(A)")
write (u, "(1x,A,I0)") "i = ", i_prc
write (u, "(A)")
write (u, "(A)") "* Generate and append another event"
write (u, "(A)")
call eio%switch_inout ()
call event%generate (1, [0._default, 0._default])
call eio%output (event, 5)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* Re-read both events"
write (u, "(A)")
call eio%init_in (sample)
call eio%input_i_prc (i_prc, iostat)
call eio%input_event (event, iostat)
call eio%input_i_prc (i_prc, iostat)
call eio%input_event (event, iostat)
call eio%write (u)
write (u, "(A)")
write (u, "(1x,A,I0)") "i = ", i_prc
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
deallocate (eio)
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_base_1"
end subroutine eio_base_1
@ %def eio_base_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Direct Event Access}
As a convenient application of the base type, we construct an event
handler that allows us of setting and retrieving events just in the
same way as an file I/O format, but directly dealing with particle
data and momenta. This is an input and output format, but we do not
care about counting events.
<<[[eio_direct.f90]]>>=
<<File header>>
module eio_direct
<<Use kinds>>
<<Use strings>>
use lorentz, only: vector4_t
use particles, only: particle_set_t
use model_data, only: model_data_t
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO direct: public>>
<<EIO direct: types>>
interface
<<EIO direct: sub interfaces>>
end interface
end module eio_direct
@ %def eio_direct
@
<<[[eio_direct_sub.f90]]>>=
<<File header>>
submodule (eio_direct) eio_direct_s
use io_units
use diagnostics
use cputime
implicit none
contains
<<EIO direct: procedures>>
end submodule eio_direct_s
@ %def eio_direct_s
@
\subsection{Type}
<<EIO direct: public>>=
public :: eio_direct_t
<<EIO direct: types>>=
type, extends (eio_t) :: eio_direct_t
private
logical :: i_evt_set = .false.
integer :: i_evt = 0
integer :: i_prc = 0
integer :: i_mci = 0
integer :: i_term = 0
integer :: channel = 0
logical :: passed_set = .false.
logical :: passed = .true.
type(particle_set_t) :: pset
contains
<<EIO direct: eio direct: TBP>>
end type eio_direct_t
@ %def eio_direct_t
@
\subsection{Common Methods}
Output.
<<EIO direct: eio direct: TBP>>=
procedure :: write => eio_direct_write
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_write (object, unit)
class(eio_direct_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_direct_write
<<EIO direct: procedures>>=
module subroutine eio_direct_write (object, unit)
class(eio_direct_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Event direct access:"
if (object%i_evt_set) then
write (u, "(3x,A,1x,I0)") "i_evt =", object%i_evt
else
write (u, "(3x,A)") "i_evt = [undefined]"
end if
write (u, "(3x,A,1x,I0)") "i_prc =", object%i_prc
write (u, "(3x,A,1x,I0)") "i_mci =", object%i_prc
write (u, "(3x,A,1x,I0)") "i_term =", object%i_prc
write (u, "(3x,A,1x,I0)") "channel =", object%i_prc
if (object%passed_set) then
write (u, "(3x,A,1x,L1)") "passed =", object%passed
else
write (u, "(3x,A)") "passed = [N/A]"
end if
call object%pset%write (u)
end subroutine eio_direct_write
@ %def eio_direct_write
@ Finalizer: trivial.
<<EIO direct: eio direct: TBP>>=
procedure :: final => eio_direct_final
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_final (object)
class(eio_direct_t), intent(inout) :: object
end subroutine eio_direct_final
<<EIO direct: procedures>>=
module subroutine eio_direct_final (object)
class(eio_direct_t), intent(inout) :: object
call object%pset%final ()
end subroutine eio_direct_final
@ %def eio_direct_final
@ Initialize for input and/or output, both are identical
<<EIO direct: eio direct: TBP>>=
procedure :: init_out => eio_direct_init_out
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_init_out &
(eio, sample, data, success, extension)
class(eio_direct_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_direct_init_out
<<EIO direct: procedures>>=
module subroutine eio_direct_init_out &
(eio, sample, data, success, extension)
class(eio_direct_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
if (present (success)) success = .true.
end subroutine eio_direct_init_out
@ %def eio_direct_init_out
@
<<EIO direct: eio direct: TBP>>=
procedure :: init_in => eio_direct_init_in
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_init_in &
(eio, sample, data, success, extension)
class(eio_direct_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_direct_init_in
<<EIO direct: procedures>>=
module subroutine eio_direct_init_in &
(eio, sample, data, success, extension)
class(eio_direct_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
if (present (success)) success = .true.
end subroutine eio_direct_init_in
@ %def eio_direct_init_in
@ Switch from input to output: no-op
<<EIO direct: eio direct: TBP>>=
procedure :: switch_inout => eio_direct_switch_inout
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_switch_inout (eio, success)
class(eio_direct_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_direct_switch_inout
<<EIO direct: procedures>>=
module subroutine eio_direct_switch_inout (eio, success)
class(eio_direct_t), intent(inout) :: eio
logical, intent(out), optional :: success
if (present (success)) success = .true.
end subroutine eio_direct_switch_inout
@ %def eio_direct_switch_inout
@ Output: transfer event contents from the [[event]] object to the
[[eio]] object. Note that finalization of the particle set is not
(yet) automatic.
<<EIO direct: eio direct: TBP>>=
procedure :: output => eio_direct_output
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_direct_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_direct_output
<<EIO direct: procedures>>=
module subroutine eio_direct_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_direct_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
type(particle_set_t), pointer :: pset_ptr
call eio%pset%final ()
if (event%has_index ()) then
call eio%set_event_index (event%get_index ())
else
call eio%reset_event_index ()
end if
if (present (passed)) then
eio%passed = passed
eio%passed_set = .true.
else
eio%passed_set = .false.
end if
pset_ptr => event%get_particle_set_ptr ()
if (associated (pset_ptr)) then
eio%i_prc = i_prc
eio%pset = pset_ptr
end if
end subroutine eio_direct_output
@ %def eio_direct_output
@ Input: transfer event contents from the [[eio]] object to the
[[event]] object. The [[i_prc]] parameter has been stored inside the
[[eio]] record before.
<<EIO direct: eio direct: TBP>>=
procedure :: input_i_prc => eio_direct_input_i_prc
procedure :: input_event => eio_direct_input_event
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_input_i_prc (eio, i_prc, iostat)
class(eio_direct_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_direct_input_i_prc
module subroutine eio_direct_input_event (eio, event, iostat, event_handle)
class(eio_direct_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_direct_input_event
<<EIO direct: procedures>>=
module subroutine eio_direct_input_i_prc (eio, i_prc, iostat)
class(eio_direct_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
i_prc = eio%i_prc
iostat = 0
end subroutine eio_direct_input_i_prc
module subroutine eio_direct_input_event (eio, event, iostat, event_handle)
class(eio_direct_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
call event%select (eio%i_mci, eio%i_term, eio%channel)
if (eio%has_event_index ()) then
call event%set_index (eio%get_event_index ())
else
call event%reset_index ()
end if
call event%set_hard_particle_set (eio%pset)
end subroutine eio_direct_input_event
@ %def eio_direct_input_i_prc
@ %def eio_direct_input_event
@ No-op.
<<EIO direct: eio direct: TBP>>=
procedure :: skip => eio_direct_skip
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_skip (eio, iostat)
class(eio_direct_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_direct_skip
<<EIO direct: procedures>>=
module subroutine eio_direct_skip (eio, iostat)
class(eio_direct_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_direct_skip
@ %def eio_direct_skip
@
\subsection{Retrieve individual contents}
<<EIO direct: eio direct: TBP>>=
procedure :: has_event_index => eio_direct_has_event_index
procedure :: get_event_index => eio_direct_get_event_index
procedure :: passed_known => eio_direct_passed_known
procedure :: has_passed => eio_direct_has_passed
procedure :: get_n_in => eio_direct_get_n_in
procedure :: get_n_out => eio_direct_get_n_out
procedure :: get_n_tot => eio_direct_get_n_tot
<<EIO direct: sub interfaces>>=
module function eio_direct_has_event_index (eio) result (flag)
class(eio_direct_t), intent(in) :: eio
logical :: flag
end function eio_direct_has_event_index
module function eio_direct_get_event_index (eio) result (index)
class(eio_direct_t), intent(in) :: eio
integer :: index
end function eio_direct_get_event_index
module function eio_direct_passed_known (eio) result (flag)
class(eio_direct_t), intent(in) :: eio
logical :: flag
end function eio_direct_passed_known
module function eio_direct_has_passed (eio) result (flag)
class(eio_direct_t), intent(in) :: eio
logical :: flag
end function eio_direct_has_passed
module function eio_direct_get_n_in (eio) result (n_in)
class(eio_direct_t), intent(in) :: eio
integer :: n_in
end function eio_direct_get_n_in
module function eio_direct_get_n_out (eio) result (n_out)
class(eio_direct_t), intent(in) :: eio
integer :: n_out
end function eio_direct_get_n_out
module function eio_direct_get_n_tot (eio) result (n_tot)
class(eio_direct_t), intent(in) :: eio
integer :: n_tot
end function eio_direct_get_n_tot
<<EIO direct: procedures>>=
module function eio_direct_has_event_index (eio) result (flag)
class(eio_direct_t), intent(in) :: eio
logical :: flag
flag = eio%i_evt_set
end function eio_direct_has_event_index
module function eio_direct_get_event_index (eio) result (index)
class(eio_direct_t), intent(in) :: eio
integer :: index
if (eio%has_event_index ()) then
index = eio%i_evt
else
index = 0
end if
end function eio_direct_get_event_index
module function eio_direct_passed_known (eio) result (flag)
class(eio_direct_t), intent(in) :: eio
logical :: flag
flag = eio%passed_set
end function eio_direct_passed_known
module function eio_direct_has_passed (eio) result (flag)
class(eio_direct_t), intent(in) :: eio
logical :: flag
if (eio%passed_known ()) then
flag = eio%passed
else
flag = .true.
end if
end function eio_direct_has_passed
module function eio_direct_get_n_in (eio) result (n_in)
class(eio_direct_t), intent(in) :: eio
integer :: n_in
n_in = eio%pset%get_n_in ()
end function eio_direct_get_n_in
module function eio_direct_get_n_out (eio) result (n_out)
class(eio_direct_t), intent(in) :: eio
integer :: n_out
n_out = eio%pset%get_n_out ()
end function eio_direct_get_n_out
module function eio_direct_get_n_tot (eio) result (n_tot)
class(eio_direct_t), intent(in) :: eio
integer :: n_tot
n_tot = eio%pset%get_n_tot ()
end function eio_direct_get_n_tot
@ %def eio_direct_has_event_index
@ %def eio_direct_get_event_index
@ %def eio_direct_passed_known
@ %def eio_direct_has_passed
@ %def eio_direct_get_n_in
@ %def eio_direct_get_n_out
@ %def eio_direct_get_n_tot
@ All momenta as a single allocatable array.
<<EIO direct: eio direct: TBP>>=
procedure :: get_momentum_array => eio_direct_get_momentum_array
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_get_momentum_array (eio, p)
class(eio_direct_t), intent(in) :: eio
type(vector4_t), dimension(:), allocatable, intent(out) :: p
end subroutine eio_direct_get_momentum_array
<<EIO direct: procedures>>=
module subroutine eio_direct_get_momentum_array (eio, p)
class(eio_direct_t), intent(in) :: eio
type(vector4_t), dimension(:), allocatable, intent(out) :: p
integer :: n
n = eio%get_n_tot ()
allocate (p (n))
p(:) = eio%pset%get_momenta ()
end subroutine eio_direct_get_momentum_array
@ %def eio_direct_get_momentum_array
@
\subsection{Manual access}
Build the contained particle set from scratch.
<<EIO direct: eio direct: TBP>>=
procedure :: init_direct => eio_direct_init_direct
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_init_direct &
(eio, n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
class(eio_direct_t), intent(out) :: eio
integer, intent(in) :: n_beam
integer, intent(in) :: n_in
integer, intent(in) :: n_rem
integer, intent(in) :: n_vir
integer, intent(in) :: n_out
integer, dimension(:), intent(in) :: pdg
class(model_data_t), intent(in), target :: model
end subroutine eio_direct_init_direct
<<EIO direct: procedures>>=
module subroutine eio_direct_init_direct &
(eio, n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
class(eio_direct_t), intent(out) :: eio
integer, intent(in) :: n_beam
integer, intent(in) :: n_in
integer, intent(in) :: n_rem
integer, intent(in) :: n_vir
integer, intent(in) :: n_out
integer, dimension(:), intent(in) :: pdg
class(model_data_t), intent(in), target :: model
call eio%pset%init_direct (n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
end subroutine eio_direct_init_direct
@ %def eio_direct_init_direct
@ Set/reset the event index, which is optional.
<<EIO direct: eio direct: TBP>>=
procedure :: set_event_index => eio_direct_set_event_index
procedure :: reset_event_index => eio_direct_reset_event_index
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_set_event_index (eio, index)
class(eio_direct_t), intent(inout) :: eio
integer, intent(in) :: index
end subroutine eio_direct_set_event_index
module subroutine eio_direct_reset_event_index (eio)
class(eio_direct_t), intent(inout) :: eio
end subroutine eio_direct_reset_event_index
<<EIO direct: procedures>>=
module subroutine eio_direct_set_event_index (eio, index)
class(eio_direct_t), intent(inout) :: eio
integer, intent(in) :: index
eio%i_evt = index
eio%i_evt_set = .true.
end subroutine eio_direct_set_event_index
module subroutine eio_direct_reset_event_index (eio)
class(eio_direct_t), intent(inout) :: eio
eio%i_evt_set = .false.
end subroutine eio_direct_reset_event_index
@ %def eio_direct_set_event_index
@ %def eio_direct_reset_event_index
@ Set the selection indices. This is supposed to select the [[i_prc]],
[[i_mci]], [[i_term]], and [[channel]]
entries of the event where the momentum set has to be stored, respectively.
The selection indices determine the process, MCI set, calculation term, and
phase-space channel is to be used for recalculation. The index values must
not be zero, even if the do not apply.
<<EIO direct: eio direct: TBP>>=
procedure :: set_selection_indices => eio_direct_set_selection_indices
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_set_selection_indices &
(eio, i_prc, i_mci, i_term, channel)
class(eio_direct_t), intent(inout) :: eio
integer, intent(in) :: i_prc
integer, intent(in) :: i_mci
integer, intent(in) :: i_term
integer, intent(in) :: channel
end subroutine eio_direct_set_selection_indices
<<EIO direct: procedures>>=
module subroutine eio_direct_set_selection_indices &
(eio, i_prc, i_mci, i_term, channel)
class(eio_direct_t), intent(inout) :: eio
integer, intent(in) :: i_prc
integer, intent(in) :: i_mci
integer, intent(in) :: i_term
integer, intent(in) :: channel
eio%i_prc = i_prc
eio%i_mci = i_mci
eio%i_term = i_term
eio%channel = channel
end subroutine eio_direct_set_selection_indices
@ %def eio_direct_set_i_prc
@ Set momentum (or momenta -- elemental).
<<EIO direct: eio direct: TBP>>=
generic :: set_momentum => set_momentum_single
generic :: set_momentum => set_momentum_all
procedure :: set_momentum_single => eio_direct_set_momentum_single
procedure :: set_momentum_all => eio_direct_set_momentum_all
<<EIO direct: sub interfaces>>=
module subroutine eio_direct_set_momentum_single (eio, i, p, p2, on_shell)
class(eio_direct_t), intent(inout) :: eio
integer, intent(in) :: i
type(vector4_t), intent(in) :: p
real(default), intent(in), optional :: p2
logical, intent(in), optional :: on_shell
end subroutine eio_direct_set_momentum_single
module subroutine eio_direct_set_momentum_all (eio, p, p2, on_shell)
class(eio_direct_t), intent(inout) :: eio
type(vector4_t), dimension(:), intent(in) :: p
real(default), dimension(:), intent(in), optional :: p2
logical, intent(in), optional :: on_shell
end subroutine eio_direct_set_momentum_all
<<EIO direct: procedures>>=
module subroutine eio_direct_set_momentum_single (eio, i, p, p2, on_shell)
class(eio_direct_t), intent(inout) :: eio
integer, intent(in) :: i
type(vector4_t), intent(in) :: p
real(default), intent(in), optional :: p2
logical, intent(in), optional :: on_shell
call eio%pset%set_momentum (i, p, p2, on_shell)
end subroutine eio_direct_set_momentum_single
module subroutine eio_direct_set_momentum_all (eio, p, p2, on_shell)
class(eio_direct_t), intent(inout) :: eio
type(vector4_t), dimension(:), intent(in) :: p
real(default), dimension(:), intent(in), optional :: p2
logical, intent(in), optional :: on_shell
call eio%pset%set_momentum (p, p2, on_shell)
end subroutine eio_direct_set_momentum_all
@ %def eio_direct_set_momentum
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_direct_ut.f90]]>>=
<<File header>>
module eio_direct_ut
use unit_tests
use eio_direct_uti
<<Standard module head>>
<<EIO direct: public test>>
contains
<<EIO direct: test driver>>
end module eio_direct_ut
@ %def eio_direct_ut
@
<<[[eio_direct_uti.f90]]>>=
<<File header>>
module eio_direct_uti
<<Use kinds>>
<<Use strings>>
use lorentz, only: vector4_t
use model_data, only: model_data_t
use event_base
use eio_data
use eio_base
use eio_direct
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
<<Standard module head>>
<<EIO direct: test declarations>>
contains
<<EIO direct: tests>>
end module eio_direct_uti
@ %def eio_direct_ut
@ API: driver for the unit tests below.
<<EIO direct: public test>>=
public :: eio_direct_test
<<EIO direct: test driver>>=
subroutine eio_direct_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO direct: execute tests>>
end subroutine eio_direct_test
@ %def eio_direct_test
@
\subsubsection{Test I/O methods}
We test the implementation of all I/O methods.
<<EIO direct: execute tests>>=
call test (eio_direct_1, "eio_direct_1", &
"read and write event contents", &
u, results)
<<EIO direct: test declarations>>=
public :: eio_direct_1
<<EIO direct: tests>>=
subroutine eio_direct_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
class(eio_t), allocatable :: eio
type(event_sample_data_t) :: data
type(string_t) :: sample
type(vector4_t), dimension(:), allocatable :: p
class(model_data_t), pointer :: model
integer :: i, n_events, iostat, i_prc
write (u, "(A)") "* Test output: eio_direct_1"
write (u, "(A)") "* Purpose: generate and read/write an event"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
write (u, "(A)")
write (u, "(A)") "* Initial state"
write (u, "(A)")
allocate (eio_direct_t :: eio)
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract an empty event"
write (u, "(A)")
call eio%output (event, 1)
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Retrieve contents"
write (u, "(A)")
select type (eio)
class is (eio_direct_t)
if (eio%has_event_index ()) write (u, "(A,1x,I0)") "index =", eio%get_event_index ()
if (eio%passed_known ()) write (u, "(A,1x,L1)") "passed =", eio%has_passed ()
write (u, "(A,1x,I0)") "n_in =", eio%get_n_in ()
write (u, "(A,1x,I0)") "n_out =", eio%get_n_out ()
end select
write (u, "(A)")
write (u, "(A)") "* Generate and extract an event"
write (u, "(A)")
call event%generate (1, [0._default, 0._default])
call event%set_index (42)
model => event%get_model_ptr ()
sample = ""
call eio%init_out (sample)
call eio%output (event, 1, passed = .true.)
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Retrieve contents"
write (u, "(A)")
select type (eio)
class is (eio_direct_t)
if (eio%has_event_index ()) write (u, "(A,1x,I0)") "index =", eio%get_event_index ()
if (eio%passed_known ()) write (u, "(A,1x,L1)") "passed =", eio%has_passed ()
write (u, "(A,1x,I0)") "n_in =", eio%get_n_in ()
write (u, "(A,1x,I0)") "n_out =", eio%get_n_out ()
end select
select type (eio)
class is (eio_direct_t)
call eio%get_momentum_array (p)
if (allocated (p)) then
write (u, "(A)") "p[3] ="
call p(3)%write (u)
end if
end select
write (u, "(A)")
write (u, "(A)") "* Re-create an eio event record: initialization"
write (u, "(A)")
call eio%final ()
select type (eio)
class is (eio_direct_t)
call eio%init_direct ( &
n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 2, &
pdg = [25, 25, 25, 25], model = model)
call eio%set_event_index (42)
call eio%set_selection_indices (1, 1, 1, 1)
call eio%write (u)
end select
write (u, "(A)")
write (u, "(A)") "* Re-create an eio event record: &
&set momenta, interchanged"
write (u, "(A)")
select type (eio)
class is (eio_direct_t)
call eio%set_momentum (p([1,2,4,3]), on_shell=.true.)
call eio%write (u)
end select
write (u, "(A)")
write (u, "(A)") "* 'read' i_prc"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(1x,A,1x,I0)") "i_prc =", i_prc
write (u, "(1x,A,1x,I0)") "iostat =", iostat
write (u, "(A)")
write (u, "(A)") "* 'read' (fill) event"
write (u, "(A)")
call eio%input_event (event, iostat)
write (u, "(1x,A,1x,I0)") "iostat =", iostat
write (u, "(A)")
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
deallocate (eio)
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_direct_1"
end subroutine eio_direct_1
@ %def eio_direct_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Event Generation Checkpoints}
This is an output-only format. Its only use is to write screen
messages every $n$ events, to inform the user about progress.
<<[[eio_checkpoints.f90]]>>=
<<File header>>
module eio_checkpoints
<<Use strings>>
use cputime
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO checkpoints: public>>
<<EIO checkpoints: types>>
interface
<<EIO checkpoints: sub interfaces>>
end interface
end module eio_checkpoints
@ %def eio_checkpoints
@
<<[[eio_checkpoints_sub.f90]]>>=
<<File header>>
submodule (eio_checkpoints) eio_checkpoints_s
use io_units
use diagnostics
implicit none
<<EIO checkpoints: parameters>>
contains
<<EIO checkpoints: procedures>>
end submodule eio_checkpoints_s
@ %def eio_checkpoints_s
@
\subsection{Type}
<<EIO checkpoints: public>>=
public :: eio_checkpoints_t
<<EIO checkpoints: types>>=
type, extends (eio_t) :: eio_checkpoints_t
logical :: active = .false.
logical :: running = .false.
integer :: val = 0
integer :: n_events = 0
integer :: n_read = 0
integer :: i_evt = 0
logical :: blank = .false.
type(timer_t) :: timer
contains
<<EIO checkpoints: eio checkpoints: TBP>>
end type eio_checkpoints_t
@ %def eio_checkpoints_t
@
\subsection{Specific Methods}
Set parameters that are specifically used for checkpointing.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: set_parameters => eio_checkpoints_set_parameters
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_set_parameters (eio, checkpoint, blank)
class(eio_checkpoints_t), intent(inout) :: eio
integer, intent(in) :: checkpoint
logical, intent(in), optional :: blank
end subroutine eio_checkpoints_set_parameters
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_set_parameters (eio, checkpoint, blank)
class(eio_checkpoints_t), intent(inout) :: eio
integer, intent(in) :: checkpoint
logical, intent(in), optional :: blank
eio%val = checkpoint
if (present (blank)) eio%blank = blank
end subroutine eio_checkpoints_set_parameters
@ %def eio_checkpoints_set_parameters
@
\subsection{Common Methods}
Output. This is not the actual event format, but a readable account
of the current status.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: write => eio_checkpoints_write
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_write (object, unit)
class(eio_checkpoints_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_checkpoints_write
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_write (object, unit)
class(eio_checkpoints_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (object%active) then
write (u, "(1x,A)") "Event-sample checkpoints: active"
write (u, "(3x,A,I0)") "interval = ", object%val
write (u, "(3x,A,I0)") "n_events = ", object%n_events
write (u, "(3x,A,I0)") "n_read = ", object%n_read
write (u, "(3x,A,I0)") "n_current = ", object%i_evt
write (u, "(3x,A,L1)") "blanking = ", object%blank
call object%timer%write (u)
else
write (u, "(1x,A)") "Event-sample checkpoints: off"
end if
end subroutine eio_checkpoints_write
@ %def eio_checkpoints_write
@ Finalizer: trivial.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: final => eio_checkpoints_final
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_final (object)
class(eio_checkpoints_t), intent(inout) :: object
end subroutine eio_checkpoints_final
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_final (object)
class(eio_checkpoints_t), intent(inout) :: object
object%active = .false.
end subroutine eio_checkpoints_final
@ %def eio_checkpoints_final
@ Activate checkpointing for event generation or writing.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: init_out => eio_checkpoints_init_out
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_init_out &
(eio, sample, data, success, extension)
class(eio_checkpoints_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_checkpoints_init_out
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_init_out &
(eio, sample, data, success, extension)
class(eio_checkpoints_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
if (present (data)) then
if (eio%val > 0) then
eio%active = .true.
eio%i_evt = 0
eio%n_read = 0
eio%n_events = data%n_evt * data%nlo_multiplier
end if
end if
if (present (success)) success = .true.
end subroutine eio_checkpoints_init_out
@ %def eio_checkpoints_init_out
@ No checkpointing for event reading.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: init_in => eio_checkpoints_init_in
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_init_in &
(eio, sample, data, success, extension)
class(eio_checkpoints_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_checkpoints_init_in
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_init_in &
(eio, sample, data, success, extension)
class(eio_checkpoints_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
call msg_bug ("Event checkpoints: event input not supported")
if (present (success)) success = .false.
end subroutine eio_checkpoints_init_in
@ %def eio_checkpoints_init_in
@ Switch from input to output: also not supported.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: switch_inout => eio_checkpoints_switch_inout
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_switch_inout (eio, success)
class(eio_checkpoints_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_checkpoints_switch_inout
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_switch_inout (eio, success)
class(eio_checkpoints_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("Event checkpoints: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_checkpoints_switch_inout
@ %def eio_checkpoints_switch_inout
@ Checkpoints: display progress for the current event, if applicable.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: output => eio_checkpoints_output
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_checkpoints_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_checkpoints_output
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_checkpoints_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
logical :: rd
rd = .false.; if (present (reading)) rd = reading
if (eio%active) then
if (.not. eio%running) call eio%startup ()
if (eio%running) then
eio%i_evt = eio%i_evt + 1
if (rd) then
eio%n_read = eio%n_read + 1
else if (mod (eio%i_evt, eio%val) == 0) then
call eio%message (eio%blank)
end if
if (eio%i_evt == eio%n_events) call eio%shutdown ()
end if
end if
end subroutine eio_checkpoints_output
@ %def eio_checkpoints_output
@ When the first event is called, we have to initialize the screen output.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: startup => eio_checkpoints_startup
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_startup (eio)
class(eio_checkpoints_t), intent(inout) :: eio
end subroutine eio_checkpoints_startup
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_startup (eio)
class(eio_checkpoints_t), intent(inout) :: eio
if (eio%active .and. eio%i_evt < eio%n_events) then
call msg_message ("")
call msg_message (checkpoint_bar)
call msg_message (checkpoint_head)
call msg_message (checkpoint_bar)
write (msg_buffer, checkpoint_fmt) 0., 0, eio%n_events - eio%i_evt, "???"
call msg_message ()
eio%running = .true.
call eio%timer%start ()
end if
end subroutine eio_checkpoints_startup
@ %def eio_checkpoints_startup
@ This message is printed at every checkpoint.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: message => eio_checkpoints_message
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_message (eio, testflag)
class(eio_checkpoints_t), intent(inout) :: eio
logical, intent(in), optional :: testflag
end subroutine eio_checkpoints_message
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_message (eio, testflag)
class(eio_checkpoints_t), intent(inout) :: eio
logical, intent(in), optional :: testflag
real :: t
type(time_t) :: time_remaining
type(string_t) :: time_string
call eio%timer%stop ()
t = eio%timer
call eio%timer%restart ()
time_remaining = &
nint (t / (eio%i_evt - eio%n_read) * (eio%n_events - eio%i_evt))
time_string = time_remaining%to_string_ms (blank = testflag)
write (msg_buffer, checkpoint_fmt) &
100 * ((eio%i_evt - eio%n_read) / real (eio%n_events - eio%n_read)), &
eio%i_evt - eio%n_read, &
eio%n_events - eio%i_evt, &
char (time_string)
call msg_message ()
end subroutine eio_checkpoints_message
@ %def eio_checkpoints_message
@ When the last event is called, wrap up.
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: shutdown => eio_checkpoints_shutdown
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_shutdown (eio)
class(eio_checkpoints_t), intent(inout) :: eio
end subroutine eio_checkpoints_shutdown
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_shutdown (eio)
class(eio_checkpoints_t), intent(inout) :: eio
if (mod (eio%i_evt, eio%val) /= 0) then
write (msg_buffer, checkpoint_fmt) &
100., eio%i_evt - eio%n_read, 0, "0m:00s"
call msg_message ()
end if
call msg_message (checkpoint_bar)
call msg_message ("")
eio%running = .false.
end subroutine eio_checkpoints_shutdown
@ %def eio_checkpoints_shutdown
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: input_i_prc => eio_checkpoints_input_i_prc
procedure :: input_event => eio_checkpoints_input_event
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_input_i_prc (eio, i_prc, iostat)
class(eio_checkpoints_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_checkpoints_input_i_prc
module subroutine eio_checkpoints_input_event &
(eio, event, iostat, event_handle)
class(eio_checkpoints_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_checkpoints_input_event
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_input_i_prc (eio, i_prc, iostat)
class(eio_checkpoints_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
call msg_bug ("Event checkpoints: event input not supported")
i_prc = 0
iostat = 1
end subroutine eio_checkpoints_input_i_prc
module subroutine eio_checkpoints_input_event &
(eio, event, iostat, event_handle)
class(eio_checkpoints_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
call msg_bug ("Event checkpoints: event input not supported")
iostat = 1
end subroutine eio_checkpoints_input_event
@ %def eio_checkpoints_input_i_prc
@ %def eio_checkpoints_input_event
@
<<EIO checkpoints: eio checkpoints: TBP>>=
procedure :: skip => eio_checkpoints_skip
<<EIO checkpoints: sub interfaces>>=
module subroutine eio_checkpoints_skip (eio, iostat)
class(eio_checkpoints_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_checkpoints_skip
<<EIO checkpoints: procedures>>=
module subroutine eio_checkpoints_skip (eio, iostat)
class(eio_checkpoints_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_checkpoints_skip
@ %def eio_checkpoints_skip
@
\subsection{Message header}
<<EIO checkpoints: parameters>>=
character(*), parameter :: &
checkpoint_head = "| % complete | events generated | events remaining &
&| time remaining"
character(*), parameter :: &
checkpoint_bar = "|==================================================&
&=================|"
character(*), parameter :: &
checkpoint_fmt = "(' ',F5.1,T16,I9,T35,I9,T58,A)"
@ %def checkpoint_head
@ %def checkpoint_bar
@ %def checkpoint_fmt
@ %def checkpointing_t
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_checkpoints_ut.f90]]>>=
<<File header>>
module eio_checkpoints_ut
use unit_tests
use eio_checkpoints_uti
<<Standard module head>>
<<EIO checkpoints: public test>>
contains
<<EIO checkpoints: test driver>>
end module eio_checkpoints_ut
@ %def eio_checkpoints_ut
@
<<[[eio_checkpoints_uti.f90]]>>=
<<File header>>
module eio_checkpoints_uti
<<Use kinds>>
<<Use strings>>
use event_base
use eio_data
use eio_base
use eio_checkpoints
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
<<Standard module head>>
<<EIO checkpoints: test declarations>>
contains
<<EIO checkpoints: tests>>
end module eio_checkpoints_uti
@ %def eio_checkpoints_ut
@ API: driver for the unit tests below.
<<EIO checkpoints: public test>>=
public :: eio_checkpoints_test
<<EIO checkpoints: test driver>>=
subroutine eio_checkpoints_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO checkpoints: execute tests>>
end subroutine eio_checkpoints_test
@ %def eio_checkpoints_test
@
\subsubsection{Test I/O methods}
We test the implementation of all I/O methods.
<<EIO checkpoints: execute tests>>=
call test (eio_checkpoints_1, "eio_checkpoints_1", &
"read and write event contents", &
u, results)
<<EIO checkpoints: test declarations>>=
public :: eio_checkpoints_1
<<EIO checkpoints: tests>>=
subroutine eio_checkpoints_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
class(eio_t), allocatable :: eio
type(event_sample_data_t) :: data
type(string_t) :: sample
integer :: i, n_events
write (u, "(A)") "* Test output: eio_checkpoints_1"
write (u, "(A)") "* Purpose: generate a number of events &
&with screen output"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event)
write (u, "(A)")
write (u, "(A)") "* Generate events"
write (u, "(A)")
sample = "eio_checkpoints_1"
allocate (eio_checkpoints_t :: eio)
n_events = 10
call data%init (1, 0)
data%n_evt = n_events
select type (eio)
type is (eio_checkpoints_t)
call eio%set_parameters (checkpoint = 4)
end select
call eio%init_out (sample, data)
do i = 1, n_events
call event%generate (1, [0._default, 0._default])
call eio%output (event, i_prc = 0)
end do
write (u, "(A)") "* Checkpointing status"
write (u, "(A)")
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_checkpoints_1"
end subroutine eio_checkpoints_1
@ %def eio_checkpoints_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Event Generation Callback}
This is an output-only format. Its only use is to write screen
messages every $n$ events, to inform the user about progress.
<<[[eio_callback.f90]]>>=
<<File header>>
module eio_callback
use kinds, only: i64
<<Use strings>>
use cputime
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO callback: public>>
<<EIO callback: types>>
interface
<<EIO callback: sub interfaces>>
end interface
end module eio_callback
@ %def eio_callback
@
<<[[eio_callback_sub.f90]]>>=
<<File header>>
submodule (eio_callback) eio_callback_s
use io_units
use diagnostics
implicit none
contains
<<EIO callback: procedures>>
end submodule eio_callback_s
@ %def eio_callback_s
@
\subsection{Type}
<<EIO callback: public>>=
public :: eio_callback_t
<<EIO callback: types>>=
type, extends (eio_t) :: eio_callback_t
class(event_callback_t), allocatable :: callback
integer(i64) :: i_evt = 0
integer :: i_interval = 0
integer :: n_interval = 0
! type(timer_t) :: timer
contains
<<EIO callback: eio callback: TBP>>
end type eio_callback_t
@ %def eio_callback_t
@
\subsection{Specific Methods}
Set parameters that are specifically used for callback: the procedure
and the number of events to wait until the procedure is called (again).
<<EIO callback: eio callback: TBP>>=
procedure :: set_parameters => eio_callback_set_parameters
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_set_parameters &
(eio, callback, count_interval)
class(eio_callback_t), intent(inout) :: eio
class(event_callback_t), intent(in) :: callback
integer, intent(in) :: count_interval
end subroutine eio_callback_set_parameters
<<EIO callback: procedures>>=
module subroutine eio_callback_set_parameters &
(eio, callback, count_interval)
class(eio_callback_t), intent(inout) :: eio
class(event_callback_t), intent(in) :: callback
integer, intent(in) :: count_interval
allocate (eio%callback, source = callback)
eio%n_interval = count_interval
end subroutine eio_callback_set_parameters
@ %def eio_callback_set_parameters
@
\subsection{Common Methods}
Output. This is not the actual event format, but a readable account
of the current status.
<<EIO callback: eio callback: TBP>>=
procedure :: write => eio_callback_write
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_write (object, unit)
class(eio_callback_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_callback_write
<<EIO callback: procedures>>=
module subroutine eio_callback_write (object, unit)
class(eio_callback_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Event-sample callback:"
write (u, "(3x,A,I0)") "interval = ", object%n_interval
write (u, "(3x,A,I0)") "evt count = ", object%i_evt
! call object%timer%write (u)
end subroutine eio_callback_write
@ %def eio_callback_write
@ Finalizer: trivial.
<<EIO callback: eio callback: TBP>>=
procedure :: final => eio_callback_final
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_final (object)
class(eio_callback_t), intent(inout) :: object
end subroutine eio_callback_final
<<EIO callback: procedures>>=
module subroutine eio_callback_final (object)
class(eio_callback_t), intent(inout) :: object
end subroutine eio_callback_final
@ %def eio_callback_final
@ Activate checkpointing for event generation or writing.
<<EIO callback: eio callback: TBP>>=
procedure :: init_out => eio_callback_init_out
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_init_out &
(eio, sample, data, success, extension)
class(eio_callback_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_callback_init_out
<<EIO callback: procedures>>=
module subroutine eio_callback_init_out &
(eio, sample, data, success, extension)
class(eio_callback_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
eio%i_evt = 0
eio%i_interval = 0
if (present (success)) success = .true.
end subroutine eio_callback_init_out
@ %def eio_callback_init_out
@ No callback for event reading.
<<EIO callback: eio callback: TBP>>=
procedure :: init_in => eio_callback_init_in
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_init_in &
(eio, sample, data, success, extension)
class(eio_callback_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_callback_init_in
<<EIO callback: procedures>>=
module subroutine eio_callback_init_in &
(eio, sample, data, success, extension)
class(eio_callback_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
call msg_bug ("Event callback: event input not supported")
if (present (success)) success = .false.
end subroutine eio_callback_init_in
@ %def eio_callback_init_in
@ Switch from input to output: also not supported.
<<EIO callback: eio callback: TBP>>=
procedure :: switch_inout => eio_callback_switch_inout
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_switch_inout (eio, success)
class(eio_callback_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_callback_switch_inout
<<EIO callback: procedures>>=
module subroutine eio_callback_switch_inout (eio, success)
class(eio_callback_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("Event callback: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_callback_switch_inout
@ %def eio_callback_switch_inout
@ The actual callback. First increment counters, then call the
procedure if the counter hits the interval.
<<EIO callback: eio callback: TBP>>=
procedure :: output => eio_callback_output
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_callback_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_callback_output
<<EIO callback: procedures>>=
module subroutine eio_callback_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_callback_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
eio%i_evt = eio%i_evt + 1
if (eio%n_interval > 0) then
eio%i_interval = eio%i_interval + 1
if (eio%i_interval >= eio%n_interval) then
call eio%callback%proc (eio%i_evt, event)
eio%i_interval = 0
end if
end if
end subroutine eio_callback_output
@ %def eio_callback_output
@ No input.
<<EIO callback: eio callback: TBP>>=
procedure :: input_i_prc => eio_callback_input_i_prc
procedure :: input_event => eio_callback_input_event
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_input_i_prc (eio, i_prc, iostat)
class(eio_callback_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_callback_input_i_prc
module subroutine eio_callback_input_event &
(eio, event, iostat, event_handle)
class(eio_callback_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_callback_input_event
<<EIO callback: procedures>>=
module subroutine eio_callback_input_i_prc (eio, i_prc, iostat)
class(eio_callback_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
call msg_bug ("Event callback: event input not supported")
i_prc = 0
iostat = 1
end subroutine eio_callback_input_i_prc
module subroutine eio_callback_input_event &
(eio, event, iostat, event_handle)
class(eio_callback_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
call msg_bug ("Event callback: event input not supported")
iostat = 1
end subroutine eio_callback_input_event
@ %def eio_callback_input_i_prc
@ %def eio_callback_input_event
@
<<EIO callback: eio callback: TBP>>=
procedure :: skip => eio_callback_skip
<<EIO callback: sub interfaces>>=
module subroutine eio_callback_skip (eio, iostat)
class(eio_callback_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_callback_skip
<<EIO callback: procedures>>=
module subroutine eio_callback_skip (eio, iostat)
class(eio_callback_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_callback_skip
@ %def eio_callback_skip
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Event Weight Output}
This is an output-only format. For each event, we print the indices
that identify process, process part (MCI group), and term. As
numerical information we print the squared matrix element (trace) and
the event weight.
<<[[eio_weights.f90]]>>=
<<File header>>
module eio_weights
<<Use kinds>>
<<Use strings>>
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO weights: public>>
<<EIO weights: types>>
interface
<<EIO weights: sub interfaces>>
end interface
end module eio_weights
@ %def eio_weights
@
<<[[eio_weights_sub.f90]]>>=
<<File header>>
submodule (eio_weights) eio_weights_s
use io_units
use diagnostics
implicit none
contains
<<EIO weights: procedures>>
end submodule eio_weights_s
@ %def eio_weights_s
@
\subsection{Type}
<<EIO weights: public>>=
public :: eio_weights_t
<<EIO weights: types>>=
type, extends (eio_t) :: eio_weights_t
logical :: writing = .false.
integer :: unit = 0
logical :: pacify = .false.
contains
<<EIO weights: eio weights: TBP>>
end type eio_weights_t
@ %def eio_weights_t
@
\subsection{Specific Methods}
Set pacify flags.
<<EIO weights: eio weights: TBP>>=
procedure :: set_parameters => eio_weights_set_parameters
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_set_parameters (eio, pacify)
class(eio_weights_t), intent(inout) :: eio
logical, intent(in), optional :: pacify
end subroutine eio_weights_set_parameters
<<EIO weights: procedures>>=
module subroutine eio_weights_set_parameters (eio, pacify)
class(eio_weights_t), intent(inout) :: eio
logical, intent(in), optional :: pacify
if (present (pacify)) eio%pacify = pacify
eio%extension = "weights.dat"
end subroutine eio_weights_set_parameters
@ %def eio_weights_set_parameters
@
\subsection{Common Methods}
@ Output. This is not the actual event format, but a readable account
of the current object status.
<<EIO weights: eio weights: TBP>>=
procedure :: write => eio_weights_write
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_write (object, unit)
class(eio_weights_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_weights_write
<<EIO weights: procedures>>=
module subroutine eio_weights_write (object, unit)
class(eio_weights_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Weight stream:"
if (object%writing) then
write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
write (u, "(3x,A,L1)") "Reduced I/O prec. = ", object%pacify
else
write (u, "(3x,A)") "[closed]"
end if
end subroutine eio_weights_write
@ %def eio_weights_write
@ Finalizer: close any open file.
<<EIO weights: eio weights: TBP>>=
procedure :: final => eio_weights_final
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_final (object)
class(eio_weights_t), intent(inout) :: object
end subroutine eio_weights_final
<<EIO weights: procedures>>=
module subroutine eio_weights_final (object)
class(eio_weights_t), intent(inout) :: object
if (object%writing) then
write (msg_buffer, "(A,A,A)") "Events: closing weight stream file '", &
char (object%filename), "'"
call msg_message ()
close (object%unit)
object%writing = .false.
end if
end subroutine eio_weights_final
@ %def eio_weights_final
@ Initialize event writing.
<<EIO weights: eio weights: TBP>>=
procedure :: init_out => eio_weights_init_out
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_init_out &
(eio, sample, data, success, extension)
class(eio_weights_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_weights_init_out
<<EIO weights: procedures>>=
module subroutine eio_weights_init_out &
(eio, sample, data, success, extension)
class(eio_weights_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
if (present(extension)) then
eio%extension = extension
else
eio%extension = "weights.dat"
end if
eio%filename = sample // "." // eio%extension
eio%unit = free_unit ()
write (msg_buffer, "(A,A,A)") "Events: writing to weight stream file '", &
char (eio%filename), "'"
call msg_message ()
eio%writing = .true.
open (eio%unit, file = char (eio%filename), &
action = "write", status = "replace")
if (present (success)) success = .true.
end subroutine eio_weights_init_out
@ %def eio_weights_init_out
@ Initialize event reading.
<<EIO weights: eio weights: TBP>>=
procedure :: init_in => eio_weights_init_in
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_init_in &
(eio, sample, data, success, extension)
class(eio_weights_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_weights_init_in
<<EIO weights: procedures>>=
module subroutine eio_weights_init_in &
(eio, sample, data, success, extension)
class(eio_weights_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
call msg_bug ("Weight stream: event input not supported")
if (present (success)) success = .false.
end subroutine eio_weights_init_in
@ %def eio_weights_init_in
@ Switch from input to output: reopen the file for reading.
<<EIO weights: eio weights: TBP>>=
procedure :: switch_inout => eio_weights_switch_inout
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_switch_inout (eio, success)
class(eio_weights_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_weights_switch_inout
<<EIO weights: procedures>>=
module subroutine eio_weights_switch_inout (eio, success)
class(eio_weights_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("Weight stream: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_weights_switch_inout
@ %def eio_weights_switch_inout
@ Output an event. Write first the event indices, then weight and two
values of the squared matrix element: [[sqme_ref]] is the value stored
in the event record, and [[sqme_prc]] is the one stored in the process
instance. (They can differ: when recalculating, the former is read
from file and the latter is the result of the new calculation.)
For the alternative entries, the [[sqme]] value is always obtained by
a new calculation, and thus qualifies as [[sqme_prc]].
Don't write the file if the [[passed]] flag is set and false.
<<EIO weights: eio weights: TBP>>=
procedure :: output => eio_weights_output
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_weights_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_weights_output
<<EIO weights: procedures>>=
module subroutine eio_weights_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_weights_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
integer :: n_alt, i
real(default) :: weight, sqme_ref, sqme_prc
logical :: evt_pacify, evt_passed
evt_pacify = eio%pacify; if (present (pacify)) evt_pacify = pacify
evt_passed = .true.; if (present (passed)) evt_passed = passed
if (eio%writing) then
if (evt_passed) then
weight = event%get_weight_prc ()
sqme_ref = event%get_sqme_ref ()
sqme_prc = event%get_sqme_prc ()
n_alt = event%get_n_alt ()
1 format (I0,3(1x,ES17.10),3(1x,I0))
2 format (I0,3(1x,ES15.8),3(1x,I0))
if (evt_pacify) then
write (eio%unit, 2) 0, weight, sqme_prc, sqme_ref, &
i_prc
else
write (eio%unit, 1) 0, weight, sqme_prc, sqme_ref, &
i_prc
end if
do i = 1, n_alt
weight = event%get_weight_alt(i)
sqme_prc = event%get_sqme_alt(i)
if (evt_pacify) then
write (eio%unit, 2) i, weight, sqme_prc
else
write (eio%unit, 1) i, weight, sqme_prc
end if
end do
end if
else
call eio%write ()
call msg_fatal ("Weight stream file is not open for writing")
end if
end subroutine eio_weights_output
@ %def eio_weights_output
@ Input an event.
<<EIO weights: eio weights: TBP>>=
procedure :: input_i_prc => eio_weights_input_i_prc
procedure :: input_event => eio_weights_input_event
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_input_i_prc (eio, i_prc, iostat)
class(eio_weights_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_weights_input_i_prc
module subroutine eio_weights_input_event &
(eio, event, iostat, event_handle)
class(eio_weights_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_weights_input_event
<<EIO weights: procedures>>=
module subroutine eio_weights_input_i_prc (eio, i_prc, iostat)
class(eio_weights_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
call msg_bug ("Weight stream: event input not supported")
i_prc = 0
iostat = 1
end subroutine eio_weights_input_i_prc
module subroutine eio_weights_input_event &
(eio, event, iostat, event_handle)
class(eio_weights_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
call msg_bug ("Weight stream: event input not supported")
iostat = 1
end subroutine eio_weights_input_event
@ %def eio_weights_input_i_prc
@ %def eio_weights_input_event
@
<<EIO weights: eio weights: TBP>>=
procedure :: skip => eio_weights_skip
<<EIO weights: sub interfaces>>=
module subroutine eio_weights_skip (eio, iostat)
class(eio_weights_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_weights_skip
<<EIO weights: procedures>>=
module subroutine eio_weights_skip (eio, iostat)
class(eio_weights_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_weights_skip
@ %def eio_weights_skip
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_weights_ut.f90]]>>=
<<File header>>
module eio_weights_ut
use unit_tests
use eio_weights_uti
<<Standard module head>>
<<EIO weights: public test>>
contains
<<EIO weights: test driver>>
end module eio_weights_ut
@ %def eio_weights_ut
@
<<[[eio_weights_uti.f90]]>>=
<<File header>>
module eio_weights_uti
<<Use kinds>>
<<Use strings>>
use io_units
use event_base
use eio_data
use eio_base
use eio_weights
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
<<Standard module head>>
<<EIO weights: test declarations>>
contains
<<EIO weights: tests>>
end module eio_weights_uti
@ %def eio_weights_ut
@ API: driver for the unit tests below.
<<EIO weights: public test>>=
public :: eio_weights_test
<<EIO weights: test driver>>=
subroutine eio_weights_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO weights: execute tests>>
end subroutine eio_weights_test
@ %def eio_weights_test
@
\subsubsection{Simple event}
We test the implementation of all I/O methods.
<<EIO weights: execute tests>>=
call test (eio_weights_1, "eio_weights_1", &
"read and write event contents", &
u, results)
<<EIO weights: test declarations>>=
public :: eio_weights_1
<<EIO weights: tests>>=
subroutine eio_weights_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file
character(80) :: buffer
write (u, "(A)") "* Test output: eio_weights_1"
write (u, "(A)") "* Purpose: generate an event and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_weights_1"
allocate (eio_weights_t :: eio)
call eio%init_out (sample)
call event%generate (1, [0._default, 0._default])
call eio%output (event, i_prc = 42)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents: &
&(weight, sqme(evt), sqme(prc), i_prc)"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "eio_weights_1.weights.dat", &
action = "read", status = "old")
read (u_file, "(A)") buffer
write (u, "(A)") trim (buffer)
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_weights_1"
end subroutine eio_weights_1
@ %def eio_weights_1
@
\subsubsection{Multiple weights}
Event with several weight entries set.
<<EIO weights: execute tests>>=
call test (eio_weights_2, "eio_weights_2", &
"multiple weights", &
u, results)
<<EIO weights: test declarations>>=
public :: eio_weights_2
<<EIO weights: tests>>=
subroutine eio_weights_2 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, i
character(80) :: buffer
write (u, "(A)") "* Test output: eio_weights_2"
write (u, "(A)") "* Purpose: generate an event and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false., n_alt = 2)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_weights_2"
allocate (eio_weights_t :: eio)
call eio%init_out (sample)
select type (eio)
type is (eio_weights_t)
call eio%set_parameters (pacify = .true.)
end select
call event%generate (1, [0._default, 0._default])
call event%set (sqme_alt = [2._default, 3._default])
call event%set (weight_alt = &
[2 * event%get_weight_prc (), 3 * event%get_weight_prc ()])
call eio%output (event, i_prc = 42)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents: &
&(weight, sqme(evt), sqme(prc), i_prc)"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "eio_weights_2.weights.dat", &
action = "read", status = "old")
do i = 1, 3
read (u_file, "(A)") buffer
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_weights_2"
end subroutine eio_weights_2
@ %def eio_weights_2
@
\subsubsection{Multiple events}
Events with [[passed]] flag switched on/off.
<<EIO weights: execute tests>>=
call test (eio_weights_3, "eio_weights_3", &
"check passed-flag", &
u, results)
<<EIO weights: test declarations>>=
public :: eio_weights_3
<<EIO weights: tests>>=
subroutine eio_weights_3 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_weights_3"
write (u, "(A)") "* Purpose: generate three events and write to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
write (u, "(A)")
write (u, "(A)") "* Generate and write events"
write (u, "(A)")
sample = "eio_weights_3"
allocate (eio_weights_t :: eio)
select type (eio)
type is (eio_weights_t)
call eio%set_parameters (pacify = .true.)
end select
call eio%init_out (sample)
call event%generate (1, [0._default, 0._default])
call eio%output (event, i_prc = 1)
call event%generate (1, [0.1_default, 0._default])
call eio%output (event, i_prc = 1, passed = .false.)
call event%generate (1, [0.2_default, 0._default])
call eio%output (event, i_prc = 1, passed = .true.)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents: &
&(weight, sqme(evt), sqme(prc), i_prc), should be just two entries"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "eio_weights_3.weights.dat", &
action = "read", status = "old")
do
read (u_file, "(A)", iostat=iostat) buffer
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_weights_3"
end subroutine eio_weights_3
@ %def eio_weights_3
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Event Dump Output}
This is an output-only format. We simply dump the contents of the
[[particle_set]], using the [[write]] method of that type. The
event-format options are the options of that procedure.
<<[[eio_dump.f90]]>>=
<<File header>>
module eio_dump
use, intrinsic :: iso_fortran_env, only: output_unit
use kinds, only: i64
<<Use strings>>
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO dump: public>>
<<EIO dump: types>>
interface
<<EIO dump: sub interfaces>>
end interface
end module eio_dump
@ %def eio_dump
@
<<[[eio_dump_sub.f90]]>>=
<<File header>>
submodule (eio_dump) eio_dump_s
use io_units
use diagnostics
use format_utils, only: write_separator
use format_utils, only: pac_fmt
use format_defs, only: FMT_16, FMT_19
implicit none
contains
<<EIO dump: procedures>>
end submodule eio_dump_s
@ %def eio_dump_s
@
\subsection{Type}
<<EIO dump: public>>=
public :: eio_dump_t
<<EIO dump: types>>=
type, extends (eio_t) :: eio_dump_t
integer(i64) :: count = 0
integer :: unit = 0
logical :: writing = .false.
logical :: screen = .false.
logical :: pacify = .false.
logical :: weights = .false.
logical :: compressed = .false.
logical :: summary = .false.
contains
<<EIO dump: eio dump: TBP>>
end type eio_dump_t
@ %def eio_dump_t
@
\subsection{Specific Methods}
Set control parameters. We may provide a [[unit]] for input or output; this
will be taken if the sample file name is empty. In that case, the unit is
assumed to be open and will be kept open; no messages will be issued.
<<EIO dump: eio dump: TBP>>=
procedure :: set_parameters => eio_dump_set_parameters
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_set_parameters (eio, extension, &
pacify, weights, compressed, summary, screen, unit)
class(eio_dump_t), intent(inout) :: eio
type(string_t), intent(in), optional :: extension
logical, intent(in), optional :: pacify
logical, intent(in), optional :: weights
logical, intent(in), optional :: compressed
logical, intent(in), optional :: summary
logical, intent(in), optional :: screen
integer, intent(in), optional :: unit
end subroutine eio_dump_set_parameters
<<EIO dump: procedures>>=
module subroutine eio_dump_set_parameters (eio, extension, &
pacify, weights, compressed, summary, screen, unit)
class(eio_dump_t), intent(inout) :: eio
type(string_t), intent(in), optional :: extension
logical, intent(in), optional :: pacify
logical, intent(in), optional :: weights
logical, intent(in), optional :: compressed
logical, intent(in), optional :: summary
logical, intent(in), optional :: screen
integer, intent(in), optional :: unit
if (present (pacify)) eio%pacify = pacify
if (present (weights)) eio%weights = weights
if (present (compressed)) eio%compressed = compressed
if (present (summary)) eio%summary = summary
if (present (screen)) eio%screen = screen
if (present (unit)) eio%unit = unit
eio%extension = "pset.dat"
if (present (extension)) eio%extension = extension
end subroutine eio_dump_set_parameters
@ %def eio_dump_set_parameters
@
\subsection{Common Methods}
@ Output. This is not the actual event format, but a readable account
of the current object status.
<<EIO dump: eio dump: TBP>>=
procedure :: write => eio_dump_write
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_write (object, unit)
class(eio_dump_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_dump_write
<<EIO dump: procedures>>=
module subroutine eio_dump_write (object, unit)
class(eio_dump_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Dump event stream:"
if (object%writing) then
write (u, "(3x,A,L1)") "Screen output = ", object%screen
write (u, "(3x,A,A,A)") "Writing to file = '", char (object%filename), "'"
write (u, "(3x,A,L1)") "Reduced I/O prec. = ", object%pacify
write (u, "(3x,A,L1)") "Show weights/sqme = ", object%weights
write (u, "(3x,A,L1)") "Compressed = ", object%compressed
write (u, "(3x,A,L1)") "Summary = ", object%summary
else
write (u, "(3x,A)") "[closed]"
end if
end subroutine eio_dump_write
@ %def eio_dump_write
@ Finalizer: close any open file.
<<EIO dump: eio dump: TBP>>=
procedure :: final => eio_dump_final
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_final (object)
class(eio_dump_t), intent(inout) :: object
end subroutine eio_dump_final
<<EIO dump: procedures>>=
module subroutine eio_dump_final (object)
class(eio_dump_t), intent(inout) :: object
if (object%screen) then
write (msg_buffer, "(A,A,A)") "Events: display complete"
call msg_message ()
object%screen = .false.
end if
if (object%writing) then
if (object%filename /= "") then
write (msg_buffer, "(A,A,A)") "Events: closing event dump file '", &
char (object%filename), "'"
call msg_message ()
close (object%unit)
end if
object%writing = .false.
end if
end subroutine eio_dump_final
@ %def eio_dump_final
@ Initialize event writing.
<<EIO dump: eio dump: TBP>>=
procedure :: init_out => eio_dump_init_out
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_init_out &
(eio, sample, data, success, extension)
class(eio_dump_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_dump_init_out
<<EIO dump: procedures>>=
module subroutine eio_dump_init_out &
(eio, sample, data, success, extension)
class(eio_dump_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
if (present(extension)) then
eio%extension = extension
else
eio%extension = "pset.dat"
end if
if (sample == "" .and. eio%unit /= 0) then
eio%filename = ""
eio%writing = .true.
else if (sample /= "") then
eio%filename = sample // "." // eio%extension
eio%unit = free_unit ()
write (msg_buffer, "(A,A,A)") "Events: writing to event dump file '", &
char (eio%filename), "'"
call msg_message ()
eio%writing = .true.
open (eio%unit, file = char (eio%filename), &
action = "write", status = "replace")
end if
if (eio%screen) then
write (msg_buffer, "(A,A,A)") "Events: display on standard output"
call msg_message ()
end if
eio%count = 0
if (present (success)) success = .true.
end subroutine eio_dump_init_out
@ %def eio_dump_init_out
@ Initialize event reading.
<<EIO dump: eio dump: TBP>>=
procedure :: init_in => eio_dump_init_in
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_init_in &
(eio, sample, data, success, extension)
class(eio_dump_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_dump_init_in
<<EIO dump: procedures>>=
module subroutine eio_dump_init_in &
(eio, sample, data, success, extension)
class(eio_dump_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
call msg_bug ("Event dump: event input not supported")
if (present (success)) success = .false.
end subroutine eio_dump_init_in
@ %def eio_dump_init_in
@ Switch from input to output: reopen the file for reading.
<<EIO dump: eio dump: TBP>>=
procedure :: switch_inout => eio_dump_switch_inout
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_switch_inout (eio, success)
class(eio_dump_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_dump_switch_inout
<<EIO dump: procedures>>=
module subroutine eio_dump_switch_inout (eio, success)
class(eio_dump_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("Event dump: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_dump_switch_inout
@ %def eio_dump_switch_inout
@ Output an event. Delegate the output call to the [[write]] method
of the current particle set, if valid. Output both to file (if defined)
and to screen (if requested).
<<EIO dump: eio dump: TBP>>=
procedure :: output => eio_dump_output
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_dump_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_dump_output
<<EIO dump: procedures>>=
module subroutine eio_dump_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_dump_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
character(len=7) :: fmt
eio%count = eio%count + 1
if (present (pacify)) then
call pac_fmt (fmt, FMT_19, FMT_16, pacify)
else
call pac_fmt (fmt, FMT_19, FMT_16, eio%pacify)
end if
if (eio%writing) call dump (eio%unit)
if (eio%screen) then
call dump (output_unit)
if (logfile_unit () > 0) call dump (logfile_unit ())
end if
contains
subroutine dump (u)
integer, intent(in) :: u
integer :: i
call write_separator (u, 2)
write (u, "(1x,A,I0)", advance="no") "Event"
if (event%has_index ()) then
write (u, "(1x,'#',I0)") event%get_index ()
else
write (u, *)
end if
call write_separator (u, 2)
write (u, "(1x,A,1x,I0)") "count =", eio%count
if (present (passed)) then
write (u, "(1x,A,1x,L1)") "passed =", passed
else
write (u, "(1x,A)") "passed = [N/A]"
end if
write (u, "(1x,A,1x,I0)") "prc id =", i_prc
if (eio%weights) then
call write_separator (u)
if (event%sqme_ref_known) then
write (u, "(1x,A," // fmt // ")") "sqme (ref) = ", &
event%sqme_ref
else
write (u, "(1x,A)") "sqme (ref) = [undefined]"
end if
if (event%sqme_prc_known) then
write (u, "(1x,A," // fmt // ")") "sqme (prc) = ", &
event%sqme_prc
else
write (u, "(1x,A)") "sqme (prc) = [undefined]"
end if
if (event%weight_ref_known) then
write (u, "(1x,A," // fmt // ")") "weight (ref) = ", &
event%weight_ref
else
write (u, "(1x,A)") "weight (ref) = [undefined]"
end if
if (event%weight_prc_known) then
write (u, "(1x,A," // fmt // ")") "weight (prc) = ", &
event%weight_prc
else
write (u, "(1x,A)") "weight (prc) = [undefined]"
end if
if (event%excess_prc_known) then
write (u, "(1x,A," // fmt // ")") "excess (prc) = ", &
event%excess_prc
else
write (u, "(1x,A)") "excess (prc) = [undefined]"
end if
do i = 1, event%n_alt
if (event%sqme_ref_known) then
write (u, "(1x,A,I0,A," // fmt // ")") "sqme (", i, ") = ",&
event%sqme_prc
else
write (u, "(1x,A,I0,A)") "sqme (", i, ") = [undefined]"
end if
if (event%weight_prc_known) then
write (u, "(1x,A,I0,A," // fmt // ")") "weight (", i, ") = ",&
event%weight_prc
else
write (u, "(1x,A,I0,A)") "weight (", i, ") = [undefined]"
end if
end do
end if
call write_separator (u)
if (event%particle_set_is_valid) then
call event%particle_set%write (unit = u, &
summary = eio%summary, compressed = eio%compressed, &
testflag = eio%pacify)
else
write (u, "(1x,A)") "Particle set: [invalid]"
end if
end subroutine dump
end subroutine eio_dump_output
@ %def eio_dump_output
@ Input an event.
<<EIO dump: eio dump: TBP>>=
procedure :: input_i_prc => eio_dump_input_i_prc
procedure :: input_event => eio_dump_input_event
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_input_i_prc (eio, i_prc, iostat)
class(eio_dump_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_dump_input_i_prc
module subroutine eio_dump_input_event &
(eio, event, iostat, event_handle)
class(eio_dump_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_dump_input_event
<<EIO dump: procedures>>=
module subroutine eio_dump_input_i_prc (eio, i_prc, iostat)
class(eio_dump_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
call msg_bug ("Dump stream: event input not supported")
i_prc = 0
iostat = 1
end subroutine eio_dump_input_i_prc
module subroutine eio_dump_input_event &
(eio, event, iostat, event_handle)
class(eio_dump_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
call msg_bug ("Dump stream: event input not supported")
iostat = 1
end subroutine eio_dump_input_event
@ %def eio_dump_input_i_prc
@ %def eio_dump_input_event
@
<<EIO dump: eio dump: TBP>>=
procedure :: skip => eio_dump_skip
<<EIO dump: sub interfaces>>=
module subroutine eio_dump_skip (eio, iostat)
class(eio_dump_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_dump_skip
<<EIO dump: procedures>>=
module subroutine eio_dump_skip (eio, iostat)
class(eio_dump_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_dump_skip
@ %def eio_dump_skip
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_dump_ut.f90]]>>=
<<File header>>
module eio_dump_ut
use unit_tests
use eio_dump_uti
<<Standard module head>>
<<EIO dump: public test>>
contains
<<EIO dump: test driver>>
end module eio_dump_ut
@ %def eio_dump_ut
@
<<[[eio_dump_uti.f90]]>>=
<<File header>>
module eio_dump_uti
<<Use kinds>>
<<Use strings>>
use io_units
use event_base
use eio_data
use eio_base
use eio_dump
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
<<Standard module head>>
<<EIO dump: test declarations>>
contains
<<EIO dump: tests>>
end module eio_dump_uti
@ %def eio_dump_ut
@ API: driver for the unit tests below.
<<EIO dump: public test>>=
public :: eio_dump_test
<<EIO dump: test driver>>=
subroutine eio_dump_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO dump: execute tests>>
end subroutine eio_dump_test
@ %def eio_dump_test
@
\subsubsection{Test I/O methods}
We test the implementation of all I/O methods.
<<EIO dump: execute tests>>=
call test (eio_dump_1, "eio_dump_1", &
"write event contents", &
u, results)
<<EIO dump: test declarations>>=
public :: eio_dump_1
<<EIO dump: tests>>=
subroutine eio_dump_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
class(eio_t), allocatable :: eio
integer :: i_prc
integer :: u_file
write (u, "(A)") "* Test output: eio_dump_1"
write (u, "(A)") "* Purpose: generate events and write essentials to output"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
write (u, "(A)")
write (u, "(A)") "* Generate and write three events (two passed)"
write (u, "(A)")
allocate (eio_dump_t :: eio)
select type (eio)
type is (eio_dump_t)
call eio%set_parameters (unit = u, weights = .true., pacify = .true.)
end select
i_prc = 42
call eio%init_out (var_str (""))
call event%generate (1, [0._default, 0._default])
call eio%output (event, i_prc = i_prc)
call event%generate (1, [0.1_default, 0._default])
call event%set_index (99)
call eio%output (event, i_prc = i_prc, passed = .false.)
call event%generate (1, [0.2_default, 0._default])
call event%increment_index ()
call eio%output (event, i_prc = i_prc, passed = .true.)
write (u, "(A)")
write (u, "(A)") "* Contents of eio_dump object"
write (u, "(A)")
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
select type (eio)
type is (eio_dump_t)
eio%writing = .false.
end select
call eio%final ()
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_dump_1"
end subroutine eio_dump_1
@ %def eio_dump_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{ASCII File Formats}
Here, we implement several ASCII file formats. It is possible to
switch between them using flags.
<<[[eio_ascii.f90]]>>=
<<File header>>
module eio_ascii
<<Use strings>>
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO ascii: public>>
<<EIO ascii: types>>
interface
<<EIO ascii: sub interfaces>>
end interface
end module eio_ascii
@ %def eio_ascii
@
<<[[eio_ascii_sub.f90]]>>=
<<File header>>
submodule (eio_ascii) eio_ascii_s
use io_units
use diagnostics
use hep_common
use hep_events
implicit none
contains
<<EIO ascii: procedures>>
end submodule eio_ascii_s
@ %def eio_ascii_s
@
\subsection{Type}
<<EIO ascii: public>>=
public :: eio_ascii_t
<<EIO ascii: types>>=
type, abstract, extends (eio_t) :: eio_ascii_t
logical :: writing = .false.
integer :: unit = 0
logical :: keep_beams = .false.
logical :: keep_remnants = .true.
logical :: ensure_order = .false.
contains
<<EIO ascii: eio ascii: TBP>>
end type eio_ascii_t
@ %def eio_ascii_t
@
<<EIO ascii: public>>=
public :: eio_ascii_ascii_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_ascii_t
end type eio_ascii_ascii_t
@ %def eio_ascii_ascii_t
@
<<EIO ascii: public>>=
public :: eio_ascii_athena_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_athena_t
end type eio_ascii_athena_t
@ %def eio_ascii_athena_t
@ The debug format has a few options that can be controlled by
Sindarin variables.
<<EIO ascii: public>>=
public :: eio_ascii_debug_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_debug_t
logical :: show_process = .true.
logical :: show_transforms = .true.
logical :: show_decay = .true.
logical :: verbose = .true.
end type eio_ascii_debug_t
@ %def eio_ascii_debug_t
@
<<EIO ascii: public>>=
public :: eio_ascii_hepevt_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_hepevt_t
end type eio_ascii_hepevt_t
@ %def eio_ascii_hepevt_t
@
<<EIO ascii: public>>=
public :: eio_ascii_hepevt_verb_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_hepevt_verb_t
end type eio_ascii_hepevt_verb_t
@ %def eio_ascii_hepevt_verb_t
@
<<EIO ascii: public>>=
public :: eio_ascii_lha_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_lha_t
end type eio_ascii_lha_t
@ %def eio_ascii_lha_t
@
<<EIO ascii: public>>=
public :: eio_ascii_lha_verb_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_lha_verb_t
end type eio_ascii_lha_verb_t
@ %def eio_ascii_lha_verb_t
@
<<EIO ascii: public>>=
public :: eio_ascii_long_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_long_t
end type eio_ascii_long_t
@ %def eio_ascii_long_t
@
<<EIO ascii: public>>=
public :: eio_ascii_mokka_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_mokka_t
end type eio_ascii_mokka_t
@ %def eio_ascii_mokka_t
@
<<EIO ascii: public>>=
public :: eio_ascii_short_t
<<EIO ascii: types>>=
type, extends (eio_ascii_t) :: eio_ascii_short_t
end type eio_ascii_short_t
@ %def eio_ascii_short_t
@
\subsection{Specific Methods}
Set parameters that are specifically used with ASCII file formats. In
particular, this is the file extension.
<<EIO ascii: eio ascii: TBP>>=
procedure :: set_parameters => eio_ascii_set_parameters
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_set_parameters (eio, &
keep_beams, keep_remnants, ensure_order, extension, &
show_process, show_transforms, show_decay, verbose)
class(eio_ascii_t), intent(inout) :: eio
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
type(string_t), intent(in), optional :: extension
logical, intent(in), optional :: show_process, show_transforms, show_decay
logical, intent(in), optional :: verbose
end subroutine eio_ascii_set_parameters
<<EIO ascii: procedures>>=
module subroutine eio_ascii_set_parameters (eio, &
keep_beams, keep_remnants, ensure_order, extension, &
show_process, show_transforms, show_decay, verbose)
class(eio_ascii_t), intent(inout) :: eio
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
type(string_t), intent(in), optional :: extension
logical, intent(in), optional :: show_process, show_transforms, show_decay
logical, intent(in), optional :: verbose
if (present (keep_beams)) eio%keep_beams = keep_beams
if (present (keep_remnants)) eio%keep_remnants = keep_remnants
if (present (ensure_order)) eio%ensure_order = ensure_order
if (present (extension)) then
eio%extension = extension
else
select type (eio)
type is (eio_ascii_ascii_t)
eio%extension = "evt"
type is (eio_ascii_athena_t)
eio%extension = "athena.evt"
type is (eio_ascii_debug_t)
eio%extension = "debug"
type is (eio_ascii_hepevt_t)
eio%extension = "hepevt"
type is (eio_ascii_hepevt_verb_t)
eio%extension = "hepevt.verb"
type is (eio_ascii_lha_t)
eio%extension = "lha"
type is (eio_ascii_lha_verb_t)
eio%extension = "lha.verb"
type is (eio_ascii_long_t)
eio%extension = "long.evt"
type is (eio_ascii_mokka_t)
eio%extension = "mokka.evt"
type is (eio_ascii_short_t)
eio%extension = "short.evt"
end select
end if
select type (eio)
type is (eio_ascii_debug_t)
if (present (show_process)) eio%show_process = show_process
if (present (show_transforms)) eio%show_transforms = show_transforms
if (present (show_decay)) eio%show_decay = show_decay
if (present (verbose)) eio%verbose = verbose
end select
end subroutine eio_ascii_set_parameters
@ %def eio_ascii_set_parameters
@
\subsection{Common Methods}
Output. This is not the actual event format, but a readable account
of the current object status.
<<EIO ascii: eio ascii: TBP>>=
procedure :: write => eio_ascii_write
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_write (object, unit)
class(eio_ascii_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_ascii_write
<<EIO ascii: procedures>>=
module subroutine eio_ascii_write (object, unit)
class(eio_ascii_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
select type (object)
type is (eio_ascii_ascii_t)
write (u, "(1x,A)") "ASCII event stream (default format):"
type is (eio_ascii_athena_t)
write (u, "(1x,A)") "ASCII event stream (ATHENA format):"
type is (eio_ascii_debug_t)
write (u, "(1x,A)") "ASCII event stream (Debugging format):"
type is (eio_ascii_hepevt_t)
write (u, "(1x,A)") "ASCII event stream (HEPEVT format):"
type is (eio_ascii_hepevt_verb_t)
write (u, "(1x,A)") "ASCII event stream (verbose HEPEVT format):"
type is (eio_ascii_lha_t)
write (u, "(1x,A)") "ASCII event stream (LHA format):"
type is (eio_ascii_lha_verb_t)
write (u, "(1x,A)") "ASCII event stream (verbose LHA format):"
type is (eio_ascii_long_t)
write (u, "(1x,A)") "ASCII event stream (long format):"
type is (eio_ascii_mokka_t)
write (u, "(1x,A)") "ASCII event stream (MOKKA format):"
type is (eio_ascii_short_t)
write (u, "(1x,A)") "ASCII event stream (short format):"
end select
if (object%writing) then
write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
else
write (u, "(3x,A)") "[closed]"
end if
write (u, "(3x,A,L1)") "Keep beams = ", object%keep_beams
write (u, "(3x,A,L1)") "Keep remnants = ", object%keep_remnants
select type (object)
type is (eio_ascii_debug_t)
write (u, "(3x,A,L1)") "Show process = ", object%show_process
write (u, "(3x,A,L1)") "Show transforms = ", object%show_transforms
write (u, "(3x,A,L1)") "Show decay tree = ", object%show_decay
write (u, "(3x,A,L1)") "Verbose output = ", object%verbose
end select
end subroutine eio_ascii_write
@ %def eio_ascii_write
@ Finalizer: close any open file.
<<EIO ascii: eio ascii: TBP>>=
procedure :: final => eio_ascii_final
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_final (object)
class(eio_ascii_t), intent(inout) :: object
end subroutine eio_ascii_final
<<EIO ascii: procedures>>=
module subroutine eio_ascii_final (object)
class(eio_ascii_t), intent(inout) :: object
if (object%writing) then
write (msg_buffer, "(A,A,A)") "Events: closing ASCII file '", &
char (object%filename), "'"
call msg_message ()
close (object%unit)
object%writing = .false.
end if
end subroutine eio_ascii_final
@ %def eio_ascii_final
@ Initialize event writing.
Check weight normalization. This applies to all ASCII-type files that
use the HEPRUP common block. We can't allow normalization conventions
that are not covered by the HEPRUP definition.
<<EIO ascii: eio ascii: TBP>>=
procedure :: init_out => eio_ascii_init_out
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_init_out &
(eio, sample, data, success, extension)
class(eio_ascii_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_ascii_init_out
<<EIO ascii: procedures>>=
module subroutine eio_ascii_init_out &
(eio, sample, data, success, extension)
class(eio_ascii_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
logical :: is_width
integer :: i
if (.not. present (data)) &
call msg_bug ("ASCII initialization: missing data")
is_width = data%n_beam == 1
eio%sample = sample
call eio%check_normalization (data)
call eio%set_splitting (data)
call eio%set_filename ()
eio%unit = free_unit ()
write (msg_buffer, "(A,A,A)") "Events: writing to ASCII file '", &
char (eio%filename), "'"
call msg_message ()
eio%writing = .true.
open (eio%unit, file = char (eio%filename), &
action = "write", status = "replace")
select type (eio)
type is (eio_ascii_lha_t)
call heprup_init( &
data%pdg_beam, &
data%energy_beam, &
n_processes = data%n_proc, &
unweighted = data%unweighted, &
negative_weights = data%negative_weights)
do i = 1, data%n_proc
call heprup_set_process_parameters (i = i, &
process_id = data%proc_num_id(i), &
cross_section = data%cross_section(i), &
error = data%error(i), &
is_width = is_width)
end do
call heprup_write_ascii (eio%unit)
type is (eio_ascii_lha_verb_t)
call heprup_init( &
data%pdg_beam, &
data%energy_beam, &
n_processes = data%n_proc, &
unweighted = data%unweighted, &
negative_weights = data%negative_weights)
do i = 1, data%n_proc
call heprup_set_process_parameters (i = i, &
process_id = data%proc_num_id(i), &
cross_section = data%cross_section(i), &
error = data%error(i), &
is_width = is_width)
end do
call heprup_write_verbose (eio%unit)
end select
if (present (success)) success = .true.
end subroutine eio_ascii_init_out
@ %def eio_ascii_init_out
@ Some event properties do not go well with some output formats. In
particular, many formats require unweighted events.
<<EIO ascii: eio ascii: TBP>>=
procedure :: check_normalization => eio_ascii_check_normalization
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_check_normalization (eio, data)
class(eio_ascii_t), intent(in) :: eio
type(event_sample_data_t), intent(in) :: data
end subroutine eio_ascii_check_normalization
<<EIO ascii: procedures>>=
module subroutine eio_ascii_check_normalization (eio, data)
class(eio_ascii_t), intent(in) :: eio
type(event_sample_data_t), intent(in) :: data
if (data%unweighted) then
else
select type (eio)
type is (eio_ascii_athena_t); call msg_fatal &
("Event output (Athena format): events must be unweighted.")
type is (eio_ascii_hepevt_t); call msg_fatal &
("Event output (HEPEVT format): events must be unweighted.")
type is (eio_ascii_hepevt_verb_t); call msg_fatal &
("Event output (HEPEVT format): events must be unweighted.")
end select
select case (data%norm_mode)
case (NORM_SIGMA)
case default
select type (eio)
type is (eio_ascii_lha_t)
call msg_fatal &
("Event output (LHA): normalization for weighted events &
&must be 'sigma'")
type is (eio_ascii_lha_verb_t)
call msg_fatal &
("Event output (LHA): normalization for weighted events &
&must be 'sigma'")
end select
end select
end if
end subroutine eio_ascii_check_normalization
@ %def check_normalization
@ Initialize event reading.
<<EIO ascii: eio ascii: TBP>>=
procedure :: init_in => eio_ascii_init_in
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_init_in &
(eio, sample, data, success, extension)
class(eio_ascii_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_ascii_init_in
<<EIO ascii: procedures>>=
module subroutine eio_ascii_init_in &
(eio, sample, data, success, extension)
class(eio_ascii_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
call msg_bug ("ASCII: event input not supported")
if (present (success)) success = .false.
end subroutine eio_ascii_init_in
@ %def eio_ascii_init_in
@ Switch from input to output: reopen the file for reading.
<<EIO ascii: eio ascii: TBP>>=
procedure :: switch_inout => eio_ascii_switch_inout
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_switch_inout (eio, success)
class(eio_ascii_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_ascii_switch_inout
<<EIO ascii: procedures>>=
module subroutine eio_ascii_switch_inout (eio, success)
class(eio_ascii_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("ASCII: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_ascii_switch_inout
@ %def eio_ascii_switch_inout
@ Split event file: increment the counter, close the current file, open a new
one. If the file needs a header, repeat it for the new file. (We assume that
the common block contents are still intact.)
<<EIO ascii: eio ascii: TBP>>=
procedure :: split_out => eio_ascii_split_out
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_split_out (eio)
class(eio_ascii_t), intent(inout) :: eio
end subroutine eio_ascii_split_out
<<EIO ascii: procedures>>=
module subroutine eio_ascii_split_out (eio)
class(eio_ascii_t), intent(inout) :: eio
if (eio%split) then
eio%split_index = eio%split_index + 1
call eio%set_filename ()
write (msg_buffer, "(A,A,A)") "Events: writing to ASCII file '", &
char (eio%filename), "'"
call msg_message ()
close (eio%unit)
open (eio%unit, file = char (eio%filename), &
action = "write", status = "replace")
select type (eio)
type is (eio_ascii_lha_t)
call heprup_write_ascii (eio%unit)
type is (eio_ascii_lha_verb_t)
call heprup_write_verbose (eio%unit)
end select
end if
end subroutine eio_ascii_split_out
@ %def eio_ascii_split_out
@ Output an event. Write first the event indices, then weight and
squared matrix element, then the particle set.
Events that did not pass the selection are skipped. The exceptions are
the [[ascii]] and [[debug]] formats. These are the formats that
contain the [[passed]] flag in their output, and should be most useful
for debugging purposes.
<<EIO ascii: eio ascii: TBP>>=
procedure :: output => eio_ascii_output
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_ascii_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_ascii_output
<<EIO ascii: procedures>>=
module subroutine eio_ascii_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_ascii_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
if (present (passed)) then
if (.not. passed) then
select type (eio)
type is (eio_ascii_debug_t)
type is (eio_ascii_ascii_t)
class default
return
end select
end if
end if
if (eio%writing) then
select type (eio)
type is (eio_ascii_lha_t)
call hepeup_from_event (event, &
process_index = i_prc, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants)
call hepeup_write_lha (eio%unit)
type is (eio_ascii_lha_verb_t)
call hepeup_from_event (event, &
process_index = i_prc, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants)
call hepeup_write_verbose (eio%unit)
type is (eio_ascii_ascii_t)
call event%write (eio%unit, &
show_process = .false., &
show_transforms = .false., &
show_decay = .false., &
verbose = .false., testflag = pacify)
type is (eio_ascii_athena_t)
call hepevt_from_event (event, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order)
call hepevt_write_athena (eio%unit)
type is (eio_ascii_debug_t)
call event%write (eio%unit, &
show_process = eio%show_process, &
show_transforms = eio%show_transforms, &
show_decay = eio%show_decay, &
verbose = eio%verbose, &
testflag = pacify)
type is (eio_ascii_hepevt_t)
call hepevt_from_event (event, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order)
call hepevt_write_hepevt (eio%unit)
type is (eio_ascii_hepevt_verb_t)
call hepevt_from_event (event, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order)
call hepevt_write_verbose (eio%unit)
type is (eio_ascii_long_t)
call hepevt_from_event (event, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order)
call hepevt_write_ascii (eio%unit, .true.)
type is (eio_ascii_mokka_t)
call hepevt_from_event (event, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order)
call hepevt_write_mokka (eio%unit)
type is (eio_ascii_short_t)
call hepevt_from_event (event, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order)
call hepevt_write_ascii (eio%unit, .false.)
end select
else
call eio%write ()
call msg_fatal ("ASCII file is not open for writing")
end if
end subroutine eio_ascii_output
@ %def eio_ascii_output
@ Input an event.
<<EIO ascii: eio ascii: TBP>>=
procedure :: input_i_prc => eio_ascii_input_i_prc
procedure :: input_event => eio_ascii_input_event
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_input_i_prc (eio, i_prc, iostat)
class(eio_ascii_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_ascii_input_i_prc
module subroutine eio_ascii_input_event &
(eio, event, iostat, event_handle)
class(eio_ascii_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_ascii_input_event
<<EIO ascii: procedures>>=
module subroutine eio_ascii_input_i_prc (eio, i_prc, iostat)
class(eio_ascii_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
call msg_bug ("ASCII: event input not supported")
i_prc = 0
iostat = 1
end subroutine eio_ascii_input_i_prc
module subroutine eio_ascii_input_event &
(eio, event, iostat, event_handle)
class(eio_ascii_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
call msg_bug ("ASCII: event input not supported")
iostat = 1
end subroutine eio_ascii_input_event
@ %def eio_ascii_input_i_prc
@ %def eio_ascii_input_event
@
<<EIO ascii: eio ascii: TBP>>=
procedure :: skip => eio_ascii_skip
<<EIO ascii: sub interfaces>>=
module subroutine eio_ascii_skip (eio, iostat)
class(eio_ascii_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_ascii_skip
<<EIO ascii: procedures>>=
module subroutine eio_ascii_skip (eio, iostat)
class(eio_ascii_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_ascii_skip
@ %def eio_asciii_skip
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_ascii_ut.f90]]>>=
<<File header>>
module eio_ascii_ut
use unit_tests
use eio_ascii_uti
<<Standard module head>>
<<EIO ascii: public test>>
contains
<<EIO ascii: test driver>>
end module eio_ascii_ut
@ %def eio_ascii_ut
@
<<[[eio_ascii_uti.f90]]>>=
<<File header>>
module eio_ascii_uti
<<Use kinds>>
<<Use strings>>
use io_units
use lorentz
use model_data
use event_base
use particles
use eio_data
use eio_base
use eio_ascii
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
<<Standard module head>>
<<EIO ascii: test declarations>>
contains
<<EIO ascii: tests>>
end module eio_ascii_uti
@ %def eio_ascii_uti
@ API: driver for the unit tests below.
<<EIO ascii: public test>>=
public :: eio_ascii_test
<<EIO ascii: test driver>>=
subroutine eio_ascii_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO ascii: execute tests>>
end subroutine eio_ascii_test
@ %def eio_ascii_test
@
\subsubsection{Test I/O methods}
We test the implementation of all I/O methods, method [[ascii]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_1, "eio_ascii_1", &
"read and write event contents, format [ascii]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_1
<<EIO ascii: tests>>=
subroutine eio_ascii_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_1"
write (u, "(A)") "* Purpose: generate an event in ASCII ascii format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_1"
allocate (eio_ascii_ascii_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (42)
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".evt"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_ascii_t :: eio)
select type (eio)
type is (eio_ascii_ascii_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_1"
end subroutine eio_ascii_1
@ %def eio_ascii_1
@
We test the implementation of all I/O methods, method [[athena]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_2, "eio_ascii_2", &
"read and write event contents, format [athena]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_2
<<EIO ascii: tests>>=
subroutine eio_ascii_2 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_2"
write (u, "(A)") "* Purpose: generate an event in ASCII athena format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_2"
allocate (eio_ascii_athena_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (42)
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char(sample // ".athena.evt"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_athena_t :: eio)
select type (eio)
type is (eio_ascii_athena_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_2"
end subroutine eio_ascii_2
@ %def eio_ascii_2
@
We test the implementation of all I/O methods, method [[debug]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_3, "eio_ascii_3", &
"read and write event contents, format [debug]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_3
<<EIO ascii: tests>>=
subroutine eio_ascii_3 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_3"
write (u, "(A)") "* Purpose: generate an event in ASCII debug format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_3"
allocate (eio_ascii_debug_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".debug"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_debug_t :: eio)
select type (eio)
type is (eio_ascii_debug_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_3"
end subroutine eio_ascii_3
@ %def eio_ascii_3
@
We test the implementation of all I/O methods, method [[hepevt]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_4, "eio_ascii_4", &
"read and write event contents, format [hepevt]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_4
<<EIO ascii: tests>>=
subroutine eio_ascii_4 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_4"
write (u, "(A)") "* Purpose: generate an event in ASCII hepevt format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_4"
allocate (eio_ascii_hepevt_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".hepevt"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_hepevt_t :: eio)
select type (eio)
type is (eio_ascii_hepevt_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_4"
end subroutine eio_ascii_4
@ %def eio_ascii_4
@
We test the implementation of all I/O methods, method [[lha]] (old LHA):
<<EIO ascii: execute tests>>=
call test (eio_ascii_5, "eio_ascii_5", &
"read and write event contents, format [lha]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_5
<<EIO ascii: tests>>=
subroutine eio_ascii_5 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_5"
write (u, "(A)") "* Purpose: generate an event in ASCII LHA format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_5"
allocate (eio_ascii_lha_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".lha"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_lha_t :: eio)
select type (eio)
type is (eio_ascii_lha_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_5"
end subroutine eio_ascii_5
@ %def eio_ascii_5
@
We test the implementation of all I/O methods, method [[long]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_6, "eio_ascii_6", &
"read and write event contents, format [long]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_6
<<EIO ascii: tests>>=
subroutine eio_ascii_6 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_6"
write (u, "(A)") "* Purpose: generate an event in ASCII long format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_6"
allocate (eio_ascii_long_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".long.evt"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_long_t :: eio)
select type (eio)
type is (eio_ascii_long_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_6"
end subroutine eio_ascii_6
@ %def eio_ascii_6
@
We test the implementation of all I/O methods, method [[mokka]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_7, "eio_ascii_7", &
"read and write event contents, format [mokka]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_7
<<EIO ascii: tests>>=
subroutine eio_ascii_7 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_7"
write (u, "(A)") "* Purpose: generate an event in ASCII mokka format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_7"
allocate (eio_ascii_mokka_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".mokka.evt"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_mokka_t :: eio)
select type (eio)
type is (eio_ascii_mokka_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_7"
end subroutine eio_ascii_7
@ %def eio_ascii_7
@
We test the implementation of all I/O methods, method [[short]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_8, "eio_ascii_8", &
"read and write event contents, format [short]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_8
<<EIO ascii: tests>>=
subroutine eio_ascii_8 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_8"
write (u, "(A)") "* Purpose: generate an event in ASCII short format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_8"
allocate (eio_ascii_short_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".short.evt"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_short_t :: eio)
select type (eio)
type is (eio_ascii_short_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_8"
end subroutine eio_ascii_8
@ %def eio_ascii_8
@
We test the implementation of all I/O methods, method [[lha]] (old
LHA) in verbose version:
<<EIO ascii: execute tests>>=
call test (eio_ascii_9, "eio_ascii_9", &
"read and write event contents, format [lha_verb]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_9
<<EIO ascii: tests>>=
subroutine eio_ascii_9 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_9"
write (u, "(A)") "* Purpose: generate an event in ASCII LHA verbose format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_9"
allocate (eio_ascii_lha_verb_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".lha.verb"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_lha_verb_t :: eio)
select type (eio)
type is (eio_ascii_lha_verb_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_9"
end subroutine eio_ascii_9
@ %def eio_ascii_9
@
We test the implementation of all I/O methods, method [[hepevt_verb]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_10, "eio_ascii_10", &
"read and write event contents, format [hepevt_verb]", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_10
<<EIO ascii: tests>>=
subroutine eio_ascii_10 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_ascii_10"
write (u, "(A)") "* Purpose: generate an event in ASCII hepevt verbose format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_10"
allocate (eio_ascii_hepevt_verb_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".hepevt.verb"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_ascii_hepevt_verb_t :: eio)
select type (eio)
type is (eio_ascii_hepevt_verb_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_10"
end subroutine eio_ascii_10
@ %def eio_ascii_10
@
We test the implementation of all I/O methods, method [[mokka]]:
<<EIO ascii: execute tests>>=
call test (eio_ascii_11, "eio_ascii_11", &
"read and write event contents, format [mokka], tiny value", &
u, results)
<<EIO ascii: test declarations>>=
public :: eio_ascii_11
<<EIO ascii: tests>>=
subroutine eio_ascii_11 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(particle_set_t), pointer :: pset
type(vector4_t) :: pnew
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(128) :: buffer
real(default), parameter :: tval = 1.e-111_default
write (u, "(A)") "* Test output: eio_ascii_11"
write (u, "(A)") "* Purpose: generate an event in ASCII mokka format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)") "* with low-value cutoff"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_ascii_11"
allocate (eio_ascii_mokka_t :: eio)
select type (eio)
class is (eio_ascii_t); call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%increment_index ()
call event%evaluate_expressions ()
! Manipulate values in the event record
pset => event%get_particle_set_ptr ()
call pset%set_momentum (3, &
vector4_moving (-tval, vector3_moving ([-tval, -tval, -tval])), &
-tval**2)
call pset%set_momentum (4, &
vector4_moving (tval, vector3_moving ([tval, tval, tval])), &
tval**2)
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".mokka.evt"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_ascii_11"
end subroutine eio_ascii_11
@ %def eio_ascii_11
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{HEP Common Blocks}
Long ago, to transfer data between programs one had to set up a common
block and link both programs as libraries to the main executable. The
HEP community standardizes several of those common blocks.
The modern way of data exchange uses data files with standard
formats. However, the LHEF standard data format derives from a common
block (actually, two).
\whizard\ used to support those common blocks, and LHEF was
implemented via writing/reading blocks. We still keep this
convention, but intend to eliminate common blocks (or any other static
storage) from the workflow in the future. This will gain flexibility
towards concurrent running of program images.
We encapsulate everything here in a module. The module holds the
variables which are part of the common block. To access the common
block variables, we just have to [[use]] this module. (They are
nevertheless in the common block, since external software may access
it in this way.)
Note: This code is taken essentially unchanged from \whizard\ 2.1 and
does not (yet) provide unit tests.
<<[[hep_common.f90]]>>=
<<File header>>
module hep_common
<<Use kinds>>
use kinds, only: double
use constants
<<Use strings>>
<<Use debug>>
use lorentz
use polarizations
use model_data
use particles
<<Standard module head>>
<<HEP common: public>>
<<HEP common: interfaces>>
<<HEP common: parameters>>
<<HEP common: variables>>
<<HEP common: common blocks>>
interface
<<HEP common: sub interfaces>>
end interface
end module hep_common
@ %def hep_common
@
<<[[hep_common_sub.f90]]>>=
<<File header>>
submodule (hep_common) hep_common_s
use io_units
use diagnostics
use numeric_utils
use format_utils, only: refmt_tiny
use physics_defs, only: pb_per_fb
use physics_defs, only: HADRON_REMNANT
use physics_defs, only: HADRON_REMNANT_SINGLET
use physics_defs, only: HADRON_REMNANT_TRIPLET
use physics_defs, only: HADRON_REMNANT_OCTET
use xml
use flavors
use colors
use subevents, only: PRT_BEAM, PRT_INCOMING, PRT_OUTGOING
use subevents, only: PRT_UNDEFINED
use subevents, only: PRT_VIRTUAL, PRT_RESONANT, PRT_BEAM_REMNANT
implicit none
contains
<<HEP common: procedures>>
end submodule hep_common_s
@ %def hep_common_s
@
\subsection{Event characteristics}
The maximal number of particles in an event record.
<<HEP common: parameters>>=
integer, parameter, public :: MAXNUP = 500
@ %def MAXNUP
@ The number of particles in this event.
<<HEP common: variables>>=
integer, public :: NUP
@ %def NUP
@ The process ID for this event.
<<HEP common: variables>>=
integer, public :: IDPRUP
@ %def IDPRUP
@ The weight of this event ($\pm 1$ for unweighted events).
<<HEP common: variables>>=
double precision, public :: XWGTUP
@ %def XWGTUP
@ The factorization scale that is used for PDF calculation ($-1$ if
undefined).
<<HEP common: variables>>=
double precision, public :: SCALUP
@ %def SCALUP
@ The QED and QCD couplings $\alpha$ used for this event ($-1$ if
undefined).
<<HEP common: variables>>=
double precision, public :: AQEDUP
double precision, public :: AQCDUP
@ %def AQEDUP AQCDUP
@
\subsection{Particle characteristics}
The PDG code:
<<HEP common: variables>>=
integer, dimension(MAXNUP), public :: IDUP
@ %def IDUP
@ The status code. Incoming: $-1$, outgoing: $+1$. Intermediate
t-channel propagator: $-2$ (currently not used by WHIZARD).
Intermediate resonance whose mass should be preserved: $2$.
Intermediate resonance for documentation: $3$ (currently not used).
Beam particles: $-9$.
<<HEP common: variables>>=
integer, dimension(MAXNUP), public :: ISTUP
@ %def ISTUP
@ Index of first and last mother.
<<HEP common: variables>>=
integer, dimension(2,MAXNUP), public :: MOTHUP
@ %def MOTHUP
@ Color line index of the color and anticolor entry for the particle.
The standard recommends using large numbers; we start from MAXNUP+1.
<<HEP common: variables>>=
integer, dimension(2,MAXNUP), public :: ICOLUP
@ %def ICOLUP
@ Momentum, energy, and invariant mass: $(p_x,p_y,p_z,E,M)$. For
space-like particles, $M$ is the negative square root of the absolute
value of the invariant mass.
<<HEP common: variables>>=
double precision, dimension(5,MAXNUP), public :: PUP
@ %def PUP
@ Invariant lifetime (distance) from production to decay in mm.
<<HEP common: variables>>=
double precision, dimension(MAXNUP), public :: VTIMUP
@ %def VTIMUP
@ Cosine of the angle between the spin-vector and a particle and the
3-momentum of its mother, given in the lab frame. If
undefined/unpolarized: $9$.
<<HEP common: variables>>=
double precision, dimension(MAXNUP), public :: SPINUP
@ %def SPINUP
@
\subsection{The HEPRUP common block}
This common block is filled once per run.
\subsubsection{Run characteristics}
The maximal number of different processes.
<<HEP common: parameters>>=
integer, parameter, public :: MAXPUP = 100
@ %def MAXPUP
@ The beam PDG codes.
<<HEP common: variables>>=
integer, dimension(2), public :: IDBMUP
@ %def IDBMUP
@ The beam energies in GeV.
<<HEP common: variables>>=
double precision, dimension(2), public :: EBMUP
@ %def EBMUP
@ The PDF group and set for the two beams. (Undefined: use $-1$;
LHAPDF: use group = $0$).
<<HEP common: variables>>=
integer, dimension(2), public :: PDFGUP
integer, dimension(2), public :: PDFSUP
@ %def PDFGUP PDFSUP
@ The (re)weighting model. 1: events are weighted, the shower
generator (SHG) selects processes according to the maximum weight (in
pb) and unweights events. 2: events are weighted, the SHG selects
processes according to their cross section (in pb) and unweights
events. 3: events are unweighted and simply run through the SHG. 4:
events are weighted, and the SHG keeps the weight. Negative numbers:
negative weights are allowed (and are reweighted to $\pm 1$ by the
SHG, if allowed).
\whizard\ only supports modes 3 and 4, as the SHG is not given control
over process selection. This is consistent with writing events to
file, for offline showering.
<<HEP common: variables>>=
integer, public :: IDWTUP
@ %def IDWTUP
@ The number of different processes.
<<HEP common: variables>>=
integer, public :: NPRUP
@ %def NPRUP
@
\subsubsection{Process characteristics}
Cross section and error in pb. (Cross section is needed only for
$[[IDWTUP]] = 2$, so here both values are given for informational
purposes only.)
<<HEP common: variables>>=
double precision, dimension(MAXPUP), public :: XSECUP
double precision, dimension(MAXPUP), public :: XERRUP
@ %def XSECUP XERRUP
@ Maximum weight, i.e., the maximum value that [[XWGTUP]] can take.
Also unused for the supported weighting models. It is $\pm 1$ for
unweighted events.
<<HEP common: variables>>=
double precision, dimension(MAXPUP), public :: XMAXUP
@ %def XMAXUP
@ Internal ID of the selected process, matches [[IDPRUP]] below.
<<HEP common: variables>>=
integer, dimension(MAXPUP), public :: LPRUP
@ %def LPRUP
@
\subsubsection{The common block}
<<HEP common: common blocks>>=
common /HEPRUP/ &
IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP, &
XSECUP, XERRUP, XMAXUP, LPRUP
save /HEPRUP/
@ %def HEPRUP
@ Fill the run characteristics of the common block. The
initialization sets the beam properties, number of processes, and
weighting model.
<<HEP common: public>>=
public :: heprup_init
<<HEP common: sub interfaces>>=
module subroutine heprup_init &
(beam_pdg, beam_energy, n_processes, unweighted, negative_weights)
integer, dimension(2), intent(in) :: beam_pdg
real(default), dimension(2), intent(in) :: beam_energy
integer, intent(in) :: n_processes
logical, intent(in) :: unweighted
logical, intent(in) :: negative_weights
end subroutine heprup_init
<<HEP common: procedures>>=
module subroutine heprup_init &
(beam_pdg, beam_energy, n_processes, unweighted, negative_weights)
integer, dimension(2), intent(in) :: beam_pdg
real(default), dimension(2), intent(in) :: beam_energy
integer, intent(in) :: n_processes
logical, intent(in) :: unweighted
logical, intent(in) :: negative_weights
IDBMUP = beam_pdg
EBMUP = beam_energy
PDFGUP = -1
PDFSUP = -1
if (unweighted) then
IDWTUP = 3
else
IDWTUP = 4
end if
if (negative_weights) IDWTUP = - IDWTUP
NPRUP = n_processes
end subroutine heprup_init
@ %def heprup_init
The HEPRUP (event) common block is needed for the interface to the shower.
Filling of it is triggered by some output file formats. If these are not
present, the common block is filled with some dummy information. Be generous
with the number of processes in HEPRUP so that PYTHIA only rarely needs to be
reinitialized in case events with higher process ids are generated.
<<HEP common: public>>=
public :: assure_heprup
<<HEP common: sub interfaces>>=
module subroutine assure_heprup (pset)
type(particle_set_t), intent(in) :: pset
end subroutine assure_heprup
<<HEP common: procedures>>=
module subroutine assure_heprup (pset)
type(particle_set_t), intent(in) :: pset
integer :: i, num_id
integer, parameter :: min_processes = 10
num_id = 1
if (LPRUP (num_id) /= 0) return
call heprup_init ( &
[pset%prt(1)%get_pdg (), pset%prt(2)%get_pdg ()] , &
[pset%prt(1)%p%p(0), pset%prt(2)%p%p(0)], &
num_id, .false., .false.)
do i = 1, (num_id / min_processes + 1) * min_processes
call heprup_set_process_parameters (i = i, process_id = &
i, cross_section = 1._default, error = 1._default)
end do
end subroutine assure_heprup
@ %def assure_heprup
@ Read in the LHE file opened in unit [[u]] and add the final
particles to the [[particle_set]], the outgoing particles of the existing
[[particle_set]] are compared to the particles that are read in. When
they are equal in flavor and momenta, they are erased and their
mother-daughter relations are transferred to the existing particles.
<<HEP common: public>>=
public :: combine_lhef_with_particle_set
<<HEP common: sub interfaces>>=
module subroutine combine_lhef_with_particle_set &
(particle_set, u, model_in, model_hadrons)
type(particle_set_t), intent(inout) :: particle_set
integer, intent(in) :: u
class(model_data_t), intent(in), target :: model_in
class(model_data_t), intent(in), target :: model_hadrons
end subroutine combine_lhef_with_particle_set
<<HEP common: procedures>>=
module subroutine combine_lhef_with_particle_set &
(particle_set, u, model_in, model_hadrons)
type(particle_set_t), intent(inout) :: particle_set
integer, intent(in) :: u
class(model_data_t), intent(in), target :: model_in
class(model_data_t), intent(in), target :: model_hadrons
type(flavor_t) :: flv
type(color_t) :: col
class(model_data_t), pointer :: model
type(particle_t), dimension(:), allocatable :: prt_tmp, prt
integer :: i, j
type(vector4_t) :: mom, d_mom
integer, PARAMETER :: MAXLEN=200
character(len=maxlen) :: string
integer :: ibeg, n_tot, n_entries
integer, dimension(:), allocatable :: relations, mothers, tbd
INTEGER :: NUP,IDPRUP,IDUP,ISTUP
real(kind=double) :: XWGTUP,SCALUP,AQEDUP,AQCDUP,VTIMUP,SPINUP
integer :: MOTHUP(1:2), ICOLUP(1:2)
real(kind=double) :: PUP(1:5)
real(kind=default) :: pup_dum(1:5)
character(len=5) :: buffer
character(len=6) :: strfmt
logical :: not_found
logical :: debug_lhef = .false.
STRFMT='(A000)'
WRITE (STRFMT(3:5),'(I3)') MAXLEN
if (debug_lhef) call particle_set%write ()
rewind (u)
do
read (u,*, END=501, ERR=502) STRING
IBEG = 0
do
if (signal_is_pending ()) return
IBEG = IBEG + 1
! Allow indentation.
IF (STRING (IBEG:IBEG) .EQ. ' ' .and. IBEG < MAXLEN-6) cycle
exit
end do
IF (string(IBEG:IBEG+6) /= '<event>' .and. &
string(IBEG:IBEG+6) /= '<event ') cycle
exit
end do
!!! Read first line of event info -> number of entries
read (u, *, END=503, ERR=504) NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
n_tot = particle_set%get_n_tot ()
allocate (prt_tmp (1:n_tot+NUP))
allocate (relations (1:NUP), mothers (1:NUP), tbd(1:NUP))
do i = 1, n_tot
if (signal_is_pending ()) return
prt_tmp (i) = particle_set%get_particle (i)
end do
!!! transfer particles from lhef to particle_set
!!!...Read NUP subsequent lines with information on each particle.
n_entries = 1
mothers = 0
relations = 0
PARTICLE_LOOP: do I = 1, NUP
read (u,*, END=200, ERR=505) IDUP, ISTUP, MOTHUP(1), MOTHUP(2), &
ICOLUP(1), ICOLUP(2), (PUP (J),J=1,5), VTIMUP, SPINUP
if (model_in%test_field (IDUP)) then
model => model_in
else if (model_hadrons%test_field (IDUP)) then
model => model_hadrons
else
write (buffer, "(I5)") IDUP
call msg_error ("Parton " // buffer // &
" found neither in given model file nor in SM_hadrons")
return
end if
if (debug_lhef) then
print *, "IDUP, ISTUP, MOTHUP, PUP = ", IDUP, ISTUP, MOTHUP(1), &
MOTHUP(2), PUP
end if
call flv%init (IDUP, model)
if (IABS(IDUP) == 2212 .or. IABS(IDUP) == 2112) then
! PYTHIA sometimes sets color indices for protons and neutrons (?)
ICOLUP (1) = 0
ICOLUP (2) = 0
end if
call col%init_col_acl (ICOLUP (1), ICOLUP (2))
!!! Settings for unpolarized particles
! particle_set%prt (oldsize+i)%hel = ??
! particle_set%prt (oldsize+i)%pol = ??
if (MOTHUP(1) /= 0) then
mothers(i) = MOTHUP(1)
end if
pup_dum = PUP
if (pup_dum(4) < 1E-10_default) cycle
mom = vector4_moving (pup_dum (4), &
vector3_moving ([pup_dum (1), pup_dum (2), pup_dum (3)]))
not_found = .true.
SCAN_PARTICLES: do j = 1, n_tot
d_mom = prt_tmp(j)%get_momentum ()
if (all (nearly_equal &
(mom%p, d_mom%p, abs_smallness = 1.E-4_default)) .and. &
(prt_tmp(j)%get_pdg () == IDUP)) then
if (.not. prt_tmp(j)%get_status () == PRT_BEAM .or. &
.not. prt_tmp(j)%get_status () == PRT_BEAM_REMNANT) &
relations(i) = j
not_found = .false.
end if
end do SCAN_PARTICLES
if (not_found) then
if (debug_lhef) &
print *, "Not found: adding particle"
call prt_tmp(n_tot+n_entries)%set_flavor (flv)
call prt_tmp(n_tot+n_entries)%set_color (col)
call prt_tmp(n_tot+n_entries)%set_momentum (mom)
if (MOTHUP(1) /= 0) then
if (relations(MOTHUP(1)) /= 0) then
call prt_tmp(n_tot+n_entries)%set_parents &
([relations(MOTHUP(1))])
call prt_tmp(relations(MOTHUP(1)))%add_child (n_tot+n_entries)
if (prt_tmp(relations(MOTHUP(1)))%get_status () &
== PRT_OUTGOING) &
call prt_tmp(relations(MOTHUP(1)))%reset_status &
(PRT_VIRTUAL)
end if
end if
call prt_tmp(n_tot+n_entries)%set_status (PRT_OUTGOING)
if (debug_lhef) call prt_tmp(n_tot+n_entries)%write ()
n_entries = n_entries + 1
end if
end do PARTICLE_LOOP
do i = 1, n_tot
if (prt_tmp(i)%get_status () == PRT_OUTGOING .and. &
prt_tmp(i)%get_n_children () /= 0) then
call prt_tmp(i)%reset_status (PRT_VIRTUAL)
end if
end do
allocate (prt (1:n_tot+n_entries-1))
prt = prt_tmp (1:n_tot+n_entries-1)
! transfer to particle_set
call particle_set%replace (prt)
deallocate (prt, prt_tmp)
if (debug_lhef) then
call particle_set%write ()
print *, "combine_lhef_with_particle_set"
! stop
end if
200 continue
return
501 write(*,*) "READING LHEF failed 501"
return
502 write(*,*) "READING LHEF failed 502"
return
503 write(*,*) "READING LHEF failed 503"
return
504 write(*,*) "READING LHEF failed 504"
return
505 write(*,*) "READING LHEF failed 505"
return
end subroutine combine_lhef_with_particle_set
@ %def combine_lhef_with_particle_set
@
<<HEP common: public>>=
public :: w2p_write_lhef_event
<<HEP common: sub interfaces>>=
module subroutine w2p_write_lhef_event (unit)
integer, intent(in) :: unit
end subroutine w2p_write_lhef_event
<<HEP common: procedures>>=
module subroutine w2p_write_lhef_event (unit)
integer, intent(in) :: unit
type(xml_tag_t), allocatable :: tag_lhef, tag_head, tag_init, &
tag_event, tag_gen_n, tag_gen_v
if (debug_on) call msg_debug (D_EVENTS, "w2p_write_lhef_event")
allocate (tag_lhef, tag_head, tag_init, tag_event, &
tag_gen_n, tag_gen_v)
call tag_lhef%init (var_str ("LesHouchesEvents"), &
[xml_attribute (var_str ("version"), var_str ("1.0"))], .true.)
call tag_head%init (var_str ("header"), .true.)
call tag_init%init (var_str ("init"), .true.)
call tag_event%init (var_str ("event"), .true.)
call tag_gen_n%init (var_str ("generator_name"), .true.)
call tag_gen_v%init (var_str ("generator_version"), .true.)
call tag_lhef%write (unit); write (unit, *)
call tag_head%write (unit); write (unit, *)
write (unit, "(2x)", advance = "no")
call tag_gen_n%write (var_str ("WHIZARD"), unit)
write (unit, *)
write (unit, "(2x)", advance = "no")
call tag_gen_v%write (var_str ("<<Version>>"), unit)
write (unit, *)
call tag_head%close (unit); write (unit, *)
call tag_init%write (unit); write (unit, *)
call heprup_write_lhef (unit)
call tag_init%close (unit); write (unit, *)
call tag_event%write (unit); write (unit, *)
call hepeup_write_lhef (unit)
call tag_event%close (unit); write (unit, *)
call tag_lhef%close (unit); write (unit, *)
deallocate (tag_lhef, tag_head, tag_init, tag_event, &
tag_gen_n, tag_gen_v)
end subroutine w2p_write_lhef_event
@ %def w2p_write_lhef_event
@ Extract parameters from the common block. We leave it to the caller
to specify which parameters it actually needs.
[[PDFGUP]] and [[PDFSUP]] are not extracted. [[IDWTUP=1,2]] are not
supported by \whizard, but correspond to weighted events.
<<HEP common: public>>=
public :: heprup_get_run_parameters
<<HEP common: sub interfaces>>=
module subroutine heprup_get_run_parameters &
(beam_pdg, beam_energy, n_processes, unweighted, negative_weights)
integer, dimension(2), intent(out), optional :: beam_pdg
real(default), dimension(2), intent(out), optional :: beam_energy
integer, intent(out), optional :: n_processes
logical, intent(out), optional :: unweighted
logical, intent(out), optional :: negative_weights
end subroutine heprup_get_run_parameters
<<HEP common: procedures>>=
module subroutine heprup_get_run_parameters &
(beam_pdg, beam_energy, n_processes, unweighted, negative_weights)
integer, dimension(2), intent(out), optional :: beam_pdg
real(default), dimension(2), intent(out), optional :: beam_energy
integer, intent(out), optional :: n_processes
logical, intent(out), optional :: unweighted
logical, intent(out), optional :: negative_weights
if (present (beam_pdg)) beam_pdg = IDBMUP
if (present (beam_energy)) beam_energy = EBMUP
if (present (n_processes)) n_processes = NPRUP
if (present (unweighted)) then
select case (abs (IDWTUP))
case (3)
unweighted = .true.
case (4)
unweighted = .false.
case (1,2) !!! not supported by WHIZARD
unweighted = .false.
case default
call msg_fatal ("HEPRUP: unsupported IDWTUP value")
end select
end if
if (present (negative_weights)) then
negative_weights = IDWTUP < 0
end if
end subroutine heprup_get_run_parameters
@ %def heprup_get_run_parameters
@ Specify PDF set info. Since we support only LHAPDF, the group entry
is zero.
<<HEP common: public>>=
public :: heprup_set_lhapdf_id
<<HEP common: sub interfaces>>=
module subroutine heprup_set_lhapdf_id (i_beam, pdf_id)
integer, intent(in) :: i_beam, pdf_id
end subroutine heprup_set_lhapdf_id
<<HEP common: procedures>>=
module subroutine heprup_set_lhapdf_id (i_beam, pdf_id)
integer, intent(in) :: i_beam, pdf_id
PDFGUP(i_beam) = 0
PDFSUP(i_beam) = pdf_id
end subroutine heprup_set_lhapdf_id
@ %def heprup_set_lhapdf_id
@ Fill the characteristics for a particular process. Only the process
ID is mandatory. Note that \whizard\ computes cross sections in fb,
so we have to rescale to pb. The maximum weight is meaningless for
unweighted events.
<<HEP common: public>>=
public :: heprup_set_process_parameters
<<HEP common: sub interfaces>>=
module subroutine heprup_set_process_parameters &
(i, process_id, cross_section, error, max_weight, is_width)
integer, intent(in) :: i, process_id
real(default), intent(in), optional :: cross_section, error, max_weight
logical, intent(in), optional :: is_width
end subroutine heprup_set_process_parameters
<<HEP common: procedures>>=
module subroutine heprup_set_process_parameters &
(i, process_id, cross_section, error, max_weight, is_width)
integer, intent(in) :: i, process_id
real(default), intent(in), optional :: cross_section, error, max_weight
logical, intent(in), optional :: is_width
logical :: is_w
is_w = .false.
if (present (is_width)) is_w = is_width
LPRUP(i) = process_id
if (present (cross_section)) then
if (is_w) then
XSECUP(i) = cross_section
else
XSECUP(i) = cross_section * pb_per_fb
end if
else
XSECUP(i) = 0
end if
if (present (error)) then
if (is_w) then
XERRUP(i) = error
else
XERRUP(i) = error * pb_per_fb
end if
else
XERRUP(i) = 0
end if
select case (IDWTUP)
case (3); XMAXUP(i) = 1
case (4)
if (present (max_weight)) then
if (is_w) then
XMAXUP(i) = max_weight
else
XMAXUP(i) = max_weight * pb_per_fb
end if
else
XMAXUP(i) = 0
end if
end select
end subroutine heprup_set_process_parameters
@ %def heprup_set_process_parameters
@ Extract the process parameters, as far as needed.
<<HEP common: public>>=
public :: heprup_get_process_parameters
<<HEP common: sub interfaces>>=
module subroutine heprup_get_process_parameters &
(i, process_id, cross_section, error, max_weight, is_width)
integer, intent(in) :: i
integer, intent(out), optional :: process_id
real(default), intent(out), optional :: cross_section, error, max_weight
logical, intent(in), optional :: is_width
end subroutine heprup_get_process_parameters
<<HEP common: procedures>>=
module subroutine heprup_get_process_parameters &
(i, process_id, cross_section, error, max_weight, is_width)
integer, intent(in) :: i
integer, intent(out), optional :: process_id
real(default), intent(out), optional :: cross_section, error, max_weight
logical, intent(in), optional :: is_width
logical :: is_w
is_w = .false.
if (present (is_width)) is_w = is_width
if (present (process_id)) process_id = LPRUP(i)
if (present (cross_section)) then
if (is_w) then
cross_section = XSECUP(i)
else
cross_section = XSECUP(i) / pb_per_fb
end if
end if
if (present (error)) then
if (is_w) then
error = XERRUP(i)
else
error = XERRUP(i) / pb_per_fb
end if
end if
if (present (max_weight)) then
select case (IDWTUP)
case (3)
max_weight = 1
case (4)
max_weight = XMAXUP(i) / pb_per_fb
case (1,2) !!! not supported by WHIZARD
max_weight = 0
case default
call msg_fatal ("HEPRUP: unsupported IDWTUP value")
end select
end if
end subroutine heprup_get_process_parameters
@ %def heprup_get_process_parameters
@
\subsection{Run parameter output (verbose)}
This is a verbose output of the HEPRUP block.
<<HEP common: public>>=
public :: heprup_write_verbose
<<HEP common: sub interfaces>>=
module subroutine heprup_write_verbose (unit)
integer, intent(in), optional :: unit
end subroutine heprup_write_verbose
<<HEP common: procedures>>=
module subroutine heprup_write_verbose (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(A)") "HEPRUP Common Block"
write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)") "IDBMUP", IDBMUP, &
"PDG code of beams"
write (u, "(3x,A6,' = ',G12.5,1x,G12.5,8x,A)") "EBMUP ", EBMUP, &
"Energy of beams in GeV"
write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)") "PDFGUP", PDFGUP, &
"PDF author group [-1 = undefined]"
write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)") "PDFSUP", PDFSUP, &
"PDF set ID [-1 = undefined]"
write (u, "(3x,A6,' = ',I9,3x,1x,9x,3x,8x,A)") "IDWTUP", IDWTUP, &
"LHA code for event weight mode"
write (u, "(3x,A6,' = ',I9,3x,1x,9x,3x,8x,A)") "NPRUP ", NPRUP, &
"Number of user subprocesses"
do i = 1, NPRUP
write (u, "(1x,A,I0)") "Subprocess #", i
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "XSECUP", XSECUP(i), &
"Cross section in pb"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "XERRUP", XERRUP(i), &
"Cross section error in pb"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "XMAXUP", XMAXUP(i), &
"Maximum event weight (cf. IDWTUP)"
write (u, "(3x,A6,' = ',I9,3x,1x,12x,8x,A)") "LPRUP ", LPRUP(i), &
"Subprocess ID"
end do
end subroutine heprup_write_verbose
@ %def heprup_write_verbose
@
\subsection{Run parameter output (other formats)}
This routine writes the initialization block according to the LHEF
standard. It uses the current contents of the HEPRUP block.
<<HEP common: public>>=
public :: heprup_write_lhef
<<HEP common: sub interfaces>>=
module subroutine heprup_write_lhef (unit)
integer, intent(in), optional :: unit
end subroutine heprup_write_lhef
<<HEP common: procedures>>=
module subroutine heprup_write_lhef (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(2(1x,I0),2(1x,ES17.10),6(1x,I0))") &
IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP
do i = 1, NPRUP
write (u, "(3(1x,ES17.10),1x,I0)") &
XSECUP(i), XERRUP(i), XMAXUP(i), LPRUP(i)
end do
end subroutine heprup_write_lhef
@ %def heprup_write_lhef
@
This routine is a complete dummy at the moment. It uses the current
contents of the HEPRUP block. At the end, it should depend on certain
input flags for the different ASCII event formats.
<<HEP common: public>>=
public :: heprup_write_ascii
<<HEP common: sub interfaces>>=
module subroutine heprup_write_ascii (unit)
integer, intent(in), optional :: unit
end subroutine heprup_write_ascii
<<HEP common: procedures>>=
module subroutine heprup_write_ascii (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(2(1x,I0),2(1x,ES17.10),6(1x,I0))") &
IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP
do i = 1, NPRUP
write (u, "(3(1x,ES17.10),1x,I0)") &
XSECUP(i), XERRUP(i), XMAXUP(i), LPRUP(i)
end do
end subroutine heprup_write_ascii
@ %def heprup_write_ascii
@
\subsubsection{Run parameter input (LHEF)}
In a LHEF file, the parameters are written in correct order on
separate lines, but we should not count on the precise format.
List-directed input should just work.
<<HEP common: public>>=
public :: heprup_read_lhef
<<HEP common: sub interfaces>>=
module subroutine heprup_read_lhef (u)
integer, intent(in) :: u
end subroutine heprup_read_lhef
<<HEP common: procedures>>=
module subroutine heprup_read_lhef (u)
integer, intent(in) :: u
integer :: i
read (u, *) &
IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP
do i = 1, NPRUP
read (u, *) &
XSECUP(i), XERRUP(i), XMAXUP(i), LPRUP(i)
end do
end subroutine heprup_read_lhef
@ %def heprup_read_lhef
@
\subsection{The HEPEUP common block}
<<HEP common: common blocks>>=
common /HEPEUP/ &
NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP, &
IDUP, ISTUP, MOTHUP, ICOLUP, PUP, VTIMUP, SPINUP
save /HEPEUP/
@ %def HEPEUP
@
\subsubsection{Initialization}
Fill the event characteristics of the common block. The
initialization sets only the number of particles and initializes the
rest with default values. The other routine sets the optional
parameters.
<<HEP common: public>>=
public :: hepeup_init
public :: hepeup_set_event_parameters
<<HEP common: sub interfaces>>=
module subroutine hepeup_init (n_tot)
integer, intent(in) :: n_tot
end subroutine hepeup_init
module subroutine hepeup_set_event_parameters &
(proc_id, weight, scale, alpha_qed, alpha_qcd)
integer, intent(in), optional :: proc_id
real(default), intent(in), optional :: &
weight, scale, alpha_qed, alpha_qcd
end subroutine hepeup_set_event_parameters
<<HEP common: procedures>>=
module subroutine hepeup_init (n_tot)
integer, intent(in) :: n_tot
NUP = n_tot
IDPRUP = 0
XWGTUP = 1
SCALUP = -1
AQEDUP = -1
AQCDUP = -1
end subroutine hepeup_init
module subroutine hepeup_set_event_parameters &
(proc_id, weight, scale, alpha_qed, alpha_qcd)
integer, intent(in), optional :: proc_id
real(default), intent(in), optional :: &
weight, scale, alpha_qed, alpha_qcd
if (present (proc_id)) IDPRUP = proc_id
if (present (weight)) XWGTUP = weight
if (present (scale)) SCALUP = scale
if (present (alpha_qed)) AQEDUP = alpha_qed
if (present (alpha_qcd)) AQCDUP = alpha_qcd
end subroutine hepeup_set_event_parameters
@ %def hepeup_init hepeup_set_event_parameters
@ Extract event information. The caller determines the parameters.
<<HEP common: public>>=
public :: hepeup_get_event_parameters
<<HEP common: sub interfaces>>=
module subroutine hepeup_get_event_parameters &
(proc_id, weight, scale, alpha_qed, alpha_qcd)
integer, intent(out), optional :: proc_id
real(default), intent(out), optional :: &
weight, scale, alpha_qed, alpha_qcd
end subroutine hepeup_get_event_parameters
<<HEP common: procedures>>=
module subroutine hepeup_get_event_parameters &
(proc_id, weight, scale, alpha_qed, alpha_qcd)
integer, intent(out), optional :: proc_id
real(default), intent(out), optional :: &
weight, scale, alpha_qed, alpha_qcd
if (present (proc_id)) proc_id = IDPRUP
if (present (weight)) weight = XWGTUP
if (present (scale)) scale = SCALUP
if (present (alpha_qed)) alpha_qed = AQEDUP
if (present (alpha_qcd)) alpha_qcd = AQCDUP
end subroutine hepeup_get_event_parameters
@ %def hepeup_get_event_parameters
@
\subsubsection{Particle data}
Below we need the particle status codes which are actually defined
in the [[subevents]] module.
Set the entry for a specific particle. All parameters are set with
the exception of lifetime and spin, where default values are stored.
<<HEP common: public>>=
public :: hepeup_set_particle
<<HEP common: sub interfaces>>=
module subroutine hepeup_set_particle (i, pdg, status, parent, col, p, m2)
integer, intent(in) :: i
integer, intent(in) :: pdg, status
integer, dimension(:), intent(in) :: parent
type(vector4_t), intent(in) :: p
integer, dimension(2), intent(in) :: col
real(default), intent(in) :: m2
end subroutine hepeup_set_particle
<<HEP common: procedures>>=
module subroutine hepeup_set_particle (i, pdg, status, parent, col, p, m2)
integer, intent(in) :: i
integer, intent(in) :: pdg, status
integer, dimension(:), intent(in) :: parent
type(vector4_t), intent(in) :: p
integer, dimension(2), intent(in) :: col
real(default), intent(in) :: m2
if (i > MAXNUP) then
call msg_error (arr=[ &
var_str ("Too many particles in HEPEUP common block. " // &
"If this happened "), &
var_str ("during event output, your events will be " // &
"invalid; please consider "), &
var_str ("switching to a modern event format like HEPMC. " // &
"If you are not "), &
var_str ("using an old, HEPEUP based format and " // &
"nevertheless get this error,"), &
var_str ("please notify the WHIZARD developers,") ])
return
end if
IDUP(i) = pdg
select case (status)
case (PRT_BEAM); ISTUP(i) = -9
case (PRT_INCOMING); ISTUP(i) = -1
case (PRT_BEAM_REMNANT); ISTUP(i) = 3
case (PRT_OUTGOING); ISTUP(i) = 1
case (PRT_RESONANT); ISTUP(i) = 2
case (PRT_VIRTUAL); ISTUP(i) = 3
case default; ISTUP(i) = 0
end select
select case (size (parent))
case (0); MOTHUP(:,i) = 0
case (1); MOTHUP(1,i) = parent(1); MOTHUP(2,i) = 0
case default; MOTHUP(:,i) = [ parent(1), parent(size (parent)) ]
end select
if (col(1) > 0) then
ICOLUP(1,i) = 500 + col(1)
else
ICOLUP(1,i) = 0
end if
if (col(2) > 0) then
ICOLUP(2,i) = 500 + col(2)
else
ICOLUP(2,i) = 0
end if
PUP(1:3,i) = refmt_tiny (vector3_get_components (space_part (p)))
PUP(4,i) = refmt_tiny (energy (p))
PUP(5,i) = refmt_tiny (sign (sqrt (abs (m2)), m2))
VTIMUP(i) = 0
SPINUP(i) = 9
end subroutine hepeup_set_particle
@ %def hepeup_set_particle
@ Set the lifetime, actually $c\tau$ measured im mm, where $\tau$ is
the invariant lifetime.
<<HEP common: public>>=
public :: hepeup_set_particle_lifetime
<<HEP common: sub interfaces>>=
module subroutine hepeup_set_particle_lifetime (i, lifetime)
integer, intent(in) :: i
real(default), intent(in) :: lifetime
end subroutine hepeup_set_particle_lifetime
<<HEP common: procedures>>=
module subroutine hepeup_set_particle_lifetime (i, lifetime)
integer, intent(in) :: i
real(default), intent(in) :: lifetime
VTIMUP(i) = lifetime
end subroutine hepeup_set_particle_lifetime
@ %def hepeup_set_particle_lifetime
@ Set the particle spin entry. We need the cosine of the angle of the
spin axis with respect to the three-momentum of the parent particle.
If the particle has a full polarization density matrix given, we need
the particle momentum and polarization as well as the mother-particle
momentum. The polarization is transformed into a spin vector (which
is sensible only for spin-1/2 or massless particles), which then is
transformed into the lab frame (by a rotation of the 3-axis to the
particle momentum axis). Finally, we compute the scalar product of
this vector with the mother-particle three-momentum.
This puts severe restrictions on the applicability of this definition,
and Lorentz invariance is lost. Unfortunately, the Les Houches Accord
requires this computation.
<<HEP common: public>>=
public :: hepeup_set_particle_spin
<<HEP common: interfaces>>=
interface hepeup_set_particle_spin
module procedure hepeup_set_particle_spin_pol
end interface
<<HEP common: sub interfaces>>=
module subroutine hepeup_set_particle_spin_pol (i, p, pol, p_mother)
integer, intent(in) :: i
type(vector4_t), intent(in) :: p
type(polarization_t), intent(in) :: pol
type(vector4_t), intent(in) :: p_mother
end subroutine hepeup_set_particle_spin_pol
<<HEP common: procedures>>=
module subroutine hepeup_set_particle_spin_pol (i, p, pol, p_mother)
integer, intent(in) :: i
type(vector4_t), intent(in) :: p
type(polarization_t), intent(in) :: pol
type(vector4_t), intent(in) :: p_mother
type(vector3_t) :: s3, p3
type(vector4_t) :: s4
s3 = vector3_moving (pol%get_axis ())
p3 = space_part (p)
s4 = rotation_to_2nd (3, p3) * vector4_moving (0._default, s3)
SPINUP(i) = enclosed_angle_ct (s4, p_mother)
end subroutine hepeup_set_particle_spin_pol
@ %def hepeup_set_particle_spin
@
Extract particle data. The caller decides which ones to retrieve.
Status codes: beam remnants share the status code with virtual particles.
However, for the purpose of WHIZARD we should identify them. We
use the PDG code for this.
<<HEP common: public>>=
public :: hepeup_get_particle
<<HEP common: sub interfaces>>=
module subroutine hepeup_get_particle (i, pdg, status, parent, col, p, m2)
integer, intent(in) :: i
integer, intent(out), optional :: pdg, status
integer, dimension(:), intent(out), optional :: parent
type(vector4_t), intent(out), optional :: p
integer, dimension(2), intent(out), optional :: col
real(default), dimension(5,MAXNUP) :: pup_def
real(default), intent(out), optional :: m2
end subroutine hepeup_get_particle
<<HEP common: procedures>>=
module subroutine hepeup_get_particle (i, pdg, status, parent, col, p, m2)
integer, intent(in) :: i
integer, intent(out), optional :: pdg, status
integer, dimension(:), intent(out), optional :: parent
type(vector4_t), intent(out), optional :: p
integer, dimension(2), intent(out), optional :: col
real(default), dimension(5,MAXNUP) :: pup_def
real(default), intent(out), optional :: m2
if (present (pdg)) pdg = IDUP(i)
if (present (status)) then
select case (ISTUP(i))
case (-9); status = PRT_BEAM
case (-1); status = PRT_INCOMING
case (1); status = PRT_OUTGOING
case (2); status = PRT_RESONANT
case (3);
select case (abs (IDUP(i)))
case (HADRON_REMNANT, HADRON_REMNANT_SINGLET, &
HADRON_REMNANT_TRIPLET, HADRON_REMNANT_OCTET)
status = PRT_BEAM_REMNANT
case default
status = PRT_VIRTUAL
end select
case default
status = PRT_UNDEFINED
end select
end if
if (present (parent)) then
select case (size (parent))
case (0)
case (1); parent(1) = MOTHUP(1,i)
case (2); parent = MOTHUP(:,i)
end select
end if
if (present (col)) then
col = ICOLUP(:,i)
end if
if (present (p)) then
pup_def = PUP
p = vector4_moving (pup_def(4,i), vector3_moving (pup_def(1:3,i)))
end if
if (present (m2)) then
m2 = sign (PUP(5,i) ** 2, PUP(5,i))
end if
end subroutine hepeup_get_particle
@ %def hepeup_get_particle
@
\subsection{The HEPEVT and HEPEV4 common block}
For the LEP Monte Carlos, a standard common block has been proposed
in AKV89. We strongly recommend its use. (The description is an
abbreviated transcription of AKV89, Vol. 3, pp. 327-330).
[[NMXHEP]] is the maximum number of entries:
<<HEP common: variables>>=
integer, parameter :: NMXHEP = 4000
@ %def NMXHEP
@ [[NEVHEP]] is normally the event number, but may take special
values as follows:
0 the program does not keep track of event numbers.
-1 a special initialization record.
-2 a special final record.
<<HEP common: variables>>=
integer :: NEVHEP
@ %def NEVHEP
@ [[NHEP]] holds the number of entries for this event.
<<HEP common: variables>>=
integer, public :: NHEP
@ %def NHEP
@ The entry [[ISTHEP(N)]] gives the status code for the [[N]]th entry,
with the following semantics:
0 a null entry.
1 an existing entry, which has not decayed or fragmented.
2 a decayed or fragmented entry, which is retained for
event history information.
3 documentation line.
4- 10 reserved for future standards.
11-200 at the disposal of each model builder.
201- at the disposal of users.
<<HEP common: variables>>=
integer, dimension(NMXHEP), public :: ISTHEP
@ %def ISTHEP
@
The Particle Data Group has proposed standard particle codes,
which are to be stored in [[IDHEP(N)]].
<<HEP common: variables>>=
integer, dimension(NMXHEP), public :: IDHEP
@ %def IDHEP
@ [[JMOHEP(1,N)]] points to the mother of the [[N]]th entry, if any.
It is set to zero for initial entries.
[[JMOHEP(2,N)]] points to the second mother, if any.
<<HEP common: variables>>=
integer, dimension(2, NMXHEP), public :: JMOHEP
@ %def JMOHEP
@ [[JDAHEP(1,N)]] and [[JDAHEP(2,N)]] point to the first and last daughter
of the [[N]]th entry, if any. These are zero for entries which have not
yet decayed. The other daughters are stored in between these two.
<<HEP common: variables>>=
integer, dimension(2, NMXHEP), public :: JDAHEP
@ %def JDAHEP
@ In [[PHEP]] we store the momentum of the particle, more specifically
this means that [[PHEP(1,N)]], [[PHEP(2,N)]], and [[PHEP(3,N)]] contain the
momentum in the $x$, $y$, and $z$ direction (as defined by the machine
people), measured in GeV/c. [[PHEP(4,N)]] contains the energy in GeV
and [[PHEP(5,N)]] the mass in GeV$/c^2$. The latter may be negative for
spacelike partons.
<<HEP common: variables>>=
double precision, dimension(5, NMXHEP), public :: PHEP
@ %def PHEP
@ Finally [[VHEP]] is the place to store the position of the production
vertex. [[VHEP(1,N)]], [[VHEP(2,N)]], and [[VHEP(3,N)]] contain the $x$, $y$,
and $z$ coordinate (as defined by the machine people), measured in mm.
[[VHEP(4,N)]] contains the production time in mm/c.
<<HEP common: variables>>=
double precision, dimension(4, NMXHEP) :: VHEP
@ %def VHEP
@ As an amendment to the proposed standard common block HEPEVT, we
also have a polarisation common block HEPSPN, as described in
AKV89. [[SHEP(1,N)]], [[SHEP(2,N)]], and [[SHEP(3,N)]] give the $x$, $y$, and $z$
component of the spinvector $s$ of a fermion in the fermions restframe.
Furthermore, we add the polarization of the corresponding outgoing
particles:
<<HEP common: variables>>=
integer, dimension(NMXHEP) :: hepevt_pol
@ %def hepevt_pol
@
By this variable the identity of the current process is given, defined
via the LPRUP codes.
<<HEP common: variables>>=
integer, public :: idruplh
@ %def idruplh
This is the event weight, i.e. the cross section divided by the total
number of generated events for the output of the parton shower programs.
<<HEP common: variables>>=
double precision, public :: eventweightlh
@ %def eventweightlh
@ There are the values for the electromagnetic and the strong coupling
constants, $\alpha_{em}$ and $\alpha_s$.
<<HEP common: variables>>=
double precision, public :: alphaqedlh, alphaqcdlh
@ %def alphaqedlh, alphaqcdlh
@ This is the squared scale $Q$ of the event.
<<HEP common: variables>>=
double precision, dimension(10), public :: scalelh
@ %def scalelh
@ Finally, these variables contain the spin information and the
color/anticolor flow of the particles.
<<HEP common: variables>>=
double precision, dimension (3,NMXHEP), public :: spinlh
integer, dimension (2,NMXHEP), public :: icolorflowlh
@ %def spinlh icolorflowlh
By convention, [[SHEP(4,N)]] is always 1. All this is taken from StdHep
4.06 manual and written using Fortran90 conventions.
<<HEP common: common blocks>>=
common /HEPEVT/ &
NEVHEP, NHEP, ISTHEP, IDHEP, &
JMOHEP, JDAHEP, PHEP, VHEP
save /HEPEVT/
@ %def HEPEVT
@ Here we store HEPEVT parameters of the WHIZARD 1 realization which
are not part of the HEPEVT common block.
<<HEP common: variables>>=
integer :: hepevt_n_out, hepevt_n_remnants
@ %def hepevt_n_out, hepevt_n_remnants
@
<<HEP common: variables>>=
double precision :: hepevt_weight, hepevt_function_value
double precision :: hepevt_function_ratio
@ %def hepevt_weight hepevt_function_value
@ The HEPEV4 common block is an extension of the HEPEVT common block
to allow for partonic colored events, including especially the color
flow etc.
<<HEP common: common blocks>>=
common /HEPEV4/ &
eventweightlh, alphaqedlh, alphaqcdlh, scalelh, &
spinlh, icolorflowlh, idruplh
save /HEPEV4/
@ %def HEPEV4
@ Filling HEPEVT: If the event count is not provided, set [[NEVHEP]]
to zero. If the event count is [[-1]] or [[-2]], the record
corresponds to initialization and finalization, and the event is
irrelevant.
Note that the event count may be larger than $2^{31}$ (2 GEvents). In
that case, cut off the upper bits since [[NEVHEP]] is probably limited
to default integer.
For the HEPEV4 common block, it is unclear why the [[scalelh]] variable
is 10-dimensional. We choose to only set the first value of the array.
<<HEP common: public>>=
public :: hepevt_init
public :: hepevt_set_event_parameters
<<HEP common: sub interfaces>>=
module subroutine hepevt_init (n_tot, n_out)
integer, intent(in) :: n_tot, n_out
end subroutine hepevt_init
module subroutine hepevt_set_event_parameters &
(proc_id, weight, function_value, function_ratio, &
alpha_qcd, alpha_qed, scale, i_evt)
integer, intent(in), optional :: proc_id
integer, intent(in), optional :: i_evt
real(default), intent(in), optional :: weight, function_value, &
function_ratio, alpha_qcd, alpha_qed, scale
end subroutine hepevt_set_event_parameters
<<HEP common: procedures>>=
module subroutine hepevt_init (n_tot, n_out)
integer, intent(in) :: n_tot, n_out
NHEP = n_tot
NEVHEP = 0
idruplh = 0
hepevt_n_out = n_out
hepevt_n_remnants = 0
hepevt_weight = 1
eventweightlh = 1
hepevt_function_value = 0
hepevt_function_ratio = 1
alphaqcdlh = -1
alphaqedlh = -1
scalelh = -1
end subroutine hepevt_init
module subroutine hepevt_set_event_parameters &
(proc_id, weight, function_value, function_ratio, &
alpha_qcd, alpha_qed, scale, i_evt)
integer, intent(in), optional :: proc_id
integer, intent(in), optional :: i_evt
real(default), intent(in), optional :: weight, function_value, &
function_ratio, alpha_qcd, alpha_qed, scale
if (present (proc_id)) idruplh = proc_id
if (present (i_evt)) NEVHEP = i_evt
if (present (weight)) then
hepevt_weight = weight
eventweightlh = weight
end if
if (present (function_value)) hepevt_function_value = &
function_value
if (present (function_ratio)) hepevt_function_ratio = &
function_ratio
if (present (alpha_qcd)) alphaqcdlh = alpha_qcd
if (present (alpha_qed)) alphaqedlh = alpha_qed
if (present (scale)) scalelh(1) = scale
if (present (i_evt)) NEVHEP = i_evt
end subroutine hepevt_set_event_parameters
@ %def hepevt_init hepevt_set_event_parameters
@ Set the entry for a specific particle. All parameters are set with
the exception of lifetime and spin, where default values are stored.
<<HEP common: public>>=
public :: hepevt_set_particle
<<HEP common: sub interfaces>>=
module subroutine hepevt_set_particle &
(i, pdg, status, parent, child, p, m2, hel, vtx, &
col, pol_status, pol, fill_hepev4)
integer, intent(in) :: i
integer, intent(in) :: pdg, status
integer, dimension(:), intent(in) :: parent
integer, dimension(:), intent(in) :: child
logical, intent(in), optional :: fill_hepev4
type(vector4_t), intent(in) :: p
real(default), intent(in) :: m2
integer, dimension(2), intent(in) :: col
integer, intent(in) :: pol_status
integer, intent(in) :: hel
type(polarization_t), intent(in), optional :: pol
type(vector4_t), intent(in) :: vtx
end subroutine hepevt_set_particle
<<HEP common: procedures>>=
module subroutine hepevt_set_particle &
(i, pdg, status, parent, child, p, m2, hel, vtx, &
col, pol_status, pol, fill_hepev4)
integer, intent(in) :: i
integer, intent(in) :: pdg, status
integer, dimension(:), intent(in) :: parent
integer, dimension(:), intent(in) :: child
logical, intent(in), optional :: fill_hepev4
type(vector4_t), intent(in) :: p
real(default), intent(in) :: m2
integer, dimension(2), intent(in) :: col
integer, intent(in) :: pol_status
integer, intent(in) :: hel
type(polarization_t), intent(in), optional :: pol
type(vector4_t), intent(in) :: vtx
logical :: hepev4
hepev4 = .false.; if (present (fill_hepev4)) hepev4 = fill_hepev4
IDHEP(i) = pdg
select case (status)
case (PRT_BEAM); ISTHEP(i) = 2
case (PRT_INCOMING); ISTHEP(i) = 2
case (PRT_OUTGOING); ISTHEP(i) = 1
case (PRT_VIRTUAL); ISTHEP(i) = 2
case (PRT_RESONANT); ISTHEP(i) = 2
case default; ISTHEP(i) = 0
end select
select case (size (parent))
case (0); JMOHEP(:,i) = 0
case (1); JMOHEP(1,i) = parent(1); JMOHEP(2,i) = 0
case default; JMOHEP(:,i) = [ parent(1), parent(size (parent)) ]
end select
select case (size (child))
case (0); JDAHEP(:,i) = 0
case (1); JDAHEP(:,i) = child(1)
case default; JDAHEP(:,i) = [ child(1), child(size (child)) ]
end select
PHEP(1:3,i) = refmt_tiny (vector3_get_components (space_part (p)))
PHEP(4,i) = refmt_tiny (energy (p))
PHEP(5,i) = refmt_tiny (sign (sqrt (abs (m2)), m2))
VHEP(1:3,i) = vtx%p(1:3)
VHEP(4,i) = vtx%p(0)
hepevt_pol(i) = hel
if (hepev4) then
if (col(1) > 0) then
icolorflowlh(1,i) = 500 + col(1)
else
icolorflowlh(1,i) = 0
end if
if (col(2) > 0) then
icolorflowlh(2,i) = 500 + col(2)
else
icolorflowlh(2,i) = 0
end if
if (present (pol) .and. &
pol_status == PRT_GENERIC_POLARIZATION) then
if (pol%is_polarized ()) &
spinlh(:,i) = pol%get_axis ()
else
spinlh(:,i) = zero
spinlh(3,i) = hel
end if
end if
end subroutine hepevt_set_particle
@ %def hepevt_set_particle
@
\subsection{Event output}
This is a verbose output of the HEPEVT block.
<<HEP common: public>>=
public :: hepevt_write_verbose
<<HEP common: sub interfaces>>=
module subroutine hepevt_write_verbose (unit)
integer, intent(in), optional :: unit
end subroutine hepevt_write_verbose
<<HEP common: procedures>>=
module subroutine hepevt_write_verbose (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(A)") "HEPEVT Common Block"
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)") "NEVHEP", NEVHEP, &
"Event number"
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)") "NHEP ", NHEP, &
"Number of particles in event"
do i = 1, NHEP
write (u, "(1x,A,I0)") "Particle #", i
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)", advance="no") &
"ISTHEP", ISTHEP(i), "Status code: "
select case (ISTHEP(i))
case ( 0); write (u, "(A)") "null entry"
case ( 1); write (u, "(A)") "outgoing"
case ( 2); write (u, "(A)") "decayed"
case ( 3); write (u, "(A)") "documentation"
case (4:10); write (u, "(A)") "[unspecified]"
case (11:200); write (u, "(A)") "[model-specific]"
case (201:); write (u, "(A)") "[user-defined]"
case default; write (u, "(A)") "[undefined]"
end select
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)") "IDHEP ", IDHEP(i), &
"PDG code of particle"
write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)") "JMOHEP", JMOHEP(:,i), &
"Index of first/second mother"
write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)") "JDAHEP", JDAHEP(:,i), &
"Index of first/last daughter"
write (u, "(3x,A6,' = ',ES12.5,1x,ES12.5,8x,A)") "PHEP12", &
PHEP(1:2,i), "Transversal momentum (x/y) in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "PHEP3 ", PHEP(3,i), &
"Longitudinal momentum (z) in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "PHEP4 ", PHEP(4,i), &
"Energy in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "PHEP5 ", PHEP(5,i), &
"Invariant mass in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,ES12.5,8x,A)") "VHEP12", VHEP(1:2,i), &
"Transversal displacement (xy) in mm"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "VHEP3 ", VHEP(3,i), &
"Longitudinal displacement (z) in mm"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "VHEP4 ", VHEP(4,i), &
"Production time in mm"
end do
end subroutine hepevt_write_verbose
@ %def hepevt_write_verbose
@
This is a verbose output of the HEPEUP block.
<<HEP common: public>>=
public :: hepeup_write_verbose
<<HEP common: sub interfaces>>=
module subroutine hepeup_write_verbose (unit)
integer, intent(in), optional :: unit
end subroutine hepeup_write_verbose
<<HEP common: procedures>>=
module subroutine hepeup_write_verbose (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(A)") "HEPEUP Common Block"
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)") "NUP ", NUP, &
"Number of particles in event"
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)") "IDPRUP", IDPRUP, &
"Subprocess ID"
write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)") "XWGTUP", XWGTUP, &
"Event weight"
write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)") "SCALUP", SCALUP, &
"Event energy scale in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)") "AQEDUP", AQEDUP, &
"QED coupling [-1 = undefined]"
write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)") "AQCDUP", AQCDUP, &
"QCD coupling [-1 = undefined]"
do i = 1, NUP
write (u, "(1x,A,I0)") "Particle #", i
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)") "IDUP ", IDUP(i), &
"PDG code of particle"
write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)", advance="no") &
"ISTUP ", ISTUP(i), "Status code: "
select case (ISTUP(i))
case (-1); write (u, "(A)") "incoming"
case ( 1); write (u, "(A)") "outgoing"
case (-2); write (u, "(A)") "spacelike"
case ( 2); write (u, "(A)") "resonance"
case ( 3); write (u, "(A)") "resonance (doc)"
case (-9); write (u, "(A)") "beam"
case default; write (u, "(A)") "[undefined]"
end select
write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)") "MOTHUP", MOTHUP(:,i), &
"Index of first/last mother"
write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)") "ICOLUP", ICOLUP(:,i), &
"Color/anticolor flow index"
write (u, "(3x,A6,' = ',ES12.5,1x,ES12.5,8x,A)") "PUP1/2", PUP(1:2,i), &
"Transversal momentum (x/y) in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "PUP3 ", PUP(3,i), &
"Longitudinal momentum (z) in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "PUP4 ", PUP(4,i), &
"Energy in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "PUP5 ", PUP(5,i), &
"Invariant mass in GeV"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "VTIMUP", VTIMUP(i), &
"Invariant lifetime in mm"
write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)") "SPINUP", SPINUP(i), &
"cos(spin angle) [9 = undefined]"
end do
end subroutine hepeup_write_verbose
@ %def hepeup_write_verbose
@
\subsection{Event output in various formats}
This routine writes event output according to the LHEF standard. It
uses the current contents of the HEPEUP block.
<<HEP common: public>>=
public :: hepeup_write_lhef
public :: hepeup_write_lha
<<HEP common: sub interfaces>>=
module subroutine hepeup_write_lhef (unit)
integer, intent(in), optional :: unit
end subroutine hepeup_write_lhef
module subroutine hepeup_write_lha (unit)
integer, intent(in), optional :: unit
end subroutine hepeup_write_lha
<<HEP common: procedures>>=
module subroutine hepeup_write_lhef (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
if (debug_on) call msg_debug (D_EVENTS, "hepeup_write_lhef")
if (debug_on) call msg_debug2 (D_EVENTS, "ID IST MOTH ICOL P VTIM SPIN")
write (u, "(2(1x,I0),4(1x,ES17.10))") &
NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
do i = 1, NUP
write (u, "(6(1x,I0),7(1x,ES17.10))") &
IDUP(i), ISTUP(i), MOTHUP(:,i), ICOLUP(:,i), &
PUP(:,i), VTIMUP(i), SPINUP(i)
if (debug2_active (D_EVENTS)) then
write (msg_buffer, "(6(1x,I0),7(1x,ES17.10))") &
IDUP(i), ISTUP(i), MOTHUP(:,i), ICOLUP(:,i), &
PUP(:,i), VTIMUP(i), SPINUP(i)
call msg_message ()
end if
end do
end subroutine hepeup_write_lhef
module subroutine hepeup_write_lha (unit)
integer, intent(in), optional :: unit
integer :: u, i
integer, dimension(MAXNUP) :: spin_up
spin_up = int(SPINUP)
u = given_output_unit (unit); if (u < 0) return
write (u, "(2(1x,I5),1x,ES17.10,3(1x,ES13.6))") &
NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
write (u, "(500(1x,I5))") IDUP(:NUP)
write (u, "(500(1x,I5))") MOTHUP(1,:NUP)
write (u, "(500(1x,I5))") MOTHUP(2,:NUP)
write (u, "(500(1x,I5))") ICOLUP(1,:NUP)
write (u, "(500(1x,I5))") ICOLUP(2,:NUP)
write (u, "(500(1x,I5))") ISTUP(:NUP)
write (u, "(500(1x,I5))") spin_up(:NUP)
do i = 1, NUP
write (u, "(1x,I5,4(1x,ES17.10))") i, PUP([ 4,1,2,3 ], i)
end do
end subroutine hepeup_write_lha
@ %def hepeup_write_lhef hepeup_write_lha
@ This routine writes event output according to the HEPEVT standard. It
uses the current contents of the HEPEVT block and some additional
parameters according to the standard in WHIZARD 1. For the long ASCII
format, the value of the sample function (i.e. the product of squared
matrix element, structure functions and phase space factor is printed out).
The option of reweighting matrix elements with respect to some
reference cross section is not implemented in WHIZARD 2 for this event
format, therefore the second entry in the long ASCII format (the
function ratio) is always one. The ATHENA format is an implementation
of the HEPEVT format that is readable by the ATLAS ATHENA software
framework. It is very similar to the WHIZARD 1 HEPEVT format, except
that it contains an event counter, a particle counter inside the
event, and has the HEPEVT [[ISTHEP]] status before the PDG code. The
MOKKA format is a special ASCII format that contains the information
to be parsed to the MOKKA LC fast simulation software.
<<HEP common: public>>=
public :: hepevt_write_hepevt
public :: hepevt_write_ascii
public :: hepevt_write_athena
public :: hepevt_write_mokka
<<HEP common: sub interfaces>>=
module subroutine hepevt_write_hepevt (unit)
integer, intent(in), optional :: unit
end subroutine hepevt_write_hepevt
module subroutine hepevt_write_ascii (unit, long)
integer, intent(in), optional :: unit
logical, intent(in) :: long
end subroutine hepevt_write_ascii
module subroutine hepevt_write_athena (unit)
integer, intent(in), optional :: unit
end subroutine hepevt_write_athena
module subroutine hepevt_write_mokka (unit)
integer, intent(in), optional :: unit
end subroutine hepevt_write_mokka
<<HEP common: procedures>>=
module subroutine hepevt_write_hepevt (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(3(1x,I0),(1x,ES17.10))") &
NHEP, hepevt_n_out, hepevt_n_remnants, hepevt_weight
do i = 1, NHEP
write (u, "(7(1x,I0))") &
ISTHEP(i), IDHEP(i), JMOHEP(:,i), JDAHEP(:,i), hepevt_pol(i)
write (u, "(5(1x,ES17.10))") PHEP(:,i)
write (u, "(5(1x,ES17.10))") VHEP(:,i), 0.d0
end do
end subroutine hepevt_write_hepevt
module subroutine hepevt_write_ascii (unit, long)
integer, intent(in), optional :: unit
logical, intent(in) :: long
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(3(1x,I0),(1x,ES17.10))") &
NHEP, hepevt_n_out, hepevt_n_remnants, hepevt_weight
do i = 1, NHEP
if (ISTHEP(i) /= 1) cycle
write (u, "(2(1x,I0))") IDHEP(i), hepevt_pol(i)
write (u, "(5(1x,ES17.10))") PHEP(:,i)
end do
if (long) then
write (u, "(2(1x,ES17.10))") &
hepevt_function_value, hepevt_function_ratio
end if
end subroutine hepevt_write_ascii
module subroutine hepevt_write_athena (unit)
integer, intent(in), optional :: unit
integer :: u, i, num_event
num_event = 0
u = given_output_unit (unit); if (u < 0) return
write (u, "(2(1x,I0))") NEVHEP, NHEP
do i = 1, NHEP
write (u, "(7(1x,I0))") &
i, ISTHEP(i), IDHEP(i), JMOHEP(:,i), JDAHEP(:,i)
write (u, "(5(1x,ES17.10))") PHEP(:,i)
write (u, "(5(1x,ES17.10))") VHEP(1:4,i)
end do
end subroutine hepevt_write_athena
module subroutine hepevt_write_mokka (unit)
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(3(1x,I0),(1x,ES17.10))") &
NHEP, hepevt_n_out, hepevt_n_remnants, hepevt_weight
do i = 1, NHEP
write (u, "(4(1x,I0),4(1x,ES17.10))") &
ISTHEP(i), IDHEP(i), JDAHEP(1,i), JDAHEP(2,i), &
PHEP(1:3,i), PHEP(5,i)
end do
end subroutine hepevt_write_mokka
@ %def hepevt_write_hepevt hepevt_write_ascii
@ %def hepevt_write_athena
@
\subsection{Event input in various formats}
This routine writes event output according to the LHEF standard. It
uses the current contents of the HEPEUP block.
<<HEP common: public>>=
public :: hepeup_read_lhef
<<HEP common: sub interfaces>>=
module subroutine hepeup_read_lhef (u)
integer, intent(in) :: u
end subroutine hepeup_read_lhef
<<HEP common: procedures>>=
module subroutine hepeup_read_lhef (u)
integer, intent(in) :: u
integer :: i
read (u, *) &
NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
do i = 1, NUP
read (u, *) &
IDUP(i), ISTUP(i), MOTHUP(:,i), ICOLUP(:,i), &
PUP(:,i), VTIMUP(i), SPINUP(i)
end do
end subroutine hepeup_read_lhef
@ %def hepeup_read_lhef
@
\subsection{Data Transfer: particle sets}
The \whizard\ format for handling particle data in events is
[[particle_set_t]]. We have to interface this to the common blocks.
We first create a new particle set that contains only the particles
that are supported by the LHEF format. These are: beam, incoming,
resonant, outgoing. We drop particles with unknown, virtual or
beam-remnant status.
From this set we fill the common block. Event information such as
process ID and weight is not transferred here; this has to be done by
the caller. The spin information is set only if the particle has a
unique mother, and if its polarization is fully defined.
We use this routine also to hand over information to Pythia which lets
Tauola access SPINUP. Tauola expects in SPINUP the helicity and not the
LHA convention. We switch to this mode with [[tauola_convention]].
<<HEP common: public>>=
public :: hepeup_from_particle_set
<<HEP common: sub interfaces>>=
module subroutine hepeup_from_particle_set (pset_in, &
keep_beams, keep_remnants, tauola_convention)
type(particle_set_t), intent(in) :: pset_in
type(particle_set_t), target :: pset
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: tauola_convention
end subroutine hepeup_from_particle_set
<<HEP common: procedures>>=
module subroutine hepeup_from_particle_set (pset_in, &
keep_beams, keep_remnants, tauola_convention)
type(particle_set_t), intent(in) :: pset_in
type(particle_set_t), target :: pset
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: tauola_convention
integer :: i, n_parents, status, n_tot
integer, dimension(1) :: i_mother
logical :: kr, tc
kr = .true.; if (present (keep_remnants)) kr = keep_remnants
tc = .false.; if (present (tauola_convention)) tc = tauola_convention
call pset_in%filter_particles (pset, real_parents = .true. , &
keep_beams = keep_beams, keep_virtuals = .false.)
n_tot = pset%get_n_tot ()
call hepeup_init (n_tot)
do i = 1, n_tot
associate (prt => pset%prt(i))
status = prt%get_status ()
if (kr .and. status == PRT_BEAM_REMNANT &
.and. prt%get_n_children () == 0) &
status = PRT_OUTGOING
call hepeup_set_particle (i, &
prt%get_pdg (), &
status, &
prt%get_parents (), &
prt%get_color (), &
prt%get_momentum (), &
prt%get_p2 ())
n_parents = prt%get_n_parents ()
call hepeup_set_particle_lifetime (i, &
prt%get_lifetime ())
if (.not. tc) then
if (n_parents == 1) then
i_mother = prt%get_parents ()
select case (prt%get_polarization_status ())
case (PRT_GENERIC_POLARIZATION)
call hepeup_set_particle_spin (i, &
prt%get_momentum (), &
prt%get_polarization (), &
pset%prt(i_mother(1))%get_momentum ())
end select
end if
else
select case (prt%get_polarization_status ())
case (PRT_DEFINITE_HELICITY)
SPINUP(i) = prt%get_helicity()
end select
end if
end associate
end do
end subroutine hepeup_from_particle_set
@ %def hepeup_from_particle_set
@ Input. The particle set should be allocated properly, but we
replace the particle contents.
If there are no beam particles in the event, we try to reconstruct beam
particles and beam remnants. We assume for simplicity that the beam
particles, if any, are the first two particles. If they are absent, the first
two particles should be the incoming partons.
<<HEP common: public>>=
public :: hepeup_to_particle_set
<<HEP common: sub interfaces>>=
module subroutine hepeup_to_particle_set &
(particle_set, recover_beams, model, alt_model)
type(particle_set_t), intent(inout), target :: particle_set
logical, intent(in), optional :: recover_beams
class(model_data_t), intent(in), target :: model, alt_model
end subroutine hepeup_to_particle_set
<<HEP common: procedures>>=
module subroutine hepeup_to_particle_set &
(particle_set, recover_beams, model, alt_model)
type(particle_set_t), intent(inout), target :: particle_set
logical, intent(in), optional :: recover_beams
class(model_data_t), intent(in), target :: model, alt_model
type(particle_t), dimension(:), allocatable :: prt
integer, dimension(2) :: parent
integer, dimension(:), allocatable :: child
integer :: i, j, k, pdg, status
type(flavor_t) :: flv
type(color_t) :: col
integer, dimension(2) :: c
type(vector4_t) :: p
real(default) :: p2
logical :: reconstruct
integer :: off
if (present (recover_beams)) then
reconstruct = recover_beams .and. .not. all (ISTUP(1:2) == PRT_BEAM)
else
reconstruct = .false.
end if
if (reconstruct) then
off = 4
else
off = 0
end if
allocate (prt (NUP + off), child (NUP + off))
do i = 1, NUP
k = i + off
call hepeup_get_particle (i, pdg, status, col = c, p = p, m2 = p2)
call flv%init (pdg, model, alt_model)
call prt(k)%set_flavor (flv)
call prt(k)%reset_status (status)
call col%init (c)
call prt(k)%set_color (col)
call prt(k)%set_momentum (p, p2)
where (MOTHUP(:,i) /= 0)
parent = MOTHUP(:,i) + off
elsewhere
parent = 0
end where
call prt(k)%set_parents (parent)
child = [(j, j = 1 + off, NUP + off)]
where (MOTHUP(1,:NUP) /= i .and. MOTHUP(2,:NUP) /= i) child = 0
call prt(k)%set_children (child)
end do
if (reconstruct) then
do k = 1, 2
call prt(k)%reset_status (PRT_BEAM)
call prt(k)%set_children ([k+2,k+4])
end do
do k = 3, 4
call prt(k)%reset_status (PRT_BEAM_REMNANT)
call prt(k)%set_parents ([k-2])
end do
do k = 5, 6
call prt(k)%set_parents ([k-4])
end do
end if
call particle_set%replace (prt)
end subroutine hepeup_to_particle_set
@ %def hepeup_to_particle_set
@
The HEPEVT common block is quite similar, but does contain less
information, e.g. no color flows (it was LEP time). The spin
information is set only if the particle has a unique mother, and if
its polarization is fully defined.
<<HEP common: public>>=
public :: hepevt_from_particle_set
<<HEP common: sub interfaces>>=
module subroutine hepevt_from_particle_set &
(particle_set, keep_beams, keep_remnants, ensure_order, fill_hepev4)
type(particle_set_t), intent(in) :: particle_set
type(particle_set_t), target :: pset_hepevt, pset_tmp
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
logical, intent(in), optional :: fill_hepev4
end subroutine hepevt_from_particle_set
<<HEP common: procedures>>=
module subroutine hepevt_from_particle_set &
(particle_set, keep_beams, keep_remnants, ensure_order, fill_hepev4)
type(particle_set_t), intent(in) :: particle_set
type(particle_set_t), target :: pset_hepevt, pset_tmp
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
logical, intent(in), optional :: fill_hepev4
integer :: i, status, n_tot
logical :: activate_remnants, ensure
activate_remnants = .true.
if (present (keep_remnants)) activate_remnants = keep_remnants
ensure = .false.
if (present (ensure_order)) ensure = ensure_order
call particle_set%filter_particles (pset_tmp, real_parents = .true., &
keep_virtuals = .false., keep_beams = keep_beams)
if (ensure) then
call pset_tmp%to_hepevt_form (pset_hepevt)
else
pset_hepevt = pset_tmp
end if
n_tot = pset_hepevt%get_n_tot ()
call hepevt_init (n_tot, pset_hepevt%get_n_out ())
do i = 1, n_tot
associate (prt => pset_hepevt%prt(i))
status = prt%get_status ()
if (activate_remnants &
.and. status == PRT_BEAM_REMNANT &
.and. prt%get_n_children () == 0) &
status = PRT_OUTGOING
select case (prt%get_polarization_status ())
case (PRT_GENERIC_POLARIZATION)
call hepevt_set_particle (i, &
prt%get_pdg (), status, &
prt%get_parents (), &
prt%get_children (), &
prt%get_momentum (), &
prt%get_p2 (), &
prt%get_helicity (), &
prt%get_vertex (), &
prt%get_color (), &
prt%get_polarization_status (), &
pol = prt%get_polarization (), &
fill_hepev4 = fill_hepev4)
case default
call hepevt_set_particle (i, &
prt%get_pdg (), status, &
prt%get_parents (), &
prt%get_children (), &
prt%get_momentum (), &
prt%get_p2 (), &
prt%get_helicity (), &
prt%get_vertex (), &
prt%get_color (), &
prt%get_polarization_status (), &
fill_hepev4 = fill_hepev4)
end select
end associate
end do
call pset_hepevt%final ()
end subroutine hepevt_from_particle_set
@ %def hepevt_from_particle_set
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{HepMC events}
This section provides the interface to the HepMC C++ library for handling
Monte-Carlo events.
Each C++ class of HepMC that we use is mirrored by a Fortran type,
which contains as its only component the C pointer to the C++ object.
Each C++ method of HepMC that we use has a C wrapper function. This
function takes a pointer to the host object as its first argument.
Further arguments are either C pointers, or in the case of simple
types (integer, real), interoperable C/Fortran objects.
The C wrapper functions have explicit interfaces in the Fortran
module. They are called by Fortran wrapper procedures. These are
treated as methods of the corresponding Fortran type.
<<[[hepmc_interface.f90]]>>=
<<File header>>
module hepmc_interface
use, intrinsic :: iso_c_binding !NODEP!
<<Use kinds>>
<<Use strings>>
use lorentz
use flavors
use colors
use helicities
use polarizations
use event_handles, only: event_handle_t
<<Standard module head>>
<<HepMC interface: public>>
<<HepMC interface: types>>
<<HepMC interface: parameters>>
<<HepMC interface: interfaces>>
interface
<<HepMC interface: sub interfaces>>
end interface
end module hepmc_interface
@ %def hepmc_interface
@
<<[[hepmc_interface_sub.f90]]>>=
<<File header>>
submodule (hepmc_interface) hepmc_interface_s
use constants, only: PI
use physics_defs, only: pb_per_fb
use system_dependencies, only: HEPMC2_AVAILABLE
use system_dependencies, only: HEPMC3_AVAILABLE
use diagnostics
implicit none
contains
<<HepMC interface: procedures>>
end submodule hepmc_interface_s
@ %def hepmc_interface_s
@
\subsection{Interface check}
This function can be called in order to verify that we are using the
actual HepMC library, and not the dummy version.
<<HepMC interface: interfaces>>=
interface
logical(c_bool) function hepmc_available () bind(C)
import
end function hepmc_available
end interface
<<HepMC interface: public>>=
public :: hepmc_is_available
<<HepMC interface: sub interfaces>>=
module function hepmc_is_available () result (flag)
logical :: flag
end function hepmc_is_available
<<HepMC interface: procedures>>=
module function hepmc_is_available () result (flag)
logical :: flag
flag = hepmc_available ()
end function hepmc_is_available
@ %def hepmc_is_available
@
\subsection{FourVector}
The C version of four-vectors is often transferred by value, and the
associated procedures are all inlined. The wrapper needs to transfer
by reference, so we create FourVector objects on the heap which have
to be deleted explicitly. The input is a [[vector4_t]] or
[[vector3_t]] object from the [[lorentz]] module.
<<HepMC interface: public>>=
public :: hepmc_four_vector_t
<<HepMC interface: types>>=
type :: hepmc_four_vector_t
private
type(c_ptr) :: obj
end type hepmc_four_vector_t
@ %def hepmc_four_vector_t
@ In the C constructor, the zero-component (fourth argument) is
optional; if missing, it is set to zero. The Fortran version has
initializer form and takes either a three-vector or a four-vector.
A further version extracts the four-vector from a HepMC particle
object.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_four_vector_xyz (x, y, z) bind(C)
import
real(c_double), value :: x, y, z
end function new_four_vector_xyz
end interface
interface
type(c_ptr) function new_four_vector_xyzt (x, y, z, t) bind(C)
import
real(c_double), value :: x, y, z, t
end function new_four_vector_xyzt
end interface
@ %def new_four_vector_xyz new_four_vector_xyzt
<<HepMC interface: public>>=
public :: hepmc_four_vector_init
<<HepMC interface: interfaces>>=
interface hepmc_four_vector_init
module procedure hepmc_four_vector_init_v4
module procedure hepmc_four_vector_init_v3
module procedure hepmc_four_vector_init_hepmc_prt
end interface
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_four_vector_init_v4 (pp, p)
type(hepmc_four_vector_t), intent(out) :: pp
type(vector4_t), intent(in) :: p
end subroutine hepmc_four_vector_init_v4
module subroutine hepmc_four_vector_init_v3 (pp, p)
type(hepmc_four_vector_t), intent(out) :: pp
type(vector3_t), intent(in) :: p
end subroutine hepmc_four_vector_init_v3
module subroutine hepmc_four_vector_init_hepmc_prt (pp, prt)
type(hepmc_four_vector_t), intent(out) :: pp
type(hepmc_particle_t), intent(in) :: prt
end subroutine hepmc_four_vector_init_hepmc_prt
<<HepMC interface: procedures>>=
module subroutine hepmc_four_vector_init_v4 (pp, p)
type(hepmc_four_vector_t), intent(out) :: pp
type(vector4_t), intent(in) :: p
real(default), dimension(0:3) :: pa
pa = vector4_get_components (p)
pp%obj = new_four_vector_xyzt &
(real (pa(1), c_double), &
real (pa(2), c_double), &
real (pa(3), c_double), &
real (pa(0), c_double))
end subroutine hepmc_four_vector_init_v4
module subroutine hepmc_four_vector_init_v3 (pp, p)
type(hepmc_four_vector_t), intent(out) :: pp
type(vector3_t), intent(in) :: p
real(default), dimension(3) :: pa
pa = vector3_get_components (p)
pp%obj = new_four_vector_xyz &
(real (pa(1), c_double), &
real (pa(2), c_double), &
real (pa(3), c_double))
end subroutine hepmc_four_vector_init_v3
module subroutine hepmc_four_vector_init_hepmc_prt (pp, prt)
type(hepmc_four_vector_t), intent(out) :: pp
type(hepmc_particle_t), intent(in) :: prt
pp%obj = gen_particle_momentum (prt%obj)
end subroutine hepmc_four_vector_init_hepmc_prt
@ %def hepmc_four_vector_init
@ Here, the destructor is explicitly needed.
<<HepMC interface: interfaces>>=
interface
subroutine four_vector_delete (p_obj) bind(C)
import
type(c_ptr), value :: p_obj
end subroutine four_vector_delete
end interface
@ %def four_vector_delete
<<HepMC interface: public>>=
public :: hepmc_four_vector_final
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_four_vector_final (p)
type(hepmc_four_vector_t), intent(inout) :: p
end subroutine hepmc_four_vector_final
<<HepMC interface: procedures>>=
module subroutine hepmc_four_vector_final (p)
type(hepmc_four_vector_t), intent(inout) :: p
call four_vector_delete (p%obj)
end subroutine hepmc_four_vector_final
@ %def hepmc_four_vector_final
@ Convert to a Lorentz vector.
<<HepMC interface: interfaces>>=
interface
function four_vector_px (p_obj) result (px) bind(C)
import
real(c_double) :: px
type(c_ptr), value :: p_obj
end function four_vector_px
end interface
interface
function four_vector_py (p_obj) result (py) bind(C)
import
real(c_double) :: py
type(c_ptr), value :: p_obj
end function four_vector_py
end interface
interface
function four_vector_pz (p_obj) result (pz) bind(C)
import
real(c_double) :: pz
type(c_ptr), value :: p_obj
end function four_vector_pz
end interface
interface
function four_vector_e (p_obj) result (e) bind(C)
import
real(c_double) :: e
type(c_ptr), value :: p_obj
end function four_vector_e
end interface
@ %def four_vector_px four_vector_py four_vector_pz four_vector_e
<<HepMC interface: public>>=
public :: hepmc_four_vector_to_vector4
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_four_vector_to_vector4 (pp, p)
type(hepmc_four_vector_t), intent(in) :: pp
type(vector4_t), intent(out) :: p
end subroutine hepmc_four_vector_to_vector4
<<HepMC interface: procedures>>=
module subroutine hepmc_four_vector_to_vector4 (pp, p)
type(hepmc_four_vector_t), intent(in) :: pp
type(vector4_t), intent(out) :: p
real(default) :: E
real(default), dimension(3) :: p3
E = four_vector_e (pp%obj)
p3(1) = four_vector_px (pp%obj)
p3(2) = four_vector_py (pp%obj)
p3(3) = four_vector_pz (pp%obj)
p = vector4_moving (E, vector3_moving (p3))
end subroutine hepmc_four_vector_to_vector4
@ %def hepmc_four_vector_to_vector4
@
\subsection{Polarization}
Polarization objects are temporarily used for assigning particle
polarization. We add a flag [[polarized]]. If this is false, the
polarization is not set and should not be transferred to
[[hepmc_particle]] objects.
<<HepMC interface: public>>=
public :: hepmc_polarization_t
<<HepMC interface: types>>=
type :: hepmc_polarization_t
private
logical :: polarized = .false.
type(c_ptr) :: obj
end type hepmc_polarization_t
@ %def hepmc_polarization_t
@ Constructor. The C wrapper takes polar and azimuthal angle as
arguments. The Fortran version allows for either a complete
polarization density matrix, or for a definite (diagonal) helicity.
\emph{HepMC does not allow to specify the degree of polarization,
therefore we have to map it to either 0 or 1. We choose 0 for
polarization less than $0.5$ and 1 for polarization greater than
$0.5$. Even this simplification works only for spin-1/2 and for
massless particles; massive vector bosons cannot be treated this
way. In particular, zero helicity is always translated as
unpolarized.}
\emph{For massive vector bosons, we arbitrarily choose the convention
that the longitudinal (zero) helicity state is mapped to the theta
angle $\pi/2$. This works under the condition that helicity is
projected onto one of the basis states.}
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_polarization (theta, phi) bind(C)
import
real(c_double), value :: theta, phi
end function new_polarization
end interface
@ %def new_polarization
<<HepMC interface: public>>=
public :: hepmc_polarization_init
<<HepMC interface: interfaces>>=
interface hepmc_polarization_init
module procedure hepmc_polarization_init_pol
module procedure hepmc_polarization_init_hel
module procedure hepmc_polarization_init_int
end interface
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_polarization_init_pol (hpol, pol)
type(hepmc_polarization_t), intent(out) :: hpol
type(polarization_t), intent(in) :: pol
end subroutine hepmc_polarization_init_pol
module subroutine hepmc_polarization_init_hel (hpol, hel)
type(hepmc_polarization_t), intent(out) :: hpol
type(helicity_t), intent(in) :: hel
end subroutine hepmc_polarization_init_hel
module subroutine hepmc_polarization_init_int (hpol, hel)
type(hepmc_polarization_t), intent(out) :: hpol
integer, intent(in) :: hel
end subroutine hepmc_polarization_init_int
<<HepMC interface: procedures>>=
module subroutine hepmc_polarization_init_pol (hpol, pol)
type(hepmc_polarization_t), intent(out) :: hpol
type(polarization_t), intent(in) :: pol
real(default) :: r, theta, phi
if (pol%is_polarized ()) then
call pol%to_angles (r, theta, phi)
if (r >= 0.5) then
hpol%polarized = .true.
hpol%obj = new_polarization &
(real (theta, c_double), real (phi, c_double))
end if
end if
end subroutine hepmc_polarization_init_pol
module subroutine hepmc_polarization_init_hel (hpol, hel)
type(hepmc_polarization_t), intent(out) :: hpol
type(helicity_t), intent(in) :: hel
integer, dimension(2) :: h
if (hel%is_defined ()) then
h = hel%to_pair ()
select case (h(1))
case (1:)
hpol%polarized = .true.
hpol%obj = new_polarization (0._c_double, 0._c_double)
case (:-1)
hpol%polarized = .true.
hpol%obj = new_polarization (real (pi, c_double), 0._c_double)
case (0)
hpol%polarized = .true.
hpol%obj = new_polarization (real (pi/2, c_double), 0._c_double)
end select
end if
end subroutine hepmc_polarization_init_hel
module subroutine hepmc_polarization_init_int (hpol, hel)
type(hepmc_polarization_t), intent(out) :: hpol
integer, intent(in) :: hel
select case (hel)
case (1:)
hpol%polarized = .true.
hpol%obj = new_polarization (0._c_double, 0._c_double)
case (:-1)
hpol%polarized = .true.
hpol%obj = new_polarization (real (pi, c_double), 0._c_double)
case (0)
hpol%polarized = .true.
hpol%obj = new_polarization (real (pi/2, c_double), 0._c_double)
end select
end subroutine hepmc_polarization_init_int
@ %def hepmc_polarization_init
@ Destructor. The C object is deallocated only if the [[polarized]]
flag is set.
<<HepMC interface: interfaces>>=
interface
subroutine polarization_delete (pol_obj) bind(C)
import
type(c_ptr), value :: pol_obj
end subroutine polarization_delete
end interface
@ %def polarization_delete
<<HepMC interface: public>>=
public :: hepmc_polarization_final
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_polarization_final (hpol)
type(hepmc_polarization_t), intent(inout) :: hpol
end subroutine hepmc_polarization_final
<<HepMC interface: procedures>>=
module subroutine hepmc_polarization_final (hpol)
type(hepmc_polarization_t), intent(inout) :: hpol
if (hpol%polarized) call polarization_delete (hpol%obj)
end subroutine hepmc_polarization_final
@ %def hepmc_polarization_final
@ Recover polarization from HepMC polarization object (with the
abovementioned deficiencies).
<<HepMC interface: interfaces>>=
interface
function polarization_theta (pol_obj) result (theta) bind(C)
import
real(c_double) :: theta
type(c_ptr), value :: pol_obj
end function polarization_theta
end interface
interface
function polarization_phi (pol_obj) result (phi) bind(C)
import
real(c_double) :: phi
type(c_ptr), value :: pol_obj
end function polarization_phi
end interface
@ %def polarization_theta polarization_phi
<<HepMC interface: public>>=
public :: hepmc_polarization_to_pol
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_polarization_to_pol (hpol, flv, pol)
type(hepmc_polarization_t), intent(in) :: hpol
type(flavor_t), intent(in) :: flv
type(polarization_t), intent(out) :: pol
end subroutine hepmc_polarization_to_pol
<<HepMC interface: procedures>>=
module subroutine hepmc_polarization_to_pol (hpol, flv, pol)
type(hepmc_polarization_t), intent(in) :: hpol
type(flavor_t), intent(in) :: flv
type(polarization_t), intent(out) :: pol
real(default) :: theta, phi
theta = polarization_theta (hpol%obj)
phi = polarization_phi (hpol%obj)
call pol%init_angles (flv, 1._default, theta, phi)
end subroutine hepmc_polarization_to_pol
@ %def hepmc_polarization_to_pol
@ Recover helicity. Here, $\phi$ is ignored and only the sign of
$\cos\theta$ is relevant, mapped to positive/negative helicity.
<<HepMC interface: public>>=
public :: hepmc_polarization_to_hel
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_polarization_to_hel (hpol, flv, hel)
type(hepmc_polarization_t), intent(in) :: hpol
type(flavor_t), intent(in) :: flv
type(helicity_t), intent(out) :: hel
end subroutine hepmc_polarization_to_hel
<<HepMC interface: procedures>>=
module subroutine hepmc_polarization_to_hel (hpol, flv, hel)
type(hepmc_polarization_t), intent(in) :: hpol
type(flavor_t), intent(in) :: flv
type(helicity_t), intent(out) :: hel
real(default) :: theta
integer :: hmax
theta = polarization_theta (hpol%obj)
hmax = flv%get_spin_type () / 2
call hel%init (sign (hmax, nint (cos (theta))))
end subroutine hepmc_polarization_to_hel
@ %def hepmc_polarization_to_hel
@
\subsection{GenParticle}
Particle objects have the obvious meaning.
<<HepMC interface: public>>=
public :: hepmc_particle_t
<<HepMC interface: types>>=
type :: hepmc_particle_t
private
type(c_ptr) :: obj
end type hepmc_particle_t
@ %def hepmc_particle_t
@ Constructor. The C version takes a FourVector object, which in the
Fortran wrapper is created on the fly from a [[vector4]] Lorentz
vector.
No destructor is needed as long as all particles are entered into
vertex containers.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_gen_particle (prt_obj, pdg_id, status) bind(C)
import
type(c_ptr), value :: prt_obj
integer(c_int), value :: pdg_id, status
end function new_gen_particle
end interface
@ %def new_gen_particle
<<HepMC interface: public>>=
public :: hepmc_particle_init
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_particle_init (prt, p, pdg, status)
type(hepmc_particle_t), intent(out) :: prt
type(vector4_t), intent(in) :: p
integer, intent(in) :: pdg, status
end subroutine hepmc_particle_init
<<HepMC interface: procedures>>=
module subroutine hepmc_particle_init (prt, p, pdg, status)
type(hepmc_particle_t), intent(out) :: prt
type(vector4_t), intent(in) :: p
integer, intent(in) :: pdg, status
type(hepmc_four_vector_t) :: pp
call hepmc_four_vector_init (pp, p)
prt%obj = new_gen_particle (pp%obj, int (pdg, c_int), int (status, c_int))
call hepmc_four_vector_final (pp)
end subroutine hepmc_particle_init
@ %def hepmc_particle_init
@ Set the particle color flow.
<<HepMC interface: interfaces>>=
interface
subroutine gen_particle_set_flow (prt_obj, code_index, code) bind(C)
import
type(c_ptr), value :: prt_obj
integer(c_int), value :: code_index, code
end subroutine gen_particle_set_flow
end interface
@ %def gen_particle_set_flow
@ Set the particle color. Either from a [[color_t]] object or
directly from a pair of integers.
<<HepMC interface: interfaces>>=
interface hepmc_particle_set_color
module procedure hepmc_particle_set_color_col
module procedure hepmc_particle_set_color_int
end interface hepmc_particle_set_color
<<HepMC interface: public>>=
public :: hepmc_particle_set_color
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_particle_set_color_col (prt, col)
type(hepmc_particle_t), intent(inout) :: prt
type(color_t), intent(in) :: col
end subroutine hepmc_particle_set_color_col
module subroutine hepmc_particle_set_color_int (prt, col)
type(hepmc_particle_t), intent(inout) :: prt
integer, dimension(2), intent(in) :: col
end subroutine hepmc_particle_set_color_int
<<HepMC interface: procedures>>=
module subroutine hepmc_particle_set_color_col (prt, col)
type(hepmc_particle_t), intent(inout) :: prt
type(color_t), intent(in) :: col
integer(c_int) :: c
c = col%get_col ()
if (c /= 0) call gen_particle_set_flow (prt%obj, 1_c_int, c)
c = col%get_acl ()
if (c /= 0) call gen_particle_set_flow (prt%obj, 2_c_int, c)
end subroutine hepmc_particle_set_color_col
module subroutine hepmc_particle_set_color_int (prt, col)
type(hepmc_particle_t), intent(inout) :: prt
integer, dimension(2), intent(in) :: col
integer(c_int) :: c
c = col(1)
if (c /= 0) call gen_particle_set_flow (prt%obj, 1_c_int, c)
c = col(2)
if (c /= 0) call gen_particle_set_flow (prt%obj, 2_c_int, c)
end subroutine hepmc_particle_set_color_int
@ %def hepmc_particle_set_color
@ Set the particle polarization. For the restrictions on particle
polarization in HepMC, see above [[hepmc_polarization_init]].
<<HepMC interface: interfaces>>=
interface
subroutine gen_particle_set_polarization (prt_obj, pol_obj) bind(C)
import
type(c_ptr), value :: prt_obj, pol_obj
end subroutine gen_particle_set_polarization
end interface
@ %def gen_particle_set_polarization
<<HepMC interface: public>>=
public :: hepmc_particle_set_polarization
<<HepMC interface: interfaces>>=
interface hepmc_particle_set_polarization
module procedure hepmc_particle_set_polarization_pol
module procedure hepmc_particle_set_polarization_hel
module procedure hepmc_particle_set_polarization_int
end interface
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_particle_set_polarization_pol (prt, pol)
type(hepmc_particle_t), intent(inout) :: prt
type(polarization_t), intent(in) :: pol
end subroutine hepmc_particle_set_polarization_pol
module subroutine hepmc_particle_set_polarization_hel (prt, hel)
type(hepmc_particle_t), intent(inout) :: prt
type(helicity_t), intent(in) :: hel
end subroutine hepmc_particle_set_polarization_hel
module subroutine hepmc_particle_set_polarization_int (prt, hel)
type(hepmc_particle_t), intent(inout) :: prt
integer, intent(in) :: hel
end subroutine hepmc_particle_set_polarization_int
<<HepMC interface: procedures>>=
module subroutine hepmc_particle_set_polarization_pol (prt, pol)
type(hepmc_particle_t), intent(inout) :: prt
type(polarization_t), intent(in) :: pol
type(hepmc_polarization_t) :: hpol
call hepmc_polarization_init (hpol, pol)
if (hpol%polarized) call gen_particle_set_polarization (prt%obj, hpol%obj)
call hepmc_polarization_final (hpol)
end subroutine hepmc_particle_set_polarization_pol
module subroutine hepmc_particle_set_polarization_hel (prt, hel)
type(hepmc_particle_t), intent(inout) :: prt
type(helicity_t), intent(in) :: hel
type(hepmc_polarization_t) :: hpol
call hepmc_polarization_init (hpol, hel)
if (hpol%polarized) call gen_particle_set_polarization (prt%obj, hpol%obj)
call hepmc_polarization_final (hpol)
end subroutine hepmc_particle_set_polarization_hel
module subroutine hepmc_particle_set_polarization_int (prt, hel)
type(hepmc_particle_t), intent(inout) :: prt
integer, intent(in) :: hel
type(hepmc_polarization_t) :: hpol
call hepmc_polarization_init (hpol, hel)
if (hpol%polarized) call gen_particle_set_polarization (prt%obj, hpol%obj)
call hepmc_polarization_final (hpol)
end subroutine hepmc_particle_set_polarization_int
@ %def hepmc_particle_set_polarization
@ Return the HepMC barcode (unique integer ID) of the particle.
<<HepMC interface: interfaces>>=
interface
function gen_particle_barcode (prt_obj) result (barcode) bind(C)
import
integer(c_int) :: barcode
type(c_ptr), value :: prt_obj
end function gen_particle_barcode
end interface
@ %def gen_particle_barcode
<<HepMC interface: public>>=
public :: hepmc_particle_get_barcode
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_barcode (prt) result (barcode)
integer :: barcode
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_barcode
<<HepMC interface: procedures>>=
module function hepmc_particle_get_barcode (prt) result (barcode)
integer :: barcode
type(hepmc_particle_t), intent(in) :: prt
barcode = gen_particle_barcode (prt%obj)
end function hepmc_particle_get_barcode
@ %def hepmc_particle_get_barcode
@ Return the four-vector component of the particle object as a [[vector4_t]] Lorentz vector.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function gen_particle_momentum (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function gen_particle_momentum
end interface
@ %def gen_particle_momentum
<<HepMC interface: public>>=
public :: hepmc_particle_get_momentum
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_momentum (prt) result (p)
type(vector4_t) :: p
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_momentum
<<HepMC interface: procedures>>=
module function hepmc_particle_get_momentum (prt) result (p)
type(vector4_t) :: p
type(hepmc_particle_t), intent(in) :: prt
type(hepmc_four_vector_t) :: pp
call hepmc_four_vector_init (pp, prt)
call hepmc_four_vector_to_vector4 (pp, p)
call hepmc_four_vector_final (pp)
end function hepmc_particle_get_momentum
@ %def hepmc_particle_get_momentum
@ Return the invariant mass squared of the particle object. HepMC
stores the signed invariant mass (no squaring).
<<HepMC interface: interfaces>>=
interface
function gen_particle_generated_mass (prt_obj) result (mass) bind(C)
import
real(c_double) :: mass
type(c_ptr), value :: prt_obj
end function gen_particle_generated_mass
end interface
@ %def gen_particle_generated_mass
<<HepMC interface: public>>=
public :: hepmc_particle_get_mass_squared
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_mass_squared (prt) result (m2)
real(default) :: m2
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_mass_squared
<<HepMC interface: procedures>>=
module function hepmc_particle_get_mass_squared (prt) result (m2)
real(default) :: m2
type(hepmc_particle_t), intent(in) :: prt
real(default) :: m
m = gen_particle_generated_mass (prt%obj)
m2 = sign (m**2, m)
end function hepmc_particle_get_mass_squared
@ %def hepmc_particle_get_mass_squared
@ Return the PDG ID:
<<HepMC interface: interfaces>>=
interface
function gen_particle_pdg_id (prt_obj) result (pdg_id) bind(C)
import
integer(c_int) :: pdg_id
type(c_ptr), value :: prt_obj
end function gen_particle_pdg_id
end interface
@ %def gen_particle_pdg_id
<<HepMC interface: public>>=
public :: hepmc_particle_get_pdg
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_pdg (prt) result (pdg)
integer :: pdg
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_pdg
<<HepMC interface: procedures>>=
module function hepmc_particle_get_pdg (prt) result (pdg)
integer :: pdg
type(hepmc_particle_t), intent(in) :: prt
pdg = gen_particle_pdg_id (prt%obj)
end function hepmc_particle_get_pdg
@ %def hepmc_particle_get_pdg
@ Return the status code:
<<HepMC interface: interfaces>>=
interface
function gen_particle_status (prt_obj) result (status) bind(C)
import
integer(c_int) :: status
type(c_ptr), value :: prt_obj
end function gen_particle_status
end interface
@ %def gen_particle_status
<<HepMC interface: public>>=
public :: hepmc_particle_get_status
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_status (prt) result (status)
integer :: status
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_status
<<HepMC interface: procedures>>=
module function hepmc_particle_get_status (prt) result (status)
integer :: status
type(hepmc_particle_t), intent(in) :: prt
status = gen_particle_status (prt%obj)
end function hepmc_particle_get_status
@ %def hepmc_particle_get_status
<<HepMC interface: interfaces>>=
interface
function gen_particle_is_beam (prt_obj) result (is_beam) bind(C)
import
logical(c_bool) :: is_beam
type(c_ptr), value :: prt_obj
end function gen_particle_is_beam
end interface
@ %def gen_particle_is_beam
@ Determine whether a particle is a beam particle.
<<HepMC interface: public>>=
public :: hepmc_particle_is_beam
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_is_beam (prt) result (is_beam)
logical :: is_beam
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_is_beam
<<HepMC interface: procedures>>=
module function hepmc_particle_is_beam (prt) result (is_beam)
logical :: is_beam
type(hepmc_particle_t), intent(in) :: prt
is_beam = gen_particle_is_beam (prt%obj)
end function hepmc_particle_is_beam
@ %def hepmc_particle_is_beam
@ Return the production/decay vertex (as a pointer, no finalization
necessary).
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function gen_particle_production_vertex (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function gen_particle_production_vertex
end interface
interface
type(c_ptr) function gen_particle_end_vertex (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function gen_particle_end_vertex
end interface
@ %def gen_particle_production_vertex gen_particle_end_vertex
<<HepMC interface: public>>=
public :: hepmc_particle_get_production_vertex
public :: hepmc_particle_get_decay_vertex
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_production_vertex (prt) result (v)
type(hepmc_vertex_t) :: v
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_production_vertex
module function hepmc_particle_get_decay_vertex (prt) result (v)
type(hepmc_vertex_t) :: v
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_decay_vertex
<<HepMC interface: procedures>>=
module function hepmc_particle_get_production_vertex (prt) result (v)
type(hepmc_vertex_t) :: v
type(hepmc_particle_t), intent(in) :: prt
v%obj = gen_particle_production_vertex (prt%obj)
end function hepmc_particle_get_production_vertex
module function hepmc_particle_get_decay_vertex (prt) result (v)
type(hepmc_vertex_t) :: v
type(hepmc_particle_t), intent(in) :: prt
v%obj = gen_particle_end_vertex (prt%obj)
end function hepmc_particle_get_decay_vertex
@ %def hepmc_particle_get_production_vertex hepmc_particle_get_decay_vertex
@ Convenience function: Return the array of parent particles for a
given HepMC particle. The contents are HepMC barcodes that still have
to be mapped to the particle indices.
<<HepMC interface: public>>=
public :: hepmc_particle_get_parent_barcodes
public :: hepmc_particle_get_child_barcodes
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_parent_barcodes &
(prt) result (parent_barcode)
type(hepmc_particle_t), intent(in) :: prt
integer, dimension(:), allocatable :: parent_barcode
end function hepmc_particle_get_parent_barcodes
module function hepmc_particle_get_child_barcodes &
(prt) result (child_barcode)
type(hepmc_particle_t), intent(in) :: prt
integer, dimension(:), allocatable :: child_barcode
end function hepmc_particle_get_child_barcodes
<<HepMC interface: procedures>>=
module function hepmc_particle_get_parent_barcodes &
(prt) result (parent_barcode)
type(hepmc_particle_t), intent(in) :: prt
integer, dimension(:), allocatable :: parent_barcode
type(hepmc_vertex_t) :: v
type(hepmc_vertex_particle_in_iterator_t) :: it
integer :: i
v = hepmc_particle_get_production_vertex (prt)
if (hepmc_vertex_is_valid (v)) then
allocate (parent_barcode (hepmc_vertex_get_n_in (v)))
if (size (parent_barcode) /= 0) then
if (HEPMC2_AVAILABLE) then
call hepmc_vertex_particle_in_iterator_init (it, v)
do i = 1, size (parent_barcode)
parent_barcode(i) = hepmc_particle_get_barcode &
(hepmc_vertex_particle_in_iterator_get (it))
call hepmc_vertex_particle_in_iterator_advance (it)
end do
call hepmc_vertex_particle_in_iterator_final (it)
else if (HEPMC3_AVAILABLE) then
do i = 1, size (parent_barcode)
parent_barcode(i) = hepmc_particle_get_barcode &
(hepmc_vertex_get_nth_particle_in (v, i))
end do
end if
end if
else
allocate (parent_barcode (0))
end if
end function hepmc_particle_get_parent_barcodes
module function hepmc_particle_get_child_barcodes &
(prt) result (child_barcode)
type(hepmc_particle_t), intent(in) :: prt
integer, dimension(:), allocatable :: child_barcode
type(hepmc_vertex_t) :: v
type(hepmc_vertex_particle_out_iterator_t) :: it
integer :: i
v = hepmc_particle_get_decay_vertex (prt)
if (hepmc_vertex_is_valid (v)) then
allocate (child_barcode (hepmc_vertex_get_n_out (v)))
if (size (child_barcode) /= 0) then
if (HEPMC2_AVAILABLE) then
call hepmc_vertex_particle_out_iterator_init (it, v)
do i = 1, size (child_barcode)
child_barcode(i) = hepmc_particle_get_barcode &
(hepmc_vertex_particle_out_iterator_get (it))
call hepmc_vertex_particle_out_iterator_advance (it)
end do
call hepmc_vertex_particle_out_iterator_final (it)
else if (HEPMC3_AVAILABLE) then
do i = 1, size (child_barcode)
child_barcode(i) = hepmc_particle_get_barcode &
(hepmc_vertex_get_nth_particle_out (v, i))
end do
end if
end if
else
allocate (child_barcode (0))
end if
end function hepmc_particle_get_child_barcodes
@ %def hepmc_particle_get_parent_barcodes hepmc_particle_get_child_barcodes
@ Return the polarization (assuming that the particle is completely
polarized). Note that the generated polarization object needs finalization.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function gen_particle_polarization (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function gen_particle_polarization
end interface
@ %def gen_particle_polarization
<<HepMC interface: public>>=
public :: hepmc_particle_get_polarization
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_polarization (prt) result (pol)
type(hepmc_polarization_t) :: pol
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_polarization
<<HepMC interface: procedures>>=
module function hepmc_particle_get_polarization (prt) result (pol)
type(hepmc_polarization_t) :: pol
type(hepmc_particle_t), intent(in) :: prt
pol%obj = gen_particle_polarization (prt%obj)
end function hepmc_particle_get_polarization
@ %def hepmc_particle_get_polarization
@ Return the particle color as a two-dimensional array (color, anticolor).
<<HepMC interface: interfaces>>=
interface
function gen_particle_flow (prt_obj, code_index) result (code) bind(C)
import
integer(c_int) :: code
type(c_ptr), value :: prt_obj
integer(c_int), value :: code_index
end function gen_particle_flow
end interface
@ %def gen_particle_flow
<<HepMC interface: public>>=
public :: hepmc_particle_get_color
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_color (prt) result (col)
integer, dimension(2) :: col
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_color
<<HepMC interface: procedures>>=
module function hepmc_particle_get_color (prt) result (col)
integer, dimension(2) :: col
type(hepmc_particle_t), intent(in) :: prt
col(1) = gen_particle_flow (prt%obj, 1)
col(2) = - gen_particle_flow (prt%obj, 2)
end function hepmc_particle_get_color
@ %def hepmc_particle_get_color
@
<<HepMC interface: interfaces>>=
interface
function gen_vertex_pos_x (v_obj) result (x) bind(C)
import
type(c_ptr), value :: v_obj
real(c_double) :: x
end function gen_vertex_pos_x
end interface
interface
function gen_vertex_pos_y (v_obj) result (y) bind(C)
import
type(c_ptr), value :: v_obj
real(c_double) :: y
end function gen_vertex_pos_y
end interface
interface
function gen_vertex_pos_z (v_obj) result (z) bind(C)
import
type(c_ptr), value :: v_obj
real(c_double) :: z
end function gen_vertex_pos_z
end interface
interface
function gen_vertex_time (v_obj) result (t) bind(C)
import
type(c_ptr), value :: v_obj
real(c_double) :: t
end function gen_vertex_time
end interface
@
<<HepMC interface: public>>=
public :: hepmc_vertex_to_vertex
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_to_vertex (vtx) result (v)
type(hepmc_vertex_t), intent(in) :: vtx
type(vector4_t) :: v
end function hepmc_vertex_to_vertex
<<HepMC interface: procedures>>=
module function hepmc_vertex_to_vertex (vtx) result (v)
type(hepmc_vertex_t), intent(in) :: vtx
type(vector4_t) :: v
real(default) :: t, vx, vy, vz
if (hepmc_vertex_is_valid (vtx)) then
t = gen_vertex_time (vtx%obj)
vx = gen_vertex_pos_x (vtx%obj)
vy = gen_vertex_pos_y (vtx%obj)
vz = gen_vertex_pos_z (vtx%obj)
v = vector4_moving (t, &
vector3_moving ([vx, vy, vz]))
end if
end function hepmc_vertex_to_vertex
@ %def hepmc_vertex_to_vertex
@
\subsection{GenVertex}
Vertices are made of particles (incoming and outgoing).
<<HepMC interface: public>>=
public :: hepmc_vertex_t
<<HepMC interface: types>>=
type :: hepmc_vertex_t
private
type(c_ptr) :: obj
end type hepmc_vertex_t
@ %def hepmc_vertex_t
@ Constructor. Two versions, one plain, one with the position in
space and time (measured in mm) as argument. The Fortran version has
initializer form, and the vertex position is an optional argument.
A destructor is unnecessary as long as all vertices are entered into
an event container.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_gen_vertex () bind(C)
import
end function new_gen_vertex
end interface
interface
type(c_ptr) function new_gen_vertex_pos (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function new_gen_vertex_pos
end interface
@ %def new_gen_vertex new_gen_vertex_pos
<<HepMC interface: public>>=
public :: hepmc_vertex_init
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_init (v, x)
type(hepmc_vertex_t), intent(out) :: v
type(vector4_t), intent(in), optional :: x
end subroutine hepmc_vertex_init
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_init (v, x)
type(hepmc_vertex_t), intent(out) :: v
type(vector4_t), intent(in), optional :: x
type(hepmc_four_vector_t) :: pos
if (present (x)) then
call hepmc_four_vector_init (pos, x)
v%obj = new_gen_vertex_pos (pos%obj)
call hepmc_four_vector_final (pos)
else
v%obj = new_gen_vertex ()
end if
end subroutine hepmc_vertex_init
@ %def hepmc_vertex_init
@ Return true if the vertex pointer is non-null:
<<HepMC interface: interfaces>>=
interface
function gen_vertex_is_valid (v_obj) result (flag) bind(C)
import
logical(c_bool) :: flag
type(c_ptr), value :: v_obj
end function gen_vertex_is_valid
end interface
@ %def gen_vertex_is_valid
<<HepMC interface: public>>=
public :: hepmc_vertex_is_valid
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_is_valid (v) result (flag)
logical :: flag
type(hepmc_vertex_t), intent(in) :: v
end function hepmc_vertex_is_valid
<<HepMC interface: procedures>>=
module function hepmc_vertex_is_valid (v) result (flag)
logical :: flag
type(hepmc_vertex_t), intent(in) :: v
flag = gen_vertex_is_valid (v%obj)
end function hepmc_vertex_is_valid
@ %def hepmc_vertex_is_valid
@ Add a particle to a vertex, incoming or outgoing.
<<HepMC interface: interfaces>>=
interface
subroutine gen_vertex_add_particle_in (v_obj, prt_obj) bind(C)
import
type(c_ptr), value :: v_obj, prt_obj
end subroutine gen_vertex_add_particle_in
end interface
interface
subroutine gen_vertex_add_particle_out (v_obj, prt_obj) bind(C)
import
type(c_ptr), value :: v_obj, prt_obj
end subroutine gen_vertex_add_particle_out
end interface
<<HepMC interface: public>>=
public :: hepmc_vertex_add_particle_in
public :: hepmc_vertex_add_particle_out
@ %def gen_vertex_add_particle_in gen_vertex_add_particle_out
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_add_particle_in (v, prt)
type(hepmc_vertex_t), intent(inout) :: v
type(hepmc_particle_t), intent(in) :: prt
end subroutine hepmc_vertex_add_particle_in
module subroutine hepmc_vertex_add_particle_out (v, prt)
type(hepmc_vertex_t), intent(inout) :: v
type(hepmc_particle_t), intent(in) :: prt
end subroutine hepmc_vertex_add_particle_out
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_add_particle_in (v, prt)
type(hepmc_vertex_t), intent(inout) :: v
type(hepmc_particle_t), intent(in) :: prt
call gen_vertex_add_particle_in (v%obj, prt%obj)
end subroutine hepmc_vertex_add_particle_in
module subroutine hepmc_vertex_add_particle_out (v, prt)
type(hepmc_vertex_t), intent(inout) :: v
type(hepmc_particle_t), intent(in) :: prt
call gen_vertex_add_particle_out (v%obj, prt%obj)
end subroutine hepmc_vertex_add_particle_out
@ %def hepmc_vertex_add_particle_in hepmc_vertex_add_particle_out
@ Return the number of incoming/outgoing particles.
<<HepMC interface: interfaces>>=
interface
function gen_vertex_particles_in_size (v_obj) result (size) bind(C)
import
integer(c_int) :: size
type(c_ptr), value :: v_obj
end function gen_vertex_particles_in_size
end interface
interface
function gen_vertex_particles_out_size (v_obj) result (size) bind(C)
import
integer(c_int) :: size
type(c_ptr), value :: v_obj
end function gen_vertex_particles_out_size
end interface
interface
function gen_particle_get_n_parents (p_obj) result (size) bind(C)
import
integer(c_int) :: size
type(c_ptr), value :: p_obj
end function gen_particle_get_n_parents
end interface
interface
function gen_particle_get_n_children (p_obj) result (size) bind(C)
import
integer(c_int) :: size
type(c_ptr), value :: p_obj
end function gen_particle_get_n_children
end interface
@ %def gen_vertex_particles_in_size gen_vertex_particles_out_size
@ %def gen_particle_get_n_parents get_particle_get_n_children
<<HepMC interface: public>>=
public :: hepmc_vertex_get_n_in
public :: hepmc_vertex_get_n_out
public :: hepmc_particle_get_parents
public :: hepmc_particle_get_children
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_get_n_in (v) result (n_in)
integer :: n_in
type(hepmc_vertex_t), intent(in) :: v
end function hepmc_vertex_get_n_in
module function hepmc_vertex_get_n_out (v) result (n_out)
integer :: n_out
type(hepmc_vertex_t), intent(in) :: v
end function hepmc_vertex_get_n_out
module function hepmc_particle_get_parents (p) result (n_p)
integer :: n_p
type(hepmc_particle_t), intent(in) :: p
end function hepmc_particle_get_parents
module function hepmc_particle_get_children (p) result (n_ch)
integer :: n_ch
type(hepmc_particle_t), intent(in) :: p
end function hepmc_particle_get_children
<<HepMC interface: procedures>>=
module function hepmc_vertex_get_n_in (v) result (n_in)
integer :: n_in
type(hepmc_vertex_t), intent(in) :: v
n_in = gen_vertex_particles_in_size (v%obj)
end function hepmc_vertex_get_n_in
module function hepmc_vertex_get_n_out (v) result (n_out)
integer :: n_out
type(hepmc_vertex_t), intent(in) :: v
n_out = gen_vertex_particles_out_size (v%obj)
end function hepmc_vertex_get_n_out
module function hepmc_particle_get_parents (p) result (n_p)
integer :: n_p
type(hepmc_particle_t), intent(in) :: p
n_p = gen_particle_get_n_parents (p%obj)
end function hepmc_particle_get_parents
module function hepmc_particle_get_children (p) result (n_ch)
integer :: n_ch
type(hepmc_particle_t), intent(in) :: p
n_ch = gen_particle_get_n_children (p%obj)
end function hepmc_particle_get_children
@ %def hepmc_vertex_n_in hepmc_vertex_n_out
@ %def hepmc_particle_get_parents hepmc_particle_get_children
@ Return the number of parents/children.
<<HepMC interface: public>>=
public :: hepmc_particle_get_n_parents
public :: hepmc_particle_get_n_children
<<HepMC interface: sub interfaces>>=
module function hepmc_particle_get_n_parents (prt) result (n_parents)
integer :: n_parents
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_n_parents
module function hepmc_particle_get_n_children (prt) result (n_children)
integer :: n_children
type(hepmc_particle_t), intent(in) :: prt
end function hepmc_particle_get_n_children
<<HepMC interface: procedures>>=
module function hepmc_particle_get_n_parents (prt) result (n_parents)
integer :: n_parents
type(hepmc_particle_t), intent(in) :: prt
type(hepmc_vertex_t) :: v
if (HEPMC2_AVAILABLE) then
v = hepmc_particle_get_production_vertex (prt)
if (hepmc_vertex_is_valid (v)) then
n_parents = hepmc_vertex_get_n_in (v)
else
n_parents = 0
end if
else if (HEPMC3_AVAILABLE) then
n_parents = hepmc_particle_get_parents (prt)
end if
end function hepmc_particle_get_n_parents
module function hepmc_particle_get_n_children (prt) result (n_children)
integer :: n_children
type(hepmc_particle_t), intent(in) :: prt
type(hepmc_vertex_t) :: v
if (HEPMC2_AVAILABLE) then
v = hepmc_particle_get_decay_vertex (prt)
if (hepmc_vertex_is_valid (v)) then
n_children = hepmc_vertex_get_n_out (v)
else
n_children = 0
end if
else if (HEPMC3_AVAILABLE) then
n_children = hepmc_particle_get_children (prt)
end if
end function hepmc_particle_get_n_children
@ %def hepmc_particle_get_n_parents
@ %def hepmc_particle_get_n_children
\subsection{Vertex-particle-in iterator}
This iterator iterates over all incoming particles in an vertex. We store a
pointer to the vertex in addition to the iterator. This allows for
simple end checking.
The iterator is actually a constant iterator; it can only read.
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_in_iterator_t
<<HepMC interface: types>>=
type :: hepmc_vertex_particle_in_iterator_t
private
type(c_ptr) :: obj
type(c_ptr) :: v_obj
end type hepmc_vertex_particle_in_iterator_t
@ %def hepmc_vertex_particle_in_iterator_t
@ Constructor. The iterator is initialized at the first particle in
the vertex.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function &
new_vertex_particles_in_const_iterator (v_obj) bind(C)
import
type(c_ptr), value :: v_obj
end function new_vertex_particles_in_const_iterator
end interface
@ %def new_vertex_particles_in_const_iterator
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_in_iterator_init
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_in_iterator_init (it, v)
type(hepmc_vertex_particle_in_iterator_t), intent(out) :: it
type(hepmc_vertex_t), intent(in) :: v
end subroutine hepmc_vertex_particle_in_iterator_init
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_in_iterator_init (it, v)
type(hepmc_vertex_particle_in_iterator_t), intent(out) :: it
type(hepmc_vertex_t), intent(in) :: v
it%obj = new_vertex_particles_in_const_iterator (v%obj)
it%v_obj = v%obj
end subroutine hepmc_vertex_particle_in_iterator_init
@ %def hepmc_vertex_particle_in_iterator_init
@ Destructor. Necessary because the iterator is allocated on the
heap.
<<HepMC interface: interfaces>>=
interface
subroutine vertex_particles_in_const_iterator_delete (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end subroutine vertex_particles_in_const_iterator_delete
end interface
@ %def vertex_particles_in_const_iterator_delete
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_in_iterator_final
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_in_iterator_final (it)
type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
end subroutine hepmc_vertex_particle_in_iterator_final
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_in_iterator_final (it)
type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
call vertex_particles_in_const_iterator_delete (it%obj)
end subroutine hepmc_vertex_particle_in_iterator_final
@ %def hepmc_vertex_particle_in_iterator_final
@ Increment
<<HepMC interface: interfaces>>=
interface
subroutine vertex_particles_in_const_iterator_advance (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end subroutine vertex_particles_in_const_iterator_advance
end interface
@ %def vertex_particles_in_const_iterator_advance
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_in_iterator_advance
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_in_iterator_advance (it)
type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
end subroutine hepmc_vertex_particle_in_iterator_advance
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_in_iterator_advance (it)
type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
call vertex_particles_in_const_iterator_advance (it%obj)
end subroutine hepmc_vertex_particle_in_iterator_advance
@ %def hepmc_vertex_particle_in_iterator_advance
@ Reset to the beginning
<<HepMC interface: interfaces>>=
interface
subroutine vertex_particles_in_const_iterator_reset &
(it_obj, v_obj) bind(C)
import
type(c_ptr), value :: it_obj, v_obj
end subroutine vertex_particles_in_const_iterator_reset
end interface
@ %def vertex_particles_in_const_iterator_reset
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_in_iterator_reset
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_in_iterator_reset (it)
type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
end subroutine hepmc_vertex_particle_in_iterator_reset
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_in_iterator_reset (it)
type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
call vertex_particles_in_const_iterator_reset (it%obj, it%v_obj)
end subroutine hepmc_vertex_particle_in_iterator_reset
@ %def hepmc_vertex_particle_in_iterator_reset
@ Test: return true as long as we are not past the end.
<<HepMC interface: interfaces>>=
interface
function vertex_particles_in_const_iterator_is_valid &
(it_obj, v_obj) result (flag) bind(C)
import
logical(c_bool) :: flag
type(c_ptr), value :: it_obj, v_obj
end function vertex_particles_in_const_iterator_is_valid
end interface
@ %def vertex_particles_in_const_iterator_is_valid
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_in_iterator_is_valid
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_particle_in_iterator_is_valid &
(it) result (flag)
logical :: flag
type(hepmc_vertex_particle_in_iterator_t), intent(in) :: it
end function hepmc_vertex_particle_in_iterator_is_valid
<<HepMC interface: procedures>>=
module function hepmc_vertex_particle_in_iterator_is_valid &
(it) result (flag)
logical :: flag
type(hepmc_vertex_particle_in_iterator_t), intent(in) :: it
flag = vertex_particles_in_const_iterator_is_valid (it%obj, it%v_obj)
end function hepmc_vertex_particle_in_iterator_is_valid
@ %def hepmc_vertex_particle_in_iterator_is_valid
@ Return the particle pointed to by the iterator. (The particle
object should not be finalized, since it contains merely a pointer to
the particle which is owned by the vertex.)
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function &
vertex_particles_in_const_iterator_get (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end function vertex_particles_in_const_iterator_get
end interface
@ %def vertex_particles_in_const_iterator_get
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_in_iterator_get
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_particle_in_iterator_get (it) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_particle_in_iterator_t), intent(in) :: it
end function hepmc_vertex_particle_in_iterator_get
<<HepMC interface: procedures>>=
module function hepmc_vertex_particle_in_iterator_get (it) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_particle_in_iterator_t), intent(in) :: it
prt%obj = vertex_particles_in_const_iterator_get (it%obj)
end function hepmc_vertex_particle_in_iterator_get
@ %def hepmc_vertex_particle_in_iterator_get
@
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function vertex_get_nth_particle_in (vtx_obj, n) bind(C)
import
type(c_ptr), value :: vtx_obj
integer(c_int), value :: n
end function vertex_get_nth_particle_in
end interface
interface
type(c_ptr) function vertex_get_nth_particle_out (vtx_obj, n) bind(C)
import
type(c_ptr), value :: vtx_obj
integer(c_int), value :: n
end function vertex_get_nth_particle_out
end interface
@ %def vertex_get_nth_particle_in
<<HepMC interface: public>>=
public :: hepmc_vertex_get_nth_particle_in
public :: hepmc_vertex_get_nth_particle_out
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_get_nth_particle_in (vtx, n) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_t), intent(in) :: vtx
integer, intent(in) :: n
end function hepmc_vertex_get_nth_particle_in
module function hepmc_vertex_get_nth_particle_out (vtx, n) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_t), intent(in) :: vtx
integer, intent(in) :: n
end function hepmc_vertex_get_nth_particle_out
<<HepMC interface: procedures>>=
module function hepmc_vertex_get_nth_particle_in (vtx, n) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_t), intent(in) :: vtx
integer, intent(in) :: n
integer(c_int) :: nth
nth = n
prt%obj = vertex_get_nth_particle_in (vtx%obj, nth)
end function hepmc_vertex_get_nth_particle_in
module function hepmc_vertex_get_nth_particle_out (vtx, n) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_t), intent(in) :: vtx
integer, intent(in) :: n
integer(c_int) :: nth
nth = n
prt%obj = vertex_get_nth_particle_out (vtx%obj, nth)
end function hepmc_vertex_get_nth_particle_out
@ %def hepmc_vertex_get_nth_particle_in
@ %def hepmc_vertex_get_nth_particle_out
@
\subsection{Vertex-particle-out iterator}
This iterator iterates over all incoming particles in an vertex. We store a
pointer to the vertex in addition to the iterator. This allows for
simple end checking.
The iterator is actually a constant iterator; it can only read.
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_out_iterator_t
<<HepMC interface: types>>=
type :: hepmc_vertex_particle_out_iterator_t
private
type(c_ptr) :: obj
type(c_ptr) :: v_obj
end type hepmc_vertex_particle_out_iterator_t
@ %def hepmc_vertex_particle_out_iterator_t
@ Constructor. The iterator is initialized at the first particle in
the vertex.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function &
new_vertex_particles_out_const_iterator (v_obj) bind(C)
import
type(c_ptr), value :: v_obj
end function new_vertex_particles_out_const_iterator
end interface
@ %def new_vertex_particles_out_const_iterator
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_out_iterator_init
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_out_iterator_init (it, v)
type(hepmc_vertex_particle_out_iterator_t), intent(out) :: it
type(hepmc_vertex_t), intent(in) :: v
end subroutine hepmc_vertex_particle_out_iterator_init
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_out_iterator_init (it, v)
type(hepmc_vertex_particle_out_iterator_t), intent(out) :: it
type(hepmc_vertex_t), intent(in) :: v
it%obj = new_vertex_particles_out_const_iterator (v%obj)
it%v_obj = v%obj
end subroutine hepmc_vertex_particle_out_iterator_init
@ %def hepmc_vertex_particle_out_iterator_init
@ Destructor. Necessary because the iterator is allocated on the
heap.
<<HepMC interface: interfaces>>=
interface
subroutine vertex_particles_out_const_iterator_delete (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end subroutine vertex_particles_out_const_iterator_delete
end interface
@ %def vertex_particles_out_const_iterator_delete
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_out_iterator_final
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_out_iterator_final (it)
type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
end subroutine hepmc_vertex_particle_out_iterator_final
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_out_iterator_final (it)
type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
call vertex_particles_out_const_iterator_delete (it%obj)
end subroutine hepmc_vertex_particle_out_iterator_final
@ %def hepmc_vertex_particle_out_iterator_final
@ Increment
<<HepMC interface: interfaces>>=
interface
subroutine vertex_particles_out_const_iterator_advance (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end subroutine vertex_particles_out_const_iterator_advance
end interface
@ %def vertex_particles_out_const_iterator_advance
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_out_iterator_advance
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_out_iterator_advance (it)
type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
end subroutine hepmc_vertex_particle_out_iterator_advance
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_out_iterator_advance (it)
type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
call vertex_particles_out_const_iterator_advance (it%obj)
end subroutine hepmc_vertex_particle_out_iterator_advance
@ %def hepmc_vertex_particle_out_iterator_advance
@ Reset to the beginning
<<HepMC interface: interfaces>>=
interface
subroutine vertex_particles_out_const_iterator_reset &
(it_obj, v_obj) bind(C)
import
type(c_ptr), value :: it_obj, v_obj
end subroutine vertex_particles_out_const_iterator_reset
end interface
@ %def vertex_particles_out_const_iterator_reset
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_out_iterator_reset
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_vertex_particle_out_iterator_reset (it)
type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
end subroutine hepmc_vertex_particle_out_iterator_reset
<<HepMC interface: procedures>>=
module subroutine hepmc_vertex_particle_out_iterator_reset (it)
type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
call vertex_particles_out_const_iterator_reset (it%obj, it%v_obj)
end subroutine hepmc_vertex_particle_out_iterator_reset
@ %def hepmc_vertex_particle_out_iterator_reset
@ Test: return true as long as we are not past the end.
<<HepMC interface: interfaces>>=
interface
function vertex_particles_out_const_iterator_is_valid &
(it_obj, v_obj) result (flag) bind(C)
import
logical(c_bool) :: flag
type(c_ptr), value :: it_obj, v_obj
end function vertex_particles_out_const_iterator_is_valid
end interface
@ %def vertex_particles_out_const_iterator_is_valid
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_out_iterator_is_valid
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_particle_out_iterator_is_valid &
(it) result (flag)
logical :: flag
type(hepmc_vertex_particle_out_iterator_t), intent(in) :: it
end function hepmc_vertex_particle_out_iterator_is_valid
<<HepMC interface: procedures>>=
module function hepmc_vertex_particle_out_iterator_is_valid &
(it) result (flag)
logical :: flag
type(hepmc_vertex_particle_out_iterator_t), intent(in) :: it
flag = vertex_particles_out_const_iterator_is_valid (it%obj, it%v_obj)
end function hepmc_vertex_particle_out_iterator_is_valid
@ %def hepmc_vertex_particle_out_iterator_is_valid
@ Return the particle pointed to by the iterator. (The particle
object should not be finalized, since it contains merely a pointer to
the particle which is owned by the vertex.)
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function &
vertex_particles_out_const_iterator_get (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end function vertex_particles_out_const_iterator_get
end interface
@ %def vertex_particles_out_const_iterator_get
<<HepMC interface: public>>=
public :: hepmc_vertex_particle_out_iterator_get
<<HepMC interface: sub interfaces>>=
module function hepmc_vertex_particle_out_iterator_get (it) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_particle_out_iterator_t), intent(in) :: it
end function hepmc_vertex_particle_out_iterator_get
<<HepMC interface: procedures>>=
module function hepmc_vertex_particle_out_iterator_get (it) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_vertex_particle_out_iterator_t), intent(in) :: it
prt%obj = vertex_particles_out_const_iterator_get (it%obj)
end function hepmc_vertex_particle_out_iterator_get
@ %def hepmc_vertex_particle_out_iterator_get
@
\subsection{GenEvent}
The main object of HepMC is a GenEvent. The object is filled by
GenVertex objects, which in turn contain GenParticle objects.
This is an extension of the abstract [[event_handle_t]], so we can use the
according communicator features.
<<HepMC interface: public>>=
public :: hepmc_event_t
<<HepMC interface: types>>=
type, extends (event_handle_t) :: hepmc_event_t
private
type(c_ptr) :: obj = c_null_ptr
end type hepmc_event_t
@ %def hepmc_event_t
@ Constructor. Arguments are process ID (integer) and event ID
(integer).
The Fortran version has initializer form.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_gen_event (proc_id, event_id) bind(C)
import
integer(c_int), value :: proc_id, event_id
end function new_gen_event
end interface
@ %def new_gen_event
<<HepMC interface: public>>=
public :: hepmc_event_init
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_init (evt, proc_id, event_id)
type(hepmc_event_t), intent(out) :: evt
integer, intent(in), optional :: proc_id, event_id
end subroutine hepmc_event_init
<<HepMC interface: procedures>>=
module subroutine hepmc_event_init (evt, proc_id, event_id)
type(hepmc_event_t), intent(out) :: evt
integer, intent(in), optional :: proc_id, event_id
integer(c_int) :: pid, eid
pid = 0; if (present (proc_id)) pid = proc_id
eid = 0; if (present (event_id)) eid = event_id
evt%obj = new_gen_event (pid, eid)
end subroutine hepmc_event_init
@ %def hepmc_event_init
@ Destructor.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_delete (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end subroutine gen_event_delete
end interface
@ %def gen_event_delete
@ Finalize: use the HepMC destructor. Also nullify the pointer explicitly, to
be on the safe side.
<<HepMC interface: public>>=
public :: hepmc_event_final
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_final (evt)
type(hepmc_event_t), intent(inout) :: evt
end subroutine hepmc_event_final
<<HepMC interface: procedures>>=
module subroutine hepmc_event_final (evt)
type(hepmc_event_t), intent(inout) :: evt
if (c_associated (evt%obj)) then
call gen_event_delete (evt%obj)
evt%obj = c_null_ptr
end if
end subroutine hepmc_event_final
@ %def hepmc_event_final
@ Nullify: do not call the destructor, just nullify the C pointer. There
should be another pointer associated with the object.
<<HepMC interface: public>>=
public :: hepmc_event_nullify
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_nullify (evt)
type(hepmc_event_t), intent(inout) :: evt
end subroutine hepmc_event_nullify
<<HepMC interface: procedures>>=
module subroutine hepmc_event_nullify (evt)
type(hepmc_event_t), intent(inout) :: evt
evt%obj = c_null_ptr
end subroutine hepmc_event_nullify
@ %def hepmc_event_nullify
@ Return the actual object as a C pointer. For use in the native C++
interface only.
<<HepMC interface: public>>=
public :: hepmc_event_get_c_ptr
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_c_ptr (evt) result (p)
type(hepmc_event_t), intent(in) :: evt
type(c_ptr) :: p
end function hepmc_event_get_c_ptr
<<HepMC interface: procedures>>=
module function hepmc_event_get_c_ptr (evt) result (p)
type(hepmc_event_t), intent(in) :: evt
type(c_ptr) :: p
p = evt%obj
end function hepmc_event_get_c_ptr
@ %def hepmc_event_get_c_ptr
@ Screen output. Printing to file is possible in principle (using a
C++ output channel), by allowing an argument. Printing to an open
Fortran unit is obviously not possible.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_print (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end subroutine gen_event_print
end interface
@ %def gen_event_print
<<HepMC interface: public>>=
public :: hepmc_event_print
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_print (evt)
type(hepmc_event_t), intent(in) :: evt
end subroutine hepmc_event_print
<<HepMC interface: procedures>>=
module subroutine hepmc_event_print (evt)
type(hepmc_event_t), intent(in) :: evt
call gen_event_print (evt%obj)
end subroutine hepmc_event_print
@ %def hepmc_event_print
@ Get the event number.
<<HepMC interface: interfaces>>=
interface
integer(c_int) function gen_event_event_number (evt_obj) bind(C)
use iso_c_binding !NODEP!
type(c_ptr), value :: evt_obj
end function gen_event_event_number
end interface
@ %def gen_event_event_number
<<HepMC interface: public>>=
public :: hepmc_event_get_event_index
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_event_index (evt) result (i_proc)
integer :: i_proc
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_event_index
<<HepMC interface: procedures>>=
module function hepmc_event_get_event_index (evt) result (i_proc)
integer :: i_proc
type(hepmc_event_t), intent(in) :: evt
i_proc = gen_event_event_number (evt%obj)
end function hepmc_event_get_event_index
@ %def hepmc_event_get_event_index
<<HepMC interface: interfaces>>=
interface
integer(c_int) function gen_event_get_n_particles &
(evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function gen_event_get_n_particles
end interface
interface
integer(c_int) function gen_event_get_n_beams &
(evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function gen_event_get_n_beams
end interface
@ %def gen_event_get_n_particles gen_event_get_n_beams
<<HepMC interface: public>>=
public :: hepmc_event_get_n_particles
public :: hepmc_event_get_n_beams
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_n_particles (evt) result (n_tot)
integer :: n_tot
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_n_particles
module function hepmc_event_get_n_beams (evt) result (n_tot)
integer :: n_tot
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_n_beams
<<HepMC interface: procedures>>=
module function hepmc_event_get_n_particles (evt) result (n_tot)
integer :: n_tot
type(hepmc_event_t), intent(in) :: evt
n_tot = gen_event_get_n_particles (evt%obj)
end function hepmc_event_get_n_particles
module function hepmc_event_get_n_beams (evt) result (n_tot)
integer :: n_tot
type(hepmc_event_t), intent(in) :: evt
n_tot = gen_event_get_n_beams (evt%obj)
end function hepmc_event_get_n_beams
@ %def hepmc_event_get_n_particles
@ %def hepmc_event_get_n_beams
@ Set the numeric signal process ID
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_set_signal_process_id (evt_obj, proc_id) bind(C)
import
type(c_ptr), value :: evt_obj
integer(c_int), value :: proc_id
end subroutine gen_event_set_signal_process_id
end interface
@ %def gen_event_set_signal_process_id
<<HepMC interface: public>>=
public :: hepmc_event_set_process_id
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_set_process_id (evt, proc)
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: proc
end subroutine hepmc_event_set_process_id
<<HepMC interface: procedures>>=
module subroutine hepmc_event_set_process_id (evt, proc)
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: proc
integer(c_int) :: i_proc
i_proc = proc
call gen_event_set_signal_process_id (evt%obj, i_proc)
end subroutine hepmc_event_set_process_id
@ %def hepmc_event_set_process_id
@ Get the numeric signal process ID
<<HepMC interface: interfaces>>=
interface
integer(c_int) function gen_event_signal_process_id (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function gen_event_signal_process_id
end interface
@ %def gen_event_signal_process_id
<<HepMC interface: public>>=
public :: hepmc_event_get_process_id
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_process_id (evt) result (i_proc)
integer :: i_proc
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_process_id
<<HepMC interface: procedures>>=
module function hepmc_event_get_process_id (evt) result (i_proc)
integer :: i_proc
type(hepmc_event_t), intent(in) :: evt
i_proc = gen_event_signal_process_id (evt%obj)
end function hepmc_event_get_process_id
@ %def hepmc_event_get_process_id
@ Set the event energy scale
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_set_event_scale (evt_obj, scale) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: scale
end subroutine gen_event_set_event_scale
end interface
@ %def gen_event_set_event_scale
<<HepMC interface: public>>=
public :: hepmc_event_set_scale
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_set_scale (evt, scale)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: scale
end subroutine hepmc_event_set_scale
<<HepMC interface: procedures>>=
module subroutine hepmc_event_set_scale (evt, scale)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: scale
real(c_double) :: cscale
cscale = scale
call gen_event_set_event_scale (evt%obj, cscale)
end subroutine hepmc_event_set_scale
@ %def hepmc_event_set_scale
@ Get the event energy scale
<<HepMC interface: interfaces>>=
interface
real(c_double) function gen_event_event_scale (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function gen_event_event_scale
end interface
@ %def gen_event_event_scale
<<HepMC interface: public>>=
public :: hepmc_event_get_scale
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_scale (evt) result (scale)
real(default) :: scale
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_scale
<<HepMC interface: procedures>>=
module function hepmc_event_get_scale (evt) result (scale)
real(default) :: scale
type(hepmc_event_t), intent(in) :: evt
scale = gen_event_event_scale (evt%obj)
end function hepmc_event_get_scale
@ %def hepmc_event_set_scale
@ Set the value of $\alpha_{\rm QCD}$.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_set_alpha_qcd (evt_obj, a) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: a
end subroutine gen_event_set_alpha_qcd
end interface
@ %def gen_event_set_alpha_qcd
<<HepMC interface: public>>=
public :: hepmc_event_set_alpha_qcd
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_set_alpha_qcd (evt, alpha)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: alpha
end subroutine hepmc_event_set_alpha_qcd
<<HepMC interface: procedures>>=
module subroutine hepmc_event_set_alpha_qcd (evt, alpha)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: alpha
real(c_double) :: a
a = alpha
call gen_event_set_alpha_qcd (evt%obj, a)
end subroutine hepmc_event_set_alpha_qcd
@ %def hepmc_event_set_alpha_qcd
@ Get the value of $\alpha_{\rm QCD}$.
<<HepMC interface: interfaces>>=
interface
real(c_double) function gen_event_alpha_qcd (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function gen_event_alpha_qcd
end interface
@ %def gen_event_get_alpha_qcd
<<HepMC interface: public>>=
public :: hepmc_event_get_alpha_qcd
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_alpha_qcd (evt) result (alpha)
real(default) :: alpha
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_alpha_qcd
<<HepMC interface: procedures>>=
module function hepmc_event_get_alpha_qcd (evt) result (alpha)
real(default) :: alpha
type(hepmc_event_t), intent(in) :: evt
alpha = gen_event_alpha_qcd (evt%obj)
end function hepmc_event_get_alpha_qcd
@ %def hepmc_event_get_alpha_qcd
@ Set the value of $\alpha_{\rm QED}$.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_set_alpha_qed (evt_obj, a) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: a
end subroutine gen_event_set_alpha_qed
end interface
@ %def gen_event_set_alpha_qed
<<HepMC interface: public>>=
public :: hepmc_event_set_alpha_qed
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_set_alpha_qed (evt, alpha)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: alpha
end subroutine hepmc_event_set_alpha_qed
<<HepMC interface: procedures>>=
module subroutine hepmc_event_set_alpha_qed (evt, alpha)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: alpha
real(c_double) :: a
a = alpha
call gen_event_set_alpha_qed (evt%obj, a)
end subroutine hepmc_event_set_alpha_qed
@ %def hepmc_event_set_alpha_qed
@ Get the value of $\alpha_{\rm QED}$.
<<HepMC interface: interfaces>>=
interface
real(c_double) function gen_event_alpha_qed (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function gen_event_alpha_qed
end interface
@ %def gen_event_get_alpha_qed
<<HepMC interface: public>>=
public :: hepmc_event_get_alpha_qed
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_alpha_qed (evt) result (alpha)
real(default) :: alpha
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_alpha_qed
<<HepMC interface: procedures>>=
module function hepmc_event_get_alpha_qed (evt) result (alpha)
real(default) :: alpha
type(hepmc_event_t), intent(in) :: evt
alpha = gen_event_alpha_qed (evt%obj)
end function hepmc_event_get_alpha_qed
@ %def hepmc_event_get_alpha_qed
@ Clear a weight value to the end of the weight container.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_clear_weights (evt_obj) bind(C)
use iso_c_binding !NODEP!
type(c_ptr), value :: evt_obj
end subroutine gen_event_clear_weights
end interface
@ %def gen_event_set_alpha_qed
@ The HepMC weights are measured in pb.
<<HepMC interface: parameters>>=
integer, parameter, public :: HEPMC3_MODE_HEPMC2 = 1
integer, parameter, public :: HEPMC3_MODE_HEPMC3 = 2
integer, parameter, public :: HEPMC3_MODE_ROOT = 3
integer, parameter, public :: HEPMC3_MODE_ROOTTREE = 4
integer, parameter, public :: HEPMC3_MODE_HEPEVT = 5
@ %def HEPMC3_MODE_HEPMC2 HEPMC3_MODE_HEPMC3
@ %def HEPMC3_MODE_ROOT HEPMC3_MODE_ROOTTREE
@ %def HEPMC3_MODE_HEPEVT
@
<<HepMC interface: public>>=
public :: hepmc_event_clear_weights
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_clear_weights (evt)
type(hepmc_event_t), intent(in) :: evt
end subroutine hepmc_event_clear_weights
<<HepMC interface: procedures>>=
module subroutine hepmc_event_clear_weights (evt)
type(hepmc_event_t), intent(in) :: evt
call gen_event_clear_weights (evt%obj)
end subroutine hepmc_event_clear_weights
@ %def hepmc_event_clear_weights
@ Add a weight value to the end of the weight container.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_add_weight (evt_obj, w) bind(C)
use iso_c_binding !NODEP!
type(c_ptr), value :: evt_obj
real(c_double), value :: w
end subroutine gen_event_add_weight
end interface
@ %def gen_event_add_weight
@
<<HepMC interface: public>>=
public :: hepmc_event_add_weight
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_add_weight (evt, weight, rescale)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: weight
logical, intent(in) :: rescale
end subroutine hepmc_event_add_weight
<<HepMC interface: procedures>>=
module subroutine hepmc_event_add_weight (evt, weight, rescale)
type(hepmc_event_t), intent(in) :: evt
real(default), intent(in) :: weight
logical, intent(in) :: rescale
real(c_double) :: w
if (rescale) then
w = weight * pb_per_fb
else
w = weight
end if
call gen_event_add_weight (evt%obj, w)
end subroutine hepmc_event_add_weight
@ %def hepmc_event_add_weight
@ Get the size of the weight container (the number of valid elements).
<<HepMC interface: interfaces>>=
interface
integer(c_int) function gen_event_weights_size (evt_obj) bind(C)
use iso_c_binding !NODEP!
type(c_ptr), value :: evt_obj
end function gen_event_weights_size
end interface
@ %def gen_event_get_weight
<<HepMC interface: public>>=
public :: hepmc_event_get_weights_size
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_weights_size (evt) result (n)
integer :: n
type(hepmc_event_t), intent(in) :: evt
end function hepmc_event_get_weights_size
<<HepMC interface: procedures>>=
module function hepmc_event_get_weights_size (evt) result (n)
integer :: n
type(hepmc_event_t), intent(in) :: evt
n = gen_event_weights_size (evt%obj)
end function hepmc_event_get_weights_size
@ %def hepmc_event_get_weights_size
@ Get the value of the weight with index [[i]]. (Count from 1, while C counts
from zero.)
<<HepMC interface: interfaces>>=
interface
real(c_double) function gen_event_weight (evt_obj, i) bind(C)
use iso_c_binding !NODEP!
type(c_ptr), value :: evt_obj
integer(c_int), value :: i
end function gen_event_weight
end interface
@ %def gen_event_get_weight
<<HepMC interface: public>>=
public :: hepmc_event_get_weight
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_weight (evt, index, rescale) result (weight)
real(default) :: weight
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: index
logical, intent(in) :: rescale
end function hepmc_event_get_weight
<<HepMC interface: procedures>>=
module function hepmc_event_get_weight (evt, index, rescale) result (weight)
real(default) :: weight
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: index
logical, intent(in) :: rescale
integer(c_int) :: i
i = index - 1
if (rescale) then
weight = gen_event_weight (evt%obj, i) / pb_per_fb
else
weight = gen_event_weight (evt%obj, i)
end if
end function hepmc_event_get_weight
@ %def hepmc_event_get_weight
@ Add a vertex to the event container.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_add_vertex (evt_obj, v_obj) bind(C)
import
type(c_ptr), value :: evt_obj
type(c_ptr), value :: v_obj
end subroutine gen_event_add_vertex
end interface
@ %def gen_event_add_vertex
<<HepMC interface: public>>=
public :: hepmc_event_add_vertex
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_add_vertex (evt, v)
type(hepmc_event_t), intent(inout) :: evt
type(hepmc_vertex_t), intent(in) :: v
end subroutine hepmc_event_add_vertex
<<HepMC interface: procedures>>=
module subroutine hepmc_event_add_vertex (evt, v)
type(hepmc_event_t), intent(inout) :: evt
type(hepmc_vertex_t), intent(in) :: v
call gen_event_add_vertex (evt%obj, v%obj)
end subroutine hepmc_event_add_vertex
@ %def hepmc_event_add_vertex
@ Mark a particular vertex as the signal process (hard interaction).
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_set_signal_process_vertex (evt_obj, v_obj) bind(C)
import
type(c_ptr), value :: evt_obj
type(c_ptr), value :: v_obj
end subroutine gen_event_set_signal_process_vertex
end interface
@ %def gen_event_set_signal_process_vertex
<<HepMC interface: public>>=
public :: hepmc_event_set_signal_process_vertex
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_set_signal_process_vertex (evt, v)
type(hepmc_event_t), intent(inout) :: evt
type(hepmc_vertex_t), intent(in) :: v
end subroutine hepmc_event_set_signal_process_vertex
<<HepMC interface: procedures>>=
module subroutine hepmc_event_set_signal_process_vertex (evt, v)
type(hepmc_event_t), intent(inout) :: evt
type(hepmc_vertex_t), intent(in) :: v
call gen_event_set_signal_process_vertex (evt%obj, v%obj)
end subroutine hepmc_event_set_signal_process_vertex
@ %def hepmc_event_set_signal_process_vertex
@ Return the the signal process (hard interaction).
<<HepMC interface: interfaces>>=
interface
function gen_event_get_signal_process_vertex (evt_obj) &
result (v_obj) bind(C)
import
type(c_ptr), value :: evt_obj
type(c_ptr) :: v_obj
end function gen_event_get_signal_process_vertex
end interface
@ %def gen_event_get_signal_process_vertex
<<HepMC interface: public>>=
public :: hepmc_event_get_signal_process_vertex
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_signal_process_vertex (evt) result (v)
type(hepmc_event_t), intent(in) :: evt
type(hepmc_vertex_t) :: v
end function hepmc_event_get_signal_process_vertex
<<HepMC interface: procedures>>=
module function hepmc_event_get_signal_process_vertex (evt) result (v)
type(hepmc_event_t), intent(in) :: evt
type(hepmc_vertex_t) :: v
v%obj = gen_event_get_signal_process_vertex (evt%obj)
end function hepmc_event_get_signal_process_vertex
@ %def hepmc_event_get_signal_process_vertex
@ Set the beam particles explicitly.
<<HepMC interface: public>>=
public :: hepmc_event_set_beam_particles
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_set_beam_particles (evt, prt1, prt2)
type(hepmc_event_t), intent(inout) :: evt
type(hepmc_particle_t), intent(in) :: prt1, prt2
logical(c_bool) :: flag
end subroutine hepmc_event_set_beam_particles
<<HepMC interface: procedures>>=
module subroutine hepmc_event_set_beam_particles (evt, prt1, prt2)
type(hepmc_event_t), intent(inout) :: evt
type(hepmc_particle_t), intent(in) :: prt1, prt2
logical(c_bool) :: flag
flag = gen_event_set_beam_particles (evt%obj, prt1%obj, prt2%obj)
end subroutine hepmc_event_set_beam_particles
@ %def hepmc_event_set_beam_particles
@ The C function returns a boolean which we do not use.
<<HepMC interface: interfaces>>=
interface
logical(c_bool) function gen_event_set_beam_particles &
(evt_obj, prt1_obj, prt2_obj) bind(C)
import
type(c_ptr), value :: evt_obj, prt1_obj, prt2_obj
end function gen_event_set_beam_particles
end interface
@ %def gen_event_set_beam_particles
@ Set the cross section and error explicitly. Note that HepMC uses
pb, while WHIZARD uses fb.
<<HepMC interface: public>>=
public :: hepmc_event_set_cross_section
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_set_cross_section (evt, xsec, xsec_err)
type(hepmc_event_t), intent(inout) :: evt
real(default), intent(in) :: xsec, xsec_err
end subroutine hepmc_event_set_cross_section
<<HepMC interface: procedures>>=
module subroutine hepmc_event_set_cross_section (evt, xsec, xsec_err)
type(hepmc_event_t), intent(inout) :: evt
real(default), intent(in) :: xsec, xsec_err
call gen_event_set_cross_section &
(evt%obj, &
real (xsec * 1e-3_default, c_double), &
real (xsec_err * 1e-3_default, c_double))
end subroutine hepmc_event_set_cross_section
@ %def hepmc_event_set_cross_section
@ The C function returns a boolean which we do not use.
<<HepMC interface: interfaces>>=
interface
subroutine gen_event_set_cross_section (evt_obj, xs, xs_err) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: xs, xs_err
end subroutine gen_event_set_cross_section
end interface
@ %def gen_event_set_cross_section
@
\subsection{Event-particle iterator}
This iterator iterates over all particles in an event. We store a
pointer to the event in addition to the iterator. This allows for
simple end checking.
The iterator is actually a constant iterator; it can only read.
<<HepMC interface: public>>=
public :: hepmc_event_particle_iterator_t
<<HepMC interface: types>>=
type :: hepmc_event_particle_iterator_t
private
type(c_ptr) :: obj
type(c_ptr) :: evt_obj
end type hepmc_event_particle_iterator_t
@ %def hepmc_event_particle_iterator_t
@ Constructor. The iterator is initialized at the first particle in
the event.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_event_particle_const_iterator (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function new_event_particle_const_iterator
end interface
@ %def new_event_particle_const_iterator
<<HepMC interface: public>>=
public :: hepmc_event_particle_iterator_init
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_particle_iterator_init (it, evt)
type(hepmc_event_particle_iterator_t), intent(out) :: it
type(hepmc_event_t), intent(in) :: evt
end subroutine hepmc_event_particle_iterator_init
<<HepMC interface: procedures>>=
module subroutine hepmc_event_particle_iterator_init (it, evt)
type(hepmc_event_particle_iterator_t), intent(out) :: it
type(hepmc_event_t), intent(in) :: evt
it%obj = new_event_particle_const_iterator (evt%obj)
it%evt_obj = evt%obj
end subroutine hepmc_event_particle_iterator_init
@ %def hepmc_event_particle_iterator_init
@ Destructor. Necessary because the iterator is allocated on the
heap.
<<HepMC interface: interfaces>>=
interface
subroutine event_particle_const_iterator_delete (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end subroutine event_particle_const_iterator_delete
end interface
@ %def event_particle_const_iterator_delete
<<HepMC interface: public>>=
public :: hepmc_event_particle_iterator_final
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_particle_iterator_final (it)
type(hepmc_event_particle_iterator_t), intent(inout) :: it
end subroutine hepmc_event_particle_iterator_final
<<HepMC interface: procedures>>=
module subroutine hepmc_event_particle_iterator_final (it)
type(hepmc_event_particle_iterator_t), intent(inout) :: it
call event_particle_const_iterator_delete (it%obj)
end subroutine hepmc_event_particle_iterator_final
@ %def hepmc_event_particle_iterator_final
@ Increment
<<HepMC interface: interfaces>>=
interface
subroutine event_particle_const_iterator_advance (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end subroutine event_particle_const_iterator_advance
end interface
@ %def event_particle_const_iterator_advance
<<HepMC interface: public>>=
public :: hepmc_event_particle_iterator_advance
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_particle_iterator_advance (it)
type(hepmc_event_particle_iterator_t), intent(inout) :: it
end subroutine hepmc_event_particle_iterator_advance
<<HepMC interface: procedures>>=
module subroutine hepmc_event_particle_iterator_advance (it)
type(hepmc_event_particle_iterator_t), intent(inout) :: it
call event_particle_const_iterator_advance (it%obj)
end subroutine hepmc_event_particle_iterator_advance
@ %def hepmc_event_particle_iterator_advance
@ Reset to the beginning
<<HepMC interface: interfaces>>=
interface
subroutine event_particle_const_iterator_reset (it_obj, evt_obj) bind(C)
import
type(c_ptr), value :: it_obj, evt_obj
end subroutine event_particle_const_iterator_reset
end interface
@ %def event_particle_const_iterator_reset
<<HepMC interface: public>>=
public :: hepmc_event_particle_iterator_reset
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_event_particle_iterator_reset (it)
type(hepmc_event_particle_iterator_t), intent(inout) :: it
end subroutine hepmc_event_particle_iterator_reset
<<HepMC interface: procedures>>=
module subroutine hepmc_event_particle_iterator_reset (it)
type(hepmc_event_particle_iterator_t), intent(inout) :: it
call event_particle_const_iterator_reset (it%obj, it%evt_obj)
end subroutine hepmc_event_particle_iterator_reset
@ %def hepmc_event_particle_iterator_reset
@ Test: return true as long as we are not past the end.
<<HepMC interface: interfaces>>=
interface
function event_particle_const_iterator_is_valid &
(it_obj, evt_obj) result (flag) bind(C)
import
logical(c_bool) :: flag
type(c_ptr), value :: it_obj, evt_obj
end function event_particle_const_iterator_is_valid
end interface
@ %def event_particle_const_iterator_is_valid
<<HepMC interface: public>>=
public :: hepmc_event_particle_iterator_is_valid
<<HepMC interface: sub interfaces>>=
module function hepmc_event_particle_iterator_is_valid (it) result (flag)
logical :: flag
type(hepmc_event_particle_iterator_t), intent(in) :: it
end function hepmc_event_particle_iterator_is_valid
<<HepMC interface: procedures>>=
module function hepmc_event_particle_iterator_is_valid (it) result (flag)
logical :: flag
type(hepmc_event_particle_iterator_t), intent(in) :: it
flag = event_particle_const_iterator_is_valid (it%obj, it%evt_obj)
end function hepmc_event_particle_iterator_is_valid
@ %def hepmc_event_particle_iterator_is_valid
@ Return the particle pointed to by the iterator. (The particle
object should not be finalized, since it contains merely a pointer to
the particle which is owned by the vertex.)
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function event_particle_const_iterator_get (it_obj) bind(C)
import
type(c_ptr), value :: it_obj
end function event_particle_const_iterator_get
end interface
@ %def event_particle_const_iterator_get
<<HepMC interface: public>>=
public :: hepmc_event_particle_iterator_get
<<HepMC interface: sub interfaces>>=
module function hepmc_event_particle_iterator_get (it) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_event_particle_iterator_t), intent(in) :: it
end function hepmc_event_particle_iterator_get
<<HepMC interface: procedures>>=
module function hepmc_event_particle_iterator_get (it) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_event_particle_iterator_t), intent(in) :: it
prt%obj = event_particle_const_iterator_get (it%obj)
end function hepmc_event_particle_iterator_get
@ %def hepmc_event_particle_iterator_get
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function gen_event_get_nth_particle (evt_obj, n) bind(C)
import
type(c_ptr), value :: evt_obj
integer(c_int), value :: n
end function gen_event_get_nth_particle
end interface
interface
integer(c_int) function gen_event_get_nth_beam (evt_obj, n) bind(C)
import
type(c_ptr), value :: evt_obj
integer(c_int), value :: n
end function gen_event_get_nth_beam
end interface
@ %def gen_event_get_nth_particle
@ %def gen_event_get_nth_beam
<<HepMC interface: public>>=
public :: hepmc_event_get_nth_particle
public :: hepmc_event_get_nth_beam
<<HepMC interface: sub interfaces>>=
module function hepmc_event_get_nth_particle (evt, n) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: n
end function hepmc_event_get_nth_particle
module function hepmc_event_get_nth_beam (evt, n) result (beam_barcode)
integer :: beam_barcode
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: n
end function hepmc_event_get_nth_beam
<<HepMC interface: procedures>>=
module function hepmc_event_get_nth_particle (evt, n) result (prt)
type(hepmc_particle_t) :: prt
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: n
integer :: n_tot
integer(c_int) :: nth
nth = n
n_tot = gen_event_get_n_particles (evt%obj)
if (n > n_tot .or. n < 1) then
prt%obj = c_null_ptr
call msg_error ("HepMC interface called for wrong particle ID.")
else
prt%obj = gen_event_get_nth_particle (evt%obj, nth)
end if
end function hepmc_event_get_nth_particle
module function hepmc_event_get_nth_beam (evt, n) result (beam_barcode)
integer :: beam_barcode
type(hepmc_event_t), intent(in) :: evt
integer, intent(in) :: n
integer(c_int) :: bc
bc = gen_event_get_nth_beam (evt%obj, n)
beam_barcode = bc
end function hepmc_event_get_nth_beam
@ %def hepmc_event_get_nth_particle
@ %def hepmc_event_get_nth_beam
@
\subsection{I/O streams}
There is a specific I/O stream type for handling the output of
GenEvent objects (i.e., Monte Carlo event samples) to file. Opening
the file is done by the constructor, closing by the destructor.
<<HepMC interface: public>>=
public :: hepmc_iostream_t
<<HepMC interface: types>>=
type :: hepmc_iostream_t
private
type(c_ptr) :: obj
end type hepmc_iostream_t
@ %def hepmc_iostream_t
@ Constructor for an output stream associated to a file.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_io_gen_event_out (hepmc3_mode, filename) bind(C)
import
integer(c_int), intent(in) :: hepmc3_mode
character(c_char), dimension(*), intent(in) :: filename
end function new_io_gen_event_out
end interface
@ %def new_io_gen_event_out
<<HepMC interface: public>>=
public :: hepmc_iostream_open_out
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_iostream_open_out (iostream, filename, hepmc3_mode)
type(hepmc_iostream_t), intent(out) :: iostream
type(string_t), intent(in) :: filename
integer, intent(in) :: hepmc3_mode
end subroutine hepmc_iostream_open_out
<<HepMC interface: procedures>>=
module subroutine hepmc_iostream_open_out (iostream, filename, hepmc3_mode)
type(hepmc_iostream_t), intent(out) :: iostream
type(string_t), intent(in) :: filename
integer, intent(in) :: hepmc3_mode
integer(c_int) :: mode
mode = hepmc3_mode
iostream%obj = &
new_io_gen_event_out (mode, char (filename) // c_null_char)
end subroutine hepmc_iostream_open_out
@ %def hepmc_iostream_open_out
@ Constructor for an input stream associated to a file.
<<HepMC interface: interfaces>>=
interface
type(c_ptr) function new_io_gen_event_in (hepmc3_mode, filename) bind(C)
import
integer(c_int), intent(in) :: hepmc3_mode
character(c_char), dimension(*), intent(in) :: filename
end function new_io_gen_event_in
end interface
@ %def new_io_gen_event_in
<<HepMC interface: public>>=
public :: hepmc_iostream_open_in
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_iostream_open_in (iostream, filename, hepmc3_mode)
type(hepmc_iostream_t), intent(out) :: iostream
type(string_t), intent(in) :: filename
integer, intent(in) :: hepmc3_mode
end subroutine hepmc_iostream_open_in
<<HepMC interface: procedures>>=
module subroutine hepmc_iostream_open_in (iostream, filename, hepmc3_mode)
type(hepmc_iostream_t), intent(out) :: iostream
type(string_t), intent(in) :: filename
integer, intent(in) :: hepmc3_mode
integer(c_int) :: mode
mode = hepmc3_mode
iostream%obj = &
new_io_gen_event_in (mode, char (filename) // c_null_char)
end subroutine hepmc_iostream_open_in
@ %def hepmc_iostream_open_in
@ Destructor:
<<HepMC interface: interfaces>>=
interface
subroutine io_gen_event_delete (io_obj) bind(C)
import
type(c_ptr), value :: io_obj
end subroutine io_gen_event_delete
end interface
@ %def io_gen_event_delete
<<HepMC interface: public>>=
public :: hepmc_iostream_close
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_iostream_close (iostream)
type(hepmc_iostream_t), intent(inout) :: iostream
end subroutine hepmc_iostream_close
<<HepMC interface: procedures>>=
module subroutine hepmc_iostream_close (iostream)
type(hepmc_iostream_t), intent(inout) :: iostream
call io_gen_event_delete (iostream%obj)
end subroutine hepmc_iostream_close
@ %def hepmc_iostream_close
@ Write a single event to the I/O stream.
<<HepMC interface: interfaces>>=
interface
subroutine io_gen_event_write_event (io_obj, evt_obj) bind(C)
import
type(c_ptr), value :: io_obj, evt_obj
end subroutine io_gen_event_write_event
end interface
interface
subroutine io_gen_event_write_event_hepmc2 (io_obj, evt_obj) bind(C)
import
type(c_ptr), value :: io_obj, evt_obj
end subroutine io_gen_event_write_event_hepmc2
end interface
@ %def io_gen_event_write_event io_gen_event_write_event_hepmc2
<<HepMC interface: public>>=
public :: hepmc_iostream_write_event
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_iostream_write_event (iostream, evt, hepmc3_mode)
type(hepmc_iostream_t), intent(inout) :: iostream
type(hepmc_event_t), intent(in) :: evt
integer, intent(in), optional :: hepmc3_mode
end subroutine hepmc_iostream_write_event
<<HepMC interface: procedures>>=
module subroutine hepmc_iostream_write_event (iostream, evt, hepmc3_mode)
type(hepmc_iostream_t), intent(inout) :: iostream
type(hepmc_event_t), intent(in) :: evt
integer, intent(in), optional :: hepmc3_mode
integer :: mode
mode = HEPMC3_MODE_HEPMC3
if (present (hepmc3_mode)) mode = hepmc3_mode
call io_gen_event_write_event (iostream%obj, evt%obj)
end subroutine hepmc_iostream_write_event
@ %def hepmc_iostream_write_event
@ Read a single event from the I/O stream. Return true if successful.
<<HepMC interface: interfaces>>=
interface
logical(c_bool) function io_gen_event_read_event (io_obj, evt_obj) bind(C)
import
type(c_ptr), value :: io_obj, evt_obj
end function io_gen_event_read_event
end interface
@ %def io_gen_event_read_event
<<HepMC interface: public>>=
public :: hepmc_iostream_read_event
<<HepMC interface: sub interfaces>>=
module subroutine hepmc_iostream_read_event (iostream, evt, ok)
type(hepmc_iostream_t), intent(inout) :: iostream
type(hepmc_event_t), intent(inout) :: evt
logical, intent(out) :: ok
end subroutine hepmc_iostream_read_event
<<HepMC interface: procedures>>=
module subroutine hepmc_iostream_read_event (iostream, evt, ok)
type(hepmc_iostream_t), intent(inout) :: iostream
type(hepmc_event_t), intent(inout) :: evt
logical, intent(out) :: ok
ok = io_gen_event_read_event (iostream%obj, evt%obj)
end subroutine hepmc_iostream_read_event
@ %def hepmc_iostream_read_event
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[hepmc_interface_ut.f90]]>>=
<<File header>>
module hepmc_interface_ut
use unit_tests
use system_dependencies, only: HEPMC2_AVAILABLE
use system_dependencies, only: HEPMC3_AVAILABLE
use hepmc_interface_uti
<<Standard module head>>
<<HepMC interface: public test>>
contains
<<HepMC interface: test driver>>
end module hepmc_interface_ut
@ %def hepmc_interface_ut
@
<<[[hepmc_interface_uti.f90]]>>=
<<File header>>
module hepmc_interface_uti
<<Use kinds>>
<<Use strings>>
use io_units
use lorentz
use flavors
use colors
use polarizations
use hepmc_interface
<<Standard module head>>
<<HepMC interface: test declarations>>
contains
<<HepMC interface: tests>>
end module hepmc_interface_uti
@ %def hepmc_interface_ut
@ API: driver for the unit tests below.
<<HepMC interface: public test>>=
public :: hepmc_interface_test
<<HepMC interface: test driver>>=
subroutine hepmc_interface_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<HepMC interface: execute tests>>
end subroutine hepmc_interface_test
@ %def hepmc_test
@
This test example is an abridged version from the build-from-scratch
example in the HepMC distribution. We create two vertices for $p\to
q$ PDF splitting, then a vertex for a $qq\to W^-g$ hard-interaction
process, and finally a vertex for $W^-\to qq$ decay. The setup is for
LHC kinematics.
Extending the original example, we set color flow for the incoming
quarks and polarization for the outgoing photon. For the latter, we
have to define a particle-data object for the photon, so a flavor
object can be correctly initialized.
<<HepMC interface: execute tests>>=
if (HEPMC2_AVAILABLE) then
call test (hepmc_interface_1, "hepmc2_interface_1", &
"check HepMC2 interface", &
u, results)
else if (HEPMC3_AVAILABLE) then
call test (hepmc_interface_1, "hepmc3_interface_1", &
"check HepMC3 interface", &
u, results)
end if
<<HepMC interface: test declarations>>=
public :: hepmc_interface_1
<<HepMC interface: tests>>=
subroutine hepmc_interface_1 (u)
use physics_defs, only: VECTOR
use model_data, only: field_data_t
integer, intent(in) :: u
integer :: u_file, iostat
type(hepmc_event_t) :: evt
type(hepmc_vertex_t) :: v1, v2, v3, v4
type(hepmc_particle_t) :: prt1, prt2, prt3, prt4, prt5, prt6, prt7, prt8
type(hepmc_iostream_t) :: iostream
type(flavor_t) :: flv
type(color_t) :: col
type(polarization_t) :: pol
type(field_data_t), target :: photon_data
character(80) :: buffer
write (u, "(A)") "* Test output: HepMC interface"
write (u, "(A)") "* Purpose: test HepMC interface"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
! Initialize a photon flavor object and some polarization
call photon_data%init (var_str ("PHOTON"), 22)
call photon_data%set (spin_type=VECTOR)
call photon_data%freeze ()
call flv%init (photon_data)
call pol%init_angles &
(flv, 0.6_default, 1._default, 0.5_default)
! Event initialization
call hepmc_event_init (evt, 20, 1)
write (u, "(A)") "* p -> q splitting"
write (u, "(A)")
! $p\to q$ splittings
call hepmc_vertex_init (v1)
call hepmc_event_add_vertex (evt, v1)
call hepmc_vertex_init (v2)
call hepmc_event_add_vertex (evt, v2)
call particle_init (prt1, &
0._default, 0._default, 7000._default, 7000._default, &
2212, 3)
call hepmc_vertex_add_particle_in (v1, prt1)
call particle_init (prt2, &
0._default, 0._default,-7000._default, 7000._default, &
2212, 3)
call hepmc_vertex_add_particle_in (v2, prt2)
call particle_init (prt3, &
.750_default, -1.569_default, 32.191_default, 32.238_default, &
1, 3)
call color_init_from_array (col, [501])
call hepmc_particle_set_color (prt3, col)
call hepmc_vertex_add_particle_out (v1, prt3)
call particle_init (prt4, &
-3.047_default, -19._default, -54.629_default, 57.920_default, &
-2, 3)
call color_init_from_array (col, [-501])
call hepmc_particle_set_color (prt4, col)
call hepmc_vertex_add_particle_out (v2, prt4)
write (u, "(A)") "* Hard interaction"
write (u, "(A)")
! Hard interaction
call hepmc_vertex_init (v3)
call hepmc_event_add_vertex (evt, v3)
call hepmc_vertex_add_particle_in (v3, prt3)
call hepmc_vertex_add_particle_in (v3, prt4)
call particle_init (prt6, &
-3.813_default, 0.113_default, -1.833_default, 4.233_default, &
22, 1)
call hepmc_particle_set_polarization (prt6, pol)
call hepmc_vertex_add_particle_out (v3, prt6)
call particle_init (prt5, &
1.517_default, -20.68_default, -20.605_default, 85.925_default, &
-24, 3)
call hepmc_vertex_add_particle_out (v3, prt5)
call hepmc_event_set_signal_process_vertex (evt, v3)
! $W^-$ decay
call vertex_init_pos (v4, &
0.12_default, -0.3_default, 0.05_default, 0.004_default)
call hepmc_event_add_vertex (evt, v4)
call hepmc_vertex_add_particle_in (v4, prt5)
call particle_init (prt7, &
-2.445_default, 28.816_default, 6.082_default, 29.552_default, &
1, 1)
call hepmc_vertex_add_particle_out (v4, prt7)
call particle_init (prt8, &
3.962_default, -49.498_default, -26.687_default, 56.373_default, &
-2, 1)
call hepmc_vertex_add_particle_out (v4, prt8)
! Event output
call hepmc_event_print (evt)
write (u, "(A)") "Writing to file 'hepmc_test.hepmc'"
write (u, "(A)")
call hepmc_iostream_open_out (iostream , var_str ("hepmc_test.hepmc"), 2)
call hepmc_iostream_write_event (iostream, evt)
call hepmc_iostream_close (iostream)
write (u, "(A)") "Writing completed"
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "hepmc_test.hepmc", &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:14) == "HepMC::Version") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
write (u, "(A)")
! Wrapup
! call pol%final ()
call hepmc_event_final (evt)
write (u, "(A)")
write (u, "(A)") "* Test output end: hepmc_interface_1"
contains
subroutine vertex_init_pos (v, x, y, z, t)
type(hepmc_vertex_t), intent(out) :: v
real(default), intent(in) :: x, y, z, t
type(vector4_t) :: xx
xx = vector4_moving (t, vector3_moving ([x, y, z]))
call hepmc_vertex_init (v, xx)
end subroutine vertex_init_pos
subroutine particle_init (prt, px, py, pz, E, pdg, status)
type(hepmc_particle_t), intent(out) :: prt
real(default), intent(in) :: px, py, pz, E
integer, intent(in) :: pdg, status
type(vector4_t) :: p
p = vector4_moving (E, vector3_moving ([px, py, pz]))
call hepmc_particle_init (prt, p, pdg, status)
end subroutine particle_init
end subroutine hepmc_interface_1
@ %def hepmc_interface_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{LCIO events}
This section provides the interface to the LCIO C++ library for handling
Monte-Carlo events.
Each C++ class of LCIO that we use is mirrored by a Fortran type,
which contains as its only component the C pointer to the C++ object.
Each C++ method of LCIO that we use has a C wrapper function. This
function takes a pointer to the host object as its first argument.
Further arguments are either C pointers, or in the case of simple
types (integer, real), interoperable C/Fortran objects.
The C wrapper functions have explicit interfaces in the Fortran
module. They are called by Fortran wrapper procedures. These are
treated as methods of the corresponding Fortran type.
<<[[lcio_interface.f90]]>>=
<<File header>>
module lcio_interface
use, intrinsic :: iso_c_binding !NODEP!
<<Use kinds>>
<<Use strings>>
use lorentz
use flavors
use colors
use helicities
use polarizations
use event_handles, only: event_handle_t
<<Standard module head>>
<<LCIO interface: public>>
<<LCIO interface: types>>
<<LCIO interface: interfaces>>
interface
<<LCIO interface: sub interfaces>>
end interface
end module lcio_interface
@ %def lcio_interface
@
<<[[lcio_interface_sub.f90]]>>=
<<File header>>
submodule (lcio_interface) lcio_interface_s
use constants, only: PI
use physics_defs, only: ns_per_mm
use diagnostics
implicit none
contains
<<LCIO interface: procedures>>
end submodule lcio_interface_s
@ %def lcio_interface_s
@
\subsection{Interface check}
This function can be called in order to verify that we are using the
actual LCIO library, and not the dummy version.
<<LCIO interface: interfaces>>=
interface
logical(c_bool) function lcio_available () bind(C)
import
end function lcio_available
end interface
<<LCIO interface: public>>=
public :: lcio_is_available
<<LCIO interface: sub interfaces>>=
module function lcio_is_available () result (flag)
logical :: flag
end function lcio_is_available
<<LCIO interface: procedures>>=
module function lcio_is_available () result (flag)
logical :: flag
flag = lcio_available ()
end function lcio_is_available
@ %def lcio_is_available
@
\subsection{LCIO Run Header}
This is a type for the run header of the LCIO file.
<<LCIO interface: public>>=
public :: lcio_run_header_t
<<LCIO interface: types>>=
type :: lcio_run_header_t
private
type(c_ptr) :: obj
end type lcio_run_header_t
@ %def lcio_run_header_t
The Fortran version has initializer form.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function new_lcio_run_header (proc_id) bind(C)
import
integer(c_int), value :: proc_id
end function new_lcio_run_header
end interface
@ %def new_lcio_run_header
<<LCIO interface: interfaces>>=
interface
subroutine run_header_set_simstring &
(runhdr_obj, simstring) bind(C)
import
type(c_ptr), value :: runhdr_obj
character(c_char), dimension(*), intent(in) :: simstring
end subroutine run_header_set_simstring
end interface
@ %def run_header_set_simstring
<<LCIO interface: public>>=
public :: lcio_run_header_init
<<LCIO interface: sub interfaces>>=
module subroutine lcio_run_header_init (runhdr, proc_id, run_id)
type(lcio_run_header_t), intent(out) :: runhdr
integer, intent(in), optional :: proc_id, run_id
end subroutine lcio_run_header_init
<<LCIO interface: procedures>>=
module subroutine lcio_run_header_init (runhdr, proc_id, run_id)
type(lcio_run_header_t), intent(out) :: runhdr
integer, intent(in), optional :: proc_id, run_id
integer(c_int) :: rid
rid = 0; if (present (run_id)) rid = run_id
runhdr%obj = new_lcio_run_header (rid)
call run_header_set_simstring (runhdr%obj, &
"WHIZARD version:" // "<<Version>>")
end subroutine lcio_run_header_init
@ %def lcio_run_header_init
@
<<LCIO interface: interfaces>>=
interface
subroutine write_run_header (lcwrt_obj, runhdr_obj) bind(C)
import
type(c_ptr), value :: lcwrt_obj
type(c_ptr), value :: runhdr_obj
end subroutine write_run_header
end interface
@ %def write_run_header
<<LCIO interface: public>>=
public :: lcio_run_header_write
<<LCIO interface: sub interfaces>>=
module subroutine lcio_run_header_write (wrt, hdr)
type(lcio_writer_t), intent(inout) :: wrt
type(lcio_run_header_t), intent(inout) :: hdr
end subroutine lcio_run_header_write
<<LCIO interface: procedures>>=
module subroutine lcio_run_header_write (wrt, hdr)
type(lcio_writer_t), intent(inout) :: wrt
type(lcio_run_header_t), intent(inout) :: hdr
call write_run_header (wrt%obj, hdr%obj)
end subroutine lcio_run_header_write
@ %def lcio_run_header_write
@
\subsection{LCIO Event and LC Collection}
The main object of LCIO is a LCEventImpl. The object is filled by
MCParticle objects, which are set as LCCollection.
<<LCIO interface: public>>=
public :: lccollection_t
<<LCIO interface: types>>=
type :: lccollection_t
private
type(c_ptr) :: obj = c_null_ptr
end type lccollection_t
@ %def lccollection_t
@ Initializer.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function new_lccollection () bind(C)
import
end function new_lccollection
end interface
@ %def new_lccollection
<<LCIO interface: public>>=
public :: lcio_event_t
<<LCIO interface: types>>=
type, extends (event_handle_t) :: lcio_event_t
private
type(c_ptr) :: obj = c_null_ptr
type(lccollection_t) :: lccoll
end type lcio_event_t
@ %def lcio_event_t
@ Constructor. Arguments are process ID (integer) and event ID
(integer).
The Fortran version has initializer form.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function new_lcio_event (proc_id, event_id, run_id) bind(C)
import
integer(c_int), value :: proc_id, event_id, run_id
end function new_lcio_event
end interface
@ %def new_lcio_event
@
<<LCIO interface: public>>=
public :: lcio_event_init
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_init (evt, proc_id, event_id, run_id)
type(lcio_event_t), intent(out) :: evt
integer, intent(in), optional :: proc_id, event_id, run_id
end subroutine lcio_event_init
<<LCIO interface: procedures>>=
module subroutine lcio_event_init (evt, proc_id, event_id, run_id)
type(lcio_event_t), intent(out) :: evt
integer, intent(in), optional :: proc_id, event_id, run_id
integer(c_int) :: pid, eid, rid
pid = 0; if (present (proc_id)) pid = proc_id
eid = 0; if (present (event_id)) eid = event_id
rid = 0; if (present (run_id)) rid = run_id
evt%obj = new_lcio_event (pid, eid, rid)
evt%lccoll%obj = new_lccollection ()
end subroutine lcio_event_init
@ %def lcio_event_init
@ Destructor.
<<LCIO interface: interfaces>>=
interface
subroutine lcio_event_delete (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end subroutine lcio_event_delete
end interface
@ %def lcio_event_delete
@ Show event on screen.
<<LCIO interface: interfaces>>=
interface
subroutine dump_lcio_event (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end subroutine dump_lcio_event
end interface
@ %def dump_lcio_event
<<LCIO interface: public>>=
public :: show_lcio_event
<<LCIO interface: sub interfaces>>=
module subroutine show_lcio_event (evt)
type(lcio_event_t), intent(in) :: evt
end subroutine show_lcio_event
<<LCIO interface: procedures>>=
module subroutine show_lcio_event (evt)
type(lcio_event_t), intent(in) :: evt
if (c_associated (evt%obj)) then
call dump_lcio_event (evt%obj)
else
call msg_error ("LCIO event is not allocated.")
end if
end subroutine show_lcio_event
@ %def show_lcio_event
@ Put a single event to file.
<<LCIO interface: interfaces>>=
interface
subroutine lcio_event_to_file (evt_obj, filename) bind(C)
import
type(c_ptr), value :: evt_obj
character(c_char), dimension(*), intent(in) :: filename
end subroutine lcio_event_to_file
end interface
@ %def lcio_event_to_file
<<LCIO interface: public>>=
public :: write_lcio_event
<<LCIO interface: sub interfaces>>=
module subroutine write_lcio_event (evt, filename)
type(lcio_event_t), intent(in) :: evt
type(string_t), intent(in) :: filename
end subroutine write_lcio_event
<<LCIO interface: procedures>>=
module subroutine write_lcio_event (evt, filename)
type(lcio_event_t), intent(in) :: evt
type(string_t), intent(in) :: filename
call lcio_event_to_file (evt%obj, char (filename) // c_null_char)
end subroutine write_lcio_event
@ %def write_lcio_event
@ Finalize: use the LCIO destructor. Also nullify the pointer explicitly, to
be on the safe side.
<<LCIO interface: public>>=
public :: lcio_event_final
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_final (evt, delete)
type(lcio_event_t), intent(inout) :: evt
logical, intent(in) :: delete
end subroutine lcio_event_final
<<LCIO interface: procedures>>=
module subroutine lcio_event_final (evt, delete)
type(lcio_event_t), intent(inout) :: evt
logical, intent(in) :: delete
if (c_associated (evt%obj)) then
if (delete) call lcio_event_delete (evt%obj)
evt%obj = c_null_ptr
evt%lccoll%obj = c_null_ptr
end if
end subroutine lcio_event_final
@ %def lcio_event_final
@ Nullify: do not call the destructor, just nullify the C pointer. There
should be another pointer associated with the object.
<<LCIO interface: public>>=
public :: lcio_event_nullify
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_nullify (evt)
type(lcio_event_t), intent(inout) :: evt
end subroutine lcio_event_nullify
<<LCIO interface: procedures>>=
module subroutine lcio_event_nullify (evt)
type(lcio_event_t), intent(inout) :: evt
evt%obj = c_null_ptr
evt%lccoll%obj = c_null_ptr
end subroutine lcio_event_nullify
@ %def lcio_event_nullify
@ Return the actual object as a C pointer. For use in the native C++
interface only.
<<LCIO interface: public>>=
public :: lcio_event_get_c_ptr
<<LCIO interface: sub interfaces>>=
module function lcio_event_get_c_ptr (evt) result (p)
type(lcio_event_t), intent(in) :: evt
type(c_ptr) :: p
end function lcio_event_get_c_ptr
<<LCIO interface: procedures>>=
module function lcio_event_get_c_ptr (evt) result (p)
type(lcio_event_t), intent(in) :: evt
type(c_ptr) :: p
p = evt%obj
end function lcio_event_get_c_ptr
@ %def lcio_event_get_c_ptr
@
<<LCIO interface: interfaces>>=
interface
subroutine lcio_set_weight (evt_obj, weight) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: weight
end subroutine lcio_set_weight
end interface
interface
subroutine lcio_set_alpha_qcd (evt_obj, alphas) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: alphas
end subroutine lcio_set_alpha_qcd
end interface
interface
subroutine lcio_set_scale (evt_obj, scale) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: scale
end subroutine lcio_set_scale
end interface
interface
subroutine lcio_set_sqrts (evt_obj, sqrts) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: sqrts
end subroutine lcio_set_sqrts
end interface
interface
subroutine lcio_set_xsec (evt_obj, xsec, xsec_err) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: xsec, xsec_err
end subroutine lcio_set_xsec
end interface
interface
subroutine lcio_set_beam (evt_obj, pdg, beam) bind(C)
import
type(c_ptr), value :: evt_obj
integer(c_int), value :: pdg, beam
end subroutine lcio_set_beam
end interface
interface
subroutine lcio_set_pol (evt_obj, pol, beam) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: pol
integer(c_int), value :: beam
end subroutine lcio_set_pol
end interface
interface
subroutine lcio_set_beam_file (evt_obj, file) bind(C)
import
type(c_ptr), value :: evt_obj
character(len=1, kind=c_char), dimension(*), intent(in) :: file
end subroutine lcio_set_beam_file
end interface
interface
subroutine lcio_set_process_name (evt_obj, name) bind(C)
import
type(c_ptr), value :: evt_obj
character(len=1, kind=c_char), dimension(*), intent(in) :: name
end subroutine lcio_set_process_name
end interface
interface
subroutine lcio_set_sqme (evt_obj, sqme) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: sqme
end subroutine lcio_set_sqme
end interface
interface
subroutine lcio_set_alt_sqme (evt_obj, sqme, index) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: sqme
integer(c_int), value :: index
end subroutine lcio_set_alt_sqme
end interface
interface
subroutine lcio_set_alt_weight (evt_obj, weight, index) bind(C)
import
type(c_ptr), value :: evt_obj
real(c_double), value :: weight
integer(c_int), value :: index
end subroutine lcio_set_alt_weight
end interface
@ %def lcio_set_weight lcio_set_alpha_qcd lcio_set_scale lcio_set_sqrts
@ %def lcio_set_xsec lcio_set_beam lcio_set_pol
@ %def lcio_set_beam_file lcio_set_process_name
@ %def lcio_set_sqme lcio_set_alt_sqme lcio_set_alt_weight
@
<<LCIO interface: public>>=
public :: lcio_event_set_weight
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_weight (evt, weight)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: weight
end subroutine lcio_event_set_weight
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_weight (evt, weight)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: weight
call lcio_set_weight (evt%obj, real (weight, c_double))
end subroutine lcio_event_set_weight
@ %def lcio_event_set_weight
@
<<LCIO interface: public>>=
public :: lcio_event_set_alpha_qcd
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_alpha_qcd (evt, alphas)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: alphas
end subroutine lcio_event_set_alpha_qcd
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_alpha_qcd (evt, alphas)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: alphas
call lcio_set_alpha_qcd (evt%obj, real (alphas, c_double))
end subroutine lcio_event_set_alpha_qcd
@ %def lcio_event_set_alpha_qcd
@
<<LCIO interface: public>>=
public :: lcio_event_set_scale
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_scale (evt, scale)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: scale
end subroutine lcio_event_set_scale
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_scale (evt, scale)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: scale
call lcio_set_scale (evt%obj, real (scale, c_double))
end subroutine lcio_event_set_scale
@ %def lcio_event_set_scale
@
<<LCIO interface: public>>=
public :: lcio_event_set_sqrts
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_sqrts (evt, sqrts)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: sqrts
end subroutine lcio_event_set_sqrts
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_sqrts (evt, sqrts)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: sqrts
call lcio_set_sqrts (evt%obj, real (sqrts, c_double))
end subroutine lcio_event_set_sqrts
@ %def lcio_event_set_sqrts
@
<<LCIO interface: public>>=
public :: lcio_event_set_xsec
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_xsec (evt, xsec, xsec_err)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: xsec, xsec_err
end subroutine lcio_event_set_xsec
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_xsec (evt, xsec, xsec_err)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: xsec, xsec_err
call lcio_set_xsec (evt%obj, &
real (xsec, c_double), real (xsec_err, c_double))
end subroutine lcio_event_set_xsec
@ %def lcio_event_set_xsec
@
<<LCIO interface: public>>=
public :: lcio_event_set_beam
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_beam (evt, pdg, beam)
type(lcio_event_t), intent(inout) :: evt
integer, intent(in) :: pdg, beam
end subroutine lcio_event_set_beam
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_beam (evt, pdg, beam)
type(lcio_event_t), intent(inout) :: evt
integer, intent(in) :: pdg, beam
call lcio_set_beam (evt%obj, &
int (pdg, c_int), int (beam, c_int))
end subroutine lcio_event_set_beam
@ %def lcio_event_set_beam
@
<<LCIO interface: public>>=
public :: lcio_event_set_polarization
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_polarization (evt, pol, beam)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: pol
integer, intent(in) :: beam
end subroutine lcio_event_set_polarization
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_polarization (evt, pol, beam)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: pol
integer, intent(in) :: beam
call lcio_set_pol (evt%obj, real (pol, c_double), &
int (beam, c_int))
end subroutine lcio_event_set_polarization
@ %def lcio_event_set_polarization
@
<<LCIO interface: public>>=
public :: lcio_event_set_beam_file
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_beam_file (evt, file)
type(lcio_event_t), intent(inout) :: evt
type(string_t), intent(in) :: file
end subroutine lcio_event_set_beam_file
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_beam_file (evt, file)
type(lcio_event_t), intent(inout) :: evt
type(string_t), intent(in) :: file
call lcio_set_beam_file (evt%obj, &
char (file) // c_null_char)
end subroutine lcio_event_set_beam_file
@ %def lcio_event_set_beam_file
@
<<LCIO interface: public>>=
public :: lcio_event_set_process_name
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_process_name (evt, name)
type(lcio_event_t), intent(inout) :: evt
type(string_t), intent(in) :: name
end subroutine lcio_event_set_process_name
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_process_name (evt, name)
type(lcio_event_t), intent(inout) :: evt
type(string_t), intent(in) :: name
call lcio_set_process_name (evt%obj, &
char (name) // c_null_char)
end subroutine lcio_event_set_process_name
@ %def lcio_event_set_process_name
@
<<LCIO interface: public>>=
public :: lcio_event_set_alt_sqme
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_alt_sqme (evt, sqme, index)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: sqme
integer, intent(in) :: index
end subroutine lcio_event_set_alt_sqme
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_alt_sqme (evt, sqme, index)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: sqme
integer, intent(in) :: index
call lcio_set_alt_sqme (evt%obj, real (sqme, c_double), &
int (index, c_int))
end subroutine lcio_event_set_alt_sqme
@ %def lcio_event_set_alt_sqme
@
<<LCIO interface: public>>=
public :: lcio_event_set_sqme
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_sqme (evt, sqme)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: sqme
end subroutine lcio_event_set_sqme
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_sqme (evt, sqme)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: sqme
call lcio_set_sqme (evt%obj, real (sqme, c_double))
end subroutine lcio_event_set_sqme
@ %def lcio_event_set_sqme
@
<<LCIO interface: public>>=
public :: lcio_event_set_alt_weight
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_set_alt_weight (evt, weight, index)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: weight
integer, intent(in) :: index
end subroutine lcio_event_set_alt_weight
<<LCIO interface: procedures>>=
module subroutine lcio_event_set_alt_weight (evt, weight, index)
type(lcio_event_t), intent(inout) :: evt
real(default), intent(in) :: weight
integer, intent(in) :: index
call lcio_set_alt_weight (evt%obj, real (weight, c_double), &
int (index, c_int))
end subroutine lcio_event_set_alt_weight
@ %def lcio_event_set_alt_weight
@
<<LCIO interface: interfaces>>=
interface
subroutine lcio_event_add_collection &
(evt_obj, lccoll_obj) bind(C)
import
type(c_ptr), value :: evt_obj, lccoll_obj
end subroutine lcio_event_add_collection
end interface
@ %def lcio_event_add_collection
<<LCIO interface: public>>=
public :: lcio_event_add_coll
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_add_coll (evt)
type(lcio_event_t), intent(inout) :: evt
end subroutine lcio_event_add_coll
<<LCIO interface: procedures>>=
module subroutine lcio_event_add_coll (evt)
type(lcio_event_t), intent(inout) :: evt
call lcio_event_add_collection (evt%obj, &
evt%lccoll%obj)
end subroutine lcio_event_add_coll
@ %def lcio_event_add_coll
@
\subsection{LCIO Particle}
Particle objects have the obvious meaning.
<<LCIO interface: public>>=
public :: lcio_particle_t
<<LCIO interface: types>>=
type :: lcio_particle_t
private
type(c_ptr) :: obj
end type lcio_particle_t
@ %def lcio_particle_t
@ Constructor.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function new_lcio_particle &
(px, py, pz, pdg_id, mass, charge, status) bind(C)
import
integer(c_int), value :: pdg_id, status
real(c_double), value :: px, py, pz, mass, charge
end function new_lcio_particle
end interface
@ %def new_lcio_particle
@
<<LCIO interface: interfaces>>=
interface
subroutine add_particle_to_collection &
(prt_obj, lccoll_obj) bind(C)
import
type(c_ptr), value :: prt_obj, lccoll_obj
end subroutine add_particle_to_collection
end interface
@ %def add_particle_to_collection
<<LCIO interface: public>>=
public :: lcio_particle_add_to_evt_coll
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_add_to_evt_coll &
(lprt, evt)
type(lcio_particle_t), intent(in) :: lprt
type(lcio_event_t), intent(inout) :: evt
end subroutine lcio_particle_add_to_evt_coll
<<LCIO interface: procedures>>=
module subroutine lcio_particle_add_to_evt_coll &
(lprt, evt)
type(lcio_particle_t), intent(in) :: lprt
type(lcio_event_t), intent(inout) :: evt
call add_particle_to_collection (lprt%obj, evt%lccoll%obj)
end subroutine lcio_particle_add_to_evt_coll
@ %def lcio_particle_to_collection
@
<<LCIO interface: public>>=
public :: lcio_particle_init
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_init (prt, p, pdg, charge, status)
type(lcio_particle_t), intent(out) :: prt
type(vector4_t), intent(in) :: p
real(default), intent(in) :: charge
integer, intent(in) :: pdg, status
end subroutine lcio_particle_init
<<LCIO interface: procedures>>=
module subroutine lcio_particle_init (prt, p, pdg, charge, status)
type(lcio_particle_t), intent(out) :: prt
type(vector4_t), intent(in) :: p
real(default), intent(in) :: charge
real(default) :: mass
real(default) :: px, py, pz
integer, intent(in) :: pdg, status
px = vector4_get_component (p, 1)
py = vector4_get_component (p, 2)
pz = vector4_get_component (p, 3)
mass = p**1
prt%obj = new_lcio_particle (real (px, c_double), real (py, c_double), &
real (pz, c_double), int (pdg, c_int), &
real (mass, c_double), real (charge, c_double), int (status, c_int))
end subroutine lcio_particle_init
@ %def lcio_particle_init
@ Set the particle color flow.
<<LCIO interface: interfaces>>=
interface
subroutine lcio_set_color_flow (prt_obj, col1, col2) bind(C)
import
type(c_ptr), value :: prt_obj
integer(c_int), value :: col1, col2
end subroutine lcio_set_color_flow
end interface
@ %def lcio_set_color_flow
@ Set the particle color. Either from a [[color_t]] object or
directly from a pair of integers.
<<LCIO interface: interfaces>>=
interface lcio_particle_set_color
module procedure lcio_particle_set_color_col
module procedure lcio_particle_set_color_int
end interface lcio_particle_set_color
<<LCIO interface: public>>=
public :: lcio_particle_set_color
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_set_color_col (prt, col)
type(lcio_particle_t), intent(inout) :: prt
type(color_t), intent(in) :: col
end subroutine lcio_particle_set_color_col
module subroutine lcio_particle_set_color_int (prt, col)
type(lcio_particle_t), intent(inout) :: prt
integer, dimension(2), intent(in) :: col
end subroutine lcio_particle_set_color_int
<<LCIO interface: procedures>>=
module subroutine lcio_particle_set_color_col (prt, col)
type(lcio_particle_t), intent(inout) :: prt
type(color_t), intent(in) :: col
integer(c_int), dimension(2) :: c
c(1) = col%get_col ()
c(2) = col%get_acl ()
if (c(1) /= 0 .or. c(2) /= 0) then
call lcio_set_color_flow (prt%obj, c(1), c(2))
end if
end subroutine lcio_particle_set_color_col
module subroutine lcio_particle_set_color_int (prt, col)
type(lcio_particle_t), intent(inout) :: prt
integer, dimension(2), intent(in) :: col
integer(c_int), dimension(2) :: c
c = col
if (c(1) /= 0 .or. c(2) /= 0) then
call lcio_set_color_flow (prt%obj, c(1), c(2))
end if
end subroutine lcio_particle_set_color_int
@ %def lcio_particle_set_color
@ Return the particle color as a two-dimensional array (color, anticolor).
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_particle_flow (prt_obj, col_index) bind(C)
use iso_c_binding !NODEP!
type(c_ptr), value :: prt_obj
integer(c_int), value :: col_index
end function lcio_particle_flow
end interface
@ %def lcio_particle_flow
<<LCIO interface: public>>=
public :: lcio_particle_get_flow
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_flow (prt) result (col)
integer, dimension(2) :: col
type(lcio_particle_t), intent(in) :: prt
end function lcio_particle_get_flow
<<LCIO interface: procedures>>=
module function lcio_particle_get_flow (prt) result (col)
integer, dimension(2) :: col
type(lcio_particle_t), intent(in) :: prt
col(1) = lcio_particle_flow (prt%obj, 0_c_int)
col(2) = - lcio_particle_flow (prt%obj, 1_c_int)
end function lcio_particle_get_flow
@ %def lcio_particle_get_flow
@ Return the four-momentum of a LCIO particle.
<<LCIO interface: interfaces>>=
interface
real(c_double) function lcio_three_momentum (prt_obj, p_index) bind(C)
use iso_c_binding !NODEP!
type(c_ptr), value :: prt_obj
integer(c_int), value :: p_index
end function lcio_three_momentum
end interface
@ %def lcio_three_momentum
<<LCIO interface: interfaces>>=
interface
real(c_double) function lcio_energy (prt_obj) bind(C)
import
type(c_ptr), intent(in), value :: prt_obj
end function lcio_energy
end interface
@ %def lcio_energy
<<LCIO interface: public>>=
public :: lcio_particle_get_momentum
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_momentum (prt) result (p)
type(vector4_t) :: p
type(lcio_particle_t), intent(in) :: prt
end function lcio_particle_get_momentum
<<LCIO interface: procedures>>=
module function lcio_particle_get_momentum (prt) result (p)
type(vector4_t) :: p
type(lcio_particle_t), intent(in) :: prt
real(default) :: E, px, py, pz
E = lcio_energy (prt%obj)
px = lcio_three_momentum (prt%obj, 0_c_int)
py = lcio_three_momentum (prt%obj, 1_c_int)
pz = lcio_three_momentum (prt%obj, 2_c_int)
p = vector4_moving ( E, vector3_moving ([ px, py, pz ]))
end function lcio_particle_get_momentum
@ %def lcio_particle_get_momentum
@ Return the invariant mass squared of the particle object. LCIO
stores the signed invariant mass (no squaring).
<<LCIO interface: interfaces>>=
interface
function lcio_mass (prt_obj) result (mass) bind(C)
import
real(c_double) :: mass
type(c_ptr), value :: prt_obj
end function lcio_mass
end interface
@ %def lcio_mass
<<LCIO interface: public>>=
public :: lcio_particle_get_mass_squared
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_mass_squared (prt) result (m2)
real(default) :: m2
type(lcio_particle_t), intent(in) :: prt
end function lcio_particle_get_mass_squared
<<LCIO interface: procedures>>=
module function lcio_particle_get_mass_squared (prt) result (m2)
real(default) :: m2
type(lcio_particle_t), intent(in) :: prt
real(default) :: m
m = lcio_mass (prt%obj)
m2 = sign (m**2, m)
end function lcio_particle_get_mass_squared
@ %def lcio_particle_get_mass_squared
@ Return vertex and production time of a LCIO particle.
<<LCIO interface: interfaces>>=
interface
real(c_double) function lcio_vtx_x (prt) bind(C)
import
type(c_ptr), value :: prt
end function lcio_vtx_x
end interface
interface
real(c_double) function lcio_vtx_y (prt) bind(C)
import
type(c_ptr), value :: prt
end function lcio_vtx_y
end interface
interface
real(c_double) function lcio_vtx_z (prt) bind(C)
import
type(c_ptr), value :: prt
end function lcio_vtx_z
end interface
interface
real(c_float) function lcio_prt_time (prt) bind(C)
import
type(c_ptr), value :: prt
end function lcio_prt_time
end interface
@
@
(Decay) times in LCIO are in nanoseconds, so they need to get
converted to mm for the internal format.
<<LCIO interface: public>>=
public :: lcio_particle_get_vertex
public :: lcio_particle_get_time
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_vertex (prt) result (vtx)
type(vector3_t) :: vtx
type(lcio_particle_t), intent(in) :: prt
end function lcio_particle_get_vertex
module function lcio_particle_get_time (prt) result (time)
real(default) :: time
type(lcio_particle_t), intent(in) :: prt
end function lcio_particle_get_time
<<LCIO interface: procedures>>=
module function lcio_particle_get_vertex (prt) result (vtx)
type(vector3_t) :: vtx
type(lcio_particle_t), intent(in) :: prt
real(default) :: vx, vy, vz
vx = lcio_vtx_x (prt%obj)
vy = lcio_vtx_y (prt%obj)
vz = lcio_vtx_z (prt%obj)
vtx = vector3_moving ([vx, vy, vz])
end function lcio_particle_get_vertex
module function lcio_particle_get_time (prt) result (time)
real(default) :: time
type(lcio_particle_t), intent(in) :: prt
time = lcio_prt_time (prt%obj)
time = time / ns_per_mm
end function lcio_particle_get_time
@ %def lcio_particle_get_vertex lcio_particle_get_time
@
\subsection{Polarization}
For polarization there is a three-component float entry foreseen in the LCIO
format. Completely generic density matrices can in principle be attached to
events as float vectors added to [[LCCollection]] of the [[LCEvent]]. This is
not yet implemented currently. Here, we restrict ourselves to the same
implementation as in HepMC format: we use two entries as the polarization
angles, while the first entry gives the degree of polarization (something
not specified in the HepMC format).
\emph{For massive vector bosons, we arbitrarily choose the convention
that the longitudinal (zero) helicity state is mapped to the theta
angle $\pi/2$. This works under the condition that helicity is
projected onto one of the basis states.}
<<LCIO interface: interfaces>>=
interface
subroutine lcio_particle_set_spin (prt_obj, s1, s2, s3) bind(C)
import
type(c_ptr), value :: prt_obj
real(c_double), value :: s1, s2, s3
end subroutine lcio_particle_set_spin
end interface
@ %def lcio_particle_set_spin
@
<<LCIO interface: public>>=
public :: lcio_polarization_init
<<LCIO interface: interfaces>>=
interface lcio_polarization_init
module procedure lcio_polarization_init_pol
module procedure lcio_polarization_init_hel
module procedure lcio_polarization_init_int
end interface
<<LCIO interface: sub interfaces>>=
module subroutine lcio_polarization_init_pol (prt, pol)
type(lcio_particle_t), intent(inout) :: prt
type(polarization_t), intent(in) :: pol
end subroutine lcio_polarization_init_pol
module subroutine lcio_polarization_init_hel (prt, hel)
type(lcio_particle_t), intent(inout) :: prt
type(helicity_t), intent(in) :: hel
end subroutine lcio_polarization_init_hel
module subroutine lcio_polarization_init_int (prt, hel)
type(lcio_particle_t), intent(inout) :: prt
integer, intent(in) :: hel
end subroutine lcio_polarization_init_int
<<LCIO interface: procedures>>=
module subroutine lcio_polarization_init_pol (prt, pol)
type(lcio_particle_t), intent(inout) :: prt
type(polarization_t), intent(in) :: pol
real(default) :: r, theta, phi
if (pol%is_polarized ()) then
call pol%to_angles (r, theta, phi)
call lcio_particle_set_spin (prt%obj, &
real(r, c_double), real (theta, c_double), real (phi, c_double))
end if
end subroutine lcio_polarization_init_pol
module subroutine lcio_polarization_init_hel (prt, hel)
type(lcio_particle_t), intent(inout) :: prt
type(helicity_t), intent(in) :: hel
integer, dimension(2) :: h
if (hel%is_defined ()) then
h = hel%to_pair ()
select case (h(1))
case (1:)
call lcio_particle_set_spin (prt%obj, 1._c_double, &
0._c_double, 0._c_double)
case (:-1)
call lcio_particle_set_spin (prt%obj, 1._c_double, &
real (pi, c_double), 0._c_double)
case (0)
call lcio_particle_set_spin (prt%obj, 1._c_double, &
real (pi/2, c_double), 0._c_double)
end select
end if
end subroutine lcio_polarization_init_hel
module subroutine lcio_polarization_init_int (prt, hel)
type(lcio_particle_t), intent(inout) :: prt
integer, intent(in) :: hel
call lcio_particle_set_spin (prt%obj, 0._c_double, &
0._c_double, real (hel, c_double))
end subroutine lcio_polarization_init_int
@ %def lcio_polarization_init
@ Recover polarization from LCIO particle (with the
abovementioned deficiencies).
<<LCIO interface: interfaces>>=
interface
function lcio_polarization_degree (prt_obj) result (degree) bind(C)
import
real(c_double) :: degree
type(c_ptr), value :: prt_obj
end function lcio_polarization_degree
end interface
interface
function lcio_polarization_theta (prt_obj) result (theta) bind(C)
import
real(c_double) :: theta
type(c_ptr), value :: prt_obj
end function lcio_polarization_theta
end interface
interface
function lcio_polarization_phi (prt_obj) result (phi) bind(C)
import
real(c_double) :: phi
type(c_ptr), value :: prt_obj
end function lcio_polarization_phi
end interface
@ %def lcio_polarization_degree lcio_polarization_theta lcio_polarization_phi
<<LCIO interface: public>>=
public :: lcio_particle_to_pol
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_to_pol (prt, flv, pol)
type(lcio_particle_t), intent(in) :: prt
type(flavor_t), intent(in) :: flv
type(polarization_t), intent(out) :: pol
end subroutine lcio_particle_to_pol
<<LCIO interface: procedures>>=
module subroutine lcio_particle_to_pol (prt, flv, pol)
type(lcio_particle_t), intent(in) :: prt
type(flavor_t), intent(in) :: flv
type(polarization_t), intent(out) :: pol
real(default) :: degree, theta, phi
degree = lcio_polarization_degree (prt%obj)
theta = lcio_polarization_theta (prt%obj)
phi = lcio_polarization_phi (prt%obj)
call pol%init_angles (flv, degree, theta, phi)
end subroutine lcio_particle_to_pol
@ %def lcio_polarization_to_pol
@ Recover helicity. Here, $\phi$ and [[degree]] is ignored and only the sign of
$\cos\theta$ is relevant, mapped to positive/negative helicity.
<<LCIO interface: public>>=
public :: lcio_particle_to_hel
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_to_hel (prt, flv, hel)
type(lcio_particle_t), intent(in) :: prt
type(flavor_t), intent(in) :: flv
type(helicity_t), intent(out) :: hel
end subroutine lcio_particle_to_hel
<<LCIO interface: procedures>>=
module subroutine lcio_particle_to_hel (prt, flv, hel)
type(lcio_particle_t), intent(in) :: prt
type(flavor_t), intent(in) :: flv
type(helicity_t), intent(out) :: hel
real(default) :: theta
integer :: hmax
theta = lcio_polarization_theta (prt%obj)
hmax = flv%get_spin_type () / 2
call hel%init (sign (hmax, nint (cos (theta))))
end subroutine lcio_particle_to_hel
@ %def lcio_particle_to_hel
@ Set the vertex of a particle.
<<LCIO interface: interfaces>>=
interface
subroutine lcio_particle_set_vertex (prt_obj, vx, vy, vz) bind(C)
import
type(c_ptr), value :: prt_obj
real(c_double), value :: vx, vy, vz
end subroutine lcio_particle_set_vertex
end interface
interface
subroutine lcio_particle_set_time (prt_obj, t) bind(C)
import
type(c_ptr), value :: prt_obj
real(c_float), value :: t
end subroutine lcio_particle_set_time
end interface
@ %def lcio_particle_set_vertex lcio_particle_set_time
@
<<LCIO interface: public>>=
public :: lcio_particle_set_vtx
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_set_vtx (prt, vtx)
type(lcio_particle_t), intent(inout) :: prt
type(vector3_t), intent(in) :: vtx
end subroutine lcio_particle_set_vtx
<<LCIO interface: procedures>>=
module subroutine lcio_particle_set_vtx (prt, vtx)
type(lcio_particle_t), intent(inout) :: prt
type(vector3_t), intent(in) :: vtx
call lcio_particle_set_vertex (prt%obj, real(vtx%p(1), c_double), &
real(vtx%p(2), c_double), real(vtx%p(3), c_double))
end subroutine lcio_particle_set_vtx
@ %def lcio_particle_set_vtx
@
Times in LCIO are in nanoseconds, not in mm, so need to be converted.
<<LCIO interface: public>>=
public :: lcio_particle_set_t
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_set_t (prt, t)
type(lcio_particle_t), intent(inout) :: prt
real(default), intent(in) :: t
end subroutine lcio_particle_set_t
<<LCIO interface: procedures>>=
module subroutine lcio_particle_set_t (prt, t)
type(lcio_particle_t), intent(inout) :: prt
real(default), intent(in) :: t
real(default) :: ns_from_t_mm
ns_from_t_mm = ns_per_mm * t
call lcio_particle_set_time (prt%obj, real(ns_from_t_mm, c_float))
end subroutine lcio_particle_set_t
@ %def lcio_particle_set_t
@
<<LCIO interface: interfaces>>=
interface
subroutine lcio_particle_add_parent (prt_obj1, prt_obj2) bind(C)
import
type(c_ptr), value :: prt_obj1, prt_obj2
end subroutine lcio_particle_add_parent
end interface
@ %def lcio_particle_add_parent
<<LCIO interface: public>>=
public :: lcio_particle_set_parent
<<LCIO interface: sub interfaces>>=
module subroutine lcio_particle_set_parent (daughter, parent)
type(lcio_particle_t), intent(inout) :: daughter, parent
end subroutine lcio_particle_set_parent
<<LCIO interface: procedures>>=
module subroutine lcio_particle_set_parent (daughter, parent)
type(lcio_particle_t), intent(inout) :: daughter, parent
call lcio_particle_add_parent (daughter%obj, parent%obj)
end subroutine lcio_particle_set_parent
@ %def lcio_particle_set_parent
@
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_particle_get_generator_status &
(prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function lcio_particle_get_generator_status
end interface
@ %def lcio_particle_get_generator_status
<<LCIO interface: public>>=
public :: lcio_particle_get_status
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_status (lptr) result (status)
integer :: status
type(lcio_particle_t), intent(in) :: lptr
end function lcio_particle_get_status
<<LCIO interface: procedures>>=
module function lcio_particle_get_status (lptr) result (status)
integer :: status
type(lcio_particle_t), intent(in) :: lptr
status = lcio_particle_get_generator_status (lptr%obj)
end function lcio_particle_get_status
@ %def lcio_particle_get_status
@ Getting the PDG code.
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_particle_get_pdg_code (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function lcio_particle_get_pdg_code
end interface
@ %def lcio_particle_get_pdg_code
@
<<LCIO interface: public>>=
public :: lcio_particle_get_pdg
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_pdg (lptr) result (pdg)
integer :: pdg
type(lcio_particle_t), intent(in) :: lptr
end function lcio_particle_get_pdg
<<LCIO interface: procedures>>=
module function lcio_particle_get_pdg (lptr) result (pdg)
integer :: pdg
type(lcio_particle_t), intent(in) :: lptr
pdg = lcio_particle_get_pdg_code (lptr%obj)
end function lcio_particle_get_pdg
@ %def lcio_particle_get_pdg
@ Obtaining the number of parents and daughters of an LCIO particle.
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_n_parents (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function lcio_n_parents
end interface
@ %def lcio_n_parents
@
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_n_daughters (prt_obj) bind(C)
import
type(c_ptr), value :: prt_obj
end function lcio_n_daughters
end interface
@ %def lcio_n_daughters
@
<<LCIO interface: public>>=
public :: lcio_particle_get_n_parents
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_n_parents (lptr) result (n_parents)
integer :: n_parents
type(lcio_particle_t), intent(in) :: lptr
end function lcio_particle_get_n_parents
<<LCIO interface: procedures>>=
module function lcio_particle_get_n_parents (lptr) result (n_parents)
integer :: n_parents
type(lcio_particle_t), intent(in) :: lptr
n_parents = lcio_n_parents (lptr%obj)
end function lcio_particle_get_n_parents
@ %def lcio_particle_get_n_parents
@
<<LCIO interface: public>>=
public :: lcio_particle_get_n_children
<<LCIO interface: sub interfaces>>=
module function lcio_particle_get_n_children (lptr) result (n_children)
integer :: n_children
type(lcio_particle_t), intent(in) :: lptr
end function lcio_particle_get_n_children
<<LCIO interface: procedures>>=
module function lcio_particle_get_n_children (lptr) result (n_children)
integer :: n_children
type(lcio_particle_t), intent(in) :: lptr
n_children = lcio_n_daughters (lptr%obj)
end function lcio_particle_get_n_children
@ %def lcio_particle_get_n_children
@ This provides access from the LCIO event [[lcio_event_t]] to the array entries
of the parent and daughter arrays of the LCIO particles.
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_event_parent_k &
(evt_obj, num_part, k_parent) bind (C)
use iso_c_binding !NODEP!
type(c_ptr), value :: evt_obj
integer(c_int), value :: num_part, k_parent
end function lcio_event_parent_k
end interface
@ %def lcio_event_parent_k
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_event_daughter_k &
(evt_obj, num_part, k_daughter) bind (C)
use iso_c_binding !NODEP!
type(c_ptr), value :: evt_obj
integer(c_int), value :: num_part, k_daughter
end function lcio_event_daughter_k
end interface
@ %def lcio_event_daughter_k
@
<<LCIO interface: public>>=
public :: lcio_get_n_parents
<<LCIO interface: sub interfaces>>=
module function lcio_get_n_parents &
(evt, num_part, k_parent) result (index_parent)
type(lcio_event_t), intent(in) :: evt
integer, intent(in) :: num_part, k_parent
integer :: index_parent
end function lcio_get_n_parents
<<LCIO interface: procedures>>=
module function lcio_get_n_parents &
(evt, num_part, k_parent) result (index_parent)
type(lcio_event_t), intent(in) :: evt
integer, intent(in) :: num_part, k_parent
integer :: index_parent
index_parent = lcio_event_parent_k (evt%obj, int (num_part, c_int), &
int (k_parent, c_int))
end function lcio_get_n_parents
@ %def lcio_get_n_parents
@
<<LCIO interface: public>>=
public :: lcio_get_n_children
<<LCIO interface: sub interfaces>>=
module function lcio_get_n_children &
(evt, num_part, k_daughter) result (index_daughter)
type(lcio_event_t), intent(in) :: evt
integer, intent(in) :: num_part, k_daughter
integer :: index_daughter
end function lcio_get_n_children
<<LCIO interface: procedures>>=
module function lcio_get_n_children &
(evt, num_part, k_daughter) result (index_daughter)
type(lcio_event_t), intent(in) :: evt
integer, intent(in) :: num_part, k_daughter
integer :: index_daughter
index_daughter = lcio_event_daughter_k (evt%obj, int (num_part, c_int), &
int (k_daughter, c_int))
end function lcio_get_n_children
@ %def lcio_get_n_children
@
\subsection{LCIO Writer type}
There is a specific LCIO Writer type for handling the output of
LCEventImpl objects (i.e., Monte Carlo event samples) to file. Opening
the file is done by the constructor, closing by the destructor.
<<LCIO interface: public>>=
public :: lcio_writer_t
<<LCIO interface: types>>=
type :: lcio_writer_t
private
type(c_ptr) :: obj
end type lcio_writer_t
@ %def lcio_writer_t
@ Constructor for an output associated to a file.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function open_lcio_writer_new (filename, complevel) bind(C)
import
character(c_char), dimension(*), intent(in) :: filename
integer(c_int), intent(in) :: complevel
end function open_lcio_writer_new
end interface
@ %def open_lcio_writer_now
<<LCIO interface: public>>=
public :: lcio_writer_open_out
<<LCIO interface: sub interfaces>>=
module subroutine lcio_writer_open_out (lcio_writer, filename)
type(lcio_writer_t), intent(out) :: lcio_writer
type(string_t), intent(in) :: filename
end subroutine lcio_writer_open_out
<<LCIO interface: procedures>>=
module subroutine lcio_writer_open_out (lcio_writer, filename)
type(lcio_writer_t), intent(out) :: lcio_writer
type(string_t), intent(in) :: filename
lcio_writer%obj = open_lcio_writer_new (char (filename) // &
c_null_char, 9_c_int)
end subroutine lcio_writer_open_out
@ %def lcio_writer_open_out
@ Destructor:
<<LCIO interface: interfaces>>=
interface
subroutine lcio_writer_delete (io_obj) bind(C)
import
type(c_ptr), value :: io_obj
end subroutine lcio_writer_delete
end interface
@ %def lcio_writer_delete
<<LCIO interface: public>>=
public :: lcio_writer_close
<<LCIO interface: sub interfaces>>=
module subroutine lcio_writer_close (lciowriter)
type(lcio_writer_t), intent(inout) :: lciowriter
end subroutine lcio_writer_close
<<LCIO interface: procedures>>=
module subroutine lcio_writer_close (lciowriter)
type(lcio_writer_t), intent(inout) :: lciowriter
call lcio_writer_delete (lciowriter%obj)
end subroutine lcio_writer_close
@ %def lcio_writer_close
@ Write a single event to the LCIO writer.
<<LCIO interface: interfaces>>=
interface
subroutine lcio_write_event (io_obj, evt_obj) bind(C)
import
type(c_ptr), value :: io_obj, evt_obj
end subroutine lcio_write_event
end interface
@ %def lcio_write_event
<<LCIO interface: public>>=
public :: lcio_event_write
<<LCIO interface: sub interfaces>>=
module subroutine lcio_event_write (wrt, evt)
type(lcio_writer_t), intent(inout) :: wrt
type(lcio_event_t), intent(in) :: evt
end subroutine lcio_event_write
<<LCIO interface: procedures>>=
module subroutine lcio_event_write (wrt, evt)
type(lcio_writer_t), intent(inout) :: wrt
type(lcio_event_t), intent(in) :: evt
call lcio_write_event (wrt%obj, evt%obj)
end subroutine lcio_event_write
@ %def lcio_event_write
@
\subsection{LCIO Reader type}
There is a specific LCIO Reader type for handling the input of
LCEventImpl objects (i.e., Monte Carlo event samples) from file. Opening
the file is done by the constructor, closing by the destructor.
<<LCIO interface: public>>=
public :: lcio_reader_t
<<LCIO interface: types>>=
type :: lcio_reader_t
private
type(c_ptr) :: obj
end type lcio_reader_t
@ %def lcio_reader_t
@ Constructor for an output associated to a file.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function open_lcio_reader (filename) bind(C)
import
character(c_char), dimension(*), intent(in) :: filename
end function open_lcio_reader
end interface
@ %def open_lcio_reader
<<LCIO interface: public>>=
public :: lcio_open_file
<<LCIO interface: sub interfaces>>=
module subroutine lcio_open_file (lcio_reader, filename)
type(lcio_reader_t), intent(out) :: lcio_reader
type(string_t), intent(in) :: filename
end subroutine lcio_open_file
<<LCIO interface: procedures>>=
module subroutine lcio_open_file (lcio_reader, filename)
type(lcio_reader_t), intent(out) :: lcio_reader
type(string_t), intent(in) :: filename
lcio_reader%obj = open_lcio_reader (char (filename) // c_null_char)
end subroutine lcio_open_file
@ %def lcio_open_file
@ Destructor:
<<LCIO interface: interfaces>>=
interface
subroutine lcio_reader_delete (io_obj) bind(C)
import
type(c_ptr), value :: io_obj
end subroutine lcio_reader_delete
end interface
@ %def lcio_reader_delete
<<LCIO interface: public>>=
public :: lcio_reader_close
<<LCIO interface: sub interfaces>>=
module subroutine lcio_reader_close (lcioreader)
type(lcio_reader_t), intent(inout) :: lcioreader
end subroutine lcio_reader_close
<<LCIO interface: procedures>>=
module subroutine lcio_reader_close (lcioreader)
type(lcio_reader_t), intent(inout) :: lcioreader
call lcio_reader_delete (lcioreader%obj)
end subroutine lcio_reader_close
@ %def lcio_reader_close
@
@ Read a single event from the event file. Return true if successful.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function read_lcio_event (io_obj) bind(C)
import
type(c_ptr), value :: io_obj
end function read_lcio_event
end interface
@ %def read_lcio_event
<<LCIO interface: public>>=
public :: lcio_read_event
<<LCIO interface: sub interfaces>>=
module subroutine lcio_read_event (lcrdr, evt, ok)
type(lcio_reader_t), intent(inout) :: lcrdr
type(lcio_event_t), intent(out) :: evt
logical, intent(out) :: ok
end subroutine lcio_read_event
<<LCIO interface: procedures>>=
module subroutine lcio_read_event (lcrdr, evt, ok)
type(lcio_reader_t), intent(inout) :: lcrdr
type(lcio_event_t), intent(out) :: evt
logical, intent(out) :: ok
evt%obj = read_lcio_event (lcrdr%obj)
ok = c_associated (evt%obj)
end subroutine lcio_read_event
@ %def lcio_read_event
@ Get the event index.
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_event_get_event_number (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function lcio_event_get_event_number
end interface
@ %def lcio_event_get_event_number
<<LCIO interface: public>>=
public :: lcio_event_get_event_index
<<LCIO interface: sub interfaces>>=
module function lcio_event_get_event_index (evt) result (i_evt)
integer :: i_evt
type(lcio_event_t), intent(in) :: evt
end function lcio_event_get_event_index
<<LCIO interface: procedures>>=
module function lcio_event_get_event_index (evt) result (i_evt)
integer :: i_evt
type(lcio_event_t), intent(in) :: evt
i_evt = lcio_event_get_event_number (evt%obj)
end function lcio_event_get_event_index
@ %def lcio_event_get_event_index
@ Extract the process ID. This is stored (at the moment abusively) in the
RUN ID as well as in an additional event parameter.
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_event_signal_process_id (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function lcio_event_signal_process_id
end interface
@ %def lcio_event_signal_process_id
<<LCIO interface: public>>=
public :: lcio_event_get_process_id
<<LCIO interface: sub interfaces>>=
module function lcio_event_get_process_id (evt) result (i_proc)
integer :: i_proc
type(lcio_event_t), intent(in) :: evt
end function lcio_event_get_process_id
<<LCIO interface: procedures>>=
module function lcio_event_get_process_id (evt) result (i_proc)
integer :: i_proc
type(lcio_event_t), intent(in) :: evt
i_proc = lcio_event_signal_process_id (evt%obj)
end function lcio_event_get_process_id
@ %def lcio_event_get_process_id
@ Number of particles in an LCIO event.
<<LCIO interface: interfaces>>=
interface
integer(c_int) function lcio_event_get_n_particles (evt_obj) bind(C)
import
type(c_ptr), value :: evt_obj
end function lcio_event_get_n_particles
end interface
@ %def lcio_event_get_n_particles
<<LCIO interface:>>=
@
<<LCIO interface: public>>=
public :: lcio_event_get_n_tot
<<LCIO interface: sub interfaces>>=
module function lcio_event_get_n_tot (evt) result (n_tot)
integer :: n_tot
type(lcio_event_t), intent(in) :: evt
end function lcio_event_get_n_tot
<<LCIO interface: procedures>>=
module function lcio_event_get_n_tot (evt) result (n_tot)
integer :: n_tot
type(lcio_event_t), intent(in) :: evt
n_tot = lcio_event_get_n_particles (evt%obj)
end function lcio_event_get_n_tot
@ %def lcio_event_get_n_tot
@ Extracting $\alpha_s$ and the scale.
<<LCIO interface: interfaces>>=
interface
function lcio_event_get_alpha_qcd (evt_obj) result (as) bind(C)
import
real(c_double) :: as
type(c_ptr), value :: evt_obj
end function lcio_event_get_alpha_qcd
end interface
interface
function lcio_event_get_scale (evt_obj) result (scale) bind(C)
import
real(c_double) :: scale
type(c_ptr), value :: evt_obj
end function lcio_event_get_scale
end interface
@ %def lcio_event_get_alpha_qcd lcio_event_get_scale
@
<<LCIO interface: public>>=
public :: lcio_event_get_alphas
<<LCIO interface: sub interfaces>>=
module function lcio_event_get_alphas (evt) result (as)
type(lcio_event_t), intent(in) :: evt
real(default) :: as
end function lcio_event_get_alphas
<<LCIO interface: procedures>>=
module function lcio_event_get_alphas (evt) result (as)
type(lcio_event_t), intent(in) :: evt
real(default) :: as
as = lcio_event_get_alpha_qcd (evt%obj)
end function lcio_event_get_alphas
@ %def lcio_event_get_alphas
@
<<LCIO interface: public>>=
public :: lcio_event_get_scaleval
<<LCIO interface: sub interfaces>>=
module function lcio_event_get_scaleval (evt) result (scale)
type(lcio_event_t), intent(in) :: evt
real(default) :: scale
end function lcio_event_get_scaleval
<<LCIO interface: procedures>>=
module function lcio_event_get_scaleval (evt) result (scale)
type(lcio_event_t), intent(in) :: evt
real(default) :: scale
scale = lcio_event_get_scale (evt%obj)
end function lcio_event_get_scaleval
@ %def lcio_event_get_scaleval
@ Extracting particles by index from an LCIO event.
<<LCIO interface: interfaces>>=
interface
type(c_ptr) function lcio_event_particle_k (evt_obj, k) bind(C)
import
type(c_ptr), value :: evt_obj
integer(c_int), value :: k
end function lcio_event_particle_k
end interface
@ %def lcio_event_particle_k
@
<<LCIO interface: public>>=
public :: lcio_event_get_particle
<<LCIO interface: sub interfaces>>=
module function lcio_event_get_particle (evt, n) result (prt)
type(lcio_event_t), intent(in) :: evt
integer, intent(in) :: n
type(lcio_particle_t) :: prt
end function lcio_event_get_particle
<<LCIO interface: procedures>>=
module function lcio_event_get_particle (evt, n) result (prt)
type(lcio_event_t), intent(in) :: evt
integer, intent(in) :: n
type(lcio_particle_t) :: prt
prt%obj = lcio_event_particle_k (evt%obj, int (n, c_int))
end function lcio_event_get_particle
@ %def lcio_event_get_particle
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[lcio_interface_ut.f90]]>>=
<<File header>>
module lcio_interface_ut
use unit_tests
use lcio_interface_uti
<<Standard module head>>
<<LCIO interface: public test>>
contains
<<LCIO interface: test driver>>
end module lcio_interface_ut
@ %def lcio_interface_ut
@
<<[[lcio_interface_uti.f90]]>>=
<<File header>>
module lcio_interface_uti
<<Use kinds>>
<<Use strings>>
use io_units
use lorentz
use flavors
use colors
use polarizations
use lcio_interface
<<Standard module head>>
<<LCIO interface: test declarations>>
contains
<<LCIO interface: tests>>
end module lcio_interface_uti
@ %def lcio_interface_ut
@ API: driver for the unit tests below.
<<LCIO interface: public test>>=
public :: lcio_interface_test
<<LCIO interface: test driver>>=
subroutine lcio_interface_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<LCIO interface: execute tests>>
end subroutine lcio_interface_test
@ %def lcio_interface_test
@
<<LCIO interface: execute tests>>=
call test (lcio_interface_1, "lcio_interface_1", &
"check LCIO interface", &
u, results)
<<LCIO interface: test declarations>>=
public :: lcio_interface_1
<<LCIO interface: tests>>=
subroutine lcio_interface_1 (u)
use physics_defs, only: VECTOR
use model_data, only: field_data_t
integer, intent(in) :: u
integer :: u_file, iostat
type(lcio_event_t) :: evt
type(lcio_particle_t) :: prt1, prt2, prt3, prt4, prt5, prt6, prt7, prt8
type(flavor_t) :: flv
type(color_t) :: col
type(polarization_t) :: pol
type(field_data_t), target :: photon_data
character(220) :: buffer
write (u, "(A)") "* Test output: LCIO interface"
write (u, "(A)") "* Purpose: test LCIO interface"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
! Initialize a photon flavor object and some polarization
call photon_data%init (var_str ("PHOTON"), 22)
call photon_data%set (spin_type=VECTOR)
call photon_data%freeze ()
call flv%init (photon_data)
call pol%init_angles &
(flv, 0.6_default, 1._default, 0.5_default)
! Event initialization
call lcio_event_init (evt, 20, 1, 42)
write (u, "(A)") "* p -> q splitting"
write (u, "(A)")
! $p\to q$ splittings
call particle_init (prt1, &
0._default, 0._default, 7000._default, 7000._default, &
2212, 1._default, 3)
call particle_init (prt2, &
0._default, 0._default,-7000._default, 7000._default, &
2212, 1._default, 3)
call particle_init (prt3, &
.750_default, -1.569_default, 32.191_default, 32.238_default, &
1, -1._default/3._default, 3)
call color_init_from_array (col, [501])
call lcio_particle_set_color (prt3, col)
call lcio_particle_set_parent (prt3, prt1)
call lcio_particle_set_parent (prt3, prt2)
call particle_init (prt4, &
-3.047_default, -19._default, -54.629_default, 57.920_default, &
-2, -2._default/3._default, 3)
call color_init_from_array (col, [-501])
call lcio_particle_set_color (prt4, col)
call lcio_particle_set_parent (prt4, prt1)
call lcio_particle_set_parent (prt4, prt2)
write (u, "(A)") "* Hard interaction"
write (u, "(A)")
! Hard interaction
call particle_init (prt6, &
-3.813_default, 0.113_default, -1.833_default, 4.233_default, &
22, 0._default, 1)
call lcio_polarization_init (prt6, pol)
call particle_init (prt5, &
1.517_default, -20.68_default, -20.605_default, 85.925_default, &
-24, -1._default, 3)
call lcio_particle_set_parent (prt5, prt3)
call lcio_particle_set_parent (prt5, prt4)
call lcio_particle_set_parent (prt6, prt3)
call lcio_particle_set_parent (prt6, prt4)
! $W^-$ decay
call particle_init (prt7, &
-2.445_default, 28.816_default, 6.082_default, 29.552_default, &
1, -1._default/3._default, 1)
call particle_init (prt8, &
3.962_default, -49.498_default, -26.687_default, 56.373_default, &
-2, -2._default/3._default, 1)
call lcio_particle_set_t (prt7, 0.12_default)
call lcio_particle_set_t (prt8, 0.12_default)
call lcio_particle_set_vtx &
(prt7, vector3_moving ([-0.3_default, 0.05_default, 0.004_default]))
call lcio_particle_set_vtx &
(prt8, vector3_moving ([-0.3_default, 0.05_default, 0.004_default]))
call lcio_particle_set_parent (prt7, prt5)
call lcio_particle_set_parent (prt8, prt5)
call lcio_particle_add_to_evt_coll (prt1, evt)
call lcio_particle_add_to_evt_coll (prt2, evt)
call lcio_particle_add_to_evt_coll (prt3, evt)
call lcio_particle_add_to_evt_coll (prt4, evt)
call lcio_particle_add_to_evt_coll (prt5, evt)
call lcio_particle_add_to_evt_coll (prt6, evt)
call lcio_particle_add_to_evt_coll (prt7, evt)
call lcio_particle_add_to_evt_coll (prt8, evt)
call lcio_event_add_coll (evt)
! Event output
write (u, "(A)") "Writing in ASCII form to file 'lcio_test.slcio'"
write (u, "(A)")
call write_lcio_event (evt, var_str ("lcio_test.slcio"))
write (u, "(A)") "Writing completed"
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "lcio_test.slcio", &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (trim (buffer) == "") cycle
if (buffer(1:12) == " - timestamp") buffer = "[...]"
if (buffer(1:6) == " date:") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
write (u, "(A)")
! Wrapup
! call pol%final ()
call lcio_event_final (evt, .true.)
write (u, "(A)")
write (u, "(A)") "* Test output end: lcio_interface_1"
contains
subroutine particle_init &
(prt, px, py, pz, E, pdg, charge, status)
type(lcio_particle_t), intent(out) :: prt
real(default), intent(in) :: px, py, pz, E, charge
integer, intent(in) :: pdg, status
type(vector4_t) :: p
p = vector4_moving (E, vector3_moving ([px, py, pz]))
call lcio_particle_init (prt, p, pdg, charge, status)
end subroutine particle_init
end subroutine lcio_interface_1
@ %def lcio_interface_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{HEP Common and Events}
This is a separate module that manages data exchange between the common blocks
and [[event_t]] objects. We separate this from the previous module in order
to avoid a circular module dependency. It also contains the functions
necessary for communication between [[hepmc_event_t]] and
[[event_t]] or [[lcio_event_t]] and [[event_t]] as well as
[[particle_set_t]] and [[particle_t]] objects.
<<[[hep_events.f90]]>>=
<<File header>>
module hep_events
<<Use kinds>>
<<Use strings>>
use lorentz
use polarizations
use model_data
use particles
use hepmc_interface
use lcio_interface
use event_base
<<Standard module head>>
<<HEP events: public>>
interface
<<HEP events: sub interfaces>>
end interface
end module hep_events
@ %def hep_events
@
<<[[hep_events_sub.f90]]>>=
<<File header>>
submodule (hep_events) hep_events_s
use system_dependencies, only: HEPMC2_AVAILABLE
use system_dependencies, only: HEPMC3_AVAILABLE
use diagnostics
use numeric_utils
use flavors
use colors
use helicities
use subevents, only: PRT_BEAM, PRT_INCOMING, PRT_OUTGOING
use subevents, only: PRT_UNDEFINED
use subevents, only: PRT_VIRTUAL, PRT_RESONANT, PRT_BEAM_REMNANT
use hep_common
implicit none
contains
<<HEP events: procedures>>
end submodule hep_events_s
@ %def hep_events_s
@
\subsection{Data Transfer: events}
Fill the HEPEUP block, given a \whizard\ event object.
<<HEP events: public>>=
public :: hepeup_from_event
<<HEP events: sub interfaces>>=
module subroutine hepeup_from_event &
(event, keep_beams, keep_remnants, process_index)
class(generic_event_t), intent(in), target :: event
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
integer, intent(in), optional :: process_index
end subroutine hepeup_from_event
<<HEP events: procedures>>=
module subroutine hepeup_from_event &
(event, keep_beams, keep_remnants, process_index)
class(generic_event_t), intent(in), target :: event
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
integer, intent(in), optional :: process_index
type(particle_set_t), pointer :: particle_set
real(default) :: scale, alpha_qcd
if (event%has_valid_particle_set ()) then
particle_set => event%get_particle_set_ptr ()
call hepeup_from_particle_set (particle_set, keep_beams, keep_remnants)
if (present (process_index)) then
call hepeup_set_event_parameters (proc_id = process_index)
end if
scale = event%get_fac_scale ()
if (.not. vanishes (scale)) then
call hepeup_set_event_parameters (scale = scale)
end if
alpha_qcd = event%get_alpha_s ()
if (.not. vanishes (alpha_qcd)) then
call hepeup_set_event_parameters (alpha_qcd = alpha_qcd)
end if
if (event%weight_prc_is_known ()) then
call hepeup_set_event_parameters (weight = event%get_weight_prc ())
end if
else
call msg_bug ("HEPEUP: event incomplete")
end if
end subroutine hepeup_from_event
@ %def hepeup_from_event
@ Reverse.
Note: The current implementation sets the particle set of the hard
process and is therefore not useful if the event on file is dressed.
This should be reconsidered.
Note: setting of scale or alpha is not yet supported by the
[[event_t]] object. Ticket \#628.
<<HEP events: public>>=
public :: hepeup_to_event
<<HEP events: sub interfaces>>=
module subroutine hepeup_to_event &
(event, fallback_model, process_index, recover_beams, &
use_alpha_s, use_scale)
class(generic_event_t), intent(inout), target :: event
class(model_data_t), intent(in), target :: fallback_model
integer, intent(out), optional :: process_index
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alpha_s
logical, intent(in), optional :: use_scale
end subroutine hepeup_to_event
<<HEP events: procedures>>=
module subroutine hepeup_to_event &
(event, fallback_model, process_index, recover_beams, &
use_alpha_s, use_scale)
class(generic_event_t), intent(inout), target :: event
class(model_data_t), intent(in), target :: fallback_model
integer, intent(out), optional :: process_index
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alpha_s
logical, intent(in), optional :: use_scale
class(model_data_t), pointer :: model
real(default) :: weight, scale, alpha_qcd
type(particle_set_t) :: particle_set
model => event%get_model_ptr ()
call hepeup_to_particle_set &
(particle_set, recover_beams, model, fallback_model)
call event%set_hard_particle_set (particle_set)
call particle_set%final ()
if (present (process_index)) then
call hepeup_get_event_parameters (proc_id = process_index)
end if
call hepeup_get_event_parameters (weight = weight, &
scale = scale, alpha_qcd = alpha_qcd)
call event%set_weight_ref (weight)
if (present (use_alpha_s)) then
if (use_alpha_s .and. alpha_qcd > 0) &
call event%set_alpha_qcd_forced (alpha_qcd)
end if
if (present (use_scale)) then
if (use_scale .and. scale > 0) &
call event%set_scale_forced (scale)
end if
end subroutine hepeup_to_event
@ %def hepeup_to_event
@ Fill the HEPEVT (event) common block.
The [[i_evt]] argument overrides the index stored in the [[event]] object.
<<HEP events: public>>=
public :: hepevt_from_event
<<HEP events: sub interfaces>>=
module subroutine hepevt_from_event &
(event, process_index, i_evt, keep_beams, keep_remnants, &
ensure_order, fill_hepev4)
class(generic_event_t), intent(in), target :: event
integer, intent(in), optional :: i_evt, process_index
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
logical, intent(in), optional :: fill_hepev4
end subroutine hepevt_from_event
<<HEP events: procedures>>=
module subroutine hepevt_from_event &
(event, process_index, i_evt, keep_beams, keep_remnants, &
ensure_order, fill_hepev4)
class(generic_event_t), intent(in), target :: event
integer, intent(in), optional :: i_evt, process_index
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
logical, intent(in), optional :: fill_hepev4
type(particle_set_t), pointer :: particle_set
real(default) :: alpha_qcd, scale
if (event%has_valid_particle_set ()) then
particle_set => event%get_particle_set_ptr ()
call hepevt_from_particle_set (particle_set, keep_beams, &
keep_remnants, ensure_order, fill_hepev4)
if (present (process_index)) then
call hepevt_set_event_parameters (proc_id = process_index)
end if
if (event%weight_prc_is_known ()) then
call hepevt_set_event_parameters (weight = event%get_weight_prc ())
end if
if (event%sqme_prc_is_known ()) then
call hepevt_set_event_parameters &
(function_value = event%get_sqme_prc ())
end if
scale = event%get_fac_scale ()
if (.not. vanishes (scale)) then
call hepevt_set_event_parameters (scale = scale)
end if
alpha_qcd = event%get_alpha_s ()
if (.not. vanishes (alpha_qcd)) then
call hepevt_set_event_parameters (alpha_qcd = alpha_qcd)
end if
if (present (i_evt)) then
call hepevt_set_event_parameters (i_evt = i_evt)
else if (event%has_index ()) then
call hepevt_set_event_parameters (i_evt = event%get_index ())
else
call hepevt_set_event_parameters (i_evt = 0)
end if
else
call msg_bug ("HEPEVT: event incomplete")
end if
end subroutine hepevt_from_event
@ %def hepevt_from_event
@
\subsubsection{HepMC format}
The master output function fills a HepMC GenEvent object that is
already initialized, but has no vertices in it.
We first set up the vertex lists and enter the vertices into the HepMC
event. Then, we assign first all incoming particles and then all
outgoing particles to their associated vertices. Particles which have
neither parent nor children entries (this should not happen) are
dropped.
Finally, we insert the beam particles. If there are none, use the incoming
particles instead.
@ Transform a particle into a [[hepmc_particle]] object, including
color and polarization. The HepMC status is equivalent to the HEPEVT
status, in particular: 0 = null entry, 1 = physical particle, 2 =
decayed/fragmented SM hadron, tau or muon, 3 = other unphysical particle
entry, 4 = incoming particles, 11 = intermediate resonance such as squarks.
The use of 11 for intermediate resonances is as done by HERWIG, see
http://herwig.hepforge.org/trac/wiki/FaQs.
<<HEP events: procedures>>=
subroutine particle_to_hepmc (prt, hprt)
type(particle_t), intent(in) :: prt
type(hepmc_particle_t), intent(out) :: hprt
integer :: hepmc_status
select case (prt%get_status ())
case (PRT_UNDEFINED)
hepmc_status = 0
case (PRT_OUTGOING)
hepmc_status = 1
case (PRT_BEAM)
hepmc_status = 4
case (PRT_RESONANT)
hepmc_status = 2
case (PRT_BEAM_REMNANT)
if (prt%get_n_children () == 0) then
hepmc_status = 1
else
hepmc_status = 3
end if
case default
hepmc_status = 3
end select
call hepmc_particle_init (hprt, &
prt%get_momentum (), prt%get_pdg (), &
hepmc_status)
if (HEPMC2_AVAILABLE) then
call hepmc_particle_set_color (hprt, prt%get_color ())
select case (prt%get_polarization_status ())
case (PRT_DEFINITE_HELICITY)
call hepmc_particle_set_polarization (hprt, &
prt%get_helicity ())
case (PRT_GENERIC_POLARIZATION)
call hepmc_particle_set_polarization (hprt, &
prt%get_polarization ())
end select
end if
end subroutine particle_to_hepmc
@ %def particle_to_hepmc
@ For HepMC3, a HepMC particle needs first to be attached to a vertex
and an event before non-intrinsic particle properties (color flow and
helicity) could be set.
<<HEP events: public>>=
public :: hepmc_event_from_particle_set
<<HEP events: sub interfaces>>=
module subroutine hepmc_event_from_particle_set &
(evt, particle_set, cross_section, error, color)
type(hepmc_event_t), intent(inout) :: evt
type(particle_set_t), intent(in) :: particle_set
real(default), intent(in), optional :: cross_section, error
logical, intent(in), optional :: color
end subroutine hepmc_event_from_particle_set
<<HEP events: procedures>>=
module subroutine hepmc_event_from_particle_set &
(evt, particle_set, cross_section, error, color)
type(hepmc_event_t), intent(inout) :: evt
type(particle_set_t), intent(in) :: particle_set
real(default), intent(in), optional :: cross_section, error
logical, intent(in), optional :: color
type(hepmc_vertex_t), dimension(:), allocatable :: v
type(hepmc_particle_t), dimension(:), allocatable :: hprt
type(hepmc_particle_t), dimension(2) :: hbeam
type(vector4_t), dimension(:), allocatable :: vtx
logical, dimension(:), allocatable :: is_beam
integer, dimension(:), allocatable :: v_from, v_to
integer :: n_vertices, n_tot, i
logical :: write_color
write_color = .false.
if (present (color)) write_color = color
n_tot = particle_set%get_n_tot ()
allocate (v_from (n_tot), v_to (n_tot))
call particle_set%assign_vertices (v_from, v_to, n_vertices)
allocate (hprt (n_tot))
allocate (vtx (n_vertices))
vtx = vector4_null
do i = 1, n_tot
if (v_to(i) /= 0 .or. v_from(i) /= 0) then
call particle_to_hepmc (particle_set%prt(i), hprt(i))
if (v_from(i) /= 0) then
vtx(v_from(i)) = particle_set%prt(i)%get_vertex ()
end if
end if
end do
if (present (cross_section) .and. present(error)) &
call hepmc_event_set_cross_section (evt, cross_section, error)
allocate (v (n_vertices))
do i = 1, n_vertices
call hepmc_vertex_init (v(i), vtx(i))
call hepmc_event_add_vertex (evt, v(i))
end do
allocate (is_beam (n_tot))
is_beam = particle_set%prt(1:n_tot)%get_status () == PRT_BEAM
if (.not. any (is_beam)) then
is_beam = particle_set%prt(1:n_tot)%get_status () == PRT_INCOMING
end if
if (count (is_beam) == 2) then
hbeam = pack (hprt, is_beam)
call hepmc_event_set_beam_particles (evt, hbeam(1), hbeam(2))
end if
do i = 1, n_tot
if (v_to(i) /= 0) then
call hepmc_vertex_add_particle_in (v(v_to(i)), hprt(i))
end if
end do
do i = 1, n_tot
if (v_from(i) /= 0) then
call hepmc_vertex_add_particle_out (v(v_from(i)), hprt(i))
end if
end do
FIND_SIGNAL_PROCESS: do i = 1, n_tot
if (particle_set%prt(i)%get_status () == PRT_INCOMING) then
call hepmc_event_set_signal_process_vertex (evt, v(v_to(i)))
exit FIND_SIGNAL_PROCESS
end if
end do FIND_SIGNAL_PROCESS
if (HEPMC3_AVAILABLE) then
do i = 1, n_tot
if (write_color) then
call hepmc_particle_set_color (hprt(i), &
particle_set%prt(i)%get_color ())
end if
select case (particle_set%prt(i)%get_polarization_status ())
case (PRT_DEFINITE_HELICITY)
call hepmc_particle_set_polarization (hprt(i), &
particle_set%prt(i)%get_helicity ())
case (PRT_GENERIC_POLARIZATION)
call hepmc_particle_set_polarization (hprt(i), &
particle_set%prt(i)%get_polarization ())
end select
end do
end if
end subroutine hepmc_event_from_particle_set
@ %def hepmc_event_from_particle_set
@ Initialize a particle from a HepMC particle object. The model is
necessary for making a fully qualified flavor component. We have the
additional flag [[polarized]] which tells whether the polarization
information should be interpreted or ignored, and the lookup array of
barcodes. Note that the lookup array is searched linearly, a possible
bottleneck for large particle arrays. If necessary, the barcode array
could be replaced by a hash table.
<<HEP events: procedures>>=
subroutine particle_from_hepmc_particle &
(prt, hprt, model, fallback_model, polarization, barcode)
type(particle_t), intent(out) :: prt
type(hepmc_particle_t), intent(in) :: hprt
type(model_data_t), intent(in), target :: model
type(model_data_t), intent(in), target :: fallback_model
type(hepmc_vertex_t) :: vtx
integer, intent(in) :: polarization
integer, dimension(:), intent(in) :: barcode
type(hepmc_polarization_t) :: hpol
type(flavor_t) :: flv
type(color_t) :: col
type(helicity_t) :: hel
type(polarization_t) :: pol
type(vector4_t) :: vertex
integer :: n_parents, n_children
integer, dimension(:), allocatable :: &
parent_barcode, child_barcode, parent, child
integer :: i
select case (hepmc_particle_get_status (hprt))
case (1); call prt%set_status (PRT_OUTGOING)
case (2); call prt%set_status (PRT_RESONANT)
case (3); call prt%set_status (PRT_VIRTUAL)
end select
if (hepmc_particle_is_beam (hprt)) call prt%set_status (PRT_BEAM)
call flv%init (hepmc_particle_get_pdg (hprt), model, fallback_model)
call col%init (hepmc_particle_get_color (hprt))
call prt%set_flavor (flv)
call prt%set_color (col)
call prt%set_polarization (polarization)
select case (polarization)
case (PRT_DEFINITE_HELICITY)
hpol = hepmc_particle_get_polarization (hprt)
call hepmc_polarization_to_hel (hpol, prt%get_flv (), hel)
call prt%set_helicity (hel)
call hepmc_polarization_final (hpol)
case (PRT_GENERIC_POLARIZATION)
hpol = hepmc_particle_get_polarization (hprt)
call hepmc_polarization_to_pol (hpol, prt%get_flv (), pol)
call prt%set_pol (pol)
call hepmc_polarization_final (hpol)
end select
call prt%set_momentum (hepmc_particle_get_momentum (hprt), &
hepmc_particle_get_mass_squared (hprt))
n_parents = hepmc_particle_get_n_parents (hprt)
n_children = hepmc_particle_get_n_children (hprt)
if (HEPMC2_AVAILABLE) then
allocate (parent_barcode (n_parents), parent (n_parents))
allocate (child_barcode (n_children), child (n_children))
parent_barcode = hepmc_particle_get_parent_barcodes (hprt)
child_barcode = hepmc_particle_get_child_barcodes (hprt)
do i = 1, size (barcode)
where (parent_barcode == barcode(i)) parent = i
where (child_barcode == barcode(i)) child = i
end do
call prt%set_parents (parent)
call prt%set_children (child)
else if (HEPMC3_AVAILABLE) then
allocate (parent_barcode (n_parents), parent (n_parents))
allocate (child_barcode (n_children), child (n_children))
parent_barcode = hepmc_particle_get_parent_barcodes (hprt)
child_barcode = hepmc_particle_get_child_barcodes (hprt)
do i = 1, size (barcode)
where (parent_barcode == barcode(i)) parent = i
where (child_barcode == barcode(i)) child = i
end do
call prt%set_parents (parent)
call prt%set_children (child)
end if
if (prt%get_status () == PRT_VIRTUAL .and. n_parents == 0) &
call prt%set_status (PRT_INCOMING)
if (HEPMC2_AVAILABLE) then
vtx = hepmc_particle_get_decay_vertex (hprt)
if (hepmc_vertex_is_valid (vtx)) then
vertex = hepmc_vertex_to_vertex (vtx)
if (vertex /= vector4_null) call prt%set_vertex (vertex)
end if
end if
end subroutine particle_from_hepmc_particle
@ %def particle_from_hepmc_particle
@ If a particle set is initialized from a HepMC event record, we have
to specify the treatment of polarization (unpolarized or density
matrix) which is common to all particles. Correlated polarization
information is not available.
There is some complication in reconstructing incoming particles and
beam remnants. First of all, they all will be tagged as virtual. We
then define an incoming particle as
<<HEP events: public>>=
public :: hepmc_event_to_particle_set
<<HEP events: sub interfaces>>=
module subroutine hepmc_event_to_particle_set &
(particle_set, evt, model, fallback_model, polarization)
type(particle_set_t), intent(inout), target :: particle_set
type(hepmc_event_t), intent(in) :: evt
class(model_data_t), intent(in), target :: model, fallback_model
integer, intent(in) :: polarization
end subroutine hepmc_event_to_particle_set
<<HEP events: procedures>>=
module subroutine hepmc_event_to_particle_set &
(particle_set, evt, model, fallback_model, polarization)
type(particle_set_t), intent(inout), target :: particle_set
type(hepmc_event_t), intent(in) :: evt
class(model_data_t), intent(in), target :: model, fallback_model
integer, intent(in) :: polarization
type(hepmc_event_particle_iterator_t) :: it
type(hepmc_vertex_t) :: v
type(hepmc_vertex_particle_in_iterator_t) :: v_it
type(hepmc_particle_t) :: prt
integer, dimension(:), allocatable :: barcode, n_parents
integer :: n_tot, n_beam, i, bc
n_tot = hepmc_event_get_n_particles(evt)
allocate (barcode (n_tot))
if (HEPMC2_AVAILABLE) then
call hepmc_event_particle_iterator_init (it, evt)
do i = 1, n_tot
barcode(i) = hepmc_particle_get_barcode &
(hepmc_event_particle_iterator_get (it))
call hepmc_event_particle_iterator_advance (it)
end do
allocate (particle_set%prt (n_tot))
call hepmc_event_particle_iterator_reset (it)
do i = 1, n_tot
prt = hepmc_event_particle_iterator_get (it)
call particle_from_hepmc_particle (particle_set%prt(i), &
prt, model, fallback_model, polarization, barcode)
call hepmc_event_particle_iterator_advance (it)
end do
call hepmc_event_particle_iterator_final (it)
v = hepmc_event_get_signal_process_vertex (evt)
if (hepmc_vertex_is_valid (v)) then
call hepmc_vertex_particle_in_iterator_init (v_it, v)
do while (hepmc_vertex_particle_in_iterator_is_valid (v_it))
prt = hepmc_vertex_particle_in_iterator_get (v_it)
bc = hepmc_particle_get_barcode &
(hepmc_vertex_particle_in_iterator_get (v_it))
do i = 1, size(barcode)
if (bc == barcode(i)) &
call particle_set%prt(i)%set_status (PRT_INCOMING)
end do
call hepmc_vertex_particle_in_iterator_advance (v_it)
end do
call hepmc_vertex_particle_in_iterator_final (v_it)
end if
else if (HEPMC3_AVAILABLE) then
allocate (particle_set%prt (n_tot))
do i = 1, n_tot
barcode(i) = hepmc_particle_get_barcode &
(hepmc_event_get_nth_particle (evt, i))
end do
do i = 1, n_tot
prt = hepmc_event_get_nth_particle (evt, i)
call particle_from_hepmc_particle (particle_set%prt(i), &
prt, model, fallback_model, polarization, barcode)
end do
end if
do i = 1, n_tot
if (particle_set%prt(i)%get_status () == PRT_VIRTUAL &
.and. particle_set%prt(i)%get_n_children () == 0) &
call particle_set%prt(i)%set_status (PRT_OUTGOING)
end do
if (HEPMC3_AVAILABLE) then
n_beam = hepmc_event_get_n_beams (evt)
do i = 1, n_beam
bc = hepmc_event_get_nth_beam (evt, i)
if (.not. particle_set%prt(bc)%get_status () == PRT_INCOMING) &
call particle_set%prt(bc)%set_status (PRT_BEAM)
end do
do i = 1, n_tot
if (particle_set%prt(i)%get_status () == PRT_VIRTUAL) then
n_parents = particle_set%prt(i)%get_parents ()
if (all &
(particle_set%prt(n_parents)%get_status () == PRT_BEAM)) then
call particle_set%prt(i)%set_status (PRT_INCOMING)
end if
end if
end do
end if
particle_set%n_tot = n_tot
particle_set%n_beam = &
count (particle_set%prt%get_status () == PRT_BEAM)
particle_set%n_in = &
count (particle_set%prt%get_status () == PRT_INCOMING)
particle_set%n_out = &
count (particle_set%prt%get_status () == PRT_OUTGOING)
particle_set%n_vir = &
particle_set%n_tot - particle_set%n_in - particle_set%n_out
end subroutine hepmc_event_to_particle_set
@ %def hepmc_event_to_particle_set
@ Fill a WHIZARD event from a HepMC event record. In HepMC the weights
are in a weight container. If the size of this container is larger than
one, it is ambiguous to assign the event a specific weight. For now we
only allow to read in unweighted events.
<<HEP events: public>>=
public :: hepmc_to_event
<<HEP events: sub interfaces>>=
module subroutine hepmc_to_event &
(event, hepmc_event, fallback_model, process_index, &
recover_beams, use_alpha_s, use_scale)
class(generic_event_t), intent(inout), target :: event
type(hepmc_event_t), intent(inout) :: hepmc_event
class(model_data_t), intent(in), target :: fallback_model
integer, intent(out), optional :: process_index
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alpha_s
logical, intent(in), optional :: use_scale
end subroutine hepmc_to_event
<<HEP events: procedures>>=
module subroutine hepmc_to_event &
(event, hepmc_event, fallback_model, process_index, &
recover_beams, use_alpha_s, use_scale)
class(generic_event_t), intent(inout), target :: event
type(hepmc_event_t), intent(inout) :: hepmc_event
class(model_data_t), intent(in), target :: fallback_model
integer, intent(out), optional :: process_index
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alpha_s
logical, intent(in), optional :: use_scale
class(model_data_t), pointer :: model
real(default) :: scale, alpha_qcd
type(particle_set_t) :: particle_set
model => event%get_model_ptr ()
call event%set_index (hepmc_event_get_event_index (hepmc_event))
call hepmc_event_to_particle_set (particle_set, &
hepmc_event, model, fallback_model, PRT_DEFINITE_HELICITY)
call event%set_hard_particle_set (particle_set)
call particle_set%final ()
call event%set_weight_ref (1._default)
alpha_qcd = hepmc_event_get_alpha_qcd (hepmc_event)
scale = hepmc_event_get_scale (hepmc_event)
if (present (use_alpha_s)) then
if (use_alpha_s .and. alpha_qcd > 0) &
call event%set_alpha_qcd_forced (alpha_qcd)
end if
if (present (use_scale)) then
if (use_scale .and. scale > 0) &
call event%set_scale_forced (scale)
end if
end subroutine hepmc_to_event
@ %def hepmc_to_event
@
\subsubsection{LCIO event format}
The master output function fills a LCIO event object that is
already initialized, but has no particles in it.
In contrast to HepMC in LCIO there are no vertices (except for tracker
and other detector specifications). So we assign first all incoming
particles and then all outgoing particles to LCIO particle types.
Particles which have neither parent nor children entries (this
should not happen) are dropped. Finally, we insert the beam particles.
If there are none, use the incoming particles instead.
Transform a particle into a [[lcio_particle]] object, including
color and polarization. The LCIO status is equivalent to the HepMC
status, in particular: 0 = null entry, 1 = physical particle, 2 =
decayed/fragmented SM hadron, tau or muon, 3 = other unphysical particle
entry, 4 = incoming particles, 11 = intermediate resonance such as squarks.
The use of 11 for intermediate resonances is as done by HERWIG, see
http://herwig.hepforge.org/trac/wiki/FaQs.
A beam-remnant particle (e.g., ISR photon) that has no children is
tagged as outgoing, otherwise unphysical.
<<HEP events: public>>=
public :: particle_to_lcio
<<HEP events: sub interfaces>>=
module subroutine particle_to_lcio (prt, lprt)
type(particle_t), intent(in) :: prt
type(lcio_particle_t), intent(out) :: lprt
end subroutine particle_to_lcio
<<HEP events: procedures>>=
module subroutine particle_to_lcio (prt, lprt)
type(particle_t), intent(in) :: prt
type(lcio_particle_t), intent(out) :: lprt
integer :: lcio_status
type(vector4_t) :: vtx
select case (prt%get_status ())
case (PRT_UNDEFINED)
lcio_status = 0
case (PRT_OUTGOING)
lcio_status = 1
case (PRT_BEAM_REMNANT)
if (prt%get_n_children () == 0) then
lcio_status = 1
else
lcio_status = 3
end if
case (PRT_BEAM)
lcio_status = 4
case (PRT_RESONANT)
lcio_status = 2
case default
lcio_status = 3
end select
call lcio_particle_init (lprt, &
prt%get_momentum (), &
prt%get_pdg (), &
prt%flv%get_charge (), &
lcio_status)
call lcio_particle_set_color (lprt, prt%get_color ())
vtx = prt%get_vertex ()
call lcio_particle_set_vtx (lprt, space_part (vtx))
call lcio_particle_set_t (lprt, vtx%p(0))
select case (prt%get_polarization_status ())
case (PRT_DEFINITE_HELICITY)
call lcio_polarization_init (lprt, prt%get_helicity ())
case (PRT_GENERIC_POLARIZATION)
call lcio_polarization_init (lprt, prt%get_polarization ())
end select
end subroutine particle_to_lcio
@ %def particle_to_lcio
@
@ Initialize a particle from a LCIO particle object. The model is
necessary for making a fully qualified flavor component.
<<HEP events: public>>=
public :: particle_from_lcio_particle
<<HEP events: sub interfaces>>=
module subroutine particle_from_lcio_particle &
(prt, lprt, model, fallback_model, daughters, parents, polarization)
type(particle_t), intent(out) :: prt
type(lcio_particle_t), intent(in) :: lprt
type(model_data_t), intent(in), target :: model
type(model_data_t), intent(in), target :: fallback_model
integer, dimension(:), intent(in) :: daughters, parents
integer, intent(in) :: polarization
end subroutine particle_from_lcio_particle
<<HEP events: procedures>>=
module subroutine particle_from_lcio_particle &
(prt, lprt, model, fallback_model, daughters, parents, polarization)
type(particle_t), intent(out) :: prt
type(lcio_particle_t), intent(in) :: lprt
type(model_data_t), intent(in), target :: model
type(model_data_t), intent(in), target :: fallback_model
integer, dimension(:), intent(in) :: daughters, parents
integer, intent(in) :: polarization
type(vector4_t) :: vtx4
type(flavor_t) :: flv
type(color_t) :: col
type(helicity_t) :: hel
type(polarization_t) :: pol
select case (lcio_particle_get_status (lprt))
case (1); call prt%set_status (PRT_OUTGOING)
case (2); call prt%set_status (PRT_RESONANT)
case (3)
select case (size (parents))
case (0)
call prt%set_status (PRT_INCOMING)
case default
call prt%set_status (PRT_VIRTUAL)
end select
case (4); call prt%set_status (PRT_BEAM)
end select
call flv%init (lcio_particle_get_pdg (lprt), model, fallback_model)
call col%init (lcio_particle_get_flow (lprt))
if (flv%is_beam_remnant ()) call prt%set_status (PRT_BEAM_REMNANT)
call prt%set_flavor (flv)
call prt%set_color (col)
call prt%set_polarization (polarization)
select case (polarization)
case (PRT_DEFINITE_HELICITY)
call lcio_particle_to_hel (lprt, prt%get_flv (), hel)
call prt%set_helicity (hel)
case (PRT_GENERIC_POLARIZATION)
call lcio_particle_to_pol (lprt, prt%get_flv (), pol)
call prt%set_pol (pol)
end select
call prt%set_momentum (lcio_particle_get_momentum (lprt), &
lcio_particle_get_mass_squared (lprt))
call prt%set_parents (parents)
call prt%set_children (daughters)
vtx4 = vector4_moving (lcio_particle_get_time (lprt), &
lcio_particle_get_vertex (lprt))
if (vtx4 /= vector4_null) call prt%set_vertex (vtx4)
end subroutine particle_from_lcio_particle
@ %def particle_from_lcio_particle
@
<<HEP events: public>>=
public :: lcio_event_from_particle_set
<<HEP events: sub interfaces>>=
module subroutine lcio_event_from_particle_set (evt, particle_set)
type(lcio_event_t), intent(inout) :: evt
type(particle_set_t), intent(in) :: particle_set
end subroutine lcio_event_from_particle_set
<<HEP events: procedures>>=
module subroutine lcio_event_from_particle_set (evt, particle_set)
type(lcio_event_t), intent(inout) :: evt
type(particle_set_t), intent(in) :: particle_set
type(lcio_particle_t), dimension(:), allocatable :: lprt
type(particle_set_t), target :: pset_filtered
integer, dimension(:), allocatable :: parent
integer :: n_tot, i, j, n_beam, n_parents, type, beam_count
call particle_set%filter_particles ( pset_filtered, &
real_parents = .true. , keep_beams = .true. , keep_virtuals = .false.)
n_tot = pset_filtered%n_tot
n_beam = count (pset_filtered%prt%get_status () == PRT_BEAM)
if (n_beam == 0) then
type = PRT_INCOMING
else
type = PRT_BEAM
end if
beam_count = 0
allocate (lprt (n_tot))
do i = 1, n_tot
call particle_to_lcio (pset_filtered%prt(i), lprt(i))
n_parents = pset_filtered%prt(i)%get_n_parents ()
if (n_parents /= 0) then
allocate (parent (n_parents))
parent = pset_filtered%prt(i)%get_parents ()
do j = 1, n_parents
call lcio_particle_set_parent (lprt(i), lprt(parent(j)))
end do
deallocate (parent)
end if
if (pset_filtered%prt(i)%get_status () == type) then
beam_count = beam_count + 1
call lcio_event_set_beam &
(evt, pset_filtered%prt(i)%get_pdg (), beam_count)
end if
call lcio_particle_add_to_evt_coll (lprt(i), evt)
end do
call lcio_event_add_coll (evt)
end subroutine lcio_event_from_particle_set
@ %def lcio_event_from_particle_set
@ If a particle set is initialized from a LCIO event record, we have
to specify the treatment of polarization (unpolarized or density
matrix) which is common to all particles. Correlated polarization
information is not available.
<<HEP events: public>>=
public :: lcio_event_to_particle_set
<<HEP events: sub interfaces>>=
module subroutine lcio_event_to_particle_set &
(particle_set, evt, model, fallback_model, polarization)
type(particle_set_t), intent(inout), target :: particle_set
type(lcio_event_t), intent(in) :: evt
class(model_data_t), intent(in), target :: model, fallback_model
integer, intent(in) :: polarization
end subroutine lcio_event_to_particle_set
<<HEP events: procedures>>=
module subroutine lcio_event_to_particle_set &
(particle_set, evt, model, fallback_model, polarization)
type(particle_set_t), intent(inout), target :: particle_set
type(lcio_event_t), intent(in) :: evt
class(model_data_t), intent(in), target :: model, fallback_model
integer, intent(in) :: polarization
type(lcio_particle_t) :: prt
integer, dimension(:), allocatable :: parents, daughters
integer :: n_tot, i, j, n_parents, n_children
n_tot = lcio_event_get_n_tot (evt)
allocate (particle_set%prt (n_tot))
do i = 1, n_tot
prt = lcio_event_get_particle (evt, i-1)
n_parents = lcio_particle_get_n_parents (prt)
n_children = lcio_particle_get_n_children (prt)
allocate (daughters (n_children))
allocate (parents (n_parents))
if (n_children > 0) then
do j = 1, n_children
daughters(j) = lcio_get_n_children (evt,i,j)
end do
end if
if (n_parents > 0) then
do j = 1, n_parents
parents(j) = lcio_get_n_parents (evt,i,j)
end do
end if
call particle_from_lcio_particle (particle_set%prt(i), &
prt, model, fallback_model, &
daughters, parents, polarization)
deallocate (daughters, parents)
end do
do i = 1, n_tot
if (particle_set%prt(i)%get_status () == PRT_VIRTUAL) then
CHECK_BEAM: do j = 1, particle_set%prt(i)%get_n_parents ()
if (particle_set%prt(j)%get_status () == PRT_BEAM) &
call particle_set%prt(i)%set_status (PRT_INCOMING)
exit CHECK_BEAM
end do CHECK_BEAM
end if
end do
particle_set%n_tot = n_tot
particle_set%n_beam = &
count (particle_set%prt%get_status () == PRT_BEAM)
particle_set%n_in = &
count (particle_set%prt%get_status () == PRT_INCOMING)
particle_set%n_out = &
count (particle_set%prt%get_status () == PRT_OUTGOING)
particle_set%n_vir = &
particle_set%n_tot - particle_set%n_in - particle_set%n_out
end subroutine lcio_event_to_particle_set
@ %def lcio_event_to_particle_set
@
<<HEP events: public>>=
public :: lcio_to_event
<<HEP events: sub interfaces>>=
module subroutine lcio_to_event &
(event, lcio_event, fallback_model, process_index, recover_beams, &
use_alpha_s, use_scale)
class(generic_event_t), intent(inout), target :: event
type(lcio_event_t), intent(inout) :: lcio_event
class(model_data_t), intent(in), target :: fallback_model
integer, intent(out), optional :: process_index
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alpha_s
logical, intent(in), optional :: use_scale
end subroutine lcio_to_event
<<HEP events: procedures>>=
module subroutine lcio_to_event &
(event, lcio_event, fallback_model, process_index, recover_beams, &
use_alpha_s, use_scale)
class(generic_event_t), intent(inout), target :: event
type(lcio_event_t), intent(inout) :: lcio_event
class(model_data_t), intent(in), target :: fallback_model
integer, intent(out), optional :: process_index
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alpha_s
logical, intent(in), optional :: use_scale
class(model_data_t), pointer :: model
real(default) :: scale, alpha_qcd
type(particle_set_t) :: particle_set
model => event%get_model_ptr ()
call lcio_event_to_particle_set (particle_set, &
lcio_event, model, fallback_model, PRT_DEFINITE_HELICITY)
call event%set_hard_particle_set (particle_set)
call particle_set%final ()
call event%set_weight_ref (1._default)
alpha_qcd = lcio_event_get_alphas (lcio_event)
scale = lcio_event_get_scaleval (lcio_event)
if (present (use_alpha_s)) then
if (use_alpha_s .and. alpha_qcd > 0) &
call event%set_alpha_qcd_forced (alpha_qcd)
end if
if (present (use_scale)) then
if (use_scale .and. scale > 0) &
call event%set_scale_forced (scale)
end if
end subroutine lcio_to_event
@ %def lcio_to_event
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[hep_events_ut.f90]]>>=
<<File header>>
module hep_events_ut
use unit_tests
use hepmc_interface, only: HEPMC_IS_AVAILABLE
use system_dependencies, only: HEPMC2_AVAILABLE
use hep_events_uti
<<Standard module head>>
<<HEP events: public test>>
contains
<<HEP events: test driver>>
end module hep_events_ut
@ %def hep_events_ut
@
<<[[hep_events_uti.f90]]>>=
<<File header>>
module hep_events_uti
<<Use kinds>>
<<Use strings>>
use lorentz
use flavors
use colors
use helicities
use quantum_numbers
use state_matrices, only: FM_SELECT_HELICITY, FM_FACTOR_HELICITY
use interactions
use evaluators
use model_data
use particles
use subevents
use hepmc_interface
use hep_events
<<Standard module head>>
<<HEP events: test declarations>>
contains
<<HEP events: tests>>
end module hep_events_uti
@ %def hep_events_ut
@ API: driver for the unit tests below.
<<HEP events: public test>>=
public :: hep_events_test
<<HEP events: test driver>>=
subroutine hep_events_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<HEP events: execute tests>>
end subroutine hep_events_test
@ %def particles_test
@ If [[HepMC]] is available, check the routines via [[HepMC]].
Set up a chain of production and decay and factorize the result into
particles. The process is $d\bar d \to Z \to q\bar q$.
<<HEP events: execute tests>>=
if (hepmc_is_available ()) then
call test (hep_events_1, "hep_events_1", &
"check HepMC event routines", &
u, results)
end if
<<HEP events: test declarations>>=
public :: hep_events_1
<<HEP events: tests>>=
subroutine hep_events_1 (u)
use os_interface
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(3) :: flv
type(color_t), dimension(3) :: col
type(helicity_t), dimension(3) :: hel
type(quantum_numbers_t), dimension(3) :: qn
type(vector4_t), dimension(3) :: p
type(interaction_t), target :: int1, int2
type(quantum_numbers_mask_t) :: qn_mask_conn
type(evaluator_t), target :: eval
type(interaction_t), pointer :: int
type(particle_set_t) :: particle_set1, particle_set2
type(hepmc_event_t) :: hepmc_event
type(hepmc_iostream_t) :: iostream
real(default) :: cross_section, error, weight
logical :: ok
write (u, "(A)") "* Test output: HEP events"
write (u, "(A)") "* Purpose: test HepMC event routines"
write (u, "(A)")
write (u, "(A)") "* Reading model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Initializing production process"
call int1%basic_init (2, 0, 1, set_relations=.true.)
call flv%init ([1, -1, 23], model)
call col%init_col_acl ([0, 0, 0], [0, 0, 0])
call hel(3)%init ( 1, 1)
call qn%init (flv, col, hel)
call int1%add_state (qn, value=(0.25_default, 0._default))
call hel(3)%init ( 1,-1)
call qn%init (flv, col, hel)
call int1%add_state (qn, value=(0._default, 0.25_default))
call hel(3)%init (-1, 1)
call qn%init (flv, col, hel)
call int1%add_state (qn, value=(0._default,-0.25_default))
call hel(3)%init (-1,-1)
call qn%init (flv, col, hel)
call int1%add_state (qn, value=(0.25_default, 0._default))
call hel(3)%init ( 0, 0)
call qn%init (flv, col, hel)
call int1%add_state (qn, value=(0.5_default, 0._default))
call int1%freeze ()
p(1) = vector4_moving (45._default, 45._default, 3)
p(2) = vector4_moving (45._default,-45._default, 3)
p(3) = p(1) + p(2)
call int1%set_momenta (p)
write (u, "(A)")
write (u, "(A)") "* Setup decay process"
call int2%basic_init (1, 0, 2, set_relations=.true.)
call flv%init ([23, 1, -1], model)
call col%init_col_acl ([0, 501, 0], [0, 0, 501])
call hel%init ([1, 1, 1], [1, 1, 1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(1._default, 0._default))
call hel%init ([1, 1, 1], [-1,-1,-1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(0._default, 0.1_default))
call hel%init ([-1,-1,-1], [1, 1, 1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(0._default,-0.1_default))
call hel%init ([-1,-1,-1], [-1,-1,-1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(1._default, 0._default))
call hel%init ([0, 1,-1], [0, 1,-1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(4._default, 0._default))
call hel%init ([0,-1, 1], [0, 1,-1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(2._default, 0._default))
call hel%init ([0, 1,-1], [0,-1, 1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(2._default, 0._default))
call hel%init ([0,-1, 1], [0,-1, 1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(4._default, 0._default))
call flv%init ([23, 2, -2], model)
call hel%init ([0, 1,-1], [0, 1,-1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(0.5_default, 0._default))
call hel%init ([0,-1, 1], [0,-1, 1])
call qn%init (flv, col, hel)
call int2%add_state (qn, value=(0.5_default, 0._default))
call int2%freeze ()
p(2) = vector4_moving (45._default, 45._default, 2)
p(3) = vector4_moving (45._default,-45._default, 2)
call int2%set_momenta (p)
call int2%set_source_link (1, int1, 3)
call int1%basic_write (u)
call int2%basic_write (u)
write (u, "(A)")
write (u, "(A)") "* Concatenate production and decay"
call eval%init_product (int1, int2, qn_mask_conn, &
connections_are_resonant=.true.)
call eval%receive_momenta ()
call eval%evaluate ()
call eval%write (u)
write (u, "(A)")
write (u, "(A)") "* Factorize as subevent (complete, polarized)"
write (u, "(A)")
int => eval%interaction_t
call particle_set1%init &
(ok, int, int, FM_FACTOR_HELICITY, &
[0.2_default, 0.2_default], .false., .true.)
call particle_set1%write (u)
write (u, "(A)")
write (u, "(A)") "* Factorize as subevent (in/out only, selected helicity)"
write (u, "(A)")
int => eval%interaction_t
call particle_set2%init &
(ok, int, int, FM_SELECT_HELICITY, &
[0.9_default, 0.9_default], .false., .false.)
call particle_set2%write (u)
call particle_set2%final ()
write (u, "(A)")
write (u, "(A)") "* Factorize as subevent (complete, selected helicity)"
write (u, "(A)")
int => eval%interaction_t
call particle_set2%init &
(ok, int, int, FM_SELECT_HELICITY, &
[0.7_default, 0.7_default], .false., .true.)
call particle_set2%write (u)
write (u, "(A)")
write (u, "(A)") "* Transfer particle_set to HepMC, print, and output to"
write (u, "(A)") " hep_events.hepmc.dat"
write (u, "(A)")
cross_section = 42.0_default
error = 17.0_default
weight = 1.0_default
call hepmc_event_init (hepmc_event, 11, 127)
call hepmc_event_from_particle_set (hepmc_event, particle_set2, &
cross_section, error, .true.)
call hepmc_event_add_weight (hepmc_event, weight, .true.)
call hepmc_event_print (hepmc_event)
call hepmc_iostream_open_out &
(iostream , var_str ("hep_events.hepmc.dat"), 2)
call hepmc_iostream_write_event (iostream, hepmc_event)
call hepmc_iostream_close (iostream)
write (u, "(A)")
write (u, "(A)") "* Recover from HepMC file"
write (u, "(A)")
call particle_set2%final ()
call hepmc_event_final (hepmc_event)
call hepmc_event_init (hepmc_event)
call hepmc_iostream_open_in &
(iostream , var_str ("hep_events.hepmc.dat"), HEPMC3_MODE_HEPMC3)
call hepmc_iostream_read_event (iostream, hepmc_event, ok=ok)
call hepmc_iostream_close (iostream)
call hepmc_event_to_particle_set (particle_set2, &
hepmc_event, model, model, PRT_DEFINITE_HELICITY)
call particle_set2%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call particle_set1%final ()
call particle_set2%final ()
call eval%final ()
call int1%final ()
call int2%final ()
call hepmc_event_final (hepmc_event)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: hep_events_1"
end subroutine hep_events_1
@
@ %def hep_events_1
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{LHEF Input/Output}
The LHEF event record is standardized. It is an ASCII format. We try
our best at using it for both input and output.
<<[[eio_lhef.f90]]>>=
<<File header>>
module eio_lhef
<<Use kinds>>
<<Use strings>>
use xml
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO LHEF: public>>
<<EIO LHEF: types>>
interface
<<EIO LHEF: sub interfaces>>
end interface
end module eio_lhef
@ %def eio_lhef
@
<<[[eio_lhef_sub.f90]]>>=
<<File header>>
submodule (eio_lhef) eio_lhef_s
use io_units
use string_utils
use numeric_utils
use diagnostics
use os_interface
use hep_common
use hep_events
implicit none
contains
<<EIO LHEF: procedures>>
end submodule eio_lhef_s
@ %def eio_lhef_s
@
\subsection{Type}
With sufficient confidence that it will always be three characters, we
can store the version string with a default value.
<<EIO LHEF: public>>=
public :: eio_lhef_t
<<EIO LHEF: types>>=
type, extends (eio_t) :: eio_lhef_t
logical :: writing = .false.
logical :: reading = .false.
integer :: unit = 0
type(event_sample_data_t) :: data
type(cstream_t) :: cstream
character(3) :: version = "1.0"
logical :: keep_beams = .false.
logical :: keep_remnants = .true.
logical :: keep_virtuals = .false.
logical :: recover_beams = .true.
logical :: unweighted = .true.
logical :: write_sqme_ref = .false.
logical :: write_sqme_prc = .false.
logical :: write_sqme_alt = .false.
logical :: use_alphas_from_file = .false.
logical :: use_scale_from_file = .false.
integer :: n_alt = 0
integer, dimension(:), allocatable :: proc_num_id
integer :: i_weight_sqme = 0
type(xml_tag_t) :: tag_lhef, tag_head, tag_init, tag_event
type(xml_tag_t), allocatable :: tag_whiz_info
type(xml_tag_t), allocatable :: tag_gen_n, tag_gen_v
type(xml_tag_t), allocatable :: tag_generator, tag_xsecinfo
type(xml_tag_t), allocatable :: tag_sqme_ref, tag_sqme_prc
type(xml_tag_t), dimension(:), allocatable :: tag_sqme_alt, tag_wgts_alt
type(xml_tag_t), allocatable :: tag_weight, tag_weightinfo, tag_weights
contains
<<EIO LHEF: eio lhef: TBP>>
end type eio_lhef_t
@ %def eio_lhef_t
@
\subsection{Specific Methods}
Set parameters that are specifically used with LHEF.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: set_parameters => eio_lhef_set_parameters
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_set_parameters (eio, &
keep_beams, keep_remnants, recover_beams, &
use_alphas_from_file, use_scale_from_file, &
version, extension, write_sqme_ref, write_sqme_prc, write_sqme_alt)
class(eio_lhef_t), intent(inout) :: eio
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
character(*), intent(in), optional :: version
type(string_t), intent(in), optional :: extension
logical, intent(in), optional :: write_sqme_ref
logical, intent(in), optional :: write_sqme_prc
logical, intent(in), optional :: write_sqme_alt
end subroutine eio_lhef_set_parameters
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_set_parameters (eio, &
keep_beams, keep_remnants, recover_beams, &
use_alphas_from_file, use_scale_from_file, &
version, extension, write_sqme_ref, write_sqme_prc, write_sqme_alt)
class(eio_lhef_t), intent(inout) :: eio
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
character(*), intent(in), optional :: version
type(string_t), intent(in), optional :: extension
logical, intent(in), optional :: write_sqme_ref
logical, intent(in), optional :: write_sqme_prc
logical, intent(in), optional :: write_sqme_alt
if (present (keep_beams)) eio%keep_beams = keep_beams
if (present (keep_remnants)) eio%keep_remnants = keep_remnants
if (present (recover_beams)) eio%recover_beams = recover_beams
if (present (use_alphas_from_file)) &
eio%use_alphas_from_file = use_alphas_from_file
if (present (use_scale_from_file)) &
eio%use_scale_from_file = use_scale_from_file
if (present (version)) then
select case (version)
case ("1.0", "2.0", "3.0")
eio%version = version
case default
call msg_error ("LHEF version " // version &
// " is not supported. Inserting 2.0")
eio%version = "2.0"
end select
end if
if (present (extension)) then
eio%extension = extension
else
eio%extension = "lhe"
end if
if (present (write_sqme_ref)) eio%write_sqme_ref = write_sqme_ref
if (present (write_sqme_prc)) eio%write_sqme_prc = write_sqme_prc
if (present (write_sqme_alt)) eio%write_sqme_alt = write_sqme_alt
end subroutine eio_lhef_set_parameters
@ %def eio_lhef_set_parameters
@
\subsection{Common Methods}
Output. This is not the actual event format, but a readable account
of the current object status.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: write => eio_lhef_write
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_write (object, unit)
class(eio_lhef_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_lhef_write
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_write (object, unit)
class(eio_lhef_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "LHEF event stream:"
if (object%writing) then
write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
else if (object%reading) then
write (u, "(3x,A,A)") "Reading from file = ", char (object%filename)
else
write (u, "(3x,A)") "[closed]"
end if
write (u, "(3x,A,L1)") "Keep beams = ", object%keep_beams
write (u, "(3x,A,L1)") "Keep remnants = ", object%keep_remnants
write (u, "(3x,A,L1)") "Recover beams = ", object%recover_beams
write (u, "(3x,A,L1)") "Alpha_s from file = ", &
object%use_alphas_from_file
write (u, "(3x,A,L1)") "Scale from file = ", &
object%use_scale_from_file
write (u, "(3x,A,A)") "Version = ", object%version
write (u, "(3x,A,A,A)") "File extension = '", &
char (object%extension), "'"
if (allocated (object%proc_num_id)) then
write (u, "(3x,A)") "Numerical process IDs:"
do i = 1, size (object%proc_num_id)
write (u, "(5x,I0,': ',I0)") i, object%proc_num_id(i)
end do
end if
end subroutine eio_lhef_write
@ %def eio_lhef_write
@ Finalizer: close any open file.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: final => eio_lhef_final
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_final (object)
class(eio_lhef_t), intent(inout) :: object
end subroutine eio_lhef_final
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_final (object)
class(eio_lhef_t), intent(inout) :: object
if (allocated (object%proc_num_id)) deallocate (object%proc_num_id)
if (object%writing) then
write (msg_buffer, "(A,A,A)") "Events: closing LHEF file '", &
char (object%filename), "'"
call msg_message ()
call object%write_footer ()
close (object%unit)
object%writing = .false.
else if (object%reading) then
write (msg_buffer, "(A,A,A)") "Events: closing LHEF file '", &
char (object%filename), "'"
call msg_message ()
call object%cstream%final ()
close (object%unit)
object%reading = .false.
end if
end subroutine eio_lhef_final
@ %def eio_lhef_final
@ Common initialization for input and output.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: common_init => eio_lhef_common_init
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_common_init (eio, sample, data, extension)
class(eio_lhef_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
end subroutine eio_lhef_common_init
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_common_init (eio, sample, data, extension)
class(eio_lhef_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
if (.not. present (data)) &
call msg_bug ("LHEF initialization: missing data")
eio%data = data
eio%unweighted = data%unweighted
if (eio%unweighted) then
select case (data%norm_mode)
case (NORM_UNIT)
case default; call msg_fatal &
("LHEF: normalization for unweighted events must be '1'")
end select
else
select case (data%norm_mode)
case (NORM_SIGMA)
case default; call msg_fatal &
("LHEF: normalization for weighted events must be 'sigma'")
end select
end if
eio%n_alt = data%n_alt
eio%sample = sample
if (present (extension)) then
eio%extension = extension
end if
call eio%set_filename ()
eio%unit = free_unit ()
call eio%init_tags (data)
allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
end subroutine eio_lhef_common_init
@ %def eio_lhef_common_init
@ Initialize the tag objects. Some tags depend on the LHEF
version. In particular, the tags that in LHEF 2.0 identify
individual weights by name in each event block, in LHEF 3.0 are
replaced by info tags in the init block and a single \texttt{weights}
tag in the event block. The name attributes of those tags
are specific for \whizard.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: init_tags => eio_lhef_init_tags
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_init_tags (eio, data)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(in) :: data
end subroutine eio_lhef_init_tags
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_init_tags (eio, data)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(in) :: data
real(default), parameter :: pb_per_fb = 1.e-3_default
real(default) :: xsec_width
integer :: i
call eio%tag_lhef%init ( &
var_str ("LesHouchesEvents"), &
[xml_attribute (var_str ("version"), var_str (eio%version))], &
.true.)
call eio%tag_head%init ( &
var_str ("header"), &
.true.)
call eio%tag_init%init ( &
var_str ("init"), &
.true.)
call eio%tag_event%init (var_str ("event"), &
.true.)
allocate (eio%tag_whiz_info)
call eio%tag_whiz_info%init (var_str ("WhizardInfo"), .true.)
select case (eio%version)
case ("1.0")
allocate (eio%tag_gen_n)
call eio%tag_gen_n%init ( &
var_str ("generator_name"), &
.true.)
allocate (eio%tag_gen_v)
call eio%tag_gen_v%init ( &
var_str ("generator_version"), &
.true.)
end select
select case (eio%version)
case ("2.0", "3.0")
allocate (eio%tag_generator)
call eio%tag_generator%init ( &
var_str ("generator"), &
[xml_attribute (var_str ("version"), var_str ("<<Version>>"))], &
.true.)
allocate (eio%tag_xsecinfo)
if (data%n_beam == 2) then
xsec_width = data%total_cross_section * pb_per_fb
else
xsec_width = data%total_cross_section
end if
call eio%tag_xsecinfo%init ( &
var_str ("xsecinfo"), &
[xml_attribute (var_str ("neve"), str (data%n_evt)), &
xml_attribute (var_str ("totxsec"), &
str (xsec_width))])
end select
select case (eio%version)
case ("2.0")
allocate (eio%tag_weight)
call eio%tag_weight%init (var_str ("weight"), &
[xml_attribute (var_str ("name"))])
if (eio%write_sqme_ref) then
allocate (eio%tag_sqme_ref)
call eio%tag_sqme_ref%init (var_str ("weight"), &
[xml_attribute (var_str ("name"), var_str ("sqme_ref"))], &
.true.)
end if
if (eio%write_sqme_prc) then
allocate (eio%tag_sqme_prc)
call eio%tag_sqme_prc%init (var_str ("weight"), &
[xml_attribute (var_str ("name"), var_str ("sqme_prc"))], &
.true.)
end if
if (eio%n_alt > 0) then
if (eio%write_sqme_alt) then
allocate (eio%tag_sqme_alt (1))
call eio%tag_sqme_alt(1)%init (var_str ("weight"), &
[xml_attribute (var_str ("name"), var_str ("sqme_alt"))], &
.true.)
end if
allocate (eio%tag_wgts_alt (1))
call eio%tag_wgts_alt(1)%init (var_str ("weight"), &
[xml_attribute (var_str ("name"), var_str ("wgts_alt"))], &
.true.)
end if
case ("3.0")
if (eio%write_sqme_ref) then
allocate (eio%tag_sqme_ref)
call eio%tag_sqme_ref%init (var_str ("weightinfo"), &
[xml_attribute (var_str ("name"), var_str ("sqme_ref"))])
end if
if (eio%write_sqme_prc) then
allocate (eio%tag_sqme_prc)
call eio%tag_sqme_prc%init (var_str ("weightinfo"), &
[xml_attribute (var_str ("name"), var_str ("sqme_prc"))])
end if
if (eio%n_alt > 0) then
if (eio%write_sqme_alt) then
allocate (eio%tag_sqme_alt (eio%n_alt))
do i = 1, eio%n_alt
call eio%tag_sqme_alt(i)%init (var_str ("weightinfo"), &
[xml_attribute (var_str ("name"), &
var_str ("sqme_alt") // str (i))])
end do
end if
allocate (eio%tag_wgts_alt (eio%n_alt))
do i = 1, eio%n_alt
call eio%tag_wgts_alt(i)%init (var_str ("weightinfo"), &
[xml_attribute (var_str ("name"), &
var_str ("wgts_alt") // str (i))])
end do
end if
allocate (eio%tag_weightinfo)
call eio%tag_weightinfo%init (var_str ("weightinfo"), &
[xml_attribute (var_str ("name"))])
allocate (eio%tag_weights)
call eio%tag_weights%init (var_str ("weights"), .true.)
end select
end subroutine eio_lhef_init_tags
@ %def eio_lhef_init_tags
@ Initialize event writing.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: init_out => eio_lhef_init_out
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_init_out (eio, sample, data, success, extension)
class(eio_lhef_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_lhef_init_out
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_init_out (eio, sample, data, success, extension)
class(eio_lhef_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
integer :: u, i
logical :: is_width
is_width = data%n_beam == 1
call eio%set_splitting (data)
call eio%common_init (sample, data, extension)
write (msg_buffer, "(A,A,A)") "Events: writing to LHEF file '", &
char (eio%filename), "'"
call msg_message ()
eio%writing = .true.
u = eio%unit
open (u, file = char (eio%filename), &
action = "write", status = "replace")
call eio%write_header (is_width)
call heprup_init &
(data%pdg_beam, &
data%energy_beam, &
n_processes = data%n_proc, &
unweighted = data%unweighted, &
negative_weights = data%negative_weights)
do i = 1, data%n_proc
call heprup_set_process_parameters (i = i, &
process_id = data%proc_num_id(i), &
cross_section = data%cross_section(i), &
error = data%error(i), &
is_width = is_width)
end do
call eio%tag_init%write (u); write (u, *)
call heprup_write_lhef (u)
select case (eio%version)
case ("2.0"); call eio%write_init_20 (data)
case ("3.0"); call eio%write_init_30 (data)
end select
call eio%tag_init%close (u); write (u, *)
if (present (success)) success = .true.
end subroutine eio_lhef_init_out
@ %def eio_lhef_init_out
@ Initialize event reading. First read the LHEF tag and version, then
read the header and skip over its contents, then read the init block.
(We require the opening and closing tags of the init block to be placed
on separate lines without extra stuff.)
For input, we do not (yet?) support split event files.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: init_in => eio_lhef_init_in
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_init_in (eio, sample, data, success, extension)
class(eio_lhef_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_lhef_init_in
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_init_in (eio, sample, data, success, extension)
class(eio_lhef_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
logical :: exist, ok, closing
type(event_sample_data_t) :: data_file
type(string_t) :: string
integer :: u
eio%split = .false.
call eio%common_init (sample, data, extension)
write (msg_buffer, "(A,A,A)") "Events: reading from LHEF file '", &
char (eio%filename), "'"
call msg_message ()
inquire (file = char (eio%filename), exist = exist)
if (.not. exist) call msg_fatal ("Events: LHEF file not found.")
eio%reading = .true.
u = eio%unit
open (u, file = char (eio%filename), &
action = "read", status = "old")
call eio%cstream%init (u)
call eio%read_header ()
call eio%tag_init%read (eio%cstream, ok)
if (.not. ok) call err_init
select case (eio%version)
case ("1.0"); call eio%read_init_10 (data_file)
call eio%tag_init%read_content (eio%cstream, string, closing)
if (string /= "" .or. .not. closing) call err_init
case ("2.0"); call eio%read_init_20 (data_file)
case ("3.0"); call eio%read_init_30 (data_file)
end select
call eio%merge_data (data, data_file)
if (present (success)) success = .true.
contains
subroutine err_init
call msg_fatal ("LHEF: syntax error in init tag")
end subroutine err_init
end subroutine eio_lhef_init_in
@ %def eio_lhef_init_in
@ Merge event sample data: we can check the data in the file against
our assumptions and set or reset parameters.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: merge_data => eio_merge_data
<<EIO LHEF: sub interfaces>>=
module subroutine eio_merge_data (eio, data, data_file)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(inout) :: data
type(event_sample_data_t), intent(in) :: data_file
end subroutine eio_merge_data
<<EIO LHEF: procedures>>=
module subroutine eio_merge_data (eio, data, data_file)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(inout) :: data
type(event_sample_data_t), intent(in) :: data_file
real, parameter :: tolerance = 1000 * epsilon (1._default)
if (data%unweighted .neqv. data_file%unweighted) call err_weights
if (data%negative_weights .neqv. data_file%negative_weights) &
call err_weights
if (data%norm_mode /= data_file%norm_mode) call err_norm
if (data%n_beam /= data_file%n_beam) call err_beams
if (any (data%pdg_beam /= data_file%pdg_beam)) call err_beams
if (any (abs ((data%energy_beam - data_file%energy_beam)) &
> (data%energy_beam + data_file%energy_beam) * tolerance)) &
call err_beams
if (data%n_proc /= data_file%n_proc) call err_proc
if (any (data%proc_num_id /= data_file%proc_num_id)) call err_proc
where (data%cross_section == 0)
data%cross_section = data_file%cross_section
data%error = data_file%error
end where
data%total_cross_section = sum (data%cross_section)
if (data_file%n_evt > 0) then
if (data%n_evt > 0 .and. data_file%n_evt /= data%n_evt) call err_n_evt
data%n_evt = data_file%n_evt
end if
contains
subroutine err_weights
call msg_fatal ("LHEF: mismatch in event weight properties")
end subroutine err_weights
subroutine err_norm
call msg_fatal ("LHEF: mismatch in event normalization")
end subroutine err_norm
subroutine err_beams
call msg_fatal ("LHEF: mismatch in beam properties")
end subroutine err_beams
subroutine err_proc
call msg_fatal ("LHEF: mismatch in process definitions")
end subroutine err_proc
subroutine err_n_evt
call msg_error ("LHEF: mismatch in specified number of events (ignored)")
end subroutine err_n_evt
end subroutine eio_merge_data
@ %def eio_merge_data
@ Switch from input to output: reopen the file for reading.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: switch_inout => eio_lhef_switch_inout
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_switch_inout (eio, success)
class(eio_lhef_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_lhef_switch_inout
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_switch_inout (eio, success)
class(eio_lhef_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("LHEF: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_lhef_switch_inout
@ %def eio_lhef_switch_inout
@ Split event file: increment the counter, close the current file, open a new
one. If the file needs a header, repeat it for the new file. (We assume that
the common block contents are still intact.)
<<EIO LHEF: eio lhef: TBP>>=
procedure :: split_out => eio_lhef_split_out
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_split_out (eio)
class(eio_lhef_t), intent(inout) :: eio
end subroutine eio_lhef_split_out
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_split_out (eio)
class(eio_lhef_t), intent(inout) :: eio
integer :: u
if (eio%split) then
eio%split_index = eio%split_index + 1
call eio%set_filename ()
write (msg_buffer, "(A,A,A)") "Events: writing to LHEF file '", &
char (eio%filename), "'"
call msg_message ()
call eio%write_footer ()
u = eio%unit
close (u)
open (u, file = char (eio%filename), &
action = "write", status = "replace")
call eio%write_header ()
call eio%tag_init%write (u); write (u, *)
call heprup_write_lhef (u)
select case (eio%version)
case ("2.0"); call eio%write_init_20 (eio%data)
case ("3.0"); call eio%write_init_30 (eio%data)
end select
call eio%tag_init%close (u); write (u, *)
end if
end subroutine eio_lhef_split_out
@ %def eio_lhef_split_out
@ Output an event. Write first the event indices, then weight and
squared matrix element, then the particle set.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: output => eio_lhef_output
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_lhef_output
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
integer :: u
u = given_output_unit (eio%unit); if (u < 0) return
if (present (passed)) then
if (.not. passed) return
end if
if (eio%writing) then
call hepeup_from_event (event, &
process_index = eio%proc_num_id (i_prc), &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants)
write (u, '(A)') "<event>"
call hepeup_write_lhef (eio%unit)
select case (eio%version)
case ("2.0"); call eio%write_event_20 (event)
case ("3.0"); call eio%write_event_30 (event)
end select
write (u, '(A)') "</event>"
else
call eio%write ()
call msg_fatal ("LHEF file is not open for writing")
end if
end subroutine eio_lhef_output
@ %def eio_lhef_output
@ Input an event. Upon input of [[i_prc]], we can just read in the
whole HEPEUP common block. These data are known to come first. The
[[i_prc]] value can be deduced from the IDPRUP value by a table
lookup.
Reading the common block bypasses the [[cstream]] which accesses the
input unit. This is consistent with the LHEF specification. After
the common-block data have been swallowed, we can resume reading from
stream.
We don't catch actual I/O errors. However, we return a negative value in
[[iostat]] if we reached the terminating [[</LesHouchesEvents>]] tag.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: input_i_prc => eio_lhef_input_i_prc
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_input_i_prc (eio, i_prc, iostat)
class(eio_lhef_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_lhef_input_i_prc
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_input_i_prc (eio, i_prc, iostat)
class(eio_lhef_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
integer :: i, proc_num_id
type(string_t) :: s
logical :: ok
iostat = 0
call eio%tag_lhef%read_content (eio%cstream, s, ok)
if (ok) then
if (s == "") then
iostat = -1
else
call err_close
end if
return
else
call eio%cstream%revert_record (s)
end if
call eio%tag_event%read (eio%cstream, ok)
if (.not. ok) then
call err_evt1
return
end if
call hepeup_read_lhef (eio%unit)
call hepeup_get_event_parameters (proc_id = proc_num_id)
i_prc = 0
FIND_I_PRC: do i = 1, size (eio%proc_num_id)
if (eio%proc_num_id(i) == proc_num_id) then
i_prc = i
exit FIND_I_PRC
end if
end do FIND_I_PRC
if (i_prc == 0) call err_index
contains
subroutine err_close
call msg_error ("LHEF: reading events: syntax error in closing tag")
iostat = 1
end subroutine
subroutine err_evt1
call msg_error ("LHEF: reading events: invalid event tag, &
&aborting read")
iostat = 2
end subroutine err_evt1
subroutine err_index
call msg_error ("LHEF: reading events: undefined process ID " &
// char (str (proc_num_id)) // ", aborting read")
iostat = 3
end subroutine err_index
end subroutine eio_lhef_input_i_prc
@ %def eio_lhef_input_i_prc
@ Since we have already read the event information from file, this
input routine can transfer the common-block contents to the event
record. Also, we read any further information in the event record.
Since LHEF does not give this information, we must assume that the MCI
group, term, and channel can all be safely set to 1. This works if
there is only one MCI group and term. The channel doesn't matter for
the matrix element.
The event index is incremented, as if the event was generated. The
LHEF format does not support event indices.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: input_event => eio_lhef_input_event
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_input_event (eio, event, iostat, event_handle)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_lhef_input_event
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_input_event (eio, event, iostat, event_handle)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
type(string_t) :: s
logical :: closing
iostat = 0
call event%reset_contents ()
call event%select (1, 1, 1)
call hepeup_to_event (event, eio%fallback_model, &
recover_beams = eio%recover_beams, &
use_alpha_s = eio%use_alphas_from_file, &
use_scale = eio%use_scale_from_file)
select case (eio%version)
case ("1.0")
call eio%tag_event%read_content (eio%cstream, s, closing = closing)
if (s /= "" .or. .not. closing) call err_evt2
case ("2.0"); call eio%read_event_20 (event)
case ("3.0"); call eio%read_event_30 (event)
end select
call event%increment_index ()
contains
subroutine err_evt2
call msg_error ("LHEF: reading events: syntax error in event record, &
&aborting read")
iostat = 2
end subroutine err_evt2
end subroutine eio_lhef_input_event
@ %def eio_lhef_input_event
@
<<EIO LHEF: eio lhef: TBP>>=
procedure :: skip => eio_lhef_skip
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_skip (eio, iostat)
class(eio_lhef_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_lhef_skip
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_skip (eio, iostat)
class(eio_lhef_t), intent(inout) :: eio
integer, intent(out) :: iostat
if (eio%reading) then
read (eio%unit, iostat = iostat)
else
call eio%write ()
call msg_fatal ("Raw event file is not open for reading")
end if
end subroutine eio_lhef_skip
@ %def eio_lhef_skip
@
\subsection{Les Houches Event File: header/footer}
These two routines write the header and footer for the Les Houches
Event File format (LHEF).
The current version writes no information except for the generator
name and version (v.1.0 only).
<<EIO LHEF: eio lhef: TBP>>=
procedure :: write_header => eio_lhef_write_header
procedure :: write_footer => eio_lhef_write_footer
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_write_header (eio, is_width)
class(eio_lhef_t), intent(in) :: eio
logical, intent(in), optional :: is_width
end subroutine eio_lhef_write_header
module subroutine eio_lhef_write_footer (eio)
class(eio_lhef_t), intent(in) :: eio
end subroutine eio_lhef_write_footer
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_write_header (eio, is_width)
class(eio_lhef_t), intent(in) :: eio
logical, intent(in), optional :: is_width
logical :: is_w
integer :: u
u = given_output_unit (eio%unit); if (u < 0) return
is_w = .false.
if (present (is_width)) is_w = is_width
call eio%tag_lhef%write (u); write (u, *)
call eio%tag_head%write (u); write (u, *)
select case (eio%version)
case ("1.0")
write (u, "(2x)", advance = "no")
call eio%tag_gen_n%write (var_str ("WHIZARD"), u)
write (u, *)
write (u, "(2x)", advance = "no")
call eio%tag_gen_v%write (var_str ("<<Version>>"), u)
write (u, *)
end select
if (is_w) then
call eio%tag_whiz_info%write (u); write (u, *)
write (u, "(A)") &
"# Special LHE event setup for decays, units in GeV"
call eio%tag_whiz_info%close (u); write (u, *)
end if
call eio%tag_head%close (u); write (u, *)
end subroutine eio_lhef_write_header
module subroutine eio_lhef_write_footer (eio)
class(eio_lhef_t), intent(in) :: eio
integer :: u
u = given_output_unit (eio%unit); if (u < 0) return
call eio%tag_lhef%close (u)
end subroutine eio_lhef_write_footer
@ %def eio_lhef_write_header eio_lhef_write_footer
@ Reading the header just means finding the tags and ignoring any
contents. When done, we should stand just after the header tag.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: read_header => eio_lhef_read_header
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_read_header (eio)
class(eio_lhef_t), intent(inout) :: eio
end subroutine eio_lhef_read_header
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_read_header (eio)
class(eio_lhef_t), intent(inout) :: eio
logical :: success, closing
type(string_t) :: content
call eio%tag_lhef%read (eio%cstream, success)
if (.not. success .or. .not. eio%tag_lhef%has_content) call err_lhef
if (eio%tag_lhef%get_attribute (1) /= eio%version) call err_version
call eio%tag_head%read (eio%cstream, success)
if (.not. success) call err_header
if (eio%tag_head%has_content) then
SKIP_HEADER_CONTENT: do
call eio%tag_head%read_content (eio%cstream, content, closing)
if (closing) exit SKIP_HEADER_CONTENT
end do SKIP_HEADER_CONTENT
end if
contains
subroutine err_lhef
call msg_fatal ("LHEF: LesHouchesEvents tag absent or corrupted")
end subroutine err_lhef
subroutine err_header
call msg_fatal ("LHEF: header tag absent or corrupted")
end subroutine err_header
subroutine err_version
call msg_error ("LHEF: version mismatch: expected " &
// eio%version // ", found " &
// char (eio%tag_lhef%get_attribute (1)))
end subroutine err_version
end subroutine eio_lhef_read_header
@ %def eio_lhef_read_header
@
\subsection{Version-Specific Code: 1.0}
In version 1.0, the init tag contains just HEPRUP data. While a
[[cstream]] is connected to the input unit, we bypass it temporarily
for the purpose of reading the HEPRUP contents. This is consistent
with the LHEF standard.
This routine does not read the closing tag of the init block.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: read_init_10 => eio_lhef_read_init_10
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_read_init_10 (eio, data)
class(eio_lhef_t), intent(in) :: eio
type(event_sample_data_t), intent(out) :: data
end subroutine eio_lhef_read_init_10
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_read_init_10 (eio, data)
class(eio_lhef_t), intent(in) :: eio
type(event_sample_data_t), intent(out) :: data
integer :: n_proc, i
logical :: is_width
call heprup_read_lhef (eio%unit)
call heprup_get_run_parameters (n_processes = n_proc)
call data%init (n_proc)
if (IDBMUP(2) == 0) then
data%n_beam = 1
is_width = .true.
else
data%n_beam = 2
is_width = .false.
end if
call heprup_get_run_parameters ( &
unweighted = data%unweighted, &
negative_weights = data%negative_weights, &
beam_pdg = data%pdg_beam, &
beam_energy = data%energy_beam)
if (data%unweighted) then
data%norm_mode = NORM_UNIT
else
data%norm_mode = NORM_SIGMA
end if
do i = 1, n_proc
call heprup_get_process_parameters (i, &
process_id = data%proc_num_id(i), &
cross_section = data%cross_section(i), &
error = data%error(i), &
is_width = is_width)
end do
end subroutine eio_lhef_read_init_10
@ %def eio_lhef_read_init_10
@
\subsection{Version-Specific Code: 2.0}
This is the init information for the 2.0 format, after the HEPRUP
data. We have the following tags:
\begin{itemize}
\item \texttt{generator} Generator name and version.
\item \texttt{xsecinfo} Cross section and weights data. We have the
total cross section and number of events (assuming that the event
file is intact), but information on minimum and maximum weights is
not available before the file is complete. We just write the
mandatory tags. (Note that the default values of the other tags
describe a uniform unit weight, but we can determine most values
only after the sample is complete.)
\item \texttt{cutsinfo} This optional tag is too specific to represent the
possibilities of WHIZARD, so we skip it.
\item \texttt{procinfo} This optional tag is useful for giving
details of NLO calculations. Skipped.
\item \texttt{mergetype} Optional, also not applicable.
\end{itemize}
<<EIO LHEF: eio lhef: TBP>>=
procedure :: write_init_20 => eio_lhef_write_init_20
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_write_init_20 (eio, data)
class(eio_lhef_t), intent(in) :: eio
type(event_sample_data_t), intent(in) :: data
end subroutine eio_lhef_write_init_20
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_write_init_20 (eio, data)
class(eio_lhef_t), intent(in) :: eio
type(event_sample_data_t), intent(in) :: data
integer :: u
u = eio%unit
call eio%tag_generator%write (u)
write (u, "(A)", advance="no") "WHIZARD"
call eio%tag_generator%close (u); write (u, *)
call eio%tag_xsecinfo%write (u); write (u, *)
end subroutine eio_lhef_write_init_20
@ %def eio_lhef_write_init_20
@ When reading the init block, we first call the 1.0 routine that
fills HEPRUP. Then we consider the possible tags. Only the
\texttt{generator} and \texttt{xsecinfo} tags are of interest. We
skip everything else except for the closing tag.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: read_init_20 => eio_lhef_read_init_20
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_read_init_20 (eio, data)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(out) :: data
end subroutine eio_lhef_read_init_20
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_read_init_20 (eio, data)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(out) :: data
real(default), parameter :: pb_per_fb = 1.e-3_default
type(string_t) :: content
logical :: found, closing
call eio_lhef_read_init_10 (eio, data)
SCAN_INIT_TAGS: do
call eio%tag_generator%read (eio%cstream, found)
if (found) then
if (.not. eio%tag_generator%has_content) call err_generator
call eio%tag_generator%read_content (eio%cstream, content, closing)
call msg_message ("LHEF: Event file has been generated by " &
// char (content) // " " &
// char (eio%tag_generator%get_attribute (1)))
cycle SCAN_INIT_TAGS
end if
call eio%tag_xsecinfo%read (eio%cstream, found)
if (found) then
if (eio%tag_xsecinfo%has_content) call err_xsecinfo
cycle SCAN_INIT_TAGS
end if
call eio%tag_init%read_content (eio%cstream, content, closing)
if (closing) then
if (content /= "") call err_init
exit SCAN_INIT_TAGS
end if
end do SCAN_INIT_TAGS
data%n_evt = &
read_ival (eio%tag_xsecinfo%get_attribute (1))
if (data%n_beam == 1) then
data%total_cross_section = &
read_rval (eio%tag_xsecinfo%get_attribute (2))
else
data%total_cross_section = &
read_rval (eio%tag_xsecinfo%get_attribute (2)) / pb_per_fb
end if
contains
subroutine err_generator
call msg_fatal ("LHEF: invalid generator tag")
end subroutine err_generator
subroutine err_xsecinfo
call msg_fatal ("LHEF: invalid xsecinfo tag")
end subroutine err_xsecinfo
subroutine err_init
call msg_fatal ("LHEF: syntax error after init tag")
end subroutine err_init
end subroutine eio_lhef_read_init_20
@ %def eio_lhef_read_init_20
@ This is additional event-specific information for the 2.0 format,
after the HEPEUP data. We can specify weights, starting from the
master weight and adding alternative weights. The alternative weights
are collected in a common tag.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: write_event_20 => eio_lhef_write_event_20
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_write_event_20 (eio, event)
class(eio_lhef_t), intent(in) :: eio
class(generic_event_t), intent(in) :: event
end subroutine eio_lhef_write_event_20
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_write_event_20 (eio, event)
class(eio_lhef_t), intent(in) :: eio
class(generic_event_t), intent(in) :: event
type(string_t) :: s
integer :: i, u
u = eio%unit
if (eio%write_sqme_ref) then
s = str (event%get_sqme_ref ())
call eio%tag_sqme_ref%write (s, u); write (u, *)
end if
if (eio%write_sqme_prc) then
s = str (event%get_sqme_prc ())
call eio%tag_sqme_prc%write (s, u); write (u, *)
end if
if (eio%n_alt > 0) then
if (eio%write_sqme_alt) then
s = str (event%get_sqme_alt(1))
do i = 2, eio%n_alt
s = s // " " // str (event%get_sqme_alt(i)); write (u, *)
end do
call eio%tag_sqme_alt(1)%write (s, u)
end if
s = str (event%get_weight_alt(1))
do i = 2, eio%n_alt
s = s // " " // str (event%get_weight_alt(i)); write (u, *)
end do
call eio%tag_wgts_alt(1)%write (s, u)
end if
end subroutine eio_lhef_write_event_20
@ %def eio_lhef_write_event_20
@ Read extra event data. If there is a weight entry labeled [[sqme_prc]], we
take this as the squared matrix-element value (the new
\emph{reference} value [[sqme_ref]]). Other tags, including
tags written by the above writer, are skipped.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: read_event_20 => eio_lhef_read_event_20
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_read_event_20 (eio, event)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(inout) :: event
end subroutine eio_lhef_read_event_20
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_read_event_20 (eio, event)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(inout) :: event
type(string_t) :: content
logical :: found, closing
SCAN_EVENT_TAGS: do
call eio%tag_weight%read (eio%cstream, found)
if (found) then
if (.not. eio%tag_weight%has_content) call err_weight
call eio%tag_weight%read_content (eio%cstream, content, closing)
if (.not. closing) call err_weight
if (eio%tag_weight%get_attribute (1) == "sqme_prc") then
call event%set_sqme_ref (read_rval (content))
end if
cycle SCAN_EVENT_TAGS
end if
call eio%tag_event%read_content (eio%cstream, content, closing)
if (closing) then
if (content /= "") call err_event
exit SCAN_EVENT_TAGS
end if
end do SCAN_EVENT_TAGS
contains
subroutine err_weight
call msg_fatal ("LHEF: invalid weight tag in event record")
end subroutine err_weight
subroutine err_event
call msg_fatal ("LHEF: syntax error after event tag")
end subroutine err_event
end subroutine eio_lhef_read_event_20
@ %def eio_lhef_read_event_20
@
\subsection{Version-Specific Code: 3.0}
This is the init information for the 3.0 format, after the HEPRUP
data. We have the following tags:
\begin{itemize}
\item \texttt{generator} Generator name and version.
\item \texttt{xsecinfo} Cross section and weights data. We have the
total cross section and number of events (assuming that the event
file is intact), but information on minimum and maximum weights is
not available before the file is complete. We just write the
mandatory tags. (Note that the default values of the other tags
describe a uniform unit weight, but we can determine most values
only after the sample is complete.)
\item \texttt{cutsinfo} This optional tag is too specific to represent the
possibilities of WHIZARD, so we skip it.
\item \texttt{procinfo} This optional tag is useful for giving
details of NLO calculations. Skipped.
\item \texttt{weightinfo} Determine the meaning of optional weights, whose
values are given in the event record.
\end{itemize}
<<EIO LHEF: eio lhef: TBP>>=
procedure :: write_init_30 => eio_lhef_write_init_30
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_write_init_30 (eio, data)
class(eio_lhef_t), intent(in) :: eio
type(event_sample_data_t), intent(in) :: data
end subroutine eio_lhef_write_init_30
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_write_init_30 (eio, data)
class(eio_lhef_t), intent(in) :: eio
type(event_sample_data_t), intent(in) :: data
integer :: u, i
u = given_output_unit (eio%unit)
call eio%tag_generator%write (u)
write (u, "(A)", advance="no") "WHIZARD"
call eio%tag_generator%close (u); write (u, *)
call eio%tag_xsecinfo%write (u); write (u, *)
if (eio%write_sqme_ref) then
call eio%tag_sqme_ref%write (u); write (u, *)
end if
if (eio%write_sqme_prc) then
call eio%tag_sqme_prc%write (u); write (u, *)
end if
if (eio%write_sqme_alt) then
do i = 1, eio%n_alt
call eio%tag_sqme_alt(i)%write (u); write (u, *)
end do
end if
do i = 1, eio%n_alt
call eio%tag_wgts_alt(i)%write (u); write (u, *)
end do
end subroutine eio_lhef_write_init_30
@ %def eio_lhef_write_init_30
@ When reading the init block, we first call the 1.0 routine that
fills HEPRUP. Then we consider the possible tags. Only the
\texttt{generator} and \texttt{xsecinfo} tags are of interest. We
skip everything else except for the closing tag.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: read_init_30 => eio_lhef_read_init_30
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_read_init_30 (eio, data)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(out) :: data
end subroutine eio_lhef_read_init_30
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_read_init_30 (eio, data)
class(eio_lhef_t), intent(inout) :: eio
type(event_sample_data_t), intent(out) :: data
real(default), parameter :: pb_per_fb = 1.e-3_default
type(string_t) :: content
logical :: found, closing
integer :: n_weightinfo
call eio_lhef_read_init_10 (eio, data)
n_weightinfo = 0
eio%i_weight_sqme = 0
SCAN_INIT_TAGS: do
call eio%tag_generator%read (eio%cstream, found)
if (found) then
if (.not. eio%tag_generator%has_content) call err_generator
call eio%tag_generator%read_content (eio%cstream, content, closing)
call msg_message ("LHEF: Event file has been generated by " &
// char (content) // " " &
// char (eio%tag_generator%get_attribute (1)))
cycle SCAN_INIT_TAGS
end if
call eio%tag_xsecinfo%read (eio%cstream, found)
if (found) then
if (eio%tag_xsecinfo%has_content) call err_xsecinfo
cycle SCAN_INIT_TAGS
end if
call eio%tag_weightinfo%read (eio%cstream, found)
if (found) then
if (eio%tag_weightinfo%has_content) call err_xsecinfo
n_weightinfo = n_weightinfo + 1
if (eio%tag_weightinfo%get_attribute (1) == "sqme_prc") then
eio%i_weight_sqme = n_weightinfo
end if
cycle SCAN_INIT_TAGS
end if
call eio%tag_init%read_content (eio%cstream, content, closing)
if (closing) then
if (content /= "") call err_init
exit SCAN_INIT_TAGS
end if
end do SCAN_INIT_TAGS
data%n_evt = &
read_ival (eio%tag_xsecinfo%get_attribute (1))
if (data%n_beam == 1) then
data%total_cross_section = &
read_rval (eio%tag_xsecinfo%get_attribute (2))
else
data%total_cross_section = &
read_rval (eio%tag_xsecinfo%get_attribute (2)) / pb_per_fb
end if
contains
subroutine err_generator
call msg_fatal ("LHEF: invalid generator tag")
end subroutine err_generator
subroutine err_xsecinfo
call msg_fatal ("LHEF: invalid xsecinfo tag")
end subroutine err_xsecinfo
subroutine err_init
call msg_fatal ("LHEF: syntax error after init tag")
end subroutine err_init
end subroutine eio_lhef_read_init_30
@ %def eio_lhef_read_init_30
@ This is additional event-specific information for the 3.0 format,
after the HEPEUP data. We can specify weights, starting from the
master weight and adding alternative weights. The weight tags are
already allocated, so we just have to transfer the weight values to
strings, assemble them and write them to file. All weights are
collected in a single tag.
Note: If efficiency turns out to be an issue, we may revert to
traditional character buffer writing. However, we need to know the
maximum length.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: write_event_30 => eio_lhef_write_event_30
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_write_event_30 (eio, event)
class(eio_lhef_t), intent(in) :: eio
class(generic_event_t), intent(in) :: event
end subroutine eio_lhef_write_event_30
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_write_event_30 (eio, event)
class(eio_lhef_t), intent(in) :: eio
class(generic_event_t), intent(in) :: event
type(string_t) :: s
integer :: u, i
u = eio%unit
s = ""
if (eio%write_sqme_ref) then
s = s // str (event%get_sqme_ref ()) // " "
end if
if (eio%write_sqme_prc) then
s = s // str (event%get_sqme_prc ()) // " "
end if
if (eio%n_alt > 0) then
if (eio%write_sqme_alt) then
s = s // str (event%get_sqme_alt(1)) // " "
do i = 2, eio%n_alt
s = s // str (event%get_sqme_alt(i)) // " "
end do
end if
s = s // str (event%get_weight_alt(1)) // " "
do i = 2, eio%n_alt
s = s // str (event%get_weight_alt(i)) // " "
end do
end if
if (len_trim (s) > 0) then
call eio%tag_weights%write (trim (s), u); write (u, *)
end if
end subroutine eio_lhef_write_event_30
@ %def eio_lhef_write_event_30
@ Read extra event data. If there is a [[weights]] tag and if there
was a [[weightinfo]] entry labeled [[sqme_prc]], we extract the
corresponding entry from the weights string and store this as the
event's squared matrix-element value. Other tags, including
tags written by the above writer, are skipped.
<<EIO LHEF: eio lhef: TBP>>=
procedure :: read_event_30 => eio_lhef_read_event_30
<<EIO LHEF: sub interfaces>>=
module subroutine eio_lhef_read_event_30 (eio, event)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(inout) :: event
end subroutine eio_lhef_read_event_30
<<EIO LHEF: procedures>>=
module subroutine eio_lhef_read_event_30 (eio, event)
class(eio_lhef_t), intent(inout) :: eio
class(generic_event_t), intent(inout) :: event
type(string_t) :: content, string
logical :: found, closing
integer :: i
SCAN_EVENT_TAGS: do
call eio%tag_weights%read (eio%cstream, found)
if (found) then
if (.not. eio%tag_weights%has_content) call err_weights
call eio%tag_weights%read_content (eio%cstream, content, closing)
if (.not. closing) call err_weights
if (eio%i_weight_sqme > 0) then
SCAN_WEIGHTS: do i = 1, eio%i_weight_sqme
call split (content, string, " ")
content = adjustl (content)
if (i == eio%i_weight_sqme) then
call event%set_sqme_ref (read_rval (string))
exit SCAN_WEIGHTS
end if
end do SCAN_WEIGHTS
end if
cycle SCAN_EVENT_TAGS
end if
call eio%tag_event%read_content (eio%cstream, content, closing)
if (closing) then
if (content /= "") call err_event
exit SCAN_EVENT_TAGS
end if
end do SCAN_EVENT_TAGS
contains
subroutine err_weights
call msg_fatal ("LHEF: invalid weights tag in event record")
end subroutine err_weights
subroutine err_event
call msg_fatal ("LHEF: syntax error after event tag")
end subroutine err_event
end subroutine eio_lhef_read_event_30
@ %def eio_lhef_read_event_30
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_lhef_ut.f90]]>>=
<<File header>>
module eio_lhef_ut
use unit_tests
use eio_lhef_uti
<<Standard module head>>
<<EIO LHEF: public test>>
contains
<<EIO LHEF: test driver>>
end module eio_lhef_ut
@ %def eio_lhef_ut
@
<<[[eio_lhef_uti.f90]]>>=
<<File header>>
module eio_lhef_uti
<<Use kinds>>
<<Use strings>>
use io_units
use model_data
use event_base
use eio_data
use eio_base
use eio_lhef
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
<<Standard module head>>
<<EIO LHEF: test declarations>>
contains
<<EIO LHEF: tests>>
end module eio_lhef_uti
@ %def eio_lhef_ut
@ API: driver for the unit tests below.
<<EIO LHEF: public test>>=
public :: eio_lhef_test
<<EIO LHEF: test driver>>=
subroutine eio_lhef_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO LHEF: execute tests>>
end subroutine eio_lhef_test
@ %def eio_lhef_test
@
\subsubsection{Version 1.0 Output}
We test the implementation of all I/O methods. We start with output
according to version 1.0.
<<EIO LHEF: execute tests>>=
call test (eio_lhef_1, "eio_lhef_1", &
"write version 1.0", &
u, results)
<<EIO LHEF: test declarations>>=
public :: eio_lhef_1
<<EIO LHEF: tests>>=
subroutine eio_lhef_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_lhef_1"
write (u, "(A)") "* Purpose: generate an event and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_lhef_1"
allocate (eio_lhef_t :: eio)
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // "." // eio%extension), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:21) == " <generator_version>") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_lhef_t :: eio)
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters ()
end select
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lhef_1"
end subroutine eio_lhef_1
@ %def eio_lhef_1
@
\subsubsection{Version 2.0 Output}
Version 2.0 has added a lot of options to the LHEF format. We
implement some of them.
<<EIO LHEF: execute tests>>=
call test (eio_lhef_2, "eio_lhef_2", &
"write version 2.0", &
u, results)
<<EIO LHEF: test declarations>>=
public :: eio_lhef_2
<<EIO LHEF: tests>>=
subroutine eio_lhef_2 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_lhef_2"
write (u, "(A)") "* Purpose: generate an event and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%unweighted = .false.
data%norm_mode = NORM_SIGMA
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_lhef_2"
allocate (eio_lhef_t :: eio)
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters (version = "2.0", write_sqme_prc = .true.)
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // "." // eio%extension), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:10) == "<generator") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lhef_2"
end subroutine eio_lhef_2
@ %def eio_lhef_2
@
\subsubsection{Version 3.0 Output}
Version 3.0 is an update which removes some tags (which we didn't use anyway)
and suggests a new treatment of weights.
<<EIO LHEF: execute tests>>=
call test (eio_lhef_3, "eio_lhef_3", &
"write version 3.0", &
u, results)
<<EIO LHEF: test declarations>>=
public :: eio_lhef_3
<<EIO LHEF: tests>>=
subroutine eio_lhef_3 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(80) :: buffer
write (u, "(A)") "* Test output: eio_lhef_3"
write (u, "(A)") "* Purpose: generate an event and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%unweighted = .false.
data%norm_mode = NORM_SIGMA
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_lhef_3"
allocate (eio_lhef_t :: eio)
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters (version = "3.0", write_sqme_prc = .true.)
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents:"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".lhe"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (buffer(1:10) == "<generator") buffer = "[...]"
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lhef_3"
end subroutine eio_lhef_3
@ %def eio_lhef_3
@
\subsubsection{Version 1.0 Input}
Check input of a version-1.0 conforming LHEF file.
<<EIO LHEF: execute tests>>=
call test (eio_lhef_4, "eio_lhef_4", &
"read version 1.0", &
u, results)
<<EIO LHEF: test declarations>>=
public :: eio_lhef_4
<<EIO LHEF: tests>>=
subroutine eio_lhef_4 (u)
integer, intent(in) :: u
class(model_data_t), pointer :: fallback_model
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat, i_prc
write (u, "(A)") "* Test output: eio_lhef_4"
write (u, "(A)") "* Purpose: read a LHEF 1.0 file"
write (u, "(A)")
write (u, "(A)") "* Write a LHEF data file"
write (u, "(A)")
u_file = free_unit ()
sample = "eio_lhef_4"
open (u_file, file = char (sample // ".lhe"), &
status = "replace", action = "readwrite")
write (u_file, "(A)") '<LesHouchesEvents version="1.0">'
write (u_file, "(A)") '<header>'
write (u_file, "(A)") ' <arbitrary_tag opt="foo">content</arbitrary_tag>'
write (u_file, "(A)") ' Text'
write (u_file, "(A)") ' <another_tag />'
write (u_file, "(A)") '</header>'
write (u_file, "(A)") '<init>'
write (u_file, "(A)") ' 25 25 5.0000000000E+02 5.0000000000E+02 &
& -1 -1 -1 -1 3 1'
write (u_file, "(A)") ' 1.0000000000E-01 1.0000000000E-03 &
& 1.0000000000E+00 42'
write (u_file, "(A)") '</init>'
write (u_file, "(A)") '<event>'
write (u_file, "(A)") ' 4 42 3.0574068604E+08 1.0000000000E+03 &
& -1.0000000000E+00 -1.0000000000E+00'
write (u_file, "(A)") ' 25 -1 0 0 0 0 0.0000000000E+00 0.0000000000E+00 &
& 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02 &
& 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 -1 0 0 0 0 0.0000000000E+00 0.0000000000E+00 &
&-4.8412291828E+02 5.0000000000E+02 1.2500000000E+02 &
& 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 1 1 2 0 0 -1.4960220911E+02 -4.6042825611E+02 &
& 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02 &
& 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 1 1 2 0 0 1.4960220911E+02 4.6042825611E+02 &
& 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02 &
& 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") '</event>'
write (u_file, "(A)") '</LesHouchesEvents>'
close (u_file)
write (u, "(A)") "* Initialize test process"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event, unweighted = .false.)
allocate (eio_lhef_t :: eio)
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters (recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
call data%write (u)
write (u, *)
write (u, "(A)") "* Initialize and read header"
write (u, "(A)")
call eio%init_in (sample, data)
call eio%write (u)
write (u, *)
select type (eio)
type is (eio_lhef_t)
call eio%tag_lhef%write (u); write (u, *)
end select
write (u, *)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Read event"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
select type (eio)
type is (eio_lhef_t)
write (u, "(A,I0,A,I0)") "Found process #", i_prc, &
" with ID = ", eio%proc_num_id(i_prc)
end select
call eio%input_event (event, iostat)
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Read closing"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(A,I0)") "iostat = ", iostat
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lhef_4"
end subroutine eio_lhef_4
@ %def eio_lhef_4
@
\subsubsection{Version 2.0 Input}
Check input of a version-2.0 conforming LHEF file.
<<EIO LHEF: execute tests>>=
call test (eio_lhef_5, "eio_lhef_5", &
"read version 2.0", &
u, results)
<<EIO LHEF: test declarations>>=
public :: eio_lhef_5
<<EIO LHEF: tests>>=
subroutine eio_lhef_5 (u)
integer, intent(in) :: u
class(model_data_t), pointer :: fallback_model
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat, i_prc
write (u, "(A)") "* Test output: eio_lhef_5"
write (u, "(A)") "* Purpose: read a LHEF 2.0 file"
write (u, "(A)")
write (u, "(A)") "* Write a LHEF data file"
write (u, "(A)")
u_file = free_unit ()
sample = "eio_lhef_5"
open (u_file, file = char (sample // ".lhe"), &
status = "replace", action = "readwrite")
write (u_file, "(A)") '<LesHouchesEvents version="2.0">'
write (u_file, "(A)") '<header>'
write (u_file, "(A)") '</header>'
write (u_file, "(A)") '<init>'
write (u_file, "(A)") ' 25 25 5.0000000000E+02 5.0000000000E+02 &
&-1 -1 -1 -1 4 1'
write (u_file, "(A)") ' 1.0000000000E-01 1.0000000000E-03 &
& 0.0000000000E+00 42'
write (u_file, "(A)") '<generator version="2.2.3">WHIZARD&
&</generator>'
write (u_file, "(A)") '<xsecinfo neve="1" totxsec="1.0000000000E-01" />'
write (u_file, "(A)") '</init>'
write (u_file, "(A)") '<event>'
write (u_file, "(A)") ' 4 42 3.0574068604E+08 1.0000000000E+03 &
&-1.0000000000E+00 -1.0000000000E+00'
write (u_file, "(A)") ' 25 -1 0 0 0 0 0.0000000000E+00 &
& 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 -1 0 0 0 0 0.0000000000E+00 &
& 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 1 1 2 0 0 -1.4960220911E+02 &
&-4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 1 1 2 0 0 1.4960220911E+02 &
& 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") '<weight name="sqme_prc">1.0000000000E+00</weight>'
write (u_file, "(A)") '</event>'
write (u_file, "(A)") '</LesHouchesEvents>'
close (u_file)
write (u, "(A)") "* Initialize test process"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event, unweighted = .false.)
allocate (eio_lhef_t :: eio)
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters (version = "2.0", recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call data%init (1)
data%unweighted = .false.
data%norm_mode = NORM_SIGMA
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
call data%write (u)
write (u, *)
write (u, "(A)") "* Initialize and read header"
write (u, "(A)")
call eio%init_in (sample, data)
call eio%write (u)
write (u, *)
select type (eio)
type is (eio_lhef_t)
call eio%tag_lhef%write (u); write (u, *)
end select
write (u, *)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Read event"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
select type (eio)
type is (eio_lhef_t)
write (u, "(A,I0,A,I0)") "Found process #", i_prc, &
" with ID = ", eio%proc_num_id(i_prc)
end select
call eio%input_event (event, iostat)
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Read closing"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(A,I0)") "iostat = ", iostat
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lhef_5"
end subroutine eio_lhef_5
@ %def eio_lhef_5
@
\subsubsection{Version 3.0 Input}
Check input of a version-3.0 conforming LHEF file.
<<EIO LHEF: execute tests>>=
call test (eio_lhef_6, "eio_lhef_6", &
"read version 3.0", &
u, results)
<<EIO LHEF: test declarations>>=
public :: eio_lhef_6
<<EIO LHEF: tests>>=
subroutine eio_lhef_6 (u)
integer, intent(in) :: u
class(model_data_t), pointer :: fallback_model
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat, i_prc
write (u, "(A)") "* Test output: eio_lhef_6"
write (u, "(A)") "* Purpose: read a LHEF 3.0 file"
write (u, "(A)")
write (u, "(A)") "* Write a LHEF data file"
write (u, "(A)")
u_file = free_unit ()
sample = "eio_lhef_6"
open (u_file, file = char (sample // ".lhe"), &
status = "replace", action = "readwrite")
write (u_file, "(A)") '<LesHouchesEvents version="3.0">'
write (u_file, "(A)") '<header>'
write (u_file, "(A)") '</header>'
write (u_file, "(A)") '<init>'
write (u_file, "(A)") ' 25 25 5.0000000000E+02 5.0000000000E+02 &
&-1 -1 -1 -1 4 1'
write (u_file, "(A)") ' 1.0000000000E-01 1.0000000000E-03 &
& 0.0000000000E+00 42'
write (u_file, "(A)") '<generator version="2.2.3">WHIZARD&
&</generator>'
write (u_file, "(A)") '<xsecinfo neve="1" totxsec="1.0000000000E-01" />'
write (u_file, "(A)") '<weightinfo name="sqme_prc" />'
write (u_file, "(A)") '</init>'
write (u_file, "(A)") '<event>'
write (u_file, "(A)") ' 4 42 3.0574068604E+08 1.0000000000E+03 &
&-1.0000000000E+00 -1.0000000000E+00'
write (u_file, "(A)") ' 25 -1 0 0 0 0 0.0000000000E+00 &
& 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 -1 0 0 0 0 0.0000000000E+00 &
& 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 1 1 2 0 0 -1.4960220911E+02 &
&-4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") ' 25 1 1 2 0 0 1.4960220911E+02 &
& 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 &
& 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00'
write (u_file, "(A)") '<weights>1.0000000000E+00</weights>'
write (u_file, "(A)") '</event>'
write (u_file, "(A)") '</LesHouchesEvents>'
close (u_file)
write (u, "(A)") "* Initialize test process"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event, unweighted = .false.)
allocate (eio_lhef_t :: eio)
select type (eio)
type is (eio_lhef_t)
call eio%set_parameters (version = "3.0", recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call data%init (1)
data%unweighted = .false.
data%norm_mode = NORM_SIGMA
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
call data%write (u)
write (u, *)
write (u, "(A)") "* Initialize and read header"
write (u, "(A)")
call eio%init_in (sample, data)
call eio%write (u)
write (u, *)
select type (eio)
type is (eio_lhef_t)
call eio%tag_lhef%write (u); write (u, *)
end select
write (u, *)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Read event"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
select type (eio)
type is (eio_lhef_t)
write (u, "(A,I0,A,I0)") "Found process #", i_prc, &
" with ID = ", eio%proc_num_id(i_prc)
end select
call eio%input_event (event, iostat)
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Read closing"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(A,I0)") "iostat = ", iostat
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lhef_6"
end subroutine eio_lhef_6
@ %def eio_lhef_6
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{STDHEP File Formats}
Here, we implement the two existing STDHEP file formats, one based on the
HEPRUP/HEPEUP common blocks, the other based on the HEPEVT common block.
The second one is actually the standard STDHEP format.
<<[[eio_stdhep.f90]]>>=
<<File header>>
module eio_stdhep
use kinds, only: i32, i64
<<Use strings>>
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
<<Standard module head>>
<<EIO stdhep: public>>
<<EIO stdhep: types>>
interface
<<EIO stdhep: sub interfaces>>
end interface
end module eio_stdhep
@ %def eio_stdhep
@
<<[[eio_stdhep_sub.f90]]>>=
<<File header>>
submodule (eio_stdhep) eio_stdhep_s
use io_units
use string_utils
use diagnostics
use hep_common
use hep_events
implicit none
<<EIO stdhep: variables>>
contains
<<EIO stdhep: procedures>>
end submodule eio_stdhep_s
@ %def eio_stdhep_s
@
\subsection{Type}
<<EIO stdhep: public>>=
public :: eio_stdhep_t
<<EIO stdhep: types>>=
type, abstract, extends (eio_t) :: eio_stdhep_t
logical :: writing = .false.
logical :: reading = .false.
integer :: unit = 0
logical :: keep_beams = .false.
logical :: keep_remnants = .true.
logical :: ensure_order = .false.
logical :: recover_beams = .false.
logical :: use_alphas_from_file = .false.
logical :: use_scale_from_file = .false.
integer, dimension(:), allocatable :: proc_num_id
integer(i64) :: n_events_expected = 0
contains
<<EIO stdhep: eio stdhep: TBP>>
end type eio_stdhep_t
@ %def eio_stdhep_t
@
<<EIO stdhep: public>>=
public :: eio_stdhep_hepevt_t
<<EIO stdhep: types>>=
type, extends (eio_stdhep_t) :: eio_stdhep_hepevt_t
end type eio_stdhep_hepevt_t
@ %def eio_stdhep_hepevt_t
@
<<EIO stdhep: public>>=
public :: eio_stdhep_hepeup_t
<<EIO stdhep: types>>=
type, extends (eio_stdhep_t) :: eio_stdhep_hepeup_t
end type eio_stdhep_hepeup_t
@ %def eio_stdhep_hepeup_t
@
<<EIO stdhep: public>>=
public :: eio_stdhep_hepev4_t
<<EIO stdhep: types>>=
type, extends (eio_stdhep_t) :: eio_stdhep_hepev4_t
end type eio_stdhep_hepev4_t
@ %def eio_stdhep_hepev4_t
@
\subsection{Specific Methods}
Set parameters that are specifically used with STDHEP file formats.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: set_parameters => eio_stdhep_set_parameters
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_set_parameters (eio, &
keep_beams, keep_remnants, ensure_order, recover_beams, &
use_alphas_from_file, use_scale_from_file, extension)
class(eio_stdhep_t), intent(inout) :: eio
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
type(string_t), intent(in), optional :: extension
end subroutine eio_stdhep_set_parameters
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_set_parameters (eio, &
keep_beams, keep_remnants, ensure_order, recover_beams, &
use_alphas_from_file, use_scale_from_file, extension)
class(eio_stdhep_t), intent(inout) :: eio
logical, intent(in), optional :: keep_beams
logical, intent(in), optional :: keep_remnants
logical, intent(in), optional :: ensure_order
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
type(string_t), intent(in), optional :: extension
if (present (keep_beams)) eio%keep_beams = keep_beams
if (present (keep_remnants)) eio%keep_remnants = keep_remnants
if (present (ensure_order)) eio%ensure_order = ensure_order
if (present (recover_beams)) eio%recover_beams = recover_beams
if (present (use_alphas_from_file)) &
eio%use_alphas_from_file = use_alphas_from_file
if (present (use_scale_from_file)) &
eio%use_scale_from_file = use_scale_from_file
if (present (extension)) then
eio%extension = extension
else
select type (eio)
type is (eio_stdhep_hepevt_t)
eio%extension = "hep"
type is (eio_stdhep_hepev4_t)
eio%extension = "ev4.hep"
type is (eio_stdhep_hepeup_t)
eio%extension = "up.hep"
end select
end if
end subroutine eio_stdhep_set_parameters
@ %def eio_ascii_stdhep_parameters
@
\subsection{Common Methods}
Output. This is not the actual event format, but a readable account
of the current object status.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: write => eio_stdhep_write
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_write (object, unit)
class(eio_stdhep_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_stdhep_write
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_write (object, unit)
class(eio_stdhep_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "STDHEP event stream:"
if (object%writing) then
write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
else if (object%reading) then
write (u, "(3x,A,A)") "Reading from file = ", char (object%filename)
else
write (u, "(3x,A)") "[closed]"
end if
write (u, "(3x,A,L1)") "Keep beams = ", object%keep_beams
write (u, "(3x,A,L1)") "Keep remnants = ", object%keep_remnants
write (u, "(3x,A,L1)") "Recover beams = ", object%recover_beams
write (u, "(3x,A,L1)") "Alpha_s from file = ", &
object%use_alphas_from_file
write (u, "(3x,A,L1)") "Scale from file = ", &
object%use_scale_from_file
if (allocated (object%proc_num_id)) then
write (u, "(3x,A)") "Numerical process IDs:"
do i = 1, size (object%proc_num_id)
write (u, "(5x,I0,': ',I0)") i, object%proc_num_id(i)
end do
end if
end subroutine eio_stdhep_write
@ %def eio_stdhep_write
@ Finalizer: close any open file.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: final => eio_stdhep_final
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_final (object)
class(eio_stdhep_t), intent(inout) :: object
end subroutine eio_stdhep_final
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_final (object)
class(eio_stdhep_t), intent(inout) :: object
if (allocated (object%proc_num_id)) deallocate (object%proc_num_id)
if (object%writing) then
write (msg_buffer, "(A,A,A)") "Events: closing STDHEP file '", &
char (object%filename), "'"
call msg_message ()
call stdhep_write (200)
call stdhep_end ()
object%writing = .false.
else if (object%reading) then
write (msg_buffer, "(A,A,A)") "Events: closing STDHEP file '", &
char (object%filename), "'"
call msg_message ()
object%reading = .false.
end if
end subroutine eio_stdhep_final
@ %def eio_stdhep_final
@ Common initialization for input and output.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: common_init => eio_stdhep_common_init
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_common_init (eio, sample, data, extension)
class(eio_stdhep_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
end subroutine eio_stdhep_common_init
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_common_init (eio, sample, data, extension)
class(eio_stdhep_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
if (.not. present (data)) &
call msg_bug ("STDHEP initialization: missing data")
if (present (extension)) then
eio%extension = extension
end if
eio%sample = sample
call eio%set_filename ()
eio%unit = free_unit ()
allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
end subroutine eio_stdhep_common_init
@ %def eio_stdhep_common_init
@ Split event file: increment the counter, close the current file, open a new
one. If the file needs a header, repeat it for the new file. (We assume that
the common block contents are still intact.)
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: split_out => eio_stdhep_split_out
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_split_out (eio)
class(eio_stdhep_t), intent(inout) :: eio
end subroutine eio_stdhep_split_out
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_split_out (eio)
class(eio_stdhep_t), intent(inout) :: eio
if (eio%split) then
eio%split_index = eio%split_index + 1
call eio%set_filename ()
write (msg_buffer, "(A,A,A)") "Events: writing to STDHEP file '", &
char (eio%filename), "'"
call msg_message ()
call stdhep_write (200)
call stdhep_end ()
select type (eio)
type is (eio_stdhep_hepeup_t)
call stdhep_init_out (char (eio%filename), &
"WHIZARD <<Version>>", eio%n_events_expected)
call stdhep_write (100)
call stdhep_write (STDHEP_HEPRUP)
type is (eio_stdhep_hepevt_t)
call stdhep_init_out (char (eio%filename), &
"WHIZARD <<Version>>", eio%n_events_expected)
call stdhep_write (100)
type is (eio_stdhep_hepev4_t)
call stdhep_init_out (char (eio%filename), &
"WHIZARD <<Version>>", eio%n_events_expected)
call stdhep_write (100)
end select
end if
end subroutine eio_stdhep_split_out
@ %def eio_stdhep_split_out
@ Initialize event writing.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: init_out => eio_stdhep_init_out
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_init_out &
(eio, sample, data, success, extension)
class(eio_stdhep_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_stdhep_init_out
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_init_out &
(eio, sample, data, success, extension)
class(eio_stdhep_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
logical :: is_width
integer :: i
if (.not. present (data)) &
call msg_bug ("STDHEP initialization: missing data")
is_width = data%n_beam == 1
call eio%set_splitting (data)
call eio%common_init (sample, data, extension)
eio%n_events_expected = data%n_evt
write (msg_buffer, "(A,A,A)") "Events: writing to STDHEP file '", &
char (eio%filename), "'"
call msg_message ()
eio%writing = .true.
select type (eio)
type is (eio_stdhep_hepeup_t)
call heprup_init &
(data%pdg_beam, &
data%energy_beam, &
n_processes = data%n_proc, &
unweighted = data%unweighted, &
negative_weights = data%negative_weights)
do i = 1, data%n_proc
call heprup_set_process_parameters (i = i, &
process_id = data%proc_num_id(i), &
cross_section = data%cross_section(i), &
error = data%error(i), &
is_width = is_width)
end do
call stdhep_init_out (char (eio%filename), &
"WHIZARD <<Version>>", eio%n_events_expected)
call stdhep_write (100)
call stdhep_write (STDHEP_HEPRUP)
type is (eio_stdhep_hepevt_t)
call stdhep_init_out (char (eio%filename), &
"WHIZARD <<Version>>", eio%n_events_expected)
call stdhep_write (100)
type is (eio_stdhep_hepev4_t)
call stdhep_init_out (char (eio%filename), &
"WHIZARD <<Version>>", eio%n_events_expected)
call stdhep_write (100)
end select
if (present (success)) success = .true.
end subroutine eio_stdhep_init_out
@ %def eio_stdhep_init_out
@ Initialize event reading.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: init_in => eio_stdhep_init_in
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_init_in &
(eio, sample, data, success, extension)
class(eio_stdhep_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_stdhep_init_in
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_init_in &
(eio, sample, data, success, extension)
class(eio_stdhep_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
integer :: ilbl, lok
logical :: exist
call eio%common_init (sample, data, extension)
write (msg_buffer, "(A,A,A)") "Events: reading from STDHEP file '", &
char (eio%filename), "'"
call msg_message ()
inquire (file = char (eio%filename), exist = exist)
if (.not. exist) call msg_fatal ("Events: STDHEP file not found.")
eio%reading = .true.
call stdhep_init_in (char (eio%filename), eio%n_events_expected)
call stdhep_read (ilbl, lok)
if (lok /= 0) then
call stdhep_end ()
write (msg_buffer, "(A)") "Events: STDHEP file appears to" // &
" be empty."
call msg_message ()
end if
if (ilbl == 100) then
write (msg_buffer, "(A)") "Events: reading in STDHEP events"
call msg_message ()
end if
if (present (success)) success = .false.
end subroutine eio_stdhep_init_in
@ %def eio_stdhep_init_in
@ Switch from input to output: reopen the file for reading.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: switch_inout => eio_stdhep_switch_inout
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_switch_inout (eio, success)
class(eio_stdhep_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_stdhep_switch_inout
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_switch_inout (eio, success)
class(eio_stdhep_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("STDHEP: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_stdhep_switch_inout
@ %def eio_stdhep_switch_inout
@ Output an event. Write first the event indices, then weight and
squared matrix element, then the particle set.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: output => eio_stdhep_output
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_stdhep_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_stdhep_output
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_stdhep_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
if (present (passed)) then
if (.not. passed) return
end if
if (eio%writing) then
select type (eio)
type is (eio_stdhep_hepeup_t)
call hepeup_from_event (event, &
process_index = eio%proc_num_id (i_prc), &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants)
call stdhep_write (STDHEP_HEPEUP)
type is (eio_stdhep_hepevt_t)
call hepevt_from_event (event, &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order)
call stdhep_write (STDHEP_HEPEVT)
type is (eio_stdhep_hepev4_t)
call hepevt_from_event (event, &
process_index = eio%proc_num_id (i_prc), &
keep_beams = eio%keep_beams, &
keep_remnants = eio%keep_remnants, &
ensure_order = eio%ensure_order, &
fill_hepev4 = .true.)
call stdhep_write (STDHEP_HEPEV4)
end select
else
call eio%write ()
call msg_fatal ("STDHEP file is not open for writing")
end if
end subroutine eio_stdhep_output
@ %def eio_stdhep_output
@ Input an event. We do not allow to read in STDHEP files written via
the HEPEVT common block as there is no control on the process ID.
This implies that the event index cannot be read; it is simply
incremented to count the current event sample.
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: input_i_prc => eio_stdhep_input_i_prc
procedure :: input_event => eio_stdhep_input_event
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_input_i_prc (eio, i_prc, iostat)
class(eio_stdhep_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_stdhep_input_i_prc
module subroutine eio_stdhep_input_event (eio, event, iostat, event_handle)
class(eio_stdhep_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_stdhep_input_event
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_input_i_prc (eio, i_prc, iostat)
class(eio_stdhep_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
integer :: i, ilbl, proc_num_id
iostat = 0
select type (eio)
type is (eio_stdhep_hepevt_t)
if (size (eio%proc_num_id) > 1) then
call msg_fatal ("Events: only single processes allowed " // &
"with the STDHEP HEPEVT format.")
else
proc_num_id = eio%proc_num_id (1)
call stdhep_read (ilbl, lok)
end if
type is (eio_stdhep_hepev4_t)
call stdhep_read (ilbl, lok)
proc_num_id = idruplh
type is (eio_stdhep_hepeup_t)
call stdhep_read (ilbl, lok)
if (lok /= 0) call msg_error ("Events: STDHEP appears to be " // &
"empty or corrupted.")
if (ilbl == 12) then
call stdhep_read (ilbl, lok)
end if
if (ilbl == 11) then
proc_num_id = IDPRUP
end if
end select
FIND_I_PRC: do i = 1, size (eio%proc_num_id)
if (eio%proc_num_id(i) == proc_num_id) then
i_prc = i
exit FIND_I_PRC
end if
end do FIND_I_PRC
if (i_prc == 0) call err_index
contains
subroutine err_index
call msg_error ("STDHEP: reading events: undefined process ID " &
// char (str (proc_num_id)) // ", aborting read")
iostat = 1
end subroutine err_index
end subroutine eio_stdhep_input_i_prc
module subroutine eio_stdhep_input_event (eio, event, iostat, event_handle)
class(eio_stdhep_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
iostat = 0
call event%reset_contents ()
call event%select (1, 1, 1)
call hepeup_to_event (event, eio%fallback_model, &
recover_beams = eio%recover_beams, &
use_alpha_s = eio%use_alphas_from_file, &
use_scale = eio%use_scale_from_file)
call event%increment_index ()
end subroutine eio_stdhep_input_event
@ %def eio_stdhep_input_i_prc
@ %def eio_stdhep_input_event
<<EIO stdhep: eio stdhep: TBP>>=
procedure :: skip => eio_stdhep_skip
<<EIO stdhep: sub interfaces>>=
module subroutine eio_stdhep_skip (eio, iostat)
class(eio_stdhep_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_stdhep_skip
<<EIO stdhep: procedures>>=
module subroutine eio_stdhep_skip (eio, iostat)
class(eio_stdhep_t), intent(inout) :: eio
integer, intent(out) :: iostat
if (eio%reading) then
read (eio%unit, iostat = iostat)
else
call eio%write ()
call msg_fatal ("Raw event file is not open for reading")
end if
end subroutine eio_stdhep_skip
@ %def eio_stdhep_skip
@ STDHEP speficic routines.
<<EIO stdhep: public>>=
public :: stdhep_init_out
public :: stdhep_init_in
public :: stdhep_write
public :: stdhep_end
<<EIO stdhep: sub interfaces>>=
module subroutine stdhep_init_out (file, title, nevt)
character(len=*), intent(in) :: file, title
integer(i64), intent(in) :: nevt
end subroutine stdhep_init_out
module subroutine stdhep_init_in (file, nevt)
character(len=*), intent(in) :: file
integer(i64), intent(out) :: nevt
end subroutine stdhep_init_in
module subroutine stdhep_write (ilbl)
integer, intent(in) :: ilbl
end subroutine stdhep_write
module subroutine stdhep_read (ilbl, lok)
integer, intent(out) :: ilbl, lok
end subroutine stdhep_read
module subroutine stdhep_end ()
end subroutine stdhep_end
<<EIO stdhep: procedures>>=
module subroutine stdhep_init_out (file, title, nevt)
character(len=*), intent(in) :: file, title
integer(i64), intent(in) :: nevt
integer(i32) :: nevt32
nevt32 = min (nevt, int (huge (1_i32), i64))
call stdxwinit (file, title, nevt32, istr, lok)
end subroutine stdhep_init_out
module subroutine stdhep_init_in (file, nevt)
character(len=*), intent(in) :: file
integer(i64), intent(out) :: nevt
integer(i32) :: nevt32
call stdxrinit (file, nevt32, istr, lok)
if (lok /= 0) call msg_fatal ("STDHEP: error in reading file '" // &
file // "'.")
nevt = int (nevt32, i64)
end subroutine stdhep_init_in
module subroutine stdhep_write (ilbl)
integer, intent(in) :: ilbl
call stdxwrt (ilbl, istr, lok)
end subroutine stdhep_write
module subroutine stdhep_read (ilbl, lok)
integer, intent(out) :: ilbl, lok
call stdxrd (ilbl, istr, lok)
if (lok /= 0) return
end subroutine stdhep_read
module subroutine stdhep_end ()
call stdxend (istr)
end subroutine stdhep_end
@ %def stdhep_init stdhep_read stdhep_write stdhep_end
@
\subsection{Variables}
<<EIO stdhep: variables>>=
integer, save :: istr, lok
integer, parameter :: &
STDHEP_HEPEVT = 1, STDHEP_HEPEV4 = 4, &
STDHEP_HEPEUP = 11, STDHEP_HEPRUP = 12
@
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_stdhep_ut.f90]]>>=
<<File header>>
module eio_stdhep_ut
use unit_tests
use eio_stdhep_uti
<<Standard module head>>
<<EIO stdhep: public test>>
contains
<<EIO stdhep: test driver>>
end module eio_stdhep_ut
@ %def eio_stdhep_ut
@
<<[[eio_stdhep_uti.f90]]>>=
<<File header>>
module eio_stdhep_uti
<<Use kinds>>
<<Use strings>>
use io_units
use model_data
use event_base
use eio_data
use eio_base
use xdr_wo_stdhep
use eio_stdhep
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
<<Standard module head>>
<<EIO stdhep: test declarations>>
contains
<<EIO stdhep: tests>>
end module eio_stdhep_uti
@ %def eio_stdhep_ut
@ API: driver for the unit tests below.
<<EIO stdhep: public test>>=
public :: eio_stdhep_test
<<EIO stdhep: test driver>>=
subroutine eio_stdhep_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO stdhep: execute tests>>
end subroutine eio_stdhep_test
@ %def eio_stdhep_test
@
\subsubsection{Test I/O methods}
We test the implementation of the STDHEP HEPEVT I/O method:
<<EIO stdhep: execute tests>>=
call test (eio_stdhep_1, "eio_stdhep_1", &
"read and write event contents, format [stdhep]", &
u, results)
<<EIO stdhep: test declarations>>=
public :: eio_stdhep_1
<<EIO stdhep: tests>>=
subroutine eio_stdhep_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(215) :: buffer
write (u, "(A)") "* Test output: eio_stdhep_1"
write (u, "(A)") "* Purpose: generate an event in STDHEP HEPEVT format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_stdhep_1"
allocate (eio_stdhep_hepevt_t :: eio)
select type (eio)
type is (eio_stdhep_hepevt_t)
call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (61) ! not supported by reader, actually
call event%evaluate_expressions ()
call event%pacify_particle_set ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* Write STDHEP file contents to ASCII file"
write (u, "(A)")
call write_stdhep_event &
(sample // ".hep", var_str ("eio_stdhep_1.hep.out"), 1)
write (u, "(A)")
write (u, "(A)") "* Read in ASCII contents of STDHEP file"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "eio_stdhep_1.hep.out", &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
if (trim (buffer) == "") cycle
if (buffer(1:18) == " total blocks: ") &
buffer = " total blocks: [...]"
if (buffer(1:25) == " title: WHIZARD") &
buffer = " title: WHIZARD [version]"
if (buffer(1:17) == " date:") &
buffer = " date: [...]"
if (buffer(1:17) == " closing date:") &
buffer = " closing date: [...]"
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_stdhep_hepevt_t :: eio)
select type (eio)
type is (eio_stdhep_hepevt_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_stdhep_1"
end subroutine eio_stdhep_1
@ %def eio_stdhep_1
@
We test the implementation of the STDHEP HEPEUP I/O method:
<<EIO stdhep: execute tests>>=
call test (eio_stdhep_2, "eio_stdhep_2", &
"read and write event contents, format [stdhep]", &
u, results)
<<EIO stdhep: test declarations>>=
public :: eio_stdhep_2
<<EIO stdhep: tests>>=
subroutine eio_stdhep_2 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(model_data_t), pointer :: fallback_model
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(215) :: buffer
write (u, "(A)") "* Test output: eio_stdhep_2"
write (u, "(A)") "* Purpose: generate an event in STDHEP HEPEUP format"
write (u, "(A)") "* and write weight to file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event, unweighted = .false.)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_stdhep_2"
allocate (eio_stdhep_hepeup_t :: eio)
select type (eio)
type is (eio_stdhep_hepeup_t)
call eio%set_parameters ()
end select
call eio%set_fallback_model (fallback_model)
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (62) ! not supported by reader, actually
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* Write STDHEP file contents to ASCII file"
write (u, "(A)")
call write_stdhep_event &
(sample // ".up.hep", var_str ("eio_stdhep_2.hep.out"), 2)
write (u, "(A)")
write (u, "(A)") "* Read in ASCII contents of STDHEP file"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "eio_stdhep_2.hep.out", &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
if (trim (buffer) == "") cycle
if (buffer(1:18) == " total blocks: ") &
buffer = " total blocks: [...]"
if (buffer(1:25) == " title: WHIZARD") &
buffer = " title: WHIZARD [version]"
if (buffer(1:17) == " date:") &
buffer = " date: [...]"
if (buffer(1:17) == " closing date:") &
buffer = " closing date: [...]"
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_stdhep_hepeup_t :: eio)
select type (eio)
type is (eio_stdhep_hepeup_t)
call eio%set_parameters (keep_beams = .true.)
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_stdhep_2"
end subroutine eio_stdhep_2
@ %def eio_stdhep_2
@
Check input from a StdHep file, HEPEVT block.
<<EIO stdhep: execute tests>>=
call test (eio_stdhep_3, "eio_stdhep_3", &
"read StdHep file, HEPEVT block", &
u, results)
<<EIO stdhep: test declarations>>=
public :: eio_stdhep_3
<<EIO stdhep: tests>>=
subroutine eio_stdhep_3 (u)
integer, intent(in) :: u
class(model_data_t), pointer :: fallback_model
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: iostat, i_prc
write (u, "(A)") "* Test output: eio_stdhep_3"
write (u, "(A)") "* Purpose: read a StdHep file, HEPEVT block"
write (u, "(A)")
write (u, "(A)") "* Write a StdHep data file, HEPEVT block"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_stdhep_3"
allocate (eio_stdhep_hepevt_t :: eio)
select type (eio)
type is (eio_stdhep_hepevt_t)
call eio%set_parameters ()
end select
call eio%set_fallback_model (fallback_model)
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (63) ! not supported by reader, actually
call event%evaluate_expressions ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (eio)
deallocate (fallback_model)
write (u, "(A)") "* Initialize test process"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event, unweighted = .false.)
allocate (eio_stdhep_hepevt_t :: eio)
select type (eio)
type is (eio_stdhep_hepevt_t)
call eio%set_parameters (recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
call data%write (u)
write (u, *)
write (u, "(A)") "* Initialize"
write (u, "(A)")
call eio%init_in (sample, data)
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Read event"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
select type (eio)
type is (eio_stdhep_hepevt_t)
write (u, "(A,I0,A,I0)") "Found process #", i_prc, &
" with ID = ", eio%proc_num_id(i_prc)
end select
call eio%input_event (event, iostat)
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Read closing"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(A,I0)") "iostat = ", iostat
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_stdhep_3"
end subroutine eio_stdhep_3
@ %def eio_stdhep_3
@
Check input from a StdHep file, HEPEVT block.
<<EIO stdhep: execute tests>>=
call test (eio_stdhep_4, "eio_stdhep_4", &
"read StdHep file, HEPRUP/HEPEUP block", &
u, results)
<<EIO stdhep: test declarations>>=
public :: eio_stdhep_4
<<EIO stdhep: tests>>=
subroutine eio_stdhep_4 (u)
integer, intent(in) :: u
class(model_data_t), pointer :: fallback_model
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: iostat, i_prc
write (u, "(A)") "* Test output: eio_stdhep_3"
write (u, "(A)") "* Purpose: read a StdHep file, HEPRUP/HEPEUP block"
write (u, "(A)")
write (u, "(A)") "* Write a StdHep data file, HEPRUP/HEPEUP block"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event)
call data%init (1)
data%n_evt = 1
data%n_beam = 2
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event, HEPEUP/HEPRUP"
write (u, "(A)")
sample = "eio_stdhep_4"
allocate (eio_stdhep_hepeup_t :: eio)
select type (eio)
type is (eio_stdhep_hepeup_t)
call eio%set_parameters ()
end select
call eio%set_fallback_model (fallback_model)
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (64) ! not supported by reader, actually
call event%evaluate_expressions ()
call event%pacify_particle_set ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (eio)
deallocate (fallback_model)
write (u, "(A)") "* Initialize test process"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event, unweighted = .false.)
allocate (eio_stdhep_hepeup_t :: eio)
select type (eio)
type is (eio_stdhep_hepeup_t)
call eio%set_parameters (recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
call data%write (u)
write (u, *)
write (u, "(A)") "* Initialize"
write (u, "(A)")
call eio%init_in (sample, data)
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Read event"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
select type (eio)
type is (eio_stdhep_hepeup_t)
write (u, "(A,I0,A,I0)") "Found process #", i_prc, &
" with ID = ", eio%proc_num_id(i_prc)
end select
call eio%input_event (event, iostat)
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Read closing"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(A,I0)") "iostat = ", iostat
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_stdhep_4"
end subroutine eio_stdhep_4
@ %def eio_stdhep_4
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{HepMC Output}
The HepMC event record is standardized. It is an ASCII format. We try
our best at using it for both input and output.
<<[[eio_hepmc.f90]]>>=
<<File header>>
module eio_hepmc
<<Use kinds>>
<<Use strings>>
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
use hepmc_interface
<<Standard module head>>
<<EIO HepMC: public>>
<<EIO HepMC: types>>
interface
<<EIO HepMC: sub interfaces>>
end interface
end module eio_hepmc
@ %def eio_hepmc
@
<<[[eio_hepmc_sub.f90]]>>=
<<File header>>
submodule (eio_hepmc) eio_hepmc_s
use io_units
use string_utils
use diagnostics
use particles
use model_data
use hep_events
implicit none
contains
<<EIO HepMC: procedures>>
end submodule eio_hepmc_s
@ %def eio_hepmc_s
@
\subsection{Type}
A type [[hepmc_event]] is introduced as container to store HepMC event
data, particularly for splitting the reading into read out of the process
index and the proper event data.
Note: the [[keep_beams]] flag is not supported. Beams will always
be written. Tools like \texttt{Rivet} can use the cross section
information of a HepMC file for scaling plots. As there is no header in
HepMC and this is written for every event, we make it optional with
[[output_cross_section]].
<<EIO HepMC: public>>=
public :: eio_hepmc_t
<<EIO HepMC: types>>=
type, extends (eio_t) :: eio_hepmc_t
logical :: writing = .false.
logical :: reading = .false.
type(event_sample_data_t) :: data
! logical :: keep_beams = .false.
logical :: recover_beams = .false.
logical :: use_alphas_from_file = .false.
logical :: use_scale_from_file = .false.
logical :: output_cross_section = .false.
integer :: hepmc3_mode = HEPMC3_MODE_HEPMC3
logical :: hepmc3_flows = .false.
type(hepmc_iostream_t) :: iostream
type(hepmc_event_t) :: hepmc_event
integer, dimension(:), allocatable :: proc_num_id
contains
<<EIO HepMC: eio hepmc: TBP>>
end type eio_hepmc_t
@ %def eio_hepmc_t
@
\subsection{Specific Methods}
Set parameters that are specifically used with HepMC.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: set_parameters => eio_hepmc_set_parameters
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_set_parameters &
(eio, recover_beams, use_alphas_from_file, &
use_scale_from_file, extension, output_cross_section, &
hepmc3_mode, hepmc3_write_flows)
class(eio_hepmc_t), intent(inout) :: eio
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
logical, intent(in), optional :: output_cross_section
type(string_t), intent(in), optional :: extension
integer, intent(in), optional :: hepmc3_mode
logical ,intent(in), optional :: hepmc3_write_flows
end subroutine eio_hepmc_set_parameters
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_set_parameters &
(eio, recover_beams, use_alphas_from_file, &
use_scale_from_file, extension, output_cross_section, &
hepmc3_mode, hepmc3_write_flows)
class(eio_hepmc_t), intent(inout) :: eio
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
logical, intent(in), optional :: output_cross_section
type(string_t), intent(in), optional :: extension
integer, intent(in), optional :: hepmc3_mode
logical ,intent(in), optional :: hepmc3_write_flows
if (present (recover_beams)) &
eio%recover_beams = recover_beams
if (present (use_alphas_from_file)) &
eio%use_alphas_from_file = use_alphas_from_file
if (present (use_scale_from_file)) &
eio%use_scale_from_file = use_scale_from_file
if (present (extension)) then
eio%extension = extension
else
eio%extension = "hepmc"
end if
if (present (output_cross_section)) &
eio%output_cross_section = output_cross_section
if (present (hepmc3_mode)) &
eio%hepmc3_mode = hepmc3_mode
if (present (hepmc3_write_flows)) &
eio%hepmc3_flows = hepmc3_write_flows
end subroutine eio_hepmc_set_parameters
@ %def eio_hepmc_set_parameters
@
\subsection{Common Methods}
Output. This is not the actual event format, but a readable account
of the current object status.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: write => eio_hepmc_write
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_write (object, unit)
class(eio_hepmc_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_hepmc_write
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_write (object, unit)
class(eio_hepmc_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "HepMC event stream:"
if (object%writing) then
write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
else if (object%reading) then
write (u, "(3x,A,A)") "Reading from file = ", char (object%filename)
else
write (u, "(3x,A)") "[closed]"
end if
write (u, "(3x,A,L1)") "Recover beams = ", object%recover_beams
write (u, "(3x,A,L1)") "Alpha_s from file = ", &
object%use_alphas_from_file
write (u, "(3x,A,L1)") "Scale from file = ", &
object%use_scale_from_file
write (u, "(3x,A,A,A)") "File extension = '", &
char (object%extension), "'"
write (u, "(3x,A,I0)") "HepMC3 mode = ", object%hepmc3_mode
write (u, "(3x,A,L1)") "HepMC3 flows = ", object%hepmc3_flows
if (allocated (object%proc_num_id)) then
write (u, "(3x,A)") "Numerical process IDs:"
do i = 1, size (object%proc_num_id)
write (u, "(5x,I0,': ',I0)") i, object%proc_num_id(i)
end do
end if
end subroutine eio_hepmc_write
@ %def eio_hepmc_write
@ Finalizer: close any open file.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: final => eio_hepmc_final
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_final (object)
class(eio_hepmc_t), intent(inout) :: object
end subroutine eio_hepmc_final
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_final (object)
class(eio_hepmc_t), intent(inout) :: object
if (allocated (object%proc_num_id)) deallocate (object%proc_num_id)
if (object%writing) then
write (msg_buffer, "(A,A,A)") "Events: closing HepMC file '", &
char (object%filename), "'"
call msg_message ()
call hepmc_iostream_close (object%iostream)
object%writing = .false.
else if (object%reading) then
write (msg_buffer, "(A,A,A)") "Events: closing HepMC file '", &
char (object%filename), "'"
call msg_message ()
call hepmc_iostream_close (object%iostream)
object%reading = .false.
end if
end subroutine eio_hepmc_final
@ %def eio_hepmc_final
@ Split event file: increment the counter, close the current file, open a new
one. If the file needs a header, repeat it for the new file.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: split_out => eio_hepmc_split_out
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_split_out (eio)
class(eio_hepmc_t), intent(inout) :: eio
end subroutine eio_hepmc_split_out
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_split_out (eio)
class(eio_hepmc_t), intent(inout) :: eio
if (eio%split) then
eio%split_index = eio%split_index + 1
call eio%set_filename ()
write (msg_buffer, "(A,A,A)") "Events: writing to HepMC file '", &
char (eio%filename), "'"
call msg_message ()
call hepmc_iostream_close (eio%iostream)
call hepmc_iostream_open_out (eio%iostream, &
eio%filename, eio%hepmc3_mode)
end if
end subroutine eio_hepmc_split_out
@ %def eio_hepmc_split_out
@ Common initialization for input and output.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: common_init => eio_hepmc_common_init
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_common_init (eio, sample, data, extension)
class(eio_hepmc_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
end subroutine eio_hepmc_common_init
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_common_init (eio, sample, data, extension)
class(eio_hepmc_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
if (.not. present (data)) &
call msg_bug ("HepMC initialization: missing data")
eio%data = data
! We could relax this condition now with weighted hepmc events
if (data%unweighted) then
select case (data%norm_mode)
case (NORM_UNIT)
case default; call msg_fatal &
("HepMC: normalization for unweighted events must be '1'")
end select
end if
eio%sample = sample
if (present (extension)) then
eio%extension = extension
end if
call eio%set_filename ()
allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
end subroutine eio_hepmc_common_init
@ %def eio_hepmc_common_init
@ Initialize event writing.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: init_out => eio_hepmc_init_out
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_init_out (eio, sample, data, success, extension)
class(eio_hepmc_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_hepmc_init_out
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_init_out (eio, sample, data, success, extension)
class(eio_hepmc_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
call eio%set_splitting (data)
call eio%common_init (sample, data, extension)
write (msg_buffer, "(A,A,A)") "Events: writing to HepMC file '", &
char (eio%filename), "'"
call msg_message ()
eio%writing = .true.
call hepmc_iostream_open_out (eio%iostream, &
eio%filename, eio%hepmc3_mode)
if (present (success)) success = .true.
end subroutine eio_hepmc_init_out
@ %def eio_hepmc_init_out
@ Initialize event reading. For input, we do not (yet) support split
event files.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: init_in => eio_hepmc_init_in
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_init_in (eio, sample, data, success, extension)
class(eio_hepmc_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_hepmc_init_in
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_init_in (eio, sample, data, success, extension)
class(eio_hepmc_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
logical :: exist
eio%split = .false.
call eio%common_init (sample, data, extension)
write (msg_buffer, "(A,A,A)") "Events: reading from HepMC file '", &
char (eio%filename), "'"
call msg_message ()
inquire (file = char (eio%filename), exist = exist)
if (.not. exist) call msg_fatal ("Events: HepMC file not found.")
eio%reading = .true.
call hepmc_iostream_open_in (eio%iostream, &
eio%filename, eio%hepmc3_mode)
if (present (success)) success = .true.
end subroutine eio_hepmc_init_in
@ %def eio_hepmc_init_in
@ Switch from input to output: reopen the file for reading.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: switch_inout => eio_hepmc_switch_inout
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_switch_inout (eio, success)
class(eio_hepmc_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_hepmc_switch_inout
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_switch_inout (eio, success)
class(eio_hepmc_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("HepMC: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_hepmc_switch_inout
@ %def eio_hepmc_switch_inout
@ Output an event to the allocated HepMC output stream. For the
moment, we set [[alpha_qed]] always to -1. There should be methods for
the handling of $\alpha$ in [[me_methods]] in the same way as for
$\alpha_s$.
If an [[event_handle]] is in the argument list, and it is of the correct HepMC
type, do not destroy the event but transfer it there (i.e., the enclosed C
pointer).
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: output => eio_hepmc_output
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_hepmc_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_hepmc_output
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_hepmc_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
type(particle_set_t), pointer :: pset_ptr
if (present (passed)) then
if (.not. passed) return
end if
if (eio%writing) then
pset_ptr => event%get_particle_set_ptr ()
call hepmc_event_init (eio%hepmc_event, &
proc_id = eio%proc_num_id(i_prc), &
event_id = event%get_index ())
if (eio%output_cross_section .and. eio%data%n_beam == 2) then
call hepmc_event_from_particle_set (eio%hepmc_event, pset_ptr, &
eio%data%cross_section(i_prc), eio%data%error(i_prc), &
color = eio%hepmc3_flows)
else
call hepmc_event_from_particle_set (eio%hepmc_event, pset_ptr, &
color = eio%hepmc3_flows)
end if
call hepmc_event_set_scale (eio%hepmc_event, event%get_fac_scale ())
call hepmc_event_set_alpha_qcd (eio%hepmc_event, event%get_alpha_s ())
call hepmc_event_set_alpha_qed (eio%hepmc_event, -1._default)
- if (.not. eio%data%unweighted) then
+ if (.not. eio%data%unweighted .or. eio%data%negative_weights) then
select case (eio%data%norm_mode)
case (NORM_UNIT,NORM_N_EVT)
call hepmc_event_add_weight &
(eio%hepmc_event, event%weight_prc, .false.)
case default
call hepmc_event_add_weight &
(eio%hepmc_event, event%weight_prc, .true.)
end select
end if
call hepmc_iostream_write_event (eio%iostream, &
eio%hepmc_event, eio%hepmc3_mode)
call maybe_transfer_event_to_handle (eio%hepmc_event, event_handle)
call hepmc_event_final (eio%hepmc_event)
else
call eio%write ()
call msg_fatal ("HepMC file is not open for writing")
end if
end subroutine eio_hepmc_output
@ %def eio_hepmc_output
@ Input an event.
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: input_i_prc => eio_hepmc_input_i_prc
procedure :: input_event => eio_hepmc_input_event
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_input_i_prc (eio, i_prc, iostat)
class(eio_hepmc_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_hepmc_input_i_prc
module subroutine eio_hepmc_input_event (eio, event, iostat, event_handle)
class(eio_hepmc_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_hepmc_input_event
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_input_i_prc (eio, i_prc, iostat)
class(eio_hepmc_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
logical :: ok
integer :: i, proc_num_id
iostat = 0
call hepmc_event_init (eio%hepmc_event)
call hepmc_iostream_read_event (eio%iostream, &
eio%hepmc_event, ok=ok)
proc_num_id = hepmc_event_get_process_id (eio%hepmc_event)
if (.not. ok) then
iostat = -1
return
end if
i_prc = 0
FIND_I_PRC: do i = 1, size (eio%proc_num_id)
if (eio%proc_num_id(i) == proc_num_id) then
i_prc = i
exit FIND_I_PRC
end if
end do FIND_I_PRC
if (i_prc == 0) call err_index
contains
subroutine err_index
call msg_error ("HepMC: reading events: undefined process ID " &
// char (str (proc_num_id)) // ", aborting read")
iostat = 1
end subroutine err_index
end subroutine eio_hepmc_input_i_prc
module subroutine eio_hepmc_input_event (eio, event, iostat, event_handle)
class(eio_hepmc_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
iostat = 0
call event%reset_contents ()
call event%select (1, 1, 1)
call hepmc_to_event (event, eio%hepmc_event, &
eio%fallback_model, &
recover_beams = eio%recover_beams, &
use_alpha_s = eio%use_alphas_from_file, &
use_scale = eio%use_scale_from_file)
call maybe_transfer_event_to_handle (eio%hepmc_event, event_handle)
call hepmc_event_final (eio%hepmc_event)
end subroutine eio_hepmc_input_event
@ %def eio_hepmc_input_i_prc
@ %def eio_hepmc_input_event
@
If an [[event_handle]] is in the argument list, and it is of the correct HepMC
type, do not destroy the event but transfer it to the handle (i.e., the
enclosed C pointer). Nullify the original pointer, so the event does not get
destroyed.
<<EIO HepMC: procedures>>=
subroutine maybe_transfer_event_to_handle (hepmc_event, event_handle)
type(hepmc_event_t), intent(inout) :: hepmc_event
class(event_handle_t), intent(inout), optional :: event_handle
if (present (event_handle)) then
select type (event_handle)
type is (hepmc_event_t)
call hepmc_event_final (event_handle) ! just in case
event_handle = hepmc_event
call hepmc_event_nullify (hepmc_event) ! avoid destructor call
end select
end if
end subroutine maybe_transfer_event_to_handle
@ %def transfer_event_to_handle
@
<<EIO HepMC: eio hepmc: TBP>>=
procedure :: skip => eio_hepmc_skip
<<EIO HepMC: sub interfaces>>=
module subroutine eio_hepmc_skip (eio, iostat)
class(eio_hepmc_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_hepmc_skip
<<EIO HepMC: procedures>>=
module subroutine eio_hepmc_skip (eio, iostat)
class(eio_hepmc_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_hepmc_skip
@ %def eio_hepmc_skip
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_hepmc_ut.f90]]>>=
<<File header>>
module eio_hepmc_ut
use unit_tests
use system_dependencies, only: HEPMC2_AVAILABLE
use system_dependencies, only: HEPMC3_AVAILABLE
use eio_hepmc_uti
<<Standard module head>>
<<EIO HepMC: public test>>
contains
<<EIO HepMC: test driver>>
end module eio_hepmc_ut
@ %def eio_hepmc_ut
@
<<[[eio_hepmc_uti.f90]]>>=
<<File header>>
module eio_hepmc_uti
<<Use kinds>>
<<Use strings>>
use system_dependencies, only: HEPMC2_AVAILABLE
use system_dependencies, only: HEPMC3_AVAILABLE
use io_units
use diagnostics
use model_data
use event_base
use eio_data
use eio_base
use eio_hepmc
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
<<Standard module head>>
<<EIO HepMC: test declarations>>
contains
<<EIO HepMC: tests>>
end module eio_hepmc_uti
@ %def eio_hepmc_ut
@ API: driver for the unit tests below.
<<EIO HepMC: public test>>=
public :: eio_hepmc_test
<<EIO HepMC: test driver>>=
subroutine eio_hepmc_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO HepMC: execute tests>>
end subroutine eio_hepmc_test
@ %def eio_hepmc_test
@
\subsubsection{Test I/O methods}
We test the implementation of all I/O methods.
<<EIO HepMC: execute tests>>=
if (HEPMC2_AVAILABLE) then
call test (eio_hepmc_1, "eio_hepmc2_1", &
"write event contents", &
u, results)
else if (HEPMC3_AVAILABLE) then
call test (eio_hepmc_1, "eio_hepmc3_1", &
"write event contents", &
u, results)
end if
<<EIO HepMC: test declarations>>=
public :: eio_hepmc_1
<<EIO HepMC: tests>>=
subroutine eio_hepmc_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(116) :: buffer
write (u, "(A)") "* Test output: eio_hepmc_1"
write (u, "(A)") "* Purpose: write a HepMC file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted=.false.)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_hepmc_1"
allocate (eio_hepmc_t :: eio)
select type (eio)
type is (eio_hepmc_t)
call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (55)
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents (blanking out last two digits):"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".hepmc"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
if (trim (buffer) == "") cycle
if (buffer(1:14) == "HepMC::Version") cycle
if (HEPMC2_AVAILABLE) then
if (buffer(1:10) == "P 10001 25") &
call buffer_blanker (buffer, 32, 55, 78)
if (buffer(1:10) == "P 10002 25") &
call buffer_blanker (buffer, 33, 56, 79)
if (buffer(1:10) == "P 10003 25") &
call buffer_blanker (buffer, 29, 53, 78, 101)
if (buffer(1:10) == "P 10004 25") &
call buffer_blanker (buffer, 28, 51, 76, 99)
else if (HEPMC3_AVAILABLE) then
if (buffer(1:8) == "P 1 0 25") &
call buffer_blanker (buffer, 26, 49, 72)
if (buffer(1:8) == "P 2 0 25") &
call buffer_blanker (buffer, 26, 49, 73)
if (buffer(1:9) == "P 3 -1 25") &
call buffer_blanker (buffer, 28, 52, 75)
if (buffer(1:9) == "P 4 -1 25") &
call buffer_blanker (buffer, 27, 50, 73)
end if
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_hepmc_t :: eio)
select type (eio)
type is (eio_hepmc_t)
call eio%set_parameters ()
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_hepmc_1"
contains
subroutine buffer_blanker (buf, pos1, pos2, pos3, pos4)
character(len=*), intent(inout) :: buf
integer, intent(in) :: pos1, pos2, pos3
integer, intent(in), optional :: pos4
type(string_t) :: line
line = var_str (trim (buf))
line = replace (line, pos1, "XX")
line = replace (line, pos2, "XX")
line = replace (line, pos3, "XX")
if (present (pos4)) then
line = replace (line, pos4, "XX")
end if
line = replace (line, "4999999999999", "5000000000000")
buf = char (line)
end subroutine buffer_blanker
end subroutine eio_hepmc_1
@ %def eio_hepmc_1
@ Test also the reading of HepMC events.
<<EIO HepMC: execute tests>>=
if (HEPMC2_AVAILABLE) then
call test (eio_hepmc_2, "eio_hepmc2_2", &
"read event contents", &
u, results)
else if (HEPMC3_AVAILABLE) then
call test (eio_hepmc_2, "eio_hepmc3_2", &
"read event contents", &
u, results)
end if
<<EIO HepMC: test declarations>>=
public :: eio_hepmc_2
<<EIO HepMC: tests>>=
subroutine eio_hepmc_2 (u)
integer, intent(in) :: u
class(model_data_t), pointer :: fallback_model
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat, i_prc
write (u, "(A)") "* Test output: eio_hepmc_2"
write (u, "(A)") "* Purpose: read a HepMC event"
write (u, "(A)")
write (u, "(A)") "* Write a HepMC data file"
write (u, "(A)")
u_file = free_unit ()
sample = "eio_hepmc_2"
open (u_file, file = char (sample // ".hepmc"), &
status = "replace", action = "readwrite")
if (HEPMC2_AVAILABLE) then
write (u_file, "(A)") "HepMC::Version 2.06.09"
write (u_file, "(A)") "HepMC::IO_GenEvent-START_EVENT_LISTING"
write (u_file, "(A)") "E 66 -1 -1.0000000000000000e+00 &
&-1.0000000000000000e+00 &
&-1.0000000000000000e+00 42 0 1 10001 10002 0 0"
write (u_file, "(A)") "U GEV MM"
write (u_file, "(A)") "V -1 0 0 0 0 0 2 2 0"
write (u_file, "(A)") "P 10001 25 0 0 4.8412291827592713e+02 &
&5.0000000000000000e+02 &
&1.2499999999999989e+02 3 0 0 -1 0"
write (u_file, "(A)") "P 10002 25 0 0 -4.8412291827592713e+02 &
&5.0000000000000000e+02 &
&1.2499999999999989e+02 3 0 0 -1 0"
write (u_file, "(A)") "P 10003 25 -1.4960220911365536e+02 &
&-4.6042825611414656e+02 &
&0 5.0000000000000000e+02 1.2500000000000000e+02 1 0 0 0 0"
write (u_file, "(A)") "P 10004 25 1.4960220911365536e+02 &
&4.6042825611414656e+02 &
&0 5.0000000000000000e+02 1.2500000000000000e+02 1 0 0 0 0"
write (u_file, "(A)") "HepMC::IO_GenEvent-END_EVENT_LISTING"
else if (HEPMC3_AVAILABLE) then
write (u_file, "(A)") "HepMC::Version 3.01.01"
write (u_file, "(A)") "HepMC::Asciiv3-START_EVENT_LISTING"
write (u_file, "(A)") "E 55 1 4"
write (u_file, "(A)") "U GEV MM"
write (u_file, "(A)") "A 0 alphaQCD -1"
write (u_file, "(A)") "A 0 event_scale 1000"
write (u_file, "(A)") "A 0 signal_process_id 42"
write (u_file, "(A)") "P 1 0 25 0.0000000000000000e+00 &
&0.0000000000000000e+00 4.8412291827592713e+02 &
&5.0000000000000000e+02 1.2499999999999989e+02 3"
write (u_file, "(A)") "P 2 0 25 0.0000000000000000e+00 &
&0.0000000000000000e+00 -4.8412291827592713e+02 &
&5.0000000000000000e+02 1.2499999999999989e+02 3"
write (u_file, "(A)") "V -1 0 [1,2]"
write (u_file, "(A)") "P 3 -1 25 -1.4960220911365536e+02 &
&-4.6042825611414656e+02 0.0000000000000000e+00 &
&5.0000000000000000e+02 1.2500000000000000e+02 1"
write (u_file, "(A)") "P 4 -1 25 1.4960220911365536e+02 &
&4.6042825611414656e+02 0.0000000000000000e+00 &
&5.0000000000000000e+02 1.2500000000000000e+02 1"
write (u_file, "(A)") "HepMC::Asciiv3-END_EVENT_LISTING"
else
call msg_fatal &
("Trying to execute eio_hepmc unit tests without a linked HepMC")
end if
close (u_file)
write (u, "(A)") "* Initialize test process"
write (u, "(A)")
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event, unweighted=.false.)
allocate (eio_hepmc_t :: eio)
select type (eio)
type is (eio_hepmc_t)
call eio%set_parameters (recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
call eio%init_in (sample, data)
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Read event"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
select type (eio)
type is (eio_hepmc_t)
write (u, "(A,I0,A,I0)") "Found process #", i_prc, &
" with ID = ", eio%proc_num_id(i_prc)
end select
call eio%input_event (event, iostat)
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Read closing"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(A,I0)") "iostat = ", iostat
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_hepmc_2"
end subroutine eio_hepmc_2
@ %def eio_hepmc_2
@
Test also the correct normalization of weighted HepMC events.
<<EIO HepMC: execute tests>>=
if (HEPMC2_AVAILABLE) then
call test (eio_hepmc_3, "eio_hepmc2_3", &
"write event contents", &
u, results)
else if (HEPMC3_AVAILABLE) then
call test (eio_hepmc_3, "eio_hepmc3_3", &
"event contents weighted, '1' normalization", &
u, results)
end if
<<EIO HepMC: test declarations>>=
public :: eio_hepmc_3
<<EIO HepMC: tests>>=
subroutine eio_hepmc_3 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: u_file, iostat
character(126) :: buffer
write (u, "(A)") "* Test output: eio_hepmc_3"
write (u, "(A)") "* Purpose: test correct HepMC normalization"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event, unweighted=.false., &
sample_norm = var_str ("1"))
call data%init (1)
data%n_beam = 2
data%unweighted = .false.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 20
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_hepmc_3"
allocate (eio_hepmc_t :: eio)
select type (eio)
type is (eio_hepmc_t)
call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (55)
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* File contents (blanking out last two digits):"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = char (sample // ".hepmc"), &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
if (trim (buffer) == "") cycle
if (buffer(1:14) == "HepMC::Version") cycle
if (HEPMC2_AVAILABLE) then
if (buffer(1:4) == "E 55") then
buffer = replace (buffer, 113, "XXXXXXXXX")
end if
if (buffer(1:10) == "P 10001 25") &
call buffer_blanker (buffer, 32, 55, 78)
if (buffer(1:10) == "P 10002 25") &
call buffer_blanker (buffer, 33, 56, 79)
if (buffer(1:10) == "P 10003 25") &
call buffer_blanker (buffer, 29, 53, 78, 101)
if (buffer(1:10) == "P 10004 25") &
call buffer_blanker (buffer, 28, 51, 76, 99)
else if (HEPMC3_AVAILABLE) then
if (buffer(1:4) == "W 3.") then
buffer = replace (buffer, 11, "XXXXXXXXXXXXXXXX")
end if
if (buffer(1:8) == "P 1 0 25") &
call buffer_blanker (buffer, 26, 49, 72, 118)
if (buffer(1:8) == "P 2 0 25") &
call buffer_blanker (buffer, 26, 49, 73, 119)
if (buffer(1:9) == "P 3 -1 25") &
call buffer_blanker (buffer, 28, 52, 75, 121)
if (buffer(1:9) == "P 4 -1 25") &
call buffer_blanker (buffer, 27, 50, 73, 119)
end if
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_hepmc_t :: eio)
select type (eio)
type is (eio_hepmc_t)
call eio%set_parameters ()
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_hepmc_3"
contains
subroutine buffer_blanker (buf, pos1, pos2, pos3, pos4)
character(len=*), intent(inout) :: buf
integer, intent(in) :: pos1, pos2, pos3
integer, intent(in), optional :: pos4
type(string_t) :: line
line = var_str (trim (buf))
line = replace (line, pos1, "XX")
line = replace (line, pos2, "XX")
line = replace (line, pos3, "XX")
if (present (pos4)) then
line = replace (line, pos4, "XX")
end if
line = replace (line, "4999999999999", "5000000000000")
buf = char (line)
end subroutine buffer_blanker
end subroutine eio_hepmc_3
@ %def eio_hepmc_3
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{LCIO Output}
The LCIO event record is standardized for the use with Linear $e^+e^-$
colliders. It is a binary event format. We try our best at using it
for both input and output.
<<[[eio_lcio.f90]]>>=
<<File header>>
module eio_lcio
<<Use kinds>>
<<Use strings>>
use event_base
use event_handles, only: event_handle_t
use eio_data
use eio_base
use lcio_interface
<<Standard module head>>
<<EIO LCIO: public>>
<<EIO LCIO: types>>
interface
<<EIO LCIO: sub interfaces>>
end interface
end module eio_lcio
@ %def eio_lcio
@
<<[[eio_lcio_sub.f90]]>>=
<<File header>>
submodule (eio_lcio) eio_lcio_s
use io_units
use string_utils
use diagnostics
use particles
use hep_events
implicit none
contains
<<EIO LCIO: procedures>>
end submodule eio_lcio_s
@ %def eio_lcio_s
@
\subsection{Type}
A type [[lcio_event]] is introduced as container to store LCIO event
data, particularly for splitting the reading into read out of the process
index and the proper event data.
Note: the [[keep_beams]] flag is not supported.
<<EIO LCIO: public>>=
public :: eio_lcio_t
<<EIO LCIO: types>>=
type, extends (eio_t) :: eio_lcio_t
logical :: writing = .false.
logical :: reading = .false.
type(event_sample_data_t) :: data
logical :: recover_beams = .false.
logical :: use_alphas_from_file = .false.
logical :: use_scale_from_file = .false.
logical :: proc_as_run_id = .true.
integer :: n_alt = 0
integer :: lcio_run_id = 0
type(lcio_writer_t) :: lcio_writer
type(lcio_reader_t) :: lcio_reader
type(lcio_run_header_t) :: lcio_run_hdr
type(lcio_event_t) :: lcio_event
integer, dimension(:), allocatable :: proc_num_id
contains
<<EIO LCIO: eio lcio: TBP>>
end type eio_lcio_t
@ %def eio_lcio_t
@
\subsection{Specific Methods}
Set parameters that are specifically used with LCIO.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: set_parameters => eio_lcio_set_parameters
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_set_parameters &
(eio, recover_beams, use_alphas_from_file, use_scale_from_file, &
extension, proc_as_run_id, lcio_run_id)
class(eio_lcio_t), intent(inout) :: eio
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
logical, intent(in), optional :: proc_as_run_id
integer, intent(in), optional :: lcio_run_id
type(string_t), intent(in), optional :: extension
end subroutine eio_lcio_set_parameters
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_set_parameters &
(eio, recover_beams, use_alphas_from_file, use_scale_from_file, &
extension, proc_as_run_id, lcio_run_id)
class(eio_lcio_t), intent(inout) :: eio
logical, intent(in), optional :: recover_beams
logical, intent(in), optional :: use_alphas_from_file
logical, intent(in), optional :: use_scale_from_file
logical, intent(in), optional :: proc_as_run_id
integer, intent(in), optional :: lcio_run_id
type(string_t), intent(in), optional :: extension
if (present (recover_beams)) eio%recover_beams = recover_beams
if (present (use_alphas_from_file)) &
eio%use_alphas_from_file = use_alphas_from_file
if (present (use_scale_from_file)) &
eio%use_scale_from_file = use_scale_from_file
if (present (proc_as_run_id)) &
eio%proc_as_run_id = proc_as_run_id
if (present (lcio_run_id)) &
eio%lcio_run_id = lcio_run_id
if (present (extension)) then
eio%extension = extension
else
eio%extension = "slcio"
end if
end subroutine eio_lcio_set_parameters
@ %def eio_lcio_set_parameters
@
\subsection{Common Methods}
Output. This is not the actual event format, but a readable account
of the current object status.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: write => eio_lcio_write
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_write (object, unit)
class(eio_lcio_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine eio_lcio_write
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_write (object, unit)
class(eio_lcio_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "LCIO event stream:"
if (object%writing) then
write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
else if (object%reading) then
write (u, "(3x,A,A)") "Reading from file = ", char (object%filename)
else
write (u, "(3x,A)") "[closed]"
end if
write (u, "(3x,A,L1)") "Recover beams = ", object%recover_beams
write (u, "(3x,A,L1)") "Alpha_s from file = ", &
object%use_alphas_from_file
write (u, "(3x,A,L1)") "Scale from file = ", &
object%use_scale_from_file
write (u, "(3x,A,L1)") "Process as run ID = ", &
object%proc_as_run_id
write (u, "(3x,A,I0)") "LCIO run ID = ", &
object%lcio_run_id
write (u, "(3x,A,A,A)") "File extension = '", &
char (object%extension), "'"
if (allocated (object%proc_num_id)) then
write (u, "(3x,A)") "Numerical process IDs:"
do i = 1, size (object%proc_num_id)
write (u, "(5x,I0,': ',I0)") i, object%proc_num_id(i)
end do
end if
end subroutine eio_lcio_write
@ %def eio_lcio_write
@ Finalizer: close any open file.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: final => eio_lcio_final
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_final (object)
class(eio_lcio_t), intent(inout) :: object
end subroutine eio_lcio_final
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_final (object)
class(eio_lcio_t), intent(inout) :: object
if (allocated (object%proc_num_id)) deallocate (object%proc_num_id)
if (object%writing) then
write (msg_buffer, "(A,A,A)") "Events: closing LCIO file '", &
char (object%filename), "'"
call msg_message ()
call lcio_writer_close (object%lcio_writer)
object%writing = .false.
else if (object%reading) then
write (msg_buffer, "(A,A,A)") "Events: closing LCIO file '", &
char (object%filename), "'"
call msg_message ()
call lcio_reader_close (object%lcio_reader)
object%reading = .false.
end if
end subroutine eio_lcio_final
@ %def eio_lcio_final
@ Split event file: increment the counter, close the current file, open a new
one. If the file needs a header, repeat it for the new file.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: split_out => eio_lcio_split_out
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_split_out (eio)
class(eio_lcio_t), intent(inout) :: eio
end subroutine eio_lcio_split_out
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_split_out (eio)
class(eio_lcio_t), intent(inout) :: eio
if (eio%split) then
eio%split_index = eio%split_index + 1
call eio%set_filename ()
write (msg_buffer, "(A,A,A)") "Events: writing to LCIO file '", &
char (eio%filename), "'"
call msg_message ()
call lcio_writer_close (eio%lcio_writer)
call lcio_writer_open_out (eio%lcio_writer, eio%filename)
end if
end subroutine eio_lcio_split_out
@ %def eio_lcio_split_out
@ Common initialization for input and output.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: common_init => eio_lcio_common_init
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_common_init (eio, sample, data, extension)
class(eio_lcio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
end subroutine eio_lcio_common_init
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_common_init (eio, sample, data, extension)
class(eio_lcio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
if (.not. present (data)) &
call msg_bug ("LCIO initialization: missing data")
eio%data = data
if (data%unweighted) then
select case (data%norm_mode)
case (NORM_UNIT)
case default; call msg_fatal &
("LCIO: normalization for unweighted events must be '1'")
end select
else
call msg_fatal ("LCIO: events must be unweighted")
end if
eio%n_alt = data%n_alt
eio%sample = sample
if (present (extension)) then
eio%extension = extension
end if
call eio%set_filename ()
allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
end subroutine eio_lcio_common_init
@ %def eio_lcio_common_init
@ Initialize event writing.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: init_out => eio_lcio_init_out
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_init_out &
(eio, sample, data, success, extension)
class(eio_lcio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
end subroutine eio_lcio_init_out
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_init_out &
(eio, sample, data, success, extension)
class(eio_lcio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(in), optional :: data
logical, intent(out), optional :: success
call eio%set_splitting (data)
call eio%common_init (sample, data, extension)
write (msg_buffer, "(A,A,A)") "Events: writing to LCIO file '", &
char (eio%filename), "'"
call msg_message ()
eio%writing = .true.
call lcio_writer_open_out (eio%lcio_writer, eio%filename)
call lcio_run_header_init (eio%lcio_run_hdr)
call lcio_run_header_write (eio%lcio_writer, eio%lcio_run_hdr)
if (present (success)) success = .true.
end subroutine eio_lcio_init_out
@ %def eio_lcio_init_out
@ Initialize event reading. For input, we do not (yet) support split
event files.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: init_in => eio_lcio_init_in
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_init_in (eio, sample, data, success, extension)
class(eio_lcio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
end subroutine eio_lcio_init_in
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_init_in (eio, sample, data, success, extension)
class(eio_lcio_t), intent(inout) :: eio
type(string_t), intent(in) :: sample
type(string_t), intent(in), optional :: extension
type(event_sample_data_t), intent(inout), optional :: data
logical, intent(out), optional :: success
logical :: exist
eio%split = .false.
call eio%common_init (sample, data, extension)
write (msg_buffer, "(A,A,A)") "Events: reading from LCIO file '", &
char (eio%filename), "'"
call msg_message ()
inquire (file = char (eio%filename), exist = exist)
if (.not. exist) call msg_fatal ("Events: LCIO file not found.")
eio%reading = .true.
call lcio_open_file (eio%lcio_reader, eio%filename)
if (present (success)) success = .true.
end subroutine eio_lcio_init_in
@ %def eio_lcio_init_in
@ Switch from input to output: reopen the file for reading.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: switch_inout => eio_lcio_switch_inout
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_switch_inout (eio, success)
class(eio_lcio_t), intent(inout) :: eio
logical, intent(out), optional :: success
end subroutine eio_lcio_switch_inout
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_switch_inout (eio, success)
class(eio_lcio_t), intent(inout) :: eio
logical, intent(out), optional :: success
call msg_bug ("LCIO: in-out switch not supported")
if (present (success)) success = .false.
end subroutine eio_lcio_switch_inout
@ %def eio_lcio_switch_inout
@ Output an event to the allocated LCIO writer.
<<EIO LCIO: eio lcio: TBP>>=
procedure :: output => eio_lcio_output
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_lcio_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_lcio_output
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_output &
(eio, event, i_prc, reading, passed, pacify, event_handle)
class(eio_lcio_t), intent(inout) :: eio
class(generic_event_t), intent(in), target :: event
integer, intent(in) :: i_prc
logical, intent(in), optional :: reading, passed, pacify
class(event_handle_t), intent(inout), optional :: event_handle
type(particle_set_t), pointer :: pset_ptr
real(default) :: sqme_prc, weight
real(default), dimension(:), allocatable :: pol
integer :: i
if (present (passed)) then
if (.not. passed) return
end if
if (eio%writing) then
pset_ptr => event%get_particle_set_ptr ()
if (eio%proc_as_run_id) then
call lcio_event_init (eio%lcio_event, &
proc_id = eio%proc_num_id (i_prc), &
event_id = event%get_index (), &
run_id = eio%proc_num_id (i_prc))
else
call lcio_event_init (eio%lcio_event, &
proc_id = eio%proc_num_id (i_prc), &
event_id = event%get_index (), &
run_id = eio%lcio_run_id)
end if
call lcio_event_from_particle_set (eio%lcio_event, pset_ptr)
call lcio_event_set_weight (eio%lcio_event, event%weight_prc)
call lcio_event_set_sqrts (eio%lcio_event, event%get_sqrts ())
call lcio_event_set_sqme (eio%lcio_event, event%get_sqme_prc ())
call lcio_event_set_scale (eio%lcio_event, event%get_fac_scale ())
call lcio_event_set_alpha_qcd (eio%lcio_event, event%get_alpha_s ())
if (eio%data%n_beam == 2) then
call lcio_event_set_xsec (eio%lcio_event, eio%data%cross_section(i_prc), &
eio%data%error(i_prc))
end if
pol = event%get_polarization ()
do i = 1, eio%data%n_beam
call lcio_event_set_polarization (eio%lcio_event, pol(i), i)
end do
call lcio_event_set_beam_file (eio%lcio_event, &
event%get_beam_file ())
call lcio_event_set_process_name (eio%lcio_event, &
event%get_process_name ())
do i = 1, eio%n_alt
sqme_prc = event%get_sqme_alt(i)
weight = event%get_weight_alt(i)
call lcio_event_set_alt_sqme (eio%lcio_event, sqme_prc, i)
call lcio_event_set_alt_weight (eio%lcio_event, weight, i)
end do
call lcio_event_write (eio%lcio_writer, eio%lcio_event)
call maybe_transfer_event_to_handle (eio%lcio_event, &
event_handle, .true.)
call lcio_event_final (eio%lcio_event, .true.)
else
call eio%write ()
call msg_fatal ("LCIO file is not open for writing")
end if
end subroutine eio_lcio_output
@ %def eio_lcio_output
@ Input an event.
[WK 22-04-21] We do no longer fix the [[i_mci]] and [[i_term]] indices to 1,
this can now be done by [[simulation_recalculate]].
<<EIO LCIO: eio lcio: TBP>>=
procedure :: input_i_prc => eio_lcio_input_i_prc
procedure :: input_event => eio_lcio_input_event
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_input_i_prc (eio, i_prc, iostat)
class(eio_lcio_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
end subroutine eio_lcio_input_i_prc
module subroutine eio_lcio_input_event (eio, event, iostat, event_handle)
class(eio_lcio_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
end subroutine eio_lcio_input_event
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_input_i_prc (eio, i_prc, iostat)
class(eio_lcio_t), intent(inout) :: eio
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
logical :: ok
integer :: i, proc_num_id
iostat = 0
call lcio_read_event (eio%lcio_reader, eio%lcio_event, ok)
if (.not. ok) then
iostat = -1
return
end if
proc_num_id = lcio_event_get_process_id (eio%lcio_event)
i_prc = 0
FIND_I_PRC: do i = 1, size (eio%proc_num_id)
if (eio%proc_num_id(i) == proc_num_id) then
i_prc = i
exit FIND_I_PRC
end if
end do FIND_I_PRC
if (i_prc == 0) call err_index
contains
subroutine err_index
call msg_error ("LCIO: reading events: undefined process ID " &
// char (str (proc_num_id)) // ", aborting read")
iostat = 1
end subroutine err_index
end subroutine eio_lcio_input_i_prc
module subroutine eio_lcio_input_event (eio, event, iostat, event_handle)
class(eio_lcio_t), intent(inout) :: eio
class(generic_event_t), intent(inout), target :: event
integer, intent(out) :: iostat
class(event_handle_t), intent(inout), optional :: event_handle
iostat = 0
call event%reset_contents ()
call event%select (0, 0, 1)
call event%set_index (lcio_event_get_event_index (eio%lcio_event))
call lcio_to_event (event, eio%lcio_event, eio%fallback_model, &
recover_beams = eio%recover_beams, &
use_alpha_s = eio%use_alphas_from_file, &
use_scale = eio%use_scale_from_file)
call maybe_transfer_event_to_handle (eio%lcio_event, &
event_handle, .false.)
call lcio_event_final (eio%lcio_event, .false.)
end subroutine eio_lcio_input_event
@ %def eio_lcio_input_i_prc
@ %def eio_lcio_input_event
@
If an [[event_handle]] is in the argument list, and it is of the correct HepMC
type, do not destroy the event but transfer it to the handle (i.e., the
enclosed C pointer). Nullify the original pointer, so the event does not get
destroyed.
<<EIO LCIO: procedures>>=
subroutine maybe_transfer_event_to_handle (lcio_event, event_handle, delete)
type(lcio_event_t), intent(inout) :: lcio_event
class(event_handle_t), intent(inout), optional :: event_handle
logical, intent(in) :: delete
if (present (event_handle)) then
select type (event_handle)
type is (lcio_event_t)
call lcio_event_final (event_handle, delete) ! just in case
event_handle = lcio_event
call lcio_event_nullify (lcio_event) ! avoid destructor call
end select
end if
end subroutine maybe_transfer_event_to_handle
@ %def transfer_event_to_handle
@
<<EIO LCIO: eio lcio: TBP>>=
procedure :: skip => eio_lcio_skip
<<EIO LCIO: sub interfaces>>=
module subroutine eio_lcio_skip (eio, iostat)
class(eio_lcio_t), intent(inout) :: eio
integer, intent(out) :: iostat
end subroutine eio_lcio_skip
<<EIO LCIO: procedures>>=
module subroutine eio_lcio_skip (eio, iostat)
class(eio_lcio_t), intent(inout) :: eio
integer, intent(out) :: iostat
iostat = 0
end subroutine eio_lcio_skip
@ %def eio_lcio_skip
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[eio_lcio_ut.f90]]>>=
<<File header>>
module eio_lcio_ut
use unit_tests
use eio_lcio_uti
<<Standard module head>>
<<EIO LCIO: public test>>
contains
<<EIO LCIO: test driver>>
end module eio_lcio_ut
@ %def eio_lcio_ut
@
<<[[eio_lcio_uti.f90]]>>=
<<File header>>
module eio_lcio_uti
<<Use kinds>>
<<Use strings>>
use io_units
use model_data
use particles
use event_base
use eio_data
use eio_base
use hep_events
use lcio_interface
use eio_lcio
use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
<<Standard module head>>
<<EIO LCIO: test declarations>>
contains
<<EIO LCIO: tests>>
end module eio_lcio_uti
@ %def eio_lcio_ut
@ API: driver for the unit tests below.
<<EIO LCIO: public test>>=
public :: eio_lcio_test
<<EIO LCIO: test driver>>=
subroutine eio_lcio_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<EIO LCIO: execute tests>>
end subroutine eio_lcio_test
@ %def eio_lcio_test
@
\subsubsection{Test I/O methods}
We test the implementation of all I/O methods.
<<EIO LCIO: execute tests>>=
call test (eio_lcio_1, "eio_lcio_1", &
"write event contents", &
u, results)
<<EIO LCIO: test declarations>>=
public :: eio_lcio_1
<<EIO LCIO: tests>>=
subroutine eio_lcio_1 (u)
integer, intent(in) :: u
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(particle_set_t), pointer :: pset_ptr
type(string_t) :: sample
integer :: u_file, iostat
character(215) :: buffer
write (u, "(A)") "* Test output: eio_lcio_1"
write (u, "(A)") "* Purpose: write a LCIO file"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
call eio_prepare_test (event)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_lcio_1"
allocate (eio_lcio_t :: eio)
select type (eio)
type is (eio_lcio_t)
call eio%set_parameters ()
end select
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (77)
call event%pacify_particle_set ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
write (u, "(A)")
write (u, "(A)") "* Reset data"
write (u, "(A)")
deallocate (eio)
allocate (eio_lcio_t :: eio)
select type (eio)
type is (eio_lcio_t)
call eio%set_parameters ()
end select
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Write LCIO file contents to ASCII file"
write (u, "(A)")
select type (eio)
type is (eio_lcio_t)
call lcio_event_init (eio%lcio_event, &
proc_id = 42, &
event_id = event%get_index ())
pset_ptr => event%get_particle_set_ptr ()
call lcio_event_from_particle_set &
(eio%lcio_event, pset_ptr)
call write_lcio_event (eio%lcio_event, var_str ("test_file.slcio"))
call lcio_event_final (eio%lcio_event, .true.)
end select
write (u, "(A)")
write (u, "(A)") "* Read in ASCII contents of LCIO file"
write (u, "(A)")
u_file = free_unit ()
open (u_file, file = "test_file.slcio", &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
if (trim (buffer) == "") cycle
if (buffer(1:12) == " - timestamp") cycle
if (buffer(1:6) == " date:") cycle
write (u, "(A)") trim (buffer)
end do
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio_cleanup_test (event)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lcio_1"
end subroutine eio_lcio_1
@ %def eio_lcio_1
@ Test also the reading of LCIO events.
<<EIO LCIO: execute tests>>=
call test (eio_lcio_2, "eio_lcio_2", &
"read event contents", &
u, results)
<<EIO LCIO: test declarations>>=
public :: eio_lcio_2
<<EIO LCIO: tests>>=
subroutine eio_lcio_2 (u)
integer, intent(in) :: u
class(model_data_t), pointer :: fallback_model
class(generic_event_t), pointer :: event
type(event_sample_data_t) :: data
class(eio_t), allocatable :: eio
type(string_t) :: sample
integer :: iostat, i_prc
write (u, "(A)") "* Test output: eio_lcio_2"
write (u, "(A)") "* Purpose: read a LCIO event"
write (u, "(A)")
write (u, "(A)") "* Initialize test process"
allocate (fallback_model)
call eio_prepare_fallback_model (fallback_model)
call eio_prepare_test (event)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
data%cross_section(1) = 100
data%error(1) = 1
data%total_cross_section = sum (data%cross_section)
write (u, "(A)")
write (u, "(A)") "* Generate and write an event"
write (u, "(A)")
sample = "eio_lcio_2"
allocate (eio_lcio_t :: eio)
select type (eio)
type is (eio_lcio_t)
call eio%set_parameters (recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call eio%init_out (sample, data)
call event%generate (1, [0._default, 0._default])
call event%set_index (88)
call event%evaluate_expressions ()
call event%pacify_particle_set ()
call eio%output (event, i_prc = 1)
call eio%write (u)
call eio%final ()
deallocate (eio)
call event%reset_contents ()
call event%reset_index ()
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
allocate (eio_lcio_t :: eio)
select type (eio)
type is (eio_lcio_t)
call eio%set_parameters (recover_beams = .false.)
end select
call eio%set_fallback_model (fallback_model)
call data%init (1)
data%n_beam = 2
data%unweighted = .true.
data%norm_mode = NORM_UNIT
data%pdg_beam = 25
data%energy_beam = 500
data%proc_num_id = [42]
call data%write (u)
write (u, *)
write (u, "(A)") "* Initialize"
write (u, "(A)")
call eio%init_in (sample, data)
call eio%write (u)
write (u, "(A)")
write (u, "(A)") "* Read event"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
select type (eio)
type is (eio_lcio_t)
write (u, "(A,I0,A,I0)") "Found process #", i_prc, &
" with ID = ", eio%proc_num_id(i_prc)
end select
call eio%input_event (event, iostat)
call event%select (1, 1, 1)
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Read closing"
write (u, "(A)")
call eio%input_i_prc (i_prc, iostat)
write (u, "(A,I0)") "iostat = ", iostat
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call eio_cleanup_test (event)
call eio_cleanup_fallback_model (fallback_model)
deallocate (fallback_model)
write (u, "(A)")
write (u, "(A)") "* Test output end: eio_lcio_2"
end subroutine eio_lcio_2
@ %def eio_lcio_2
Index: trunk/src/variables/variables.nw
===================================================================
--- trunk/src/variables/variables.nw (revision 8819)
+++ trunk/src/variables/variables.nw (revision 8820)
@@ -1,7762 +1,7763 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: variables for processes
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Variables for Processes}
\includemodulegraph{variables}
This part introduces variables as user-controlled objects that
influence the behavior of objects and calculations. Variables contain
objects of intrinsic type or of a type as introced above.
\begin{description}
\item[variables]
Store values of various kind, used by expressions and accessed by
the command interface. This provides an implementation of the [[vars_t]]
abstract type.
\item[observables]
Concrete implementation of observables (functions in the variable tree),
applicable for \whizard.
abstract type.
\end{description}
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Variables: Implementation}
The user interface deals with variables that are handled similarly to
full-flegded programming languages. The system will add a lot of
predefined variables (model parameters, flags, etc.) that are
accessible to the user by the same methods.
Variables can be of various type: logical (boolean/flag), integer,
real (default precision), subevents (used in cut expressions),
arrays of PDG codes (aliases for particles), strings. Furthermore, in
cut expressions we have unary and binary observables, which are used
like real parameters but behave like functions.
<<[[variables.f90]]>>=
<<File header>>
module variables
<<Use kinds>>
<<Use strings>>
use numeric_utils, only: pacify
use os_interface, only: paths_t
use pdg_arrays
use subevents
use var_base
<<Standard module head>>
<<Variables: public>>
<<Variables: parameters>>
<<Variables: types>>
<<Variables: interfaces>>
interface
<<Variables: sub interfaces>>
end interface
end module variables
@ %def variables
@
<<[[variables_sub.f90]]>>=
<<File header>>
submodule (variables) variables_s
use io_units
use format_utils, only: pac_fmt
use format_defs, only: FMT_12, FMT_19
use constants, only: eps0
use physics_defs, only: LAMBDA_QCD_REF
use system_dependencies
use diagnostics
use fastjet !NODEP!
implicit none
contains
<<Variables: procedures>>
end submodule variables_s
@ %def variables_s
@
\subsection{Variable list entries}
Variable (and constant) values can be of one of the following types:
<<Variables: parameters>>=
integer, parameter, public :: V_NONE = 0, V_LOG = 1, V_INT = 2, V_REAL = 3
integer, parameter, public :: V_CMPLX = 4, V_SEV = 5, V_PDG = 6, V_STR = 7
integer, parameter, public :: V_OBS1_INT = 11, V_OBS2_INT = 12
integer, parameter, public :: V_OBS1_REAL = 21, V_OBS2_REAL = 22
integer, parameter, public :: V_OBSEV_INT = 13, V_OBSEV_REAL = 23
integer, parameter, public :: V_UOBS1_INT = 31, V_UOBS2_INT = 32
integer, parameter, public :: V_UOBS1_REAL = 41, V_UOBS2_REAL = 42
@ %def V_NONE V_LOG V_INT V_REAL V_CMPLX V_PRT V_SEV V_PDG V_OBS1_INT
@ %def V_OBS2_INT V_OBSEV_INT V_OBS1_REAL V_OBS2_REAL V_OBSEV_REAL
@ %def V_UOBS1_INT V_UOBS2_INT V_UOBS1_REAL V_UOBS2_REAL
@
\subsubsection{The type}
This is an entry in the variable list. It can be of any type; in
each case only one value is allocated. It may be physically
allocated upon creation, in which case [[is_allocated]] is true, or
it may contain just a pointer to a value somewhere else, in which case
[[is_allocated]] is false.
The flag [[is_defined]] is set when the variable is given a value, even the
undefined value. (Therefore it is distinct from [[is_known]].) This matters
for variable declaration in the SINDARIN language. The variable is set up in
the compilation step and initially marked as defined, but after compilation
all variables are set undefined. Each variable becomes defined when it is
explicitly set. The difference matters in loops.
[[is_locked]] means that it cannot be given a value using the interface
routines [[var_list_set_XXX]] below. It can only be initialized, or change
automatically due to a side effect.
[[is_copy]] means that this is a local copy of a global variable. The copy
has a pointer to the original, which can be used to restore a previous value.
[[is_intrinsic]] means that this variable is defined by the program, not by
the user. Intrinsic variables cannot be (re)declared, but their values can be
reset unless they are locked. [[is_user_var]] means that the variable has
been declared by the user. It could be a new variable, or a local copy of an
intrinsic variable.
The flag [[is_known]] is a pointer which parallels the use of the
value pointer. For pointer variables, it is set if the value should point to
a known value. For ordinary variables, it should be true.
The value is implemented as a set of alternative type-specific pointers. This
emulates polymorphism, and it allows for actual pointer variables.
Observable-type variables have function pointers as values, so they behave
like macros. The functions make use of the particle objects accessible via
the pointers [[prt1]] and [[prt2]].
Finally, the [[next]] pointer indicates that we are making lists of
variables. A more efficient implementation might switch to hashes or
similar; the current implementation has $O(N)$ lookup.
<<Variables: types>>=
type :: var_entry_t
private
integer :: type = V_NONE
type(string_t) :: name
logical :: is_allocated = .false.
logical :: is_defined = .false.
logical :: is_locked = .false.
logical :: is_intrinsic = .false.
logical :: is_user_var = .false.
logical, pointer :: is_known => null ()
logical, pointer :: lval => null ()
integer, pointer :: ival => null ()
real(default), pointer :: rval => null ()
complex(default), pointer :: cval => null ()
type(subevt_t), pointer :: pval => null ()
type(pdg_array_t), pointer :: aval => null ()
type(string_t), pointer :: sval => null ()
procedure(obs_unary_int), nopass, pointer :: obs1_int => null ()
procedure(obs_unary_real), nopass, pointer :: obs1_real => null ()
procedure(obs_binary_int), nopass, pointer :: obs2_int => null ()
procedure(obs_binary_real), nopass, pointer :: obs2_real => null ()
procedure(obs_sev_int), nopass, pointer :: obsev_int => null ()
procedure(obs_sev_real), nopass, pointer :: obsev_real => null ()
type(prt_t), pointer :: prt1 => null ()
type(prt_t), pointer :: prt2 => null ()
type(var_entry_t), pointer :: next => null ()
type(var_entry_t), pointer :: previous => null ()
type(string_t) :: description
end type var_entry_t
@ %def var_entry_t
@
\subsubsection{Interfaces for the observable functions}
<<Variables: public>>=
public :: obs_unary_int
public :: obs_unary_real
public :: obs_binary_int
public :: obs_binary_real
public :: obs_sev_int
public :: obs_sev_real
<<Variables: interfaces>>=
abstract interface
function obs_unary_int (prt1) result (ival)
import
integer :: ival
type(prt_t), intent(in) :: prt1
end function obs_unary_int
end interface
abstract interface
function obs_unary_real (prt1) result (rval)
import
real(default) :: rval
type(prt_t), intent(in) :: prt1
end function obs_unary_real
end interface
abstract interface
function obs_binary_int (prt1, prt2) result (ival)
import
integer :: ival
type(prt_t), intent(in) :: prt1, prt2
end function obs_binary_int
end interface
abstract interface
function obs_binary_real (prt1, prt2) result (rval)
import
real(default) :: rval
type(prt_t), intent(in) :: prt1, prt2
end function obs_binary_real
end interface
abstract interface
function obs_sev_int (sev) result (ival)
import
integer :: ival
type(subevt_t), intent(in) :: sev
end function obs_sev_int
end interface
abstract interface
function obs_sev_real (sev) result (rval)
import
real(default) :: rval
type(subevt_t), intent(in) :: sev
end function obs_sev_real
end interface
@ %def obs_unary_int obs_unary_real
@ %def obs_binary_int obs_binary_real
@ %def obs_sev_int obs_sev_real
@
\subsubsection{Initialization}
Initialize an entry, optionally with a physical value. We also
allocate the [[is_known]] flag and set it if the value is set.
<<Variables: procedures>>=
subroutine var_entry_init_log (var, name, lval, intrinsic, user)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: intrinsic, user
var%name = name
var%type = V_LOG
allocate (var%lval, var%is_known)
if (present (lval)) then
var%lval = lval
var%is_defined = .true.
var%is_known = .true.
else
var%is_known = .false.
end if
if (present (intrinsic)) var%is_intrinsic = intrinsic
if (present (user)) var%is_user_var = user
var%is_allocated = .true.
end subroutine var_entry_init_log
subroutine var_entry_init_int (var, name, ival, intrinsic, user)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: intrinsic, user
var%name = name
var%type = V_INT
allocate (var%ival, var%is_known)
if (present (ival)) then
var%ival = ival
var%is_defined = .true.
var%is_known = .true.
else
var%is_known = .false.
end if
if (present (intrinsic)) var%is_intrinsic = intrinsic
if (present (user)) var%is_user_var = user
var%is_allocated = .true.
end subroutine var_entry_init_int
subroutine var_entry_init_real (var, name, rval, intrinsic, user)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: intrinsic, user
var%name = name
var%type = V_REAL
allocate (var%rval, var%is_known)
if (present (rval)) then
var%rval = rval
var%is_defined = .true.
var%is_known = .true.
else
var%is_known = .false.
end if
if (present (intrinsic)) var%is_intrinsic = intrinsic
if (present (user)) var%is_user_var = user
var%is_allocated = .true.
end subroutine var_entry_init_real
subroutine var_entry_init_cmplx (var, name, cval, intrinsic, user)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: intrinsic, user
var%name = name
var%type = V_CMPLX
allocate (var%cval, var%is_known)
if (present (cval)) then
var%cval = cval
var%is_defined = .true.
var%is_known = .true.
else
var%is_known = .false.
end if
if (present (intrinsic)) var%is_intrinsic = intrinsic
if (present (user)) var%is_user_var = user
var%is_allocated = .true.
end subroutine var_entry_init_cmplx
subroutine var_entry_init_subevt (var, name, pval, intrinsic, user)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in), optional :: intrinsic, user
var%name = name
var%type = V_SEV
allocate (var%pval, var%is_known)
if (present (pval)) then
var%pval = pval
var%is_defined = .true.
var%is_known = .true.
else
var%is_known = .false.
end if
if (present (intrinsic)) var%is_intrinsic = intrinsic
if (present (user)) var%is_user_var = user
var%is_allocated = .true.
end subroutine var_entry_init_subevt
subroutine var_entry_init_pdg_array (var, name, aval, intrinsic, user)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: intrinsic, user
var%name = name
var%type = V_PDG
allocate (var%aval, var%is_known)
if (present (aval)) then
var%aval = aval
var%is_defined = .true.
var%is_known = .true.
else
var%is_known = .false.
end if
if (present (intrinsic)) var%is_intrinsic = intrinsic
if (present (user)) var%is_user_var = user
var%is_allocated = .true.
end subroutine var_entry_init_pdg_array
subroutine var_entry_init_string (var, name, sval, intrinsic, user)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: sval
logical, intent(in), optional :: intrinsic, user
var%name = name
var%type = V_STR
allocate (var%sval, var%is_known)
if (present (sval)) then
var%sval = sval
var%is_defined = .true.
var%is_known = .true.
else
var%is_known = .false.
end if
if (present (intrinsic)) var%is_intrinsic = intrinsic
if (present (user)) var%is_user_var = user
var%is_allocated = .true.
end subroutine var_entry_init_string
@ %def var_entry_init_log
@ %def var_entry_init_int
@ %def var_entry_init_real
@ %def var_entry_init_cmplx
@ %def var_entry_init_subevt
@ %def var_entry_init_pdg_array
@ %def var_entry_init_string
@ Initialize an entry with a pointer to the value and, for numeric/logical
values, a pointer to the [[is_known]] flag.
<<Variables: procedures>>=
subroutine var_entry_init_log_ptr (var, name, lval, is_known, intrinsic)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
logical, intent(in), target :: lval
logical, intent(in), target :: is_known
logical, intent(in), optional :: intrinsic
var%name = name
var%type = V_LOG
var%lval => lval
var%is_known => is_known
if (present (intrinsic)) var%is_intrinsic = intrinsic
var%is_defined = .true.
end subroutine var_entry_init_log_ptr
subroutine var_entry_init_int_ptr (var, name, ival, is_known, intrinsic)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
integer, intent(in), target :: ival
logical, intent(in), target :: is_known
logical, intent(in), optional :: intrinsic
var%name = name
var%type = V_INT
var%ival => ival
var%is_known => is_known
if (present (intrinsic)) var%is_intrinsic = intrinsic
var%is_defined = .true.
end subroutine var_entry_init_int_ptr
subroutine var_entry_init_real_ptr (var, name, rval, is_known, intrinsic)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
real(default), intent(in), target :: rval
logical, intent(in), target :: is_known
logical, intent(in), optional :: intrinsic
var%name = name
var%type = V_REAL
var%rval => rval
var%is_known => is_known
if (present (intrinsic)) var%is_intrinsic = intrinsic
var%is_defined = .true.
end subroutine var_entry_init_real_ptr
subroutine var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
complex(default), intent(in), target :: cval
logical, intent(in), target :: is_known
logical, intent(in), optional :: intrinsic
var%name = name
var%type = V_CMPLX
var%cval => cval
var%is_known => is_known
if (present (intrinsic)) var%is_intrinsic = intrinsic
var%is_defined = .true.
end subroutine var_entry_init_cmplx_ptr
subroutine var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), target :: aval
logical, intent(in), target :: is_known
logical, intent(in), optional :: intrinsic
var%name = name
var%type = V_PDG
var%aval => aval
var%is_known => is_known
if (present (intrinsic)) var%is_intrinsic = intrinsic
var%is_defined = .true.
end subroutine var_entry_init_pdg_array_ptr
subroutine var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
type(subevt_t), intent(in), target :: pval
logical, intent(in), target :: is_known
logical, intent(in), optional :: intrinsic
var%name = name
var%type = V_SEV
var%pval => pval
var%is_known => is_known
if (present (intrinsic)) var%is_intrinsic = intrinsic
var%is_defined = .true.
end subroutine var_entry_init_subevt_ptr
subroutine var_entry_init_string_ptr (var, name, sval, is_known, intrinsic)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
type(string_t), intent(in), target :: sval
logical, intent(in), target :: is_known
logical, intent(in), optional :: intrinsic
var%name = name
var%type = V_STR
var%sval => sval
var%is_known => is_known
if (present (intrinsic)) var%is_intrinsic = intrinsic
var%is_defined = .true.
end subroutine var_entry_init_string_ptr
@ %def var_entry_init_log_ptr
@ %def var_entry_init_int_ptr
@ %def var_entry_init_real_ptr
@ %def var_entry_init_cmplx_ptr
@ %def var_entry_init_pdg_array_ptr
@ %def var_entry_init_subevt_ptr
@ %def var_entry_init_string_ptr
@ Initialize an entry with an observable. The procedure pointer is
not yet set.
<<Variables: procedures>>=
subroutine var_entry_init_obs (var, name, type, prt1, prt2)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
integer, intent(in) :: type
type(prt_t), intent(in), target :: prt1
type(prt_t), intent(in), optional, target :: prt2
var%type = type
var%name = name
var%prt1 => prt1
if (present (prt2)) var%prt2 => prt2
var%is_intrinsic = .true.
var%is_defined = .true.
end subroutine var_entry_init_obs
subroutine var_entry_init_obs_sev (var, name, type, pval)
type(var_entry_t), intent(out) :: var
type(string_t), intent(in) :: name
integer, intent(in) :: type
type(subevt_t), intent(in), target :: pval
var%type = type
var%name = name
var%pval => pval
var%is_intrinsic = .true.
var%is_defined = .true.
end subroutine var_entry_init_obs_sev
@ %def var_entry_init_obs var_entry_init_obs_sev
@ Mark an entry as undefined it it is a user-defined variable object, so force
re-initialization.
<<Variables: procedures>>=
subroutine var_entry_undefine (var)
type(var_entry_t), intent(inout) :: var
var%is_defined = .not. var%is_user_var
var%is_known = var%is_defined .and. var%is_known
end subroutine var_entry_undefine
@ %def var_entry_undefine
@ Clear an entry: mark it as unknown.
<<Variables: procedures>>=
subroutine var_entry_clear (var)
type(var_entry_t), intent(inout) :: var
var%is_known = .false.
end subroutine var_entry_clear
@ %def var_entry_clear
@ Lock an entry: forbid resetting the entry after initialization.
<<Variables: procedures>>=
subroutine var_entry_lock (var, locked)
type(var_entry_t), intent(inout) :: var
logical, intent(in), optional :: locked
if (present (locked)) then
var%is_locked = locked
else
var%is_locked = .true.
end if
end subroutine var_entry_lock
@ %def var_entry_lock
@
\subsubsection{Finalizer}
<<Variables: procedures>>=
subroutine var_entry_final (var)
type(var_entry_t), intent(inout) :: var
if (var%is_allocated) then
select case (var%type)
case (V_LOG); deallocate (var%lval)
case (V_INT); deallocate (var%ival)
case (V_REAL);deallocate (var%rval)
case (V_CMPLX);deallocate (var%cval)
case (V_SEV); deallocate (var%pval)
case (V_PDG); deallocate (var%aval)
case (V_STR); deallocate (var%sval)
end select
deallocate (var%is_known)
var%is_allocated = .false.
var%is_defined = .false.
end if
end subroutine var_entry_final
@ %def var_entry_final
@
\subsubsection{Output}
<<Variables: procedures>>=
recursive subroutine var_entry_write (var, unit, model_name, &
intrinsic, pacified, descriptions, ascii_output)
type(var_entry_t), intent(in) :: var
integer, intent(in), optional :: unit
type(string_t), intent(in), optional :: model_name
logical, intent(in), optional :: intrinsic
logical, intent(in), optional :: pacified
logical, intent(in), optional :: descriptions
logical, intent(in), optional :: ascii_output
type(string_t) :: col_string
logical :: show_desc, ao
integer :: u
u = given_output_unit (unit); if (u < 0) return
show_desc = .false.; if (present (descriptions)) show_desc = descriptions
ao = .false.; if (present (ascii_output)) ao = ascii_output
if (show_desc) then
if (ao) then
col_string = create_col_string (COL_BLUE)
if (var%is_locked) then
write (u, "(A)", advance="no") char (achar(27) // col_string) // &
char (var%name) // achar(27) // "[0m" //" fixed-value="
else
write (u, "(A)", advance="no") char (achar(27) // col_string) // &
char (var%name) // achar(27) // "[0m" //" default="
end if
col_string = create_col_string (COL_RED)
write (u, "(A)", advance="no") char (achar(27) // col_string)
call var_write_val (var, u, "no", pacified=.true.)
write (u, "(A)") achar(27) // "[0m"
write (u, "(A)") char (var%description)
return
else
write (u, "(A)") "\item"
write (u, "(A)", advance="no") "\ttt{" // char ( &
replace (replace (var%name, "_", "\_", every=.true.), "$", "\$" )) // &
"} "
if (var%is_known) then
if (var%is_locked) then
write (u, "(A)", advance="no") "\qquad (fixed value: \ttt{"
else
write (u, "(A)", advance="no") "\qquad (default: \ttt{"
end if
call var_write_val (var, u, "no", pacified=.true., escape_tex=.true.)
write (u, "(A)", advance="no") "})"
end if
write (u, "(A)") " \newline"
write (u, "(A)") char (var%description)
write (u, "(A)") "%%%%%"
return
end if
end if
if (present (intrinsic)) then
if (var%is_intrinsic .neqv. intrinsic) return
end if
if (.not. var%is_defined) then
write (u, "(A,1x)", advance="no") "[undefined]"
end if
if (.not. var%is_intrinsic) then
write (u, "(A,1x)", advance="no") "[user variable]"
end if
if (present (model_name)) then
write (u, "(A,A)", advance="no") char(model_name), "."
end if
write (u, "(A)", advance="no") char (var%name)
if (var%is_locked) write (u, "(A)", advance="no") "*"
if (var%is_allocated) then
write (u, "(A)", advance="no") " = "
else if (var%type /= V_NONE) then
write (u, "(A)", advance="no") " => "
end if
call var_write_val (var, u, "yes", pacified)
end subroutine var_entry_write
@ %def var_entry_write
@
<<Variables: procedures>>=
subroutine var_write_val (var, u, advance, pacified, escape_tex)
type(var_entry_t), intent(in) :: var
integer, intent(in) :: u
character(*), intent(in) :: advance
logical, intent(in), optional :: pacified, escape_tex
logical :: num_pac, et
real(default) :: rval
complex(default) :: cval
character(len=7) :: fmt
call pac_fmt (fmt, FMT_19, FMT_12, pacified)
num_pac = .false.; if (present (pacified)) num_pac = pacified
et = .false.; if (present (escape_tex)) et = escape_tex
select case (var%type)
case (V_NONE); write (u, '()', advance=advance)
case (V_LOG)
if (var%is_known) then
if (var%lval) then
write (u, "(A)", advance=advance) "true"
else
write (u, "(A)", advance=advance) "false"
end if
else
write (u, "(A)", advance=advance) "[unknown logical]"
end if
case (V_INT)
if (var%is_known) then
write (u, "(I0)", advance=advance) var%ival
else
write (u, "(A)", advance=advance) "[unknown integer]"
end if
case (V_REAL)
if (var%is_known) then
rval = var%rval
if (num_pac) then
call pacify (rval, 10 * eps0)
end if
write (u, "(" // fmt // ")", advance=advance) rval
else
write (u, "(A)", advance=advance) "[unknown real]"
end if
case (V_CMPLX)
if (var%is_known) then
cval = var%cval
if (num_pac) then
call pacify (cval, 10 * eps0)
end if
write (u, "('('," // fmt // ",','," // fmt // ",')')", advance=advance) cval
else
write (u, "(A)", advance=advance) "[unknown complex]"
end if
case (V_SEV)
if (var%is_known) then
call var%pval%write (u, prefix=" ", pacified = pacified)
else
write (u, "(A)", advance=advance) "[unknown subevent]"
end if
case (V_PDG)
if (var%is_known) then
call var%aval%write (u); write (u, *)
else
write (u, "(A)", advance=advance) "[unknown PDG array]"
end if
case (V_STR)
if (var%is_known) then
if (et) then
write (u, "(A)", advance=advance) '"' // char (replace ( &
replace (var%sval, "_", "\_", every=.true.), "$", "\$" )) // '"'
else
write (u, "(A)", advance=advance) '"' // char (var%sval) // '"'
end if
else
write (u, "(A)", advance=advance) "[unknown string]"
end if
case (V_OBS1_INT); write (u, "(A)", advance=advance) "[int] = unary observable"
case (V_OBS2_INT); write (u, "(A)", advance=advance) "[int] = binary observable"
case (V_OBSEV_INT); write (u, "(A)", advance=advance) "[int] = subeventary observable"
case (V_OBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary observable"
case (V_OBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary observable"
case (V_OBSEV_REAL); write (u, "(A)", advance=advance) "[real] = subeventary observable"
case (V_UOBS1_INT); write (u, "(A)", advance=advance) "[int] = unary user observable"
case (V_UOBS2_INT); write (u, "(A)", advance=advance) "[int] = binary user observable"
case (V_UOBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary user observable"
case (V_UOBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary user observable"
end select
end subroutine var_write_val
@ %def procedure
@
\subsubsection{Accessing contents}
<<Variables: procedures>>=
function var_entry_get_name (var) result (name)
type(string_t) :: name
type(var_entry_t), intent(in) :: var
name = var%name
end function var_entry_get_name
function var_entry_get_type (var) result (type)
integer :: type
type(var_entry_t), intent(in) :: var
type = var%type
end function var_entry_get_type
@ %def var_entry_get_name var_entry_get_type
@ Return true if the variable is defined. This the case if it is allocated
and known, or if it is a pointer.
<<Variables: procedures>>=
function var_entry_is_defined (var) result (defined)
logical :: defined
type(var_entry_t), intent(in) :: var
defined = var%is_defined
end function var_entry_is_defined
@ %def var_entry_is_defined
@ Return true if the variable is locked. If [[force]] is active,
always return false.
<<Variables: procedures>>=
function var_entry_is_locked (var, force) result (locked)
logical :: locked
type(var_entry_t), intent(in) :: var
logical, intent(in), optional :: force
if (present (force)) then
if (force) then
locked = .false.; return
end if
end if
locked = var%is_locked
end function var_entry_is_locked
@ %def var_entry_is_locked
@ Return true if the variable is intrinsic
<<Variables: procedures>>=
function var_entry_is_intrinsic (var) result (flag)
logical :: flag
type(var_entry_t), intent(in) :: var
flag = var%is_intrinsic
end function var_entry_is_intrinsic
@ %def var_entry_is_intrinsic
@ Return components
<<Variables: procedures>>=
function var_entry_is_known (var) result (flag)
logical :: flag
type(var_entry_t), intent(in) :: var
flag = var%is_known
end function var_entry_is_known
function var_entry_get_lval (var) result (lval)
logical :: lval
type(var_entry_t), intent(in) :: var
lval = var%lval
end function var_entry_get_lval
function var_entry_get_ival (var) result (ival)
integer :: ival
type(var_entry_t), intent(in) :: var
ival = var%ival
end function var_entry_get_ival
function var_entry_get_rval (var) result (rval)
real(default) :: rval
type(var_entry_t), intent(in) :: var
rval = var%rval
end function var_entry_get_rval
function var_entry_get_cval (var) result (cval)
complex(default) :: cval
type(var_entry_t), intent(in) :: var
cval = var%cval
end function var_entry_get_cval
function var_entry_get_aval (var) result (aval)
type(pdg_array_t) :: aval
type(var_entry_t), intent(in) :: var
aval = var%aval
end function var_entry_get_aval
function var_entry_get_pval (var) result (pval)
type(subevt_t) :: pval
type(var_entry_t), intent(in) :: var
pval = var%pval
end function var_entry_get_pval
function var_entry_get_sval (var) result (sval)
type(string_t) :: sval
type(var_entry_t), intent(in) :: var
sval = var%sval
end function var_entry_get_sval
@ %def var_entry_get_lval
@ %def var_entry_get_ival
@ %def var_entry_get_rval
@ %def var_entry_get_cval
@ %def var_entry_get_aval
@ %def var_entry_get_pval
@ %def var_entry_get_sval
@ Return pointers to components.
<<Variables: procedures>>=
function var_entry_get_known_ptr (var) result (ptr)
logical, pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%is_known
end function var_entry_get_known_ptr
function var_entry_get_lval_ptr (var) result (ptr)
logical, pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%lval
end function var_entry_get_lval_ptr
function var_entry_get_ival_ptr (var) result (ptr)
integer, pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%ival
end function var_entry_get_ival_ptr
function var_entry_get_rval_ptr (var) result (ptr)
real(default), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%rval
end function var_entry_get_rval_ptr
function var_entry_get_cval_ptr (var) result (ptr)
complex(default), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%cval
end function var_entry_get_cval_ptr
function var_entry_get_pval_ptr (var) result (ptr)
type(subevt_t), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%pval
end function var_entry_get_pval_ptr
function var_entry_get_aval_ptr (var) result (ptr)
type(pdg_array_t), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%aval
end function var_entry_get_aval_ptr
function var_entry_get_sval_ptr (var) result (ptr)
type(string_t), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%sval
end function var_entry_get_sval_ptr
@ %def var_entry_get_known_ptr
@ %def var_entry_get_lval_ptr var_entry_get_ival_ptr var_entry_get_rval_ptr
@ %def var_entry_get_cval_ptr var_entry_get_aval_ptr var_entry_get_pval_ptr
@ %def var_entry_get_sval_ptr
@ Furthermore,
<<Variables: procedures>>=
function var_entry_get_prt1_ptr (var) result (ptr)
type(prt_t), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%prt1
end function var_entry_get_prt1_ptr
function var_entry_get_prt2_ptr (var) result (ptr)
type(prt_t), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%prt2
end function var_entry_get_prt2_ptr
@ %def var_entry_get_prt1_ptr
@ %def var_entry_get_prt2_ptr
@ Subroutines might be safer than functions for procedure pointer transfer.
<<Variables: procedures>>=
subroutine var_entry_assign_obs1_int_ptr (ptr, var)
procedure(obs_unary_int), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%obs1_int
end subroutine var_entry_assign_obs1_int_ptr
subroutine var_entry_assign_obs1_real_ptr (ptr, var)
procedure(obs_unary_real), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%obs1_real
end subroutine var_entry_assign_obs1_real_ptr
subroutine var_entry_assign_obs2_int_ptr (ptr, var)
procedure(obs_binary_int), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%obs2_int
end subroutine var_entry_assign_obs2_int_ptr
subroutine var_entry_assign_obs2_real_ptr (ptr, var)
procedure(obs_binary_real), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%obs2_real
end subroutine var_entry_assign_obs2_real_ptr
subroutine var_entry_assign_obsev_int_ptr (ptr, var)
procedure(obs_sev_int), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%obsev_int
end subroutine var_entry_assign_obsev_int_ptr
subroutine var_entry_assign_obsev_real_ptr (ptr, var)
procedure(obs_sev_real), pointer :: ptr
type(var_entry_t), intent(in), target :: var
ptr => var%obsev_real
end subroutine var_entry_assign_obsev_real_ptr
@ %def var_entry_assign_obs1_int_ptr var_entry_assign_obs1_real_ptr
@ %def var_entry_assign_obs2_int_ptr var_entry_assign_obs2_real_ptr
@ %def var_entry_assigbn_obsev_int_ptr var_entry_assign_obsev_real_ptr
@
\subsection{Setting values}
Undefine the value.
<<Variables: procedures>>=
subroutine var_entry_clear_value (var)
type(var_entry_t), intent(inout) :: var
var%is_known = .false.
end subroutine var_entry_clear_value
@ %def var_entry_clear_value
<<Variables: procedures>>=
recursive subroutine var_entry_set_log &
(var, lval, is_known, verbose, model_name)
type(var_entry_t), intent(inout) :: var
logical, intent(in) :: lval
logical, intent(in) :: is_known
logical, intent(in), optional :: verbose
type(string_t), intent(in), optional :: model_name
integer :: u
u = logfile_unit ()
var%lval = lval
var%is_known = is_known
var%is_defined = .true.
if (present (verbose)) then
if (verbose) then
call var_entry_write (var, model_name=model_name)
call var_entry_write (var, model_name=model_name, unit=u)
if (u >= 0) flush (u)
end if
end if
end subroutine var_entry_set_log
recursive subroutine var_entry_set_int &
(var, ival, is_known, verbose, model_name)
type(var_entry_t), intent(inout) :: var
integer, intent(in) :: ival
logical, intent(in) :: is_known
logical, intent(in), optional :: verbose
type(string_t), intent(in), optional :: model_name
integer :: u
u = logfile_unit ()
var%ival = ival
var%is_known = is_known
var%is_defined = .true.
if (present (verbose)) then
if (verbose) then
call var_entry_write (var, model_name=model_name)
call var_entry_write (var, model_name=model_name, unit=u)
if (u >= 0) flush (u)
end if
end if
end subroutine var_entry_set_int
recursive subroutine var_entry_set_real &
(var, rval, is_known, verbose, model_name, pacified)
type(var_entry_t), intent(inout) :: var
real(default), intent(in) :: rval
logical, intent(in) :: is_known
logical, intent(in), optional :: verbose, pacified
type(string_t), intent(in), optional :: model_name
integer :: u
u = logfile_unit ()
var%rval = rval
var%is_known = is_known
var%is_defined = .true.
if (present (verbose)) then
if (verbose) then
call var_entry_write &
(var, model_name=model_name, pacified = pacified)
call var_entry_write &
(var, model_name=model_name, unit=u, pacified = pacified)
if (u >= 0) flush (u)
end if
end if
end subroutine var_entry_set_real
recursive subroutine var_entry_set_cmplx &
(var, cval, is_known, verbose, model_name, pacified)
type(var_entry_t), intent(inout) :: var
complex(default), intent(in) :: cval
logical, intent(in) :: is_known
logical, intent(in), optional :: verbose, pacified
type(string_t), intent(in), optional :: model_name
integer :: u
u = logfile_unit ()
var%cval = cval
var%is_known = is_known
var%is_defined = .true.
if (present (verbose)) then
if (verbose) then
call var_entry_write &
(var, model_name=model_name, pacified = pacified)
call var_entry_write &
(var, model_name=model_name, unit=u, pacified = pacified)
if (u >= 0) flush (u)
end if
end if
end subroutine var_entry_set_cmplx
recursive subroutine var_entry_set_pdg_array &
(var, aval, is_known, verbose, model_name)
type(var_entry_t), intent(inout) :: var
type(pdg_array_t), intent(in) :: aval
logical, intent(in) :: is_known
logical, intent(in), optional :: verbose
type(string_t), intent(in), optional :: model_name
integer :: u
u = logfile_unit ()
var%aval = aval
var%is_known = is_known
var%is_defined = .true.
if (present (verbose)) then
if (verbose) then
call var_entry_write (var, model_name=model_name)
call var_entry_write (var, model_name=model_name, unit=u)
if (u >= 0) flush (u)
end if
end if
end subroutine var_entry_set_pdg_array
recursive subroutine var_entry_set_subevt &
(var, pval, is_known, verbose, model_name)
type(var_entry_t), intent(inout) :: var
type(subevt_t), intent(in) :: pval
logical, intent(in) :: is_known
logical, intent(in), optional :: verbose
type(string_t), intent(in), optional :: model_name
integer :: u
u = logfile_unit ()
var%pval = pval
var%is_known = is_known
var%is_defined = .true.
if (present (verbose)) then
if (verbose) then
call var_entry_write (var, model_name=model_name)
call var_entry_write (var, model_name=model_name, unit=u)
if (u >= 0) flush (u)
end if
end if
end subroutine var_entry_set_subevt
recursive subroutine var_entry_set_string &
(var, sval, is_known, verbose, model_name)
type(var_entry_t), intent(inout) :: var
type(string_t), intent(in) :: sval
logical, intent(in) :: is_known
logical, intent(in), optional :: verbose
type(string_t), intent(in), optional :: model_name
integer :: u
u = logfile_unit ()
var%sval = sval
var%is_known = is_known
var%is_defined = .true.
if (present (verbose)) then
if (verbose) then
call var_entry_write (var, model_name=model_name)
call var_entry_write (var, model_name=model_name, unit=u)
if (u >= 0) flush (u)
end if
end if
end subroutine var_entry_set_string
@ %def var_entry_set_log
@ %def var_entry_set_int
@ %def var_entry_set_real
@ %def var_entry_set_cmplx
@ %def var_entry_set_pdg_array
@ %def var_entry_set_subevt
@ %def var_entry_set_string
@
<<Variables: procedures>>=
pure subroutine var_entry_set_description (var_entry, description)
type(var_entry_t), intent(inout) :: var_entry
type(string_t), intent(in) :: description
var_entry%description = description
end subroutine var_entry_set_description
@ %def var_entry_set_description
@
\subsection{Copies and pointer variables}
Initialize an entry with a copy of an existing variable entry. The
copy is physically allocated with the same type as the original.
<<Variables: procedures>>=
subroutine var_entry_init_copy (var, original, user)
type(var_entry_t), intent(out) :: var
type(var_entry_t), intent(in), target :: original
logical, intent(in), optional :: user
type(string_t) :: name
logical :: intrinsic
name = var_entry_get_name (original)
intrinsic = original%is_intrinsic
select case (original%type)
case (V_LOG)
call var_entry_init_log (var, name, intrinsic=intrinsic, user=user)
case (V_INT)
call var_entry_init_int (var, name, intrinsic=intrinsic, user=user)
case (V_REAL)
call var_entry_init_real (var, name, intrinsic=intrinsic, user=user)
case (V_CMPLX)
call var_entry_init_cmplx (var, name, intrinsic=intrinsic, user=user)
case (V_SEV)
call var_entry_init_subevt (var, name, intrinsic=intrinsic, user=user)
case (V_PDG)
call var_entry_init_pdg_array (var, name, intrinsic=intrinsic, user=user)
case (V_STR)
call var_entry_init_string (var, name, intrinsic=intrinsic, user=user)
end select
end subroutine var_entry_init_copy
@ %def var_entry_init_copy
@ Copy the value of an entry. The target variable entry must be initialized
correctly.
<<Variables: procedures>>=
subroutine var_entry_copy_value (var, original)
type(var_entry_t), intent(inout) :: var
type(var_entry_t), intent(in), target :: original
if (var_entry_is_known (original)) then
select case (original%type)
case (V_LOG)
call var_entry_set_log (var, var_entry_get_lval (original), .true.)
case (V_INT)
call var_entry_set_int (var, var_entry_get_ival (original), .true.)
case (V_REAL)
call var_entry_set_real (var, var_entry_get_rval (original), .true.)
case (V_CMPLX)
call var_entry_set_cmplx (var, var_entry_get_cval (original), .true.)
case (V_SEV)
call var_entry_set_subevt (var, var_entry_get_pval (original), .true.)
case (V_PDG)
call var_entry_set_pdg_array (var, var_entry_get_aval (original), .true.)
case (V_STR)
call var_entry_set_string (var, var_entry_get_sval (original), .true.)
end select
else
call var_entry_clear (var)
end if
end subroutine var_entry_copy_value
@ %def var_entry_copy_value
@
\subsection{Variable lists}
\subsubsection{The type}
Variable lists can be linked together. No initializer needed.
They are deleted separately.
<<Variables: public>>=
public :: var_list_t
<<Variables: types>>=
type, extends (vars_t) :: var_list_t
private
type(var_entry_t), pointer :: first => null ()
type(var_entry_t), pointer :: last => null ()
type(var_list_t), pointer :: next => null ()
contains
<<Variables: var list: TBP>>
end type var_list_t
@ %def var_list_t
@
\subsubsection{Constructors}
Implementation of the [[link]] deferred method. The implementation
restricts itself to var lists of the same type. We might need to
relax this constraint.
<<Variables: var list: TBP>>=
procedure :: link => var_list_link
<<Variables: sub interfaces>>=
module subroutine var_list_link (vars, target_vars)
class(var_list_t), intent(inout) :: vars
class(vars_t), intent(in), target :: target_vars
end subroutine var_list_link
<<Variables: procedures>>=
module subroutine var_list_link (vars, target_vars)
class(var_list_t), intent(inout) :: vars
class(vars_t), intent(in), target :: target_vars
select type (target_vars)
type is (var_list_t)
vars%next => target_vars
class default
call msg_bug ("var_list_link: unsupported target type")
end select
end subroutine var_list_link
@ %def var_list_link
@ Append a new entry to an existing list.
<<Variables: procedures>>=
subroutine var_list_append (var_list, var, verbose)
type(var_list_t), intent(inout), target :: var_list
type(var_entry_t), intent(inout), target :: var
logical, intent(in), optional :: verbose
if (associated (var_list%last)) then
var%previous => var_list%last
var_list%last%next => var
else
var%previous => null ()
var_list%first => var
end if
var_list%last => var
if (present (verbose)) then
if (verbose) call var_entry_write (var)
end if
end subroutine var_list_append
@ %def var_list_append
@ Sort a list.
<<Variables: var list: TBP>>=
procedure :: sort => var_list_sort
<<Variables: sub interfaces>>=
module subroutine var_list_sort (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_sort
<<Variables: procedures>>=
module subroutine var_list_sort (var_list)
class(var_list_t), intent(inout) :: var_list
type(var_entry_t), pointer :: var, previous
if (associated (var_list%first)) then
var => var_list%first
do while (associated (var))
previous => var%previous
do while (associated (previous))
if (larger_var (previous, var)) then
call var_list%swap_with_next (previous)
end if
previous => previous%previous
end do
var => var%next
end do
end if
end subroutine var_list_sort
@ %def var_list_sort
@
<<Variables: procedures>>=
pure function larger_var (var1, var2) result (larger)
logical :: larger
type(var_entry_t), intent(in) :: var1, var2
type(string_t) :: str1, str2
str1 = replace (var1%name, "?", "")
str1 = replace (str1, "$", "")
str2 = replace (var2%name, "?", "")
str2 = replace (str2, "$", "")
larger = str1 > str2
end function larger_var
@ %def larger_var
@
<<Variables: var list: TBP>>=
procedure :: get_previous => var_list_get_previous
<<Variables: sub interfaces>>=
module function var_list_get_previous &
(var_list, var_entry) result (previous)
type(var_entry_t), pointer :: previous
class(var_list_t), intent(in) :: var_list
type(var_entry_t), intent(in) :: var_entry
end function var_list_get_previous
<<Variables: procedures>>=
module function var_list_get_previous &
(var_list, var_entry) result (previous)
type(var_entry_t), pointer :: previous
class(var_list_t), intent(in) :: var_list
type(var_entry_t), intent(in) :: var_entry
previous => var_list%first
if (previous%name == var_entry%name) then
previous => null ()
else
do while (associated (previous))
if (previous%next%name == var_entry%name) exit
previous => previous%next
end do
end if
end function var_list_get_previous
@ %def var_list_get_previous
@
<<Variables: var list: TBP>>=
procedure :: swap_with_next => var_list_swap_with_next
<<Variables: sub interfaces>>=
module subroutine var_list_swap_with_next (var_list, var_entry)
class(var_list_t), intent(inout) :: var_list
type(var_entry_t), intent(in) :: var_entry
end subroutine var_list_swap_with_next
<<Variables: procedures>>=
module subroutine var_list_swap_with_next (var_list, var_entry)
class(var_list_t), intent(inout) :: var_list
type(var_entry_t), intent(in) :: var_entry
type(var_entry_t), pointer :: previous, this, next, next_next
previous => var_list%get_previous (var_entry)
if (.not. associated (previous)) then
this => var_list%first
else
this => previous%next
end if
next => this%next
next_next => next%next
if (associated (previous)) then
previous%next => next
next%previous => previous
else
var_list%first => next
next%previous => null ()
end if
this%next => next_next
if (associated (next_next)) then
next_next%previous => this
end if
next%next => this
this%previous => next
if (.not. associated (next%next)) then
var_list%last => next
end if
end subroutine var_list_swap_with_next
@ %def var_list_swap_with_next
@ Public methods for expanding the variable list (as subroutines)
<<Variables: var list: TBP>>=
generic :: append_log => var_list_append_log_s, var_list_append_log_c
procedure, private :: var_list_append_log_s
procedure, private :: var_list_append_log_c
generic :: append_int => var_list_append_int_s, var_list_append_int_c
procedure, private :: var_list_append_int_s
procedure, private :: var_list_append_int_c
generic :: append_real => var_list_append_real_s, var_list_append_real_c
procedure, private :: var_list_append_real_s
procedure, private :: var_list_append_real_c
generic :: append_cmplx => var_list_append_cmplx_s, var_list_append_cmplx_c
procedure, private :: var_list_append_cmplx_s
procedure, private :: var_list_append_cmplx_c
generic :: append_subevt => var_list_append_subevt_s, var_list_append_subevt_c
procedure, private :: var_list_append_subevt_s
procedure, private :: var_list_append_subevt_c
generic :: append_pdg_array => var_list_append_pdg_array_s, var_list_append_pdg_array_c
procedure, private :: var_list_append_pdg_array_s
procedure, private :: var_list_append_pdg_array_c
generic :: append_string => var_list_append_string_s, var_list_append_string_c
procedure, private :: var_list_append_string_s
procedure, private :: var_list_append_string_c
<<Variables: interfaces>>=
interface var_list_append_log
module procedure var_list_append_log_s
module procedure var_list_append_log_c
end interface
interface var_list_append_int
module procedure var_list_append_int_s
module procedure var_list_append_int_c
end interface
interface var_list_append_real
module procedure var_list_append_real_s
module procedure var_list_append_real_c
end interface
interface var_list_append_cmplx
module procedure var_list_append_cmplx_s
module procedure var_list_append_cmplx_c
end interface
interface var_list_append_subevt
module procedure var_list_append_subevt_s
module procedure var_list_append_subevt_c
end interface
interface var_list_append_pdg_array
module procedure var_list_append_pdg_array_s
module procedure var_list_append_pdg_array_c
end interface
interface var_list_append_string
module procedure var_list_append_string_s
module procedure var_list_append_string_c
end interface
<<Variables: sub interfaces>>=
module subroutine var_list_append_log_s &
(var_list, name, lval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_log_s
module subroutine var_list_append_int_s &
(var_list, name, ival, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_int_s
module subroutine var_list_append_real_s &
(var_list, name, rval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_real_s
module subroutine var_list_append_cmplx_s &
(var_list, name, cval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_cmplx_s
module subroutine var_list_append_subevt_s &
(var_list, name, pval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_subevt_s
module subroutine var_list_append_pdg_array_s &
(var_list, name, aval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_pdg_array_s
module subroutine var_list_append_string_s &
(var_list, name, sval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: sval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_string_s
module subroutine var_list_append_log_c &
(var_list, name, lval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_log_c
module subroutine var_list_append_int_c &
(var_list, name, ival, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_int_c
module subroutine var_list_append_real_c &
(var_list, name, rval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_real_c
module subroutine var_list_append_cmplx_c &
(var_list, name, cval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_cmplx_c
module subroutine var_list_append_subevt_c &
(var_list, name, pval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_subevt_c
module subroutine var_list_append_pdg_array_c &
(var_list, name, aval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_pdg_array_c
module subroutine var_list_append_string_c &
(var_list, name, sval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
character(*), intent(in), optional :: sval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
end subroutine var_list_append_string_c
<<Variables: procedures>>=
module subroutine var_list_append_log_s &
(var_list, name, lval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_log (var, name, lval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_log_s
module subroutine var_list_append_int_s &
(var_list, name, ival, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_int (var, name, ival, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_int_s
module subroutine var_list_append_real_s &
(var_list, name, rval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_real (var, name, rval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_real_s
module subroutine var_list_append_cmplx_s &
(var_list, name, cval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_cmplx (var, name, cval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_cmplx_s
module subroutine var_list_append_subevt_s &
(var_list, name, pval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_subevt (var, name, pval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_subevt_s
module subroutine var_list_append_pdg_array_s &
(var_list, name, aval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_pdg_array (var, name, aval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_pdg_array_s
module subroutine var_list_append_string_s &
(var_list, name, sval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: sval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_string (var, name, sval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_string_s
module subroutine var_list_append_log_c &
(var_list, name, lval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_log_s &
(var_list, var_str (name), lval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_log_c
module subroutine var_list_append_int_c &
(var_list, name, ival, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_int_s &
(var_list, var_str (name), ival, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_int_c
module subroutine var_list_append_real_c &
(var_list, name, rval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_real_s &
(var_list, var_str (name), rval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_real_c
module subroutine var_list_append_cmplx_c &
(var_list, name, cval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_cmplx_s &
(var_list, var_str (name), cval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_cmplx_c
module subroutine var_list_append_subevt_c &
(var_list, name, pval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_subevt_s &
(var_list, var_str (name), pval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_subevt_c
module subroutine var_list_append_pdg_array_c &
(var_list, name, aval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_pdg_array_s &
(var_list, var_str (name), aval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_pdg_array_c
module subroutine var_list_append_string_c &
(var_list, name, sval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
character(*), intent(in), optional :: sval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
if (present (sval)) then
call var_list_append_string_s &
(var_list, var_str (name), var_str (sval), &
locked, verbose, intrinsic, user, description)
else
call var_list_append_string_s &
(var_list, var_str (name), &
locked=locked, verbose=verbose, intrinsic=intrinsic, &
user=user, description=description)
end if
end subroutine var_list_append_string_c
@ %def var_list_append_log
@ %def var_list_append_int
@ %def var_list_append_real
@ %def var_list_append_cmplx
@ %def var_list_append_subevt
@ %def var_list_append_pdg_array
@ %def var_list_append_string
<<Variables: var list: TBP>>=
procedure :: append_log_ptr => var_list_append_log_ptr
procedure :: append_int_ptr => var_list_append_int_ptr
procedure :: append_real_ptr => var_list_append_real_ptr
procedure :: append_cmplx_ptr => var_list_append_cmplx_ptr
procedure :: append_pdg_array_ptr => var_list_append_pdg_array_ptr
procedure :: append_subevt_ptr => var_list_append_subevt_ptr
procedure :: append_string_ptr => var_list_append_string_ptr
<<Variables: sub interfaces>>=
module subroutine var_list_append_log_ptr &
(var_list, name, lval, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
logical, intent(in), target :: lval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
end subroutine var_list_append_log_ptr
module subroutine var_list_append_int_ptr &
(var_list, name, ival, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
integer, intent(in), target :: ival
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
end subroutine var_list_append_int_ptr
module subroutine var_list_append_real_ptr &
(var_list, name, rval, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
real(default), intent(in), target :: rval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
end subroutine var_list_append_real_ptr
module subroutine var_list_append_cmplx_ptr &
(var_list, name, cval, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in), target :: cval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
end subroutine var_list_append_cmplx_ptr
module subroutine var_list_append_pdg_array_ptr &
(var_list, name, aval, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), target :: aval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
end subroutine var_list_append_pdg_array_ptr
module subroutine var_list_append_subevt_ptr &
(var_list, name, pval, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in), target :: pval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
end subroutine var_list_append_subevt_ptr
module subroutine var_list_append_string_ptr &
(var_list, name, sval, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in), target :: sval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
end subroutine var_list_append_string_ptr
<<Variables: procedures>>=
module subroutine var_list_append_log_ptr &
(var_list, name, lval, is_known, locked, verbose, &
intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
logical, intent(in), target :: lval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_log_ptr (var, name, lval, is_known, intrinsic)
if (present (description)) &
call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_log_ptr
module subroutine var_list_append_int_ptr &
(var_list, name, ival, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
integer, intent(in), target :: ival
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_int_ptr (var, name, ival, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_int_ptr
module subroutine var_list_append_real_ptr &
(var_list, name, rval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
real(default), intent(in), target :: rval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_real_ptr (var, name, rval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_real_ptr
module subroutine var_list_append_cmplx_ptr &
(var_list, name, cval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in), target :: cval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_cmplx_ptr
module subroutine var_list_append_pdg_array_ptr &
(var_list, name, aval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), target :: aval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_pdg_array_ptr
module subroutine var_list_append_subevt_ptr &
(var_list, name, pval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in), target :: pval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_subevt_ptr
module subroutine var_list_append_string_ptr &
(var_list, name, sval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in), target :: sval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_string_ptr (var, name, sval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_string_ptr
@ %def var_list_append_log_ptr
@ %def var_list_append_int_ptr
@ %def var_list_append_real_ptr
@ %def var_list_append_cmplx_ptr
@ %def var_list_append_pdg_array_ptr
@ %def var_list_append_subevt_ptr
@
\subsubsection{Finalizer}
Finalize, delete the list entry by entry. The link itself is kept
intact. Follow link and delete recursively only if requested
explicitly.
<<Variables: var list: TBP>>=
procedure :: final => var_list_final
<<Variables: sub interfaces>>=
recursive module subroutine var_list_final (vars, follow_link)
class(var_list_t), intent(inout) :: vars
logical, intent(in), optional :: follow_link
end subroutine var_list_final
<<Variables: procedures>>=
recursive module subroutine var_list_final (vars, follow_link)
class(var_list_t), intent(inout) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
vars%last => null ()
do while (associated (vars%first))
var => vars%first
vars%first => var%next
call var_entry_final (var)
deallocate (var)
end do
if (present (follow_link)) then
if (follow_link) then
if (associated (vars%next)) then
call vars%next%final (follow_link)
deallocate (vars%next)
end if
end if
end if
end subroutine var_list_final
@ %def var_list_final
@
\subsubsection{Output}
Show variable list with precise control over options. E.g.,
show only variables of a certain type.
Many options, thus not an ordinary [[write]] method.
<<Variables: var list: TBP>>=
procedure :: write => var_list_write
<<Variables: sub interfaces>>=
recursive module subroutine var_list_write &
(var_list, unit, follow_link, only_type, prefix, model_name, &
intrinsic, pacified, descriptions, ascii_output)
class(var_list_t), intent(in), target :: var_list
integer, intent(in), optional :: unit
logical, intent(in), optional :: follow_link
integer, intent(in), optional :: only_type
character(*), intent(in), optional :: prefix
type(string_t), intent(in), optional :: model_name
logical, intent(in), optional :: intrinsic
logical, intent(in), optional :: pacified
logical, intent(in), optional :: descriptions
logical, intent(in), optional :: ascii_output
end subroutine var_list_write
<<Variables: procedures>>=
recursive module subroutine var_list_write &
(var_list, unit, follow_link, only_type, prefix, model_name, &
intrinsic, pacified, descriptions, ascii_output)
class(var_list_t), intent(in), target :: var_list
integer, intent(in), optional :: unit
logical, intent(in), optional :: follow_link
integer, intent(in), optional :: only_type
character(*), intent(in), optional :: prefix
type(string_t), intent(in), optional :: model_name
logical, intent(in), optional :: intrinsic
logical, intent(in), optional :: pacified
logical, intent(in), optional :: descriptions
logical, intent(in), optional :: ascii_output
type(var_entry_t), pointer :: var
integer :: u, length
logical :: write_this, write_next
u = given_output_unit (unit); if (u < 0) return
if (present (prefix)) length = len (prefix)
var => var_list%first
if (associated (var)) then
do while (associated (var))
if (present (only_type)) then
write_this = only_type == var%type
else
write_this = .true.
end if
if (write_this .and. present (prefix)) then
if (prefix /= extract (var%name, 1, length)) &
write_this = .false.
end if
if (write_this) then
call var_entry_write &
(var, unit, model_name=model_name, &
intrinsic=intrinsic, pacified=pacified, &
descriptions=descriptions, ascii_output=ascii_output)
end if
var => var%next
end do
end if
if (present (follow_link)) then
write_next = follow_link .and. associated (var_list%next)
else
write_next = associated (var_list%next)
end if
if (write_next) then
call var_list_write (var_list%next, &
unit, follow_link, only_type, prefix, model_name, &
intrinsic, pacified)
end if
end subroutine var_list_write
@ %def var_list_write
@ Write only a certain variable.
<<Variables: var list: TBP>>=
procedure :: write_var => var_list_write_var
<<Variables: sub interfaces>>=
recursive module subroutine var_list_write_var &
(var_list, name, unit, type, follow_link, &
model_name, pacified, defined, descriptions, ascii_output)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(in), optional :: unit
integer, intent(in), optional :: type
logical, intent(in), optional :: follow_link
type(string_t), intent(in), optional :: model_name
logical, intent(in), optional :: pacified
logical, intent(in), optional :: defined
logical, intent(in), optional :: descriptions
logical, intent(in), optional :: ascii_output
end subroutine var_list_write_var
<<Variables: procedures>>=
recursive module subroutine var_list_write_var &
(var_list, name, unit, type, follow_link, &
model_name, pacified, defined, descriptions, ascii_output)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(in), optional :: unit
integer, intent(in), optional :: type
logical, intent(in), optional :: follow_link
type(string_t), intent(in), optional :: model_name
logical, intent(in), optional :: pacified
logical, intent(in), optional :: defined
logical, intent(in), optional :: descriptions
logical, intent(in), optional :: ascii_output
type(var_entry_t), pointer :: var
integer :: u
u = given_output_unit (unit); if (u < 0) return
var => var_list_get_var_ptr &
(var_list, name, type, follow_link=follow_link, defined=defined)
if (associated (var)) then
call var_entry_write &
(var, unit, model_name = model_name, &
pacified = pacified, &
descriptions=descriptions, ascii_output=ascii_output)
else
write (u, "(A)") char (name) // " = [undefined]"
end if
end subroutine var_list_write_var
@ %def var_list_write_var
@
\subsection{Tools}
Return a pointer to the variable list linked to by the current one.
<<Variables: procedures>>=
function var_list_get_next_ptr (var_list) result (next_ptr)
type(var_list_t), pointer :: next_ptr
type(var_list_t), intent(in) :: var_list
next_ptr => var_list%next
end function var_list_get_next_ptr
@ %def var_list_get_next_ptr
@ Used by [[eval_trees]]:
Return a pointer to the variable with the requested name. If no such
name exists, return a null pointer. In that case, try the next list
if present, unless [[follow_link]] is unset. If [[defined]] is set, ignore
entries that exist but are undefined.
<<Variables: procedures>>=
recursive function var_list_get_var_ptr &
(var_list, name, type, follow_link, defined) result (var)
type(var_entry_t), pointer :: var
type(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(in), optional :: type
logical, intent(in), optional :: follow_link, defined
logical :: ignore_undef, search_next
ignore_undef = .true.; if (present (defined)) ignore_undef = .not. defined
var => var_list%first
if (present (type)) then
do while (associated (var))
if (var%type == type) then
if (var%name == name) then
if (ignore_undef .or. var%is_defined) return
end if
end if
var => var%next
end do
else
do while (associated (var))
if (var%name == name) then
if (ignore_undef .or. var%is_defined) return
end if
var => var%next
end do
end if
search_next = associated (var_list%next)
if (present (follow_link)) &
search_next = search_next .and. follow_link
if (search_next) &
var => var_list_get_var_ptr &
(var_list%next, name, type, defined=defined)
end function var_list_get_var_ptr
@ %def var_list_get_var_ptr
@ Return the variable type
<<Variables: var list: TBP>>=
procedure :: get_type => var_list_get_type
<<Variables: sub interfaces>>=
module function var_list_get_type &
(var_list, name, follow_link) result (type)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
logical, intent(in), optional :: follow_link
integer :: type
end function var_list_get_type
<<Variables: procedures>>=
module function var_list_get_type &
(var_list, name, follow_link) result (type)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
logical, intent(in), optional :: follow_link
integer :: type
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, follow_link=follow_link)
if (associated (var)) then
type = var%type
else
type = V_NONE
end if
end function var_list_get_type
@ %def var_list_get_type
@ Return true if the variable exists in the current list.
<<Variables: var list: TBP>>=
procedure :: contains => var_list_exists
<<Variables: sub interfaces>>=
module function var_list_exists (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_exists
<<Variables: procedures>>=
module function var_list_exists (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
lval = associated (var)
end function var_list_exists
@ %def var_list_exists
@ Return true if the variable is declared as intrinsic. (This is not a
property of the abstract [[vars_t]] type, and therefore the method is
not inherited.)
<<Variables: var list: TBP>>=
procedure :: is_intrinsic => var_list_is_intrinsic
<<Variables: sub interfaces>>=
module function var_list_is_intrinsic &
(vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_is_intrinsic
<<Variables: procedures>>=
module function var_list_is_intrinsic &
(vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
lval = var%is_intrinsic
else
lval = .false.
end if
end function var_list_is_intrinsic
@ %def var_list_is_intrinsic
@ Return true if the value is known.
<<Variables: var list: TBP>>=
procedure :: is_known => var_list_is_known
<<Variables: sub interfaces>>=
module function var_list_is_known (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_is_known
<<Variables: procedures>>=
module function var_list_is_known (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
lval = var%is_known
else
lval = .false.
end if
end function var_list_is_known
@ %def var_list_is_known
@ Return true if the value is locked. (This is not a
property of the abstract [[vars_t]] type, and therefore the method is
not inherited.)
<<Variables: var list: TBP>>=
procedure :: is_locked => var_list_is_locked
<<Variables: sub interfaces>>=
module function var_list_is_locked (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_is_locked
<<Variables: procedures>>=
module function var_list_is_locked (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
lval = var_entry_is_locked (var)
else
lval = .false.
end if
end function var_list_is_locked
@ %def var_list_is_locked
@ Return several properties at once.
<<Variables: var list: TBP>>=
procedure :: get_var_properties => var_list_get_var_properties
<<Variables: sub interfaces>>=
module subroutine var_list_get_var_properties &
(vars, name, req_type, follow_link, &
type, is_defined, is_known, is_locked)
class(var_list_t), intent(in) :: vars
type(string_t), intent(in) :: name
integer, intent(in), optional :: req_type
logical, intent(in), optional :: follow_link
integer, intent(out), optional :: type
logical, intent(out), optional :: is_defined, is_known, is_locked
end subroutine var_list_get_var_properties
<<Variables: procedures>>=
module subroutine var_list_get_var_properties &
(vars, name, req_type, follow_link, &
type, is_defined, is_known, is_locked)
class(var_list_t), intent(in) :: vars
type(string_t), intent(in) :: name
integer, intent(in), optional :: req_type
logical, intent(in), optional :: follow_link
integer, intent(out), optional :: type
logical, intent(out), optional :: is_defined, is_known, is_locked
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, type=req_type, follow_link=follow_link)
if (associated (var)) then
if (present (type)) type = var_entry_get_type (var)
if (present (is_defined)) is_defined = var_entry_is_defined (var)
if (present (is_known)) is_known = var_entry_is_known (var)
if (present (is_locked)) is_locked = var_entry_is_locked (var)
else
if (present (type)) type = V_NONE
if (present (is_defined)) is_defined = .false.
if (present (is_known)) is_known = .false.
if (present (is_locked)) is_locked = .false.
end if
end subroutine var_list_get_var_properties
@ %def var_list_get_var_properties
@ Return the value, assuming that the type is correct. We consider only
variable entries that have been [[defined]].
For convenience, allow both variable and fixed-length (literal) strings.
<<Variables: var list: TBP>>=
procedure :: get_lval => var_list_get_lval
procedure :: get_ival => var_list_get_ival
procedure :: get_rval => var_list_get_rval
procedure :: get_cval => var_list_get_cval
procedure :: get_pval => var_list_get_pval
procedure :: get_aval => var_list_get_aval
procedure :: get_sval => var_list_get_sval
<<Variables: sub interfaces>>=
module function var_list_get_lval (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_get_lval
module function var_list_get_ival (vars, name, follow_link) result (ival)
integer :: ival
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_get_ival
module function var_list_get_rval (vars, name, follow_link) result (rval)
real(default) :: rval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_get_rval
module function var_list_get_cval (vars, name, follow_link) result (cval)
complex(default) :: cval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_get_cval
module function var_list_get_aval (vars, name, follow_link) result (aval)
type(pdg_array_t) :: aval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_get_aval
module function var_list_get_pval (vars, name, follow_link) result (pval)
type(subevt_t) :: pval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_get_pval
module function var_list_get_sval (vars, name, follow_link) result (sval)
type(string_t) :: sval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
end function var_list_get_sval
<<Variables: procedures>>=
module function var_list_get_lval (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_LOG, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
lval = var%lval
else
lval = .false.
end if
else
lval = .false.
end if
end function var_list_get_lval
module function var_list_get_ival (vars, name, follow_link) result (ival)
integer :: ival
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_INT, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
ival = var%ival
else
ival = 0
end if
else
ival = 0
end if
end function var_list_get_ival
module function var_list_get_rval (vars, name, follow_link) result (rval)
real(default) :: rval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_REAL, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
rval = var%rval
else
rval = 0
end if
else
rval = 0
end if
end function var_list_get_rval
module function var_list_get_cval (vars, name, follow_link) result (cval)
complex(default) :: cval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_CMPLX, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
cval = var%cval
else
cval = 0
end if
else
cval = 0
end if
end function var_list_get_cval
module function var_list_get_aval (vars, name, follow_link) result (aval)
type(pdg_array_t) :: aval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_PDG, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
aval = var%aval
end if
end if
end function var_list_get_aval
module function var_list_get_pval (vars, name, follow_link) result (pval)
type(subevt_t) :: pval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_SEV, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
pval = var%pval
end if
end if
end function var_list_get_pval
module function var_list_get_sval (vars, name, follow_link) result (sval)
type(string_t) :: sval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_STR, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
sval = var%sval
else
sval = ""
end if
else
sval = ""
end if
end function var_list_get_sval
@ %def var_list_get_lval
@ %def var_list_get_ival
@ %def var_list_get_rval
@ %def var_list_get_cval
@ %def var_list_get_pval
@ %def var_list_get_aval
@ %def var_list_get_sval
@ Check for a valid value, given a pointer. Issue error messages if invalid.
<<Variables: procedures>>=
function var_has_value (var) result (valid)
logical :: valid
type(var_entry_t), pointer :: var
if (associated (var)) then
if (var%is_known) then
valid = .true.
else
call msg_error ("The value of variable '" // char (var%name) &
// "' is unknown but must be known at this point.")
valid = .false.
end if
else
call msg_error ("Variable '" // char (var%name) &
// "' is undefined but must have a known value at this point.")
valid = .false.
end if
end function var_has_value
@ %def var_has_value
@ Return pointers instead of values, including a pointer to the
[[known]] entry.
<<Variables: var list: TBP>>=
procedure :: get_lptr => var_list_get_lptr
procedure :: get_iptr => var_list_get_iptr
procedure :: get_rptr => var_list_get_rptr
procedure :: get_cptr => var_list_get_cptr
procedure :: get_aptr => var_list_get_aptr
procedure :: get_pptr => var_list_get_pptr
procedure :: get_sptr => var_list_get_sptr
<<Variables: sub interfaces>>=
module subroutine var_list_get_lptr (var_list, name, lptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
logical, pointer, intent(out) :: lptr
logical, pointer, intent(out), optional :: known
end subroutine var_list_get_lptr
module subroutine var_list_get_iptr (var_list, name, iptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
integer, pointer, intent(out) :: iptr
logical, pointer, intent(out), optional :: known
end subroutine var_list_get_iptr
module subroutine var_list_get_rptr (var_list, name, rptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
real(default), pointer, intent(out) :: rptr
logical, pointer, intent(out), optional :: known
end subroutine var_list_get_rptr
module subroutine var_list_get_cptr (var_list, name, cptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
complex(default), pointer, intent(out) :: cptr
logical, pointer, intent(out), optional :: known
end subroutine var_list_get_cptr
module subroutine var_list_get_aptr (var_list, name, aptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), pointer, intent(out) :: aptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
end subroutine var_list_get_aptr
module subroutine var_list_get_pptr (var_list, name, pptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), pointer, intent(out) :: pptr
logical, pointer, intent(out), optional :: known
end subroutine var_list_get_pptr
module subroutine var_list_get_sptr (var_list, name, sptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(string_t), pointer, intent(out) :: sptr
logical, pointer, intent(out), optional :: known
end subroutine var_list_get_sptr
<<Variables: procedures>>=
module subroutine var_list_get_lptr (var_list, name, lptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
logical, pointer, intent(out) :: lptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_LOG)
if (associated (var)) then
lptr => var_entry_get_lval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
lptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_lptr
module subroutine var_list_get_iptr (var_list, name, iptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
integer, pointer, intent(out) :: iptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_INT)
if (associated (var)) then
iptr => var_entry_get_ival_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
iptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_iptr
module subroutine var_list_get_rptr (var_list, name, rptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
real(default), pointer, intent(out) :: rptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_REAL)
if (associated (var)) then
rptr => var_entry_get_rval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
rptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_rptr
module subroutine var_list_get_cptr (var_list, name, cptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
complex(default), pointer, intent(out) :: cptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_CMPLX)
if (associated (var)) then
cptr => var_entry_get_cval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
cptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_cptr
module subroutine var_list_get_aptr (var_list, name, aptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), pointer, intent(out) :: aptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_PDG)
if (associated (var)) then
aptr => var_entry_get_aval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
aptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_aptr
module subroutine var_list_get_pptr (var_list, name, pptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), pointer, intent(out) :: pptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_SEV)
if (associated (var)) then
pptr => var_entry_get_pval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
pptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_pptr
module subroutine var_list_get_sptr (var_list, name, sptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(string_t), pointer, intent(out) :: sptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_STR)
if (associated (var)) then
sptr => var_entry_get_sval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
sptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_sptr
@ %def var_list_get_lptr
@ %def var_list_get_iptr
@ %def var_list_get_rptr
@ %def var_list_get_cptr
@ %def var_list_get_aptr
@ %def var_list_get_pptr
@ %def var_list_get_sptr
@
This bunch of methods handles the procedure-pointer cases.
<<Variables: var list: TBP>>=
procedure :: get_obs1_iptr => var_list_get_obs1_iptr
procedure :: get_obs2_iptr => var_list_get_obs2_iptr
procedure :: get_obsev_iptr => var_list_get_obsev_iptr
procedure :: get_obs1_rptr => var_list_get_obs1_rptr
procedure :: get_obs2_rptr => var_list_get_obs2_rptr
procedure :: get_obsev_rptr => var_list_get_obsev_rptr
<<Variables: sub interfaces>>=
module subroutine var_list_get_obs1_iptr (var_list, name, obs1_iptr, p1)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_int), pointer, intent(out) :: obs1_iptr
type(prt_t), pointer, intent(out) :: p1
end subroutine var_list_get_obs1_iptr
module subroutine var_list_get_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_int), pointer, intent(out) :: obs2_iptr
type(prt_t), pointer, intent(out) :: p1, p2
end subroutine var_list_get_obs2_iptr
module subroutine var_list_get_obsev_iptr (var_list, name, obsev_iptr, pval)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_int), pointer, intent(out) :: obsev_iptr
type(subevt_t), pointer, intent(out) :: pval
end subroutine var_list_get_obsev_iptr
module subroutine var_list_get_obs1_rptr (var_list, name, obs1_rptr, p1)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_real), pointer, intent(out) :: obs1_rptr
type(prt_t), pointer, intent(out) :: p1
end subroutine var_list_get_obs1_rptr
module subroutine var_list_get_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_real), pointer, intent(out) :: obs2_rptr
type(prt_t), pointer, intent(out) :: p1, p2
end subroutine var_list_get_obs2_rptr
module subroutine var_list_get_obsev_rptr (var_list, name, obsev_rptr, pval)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_real), pointer, intent(out) :: obsev_rptr
type(subevt_t), pointer, intent(out) :: pval
end subroutine var_list_get_obsev_rptr
<<Variables: procedures>>=
module subroutine var_list_get_obs1_iptr (var_list, name, obs1_iptr, p1)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_int), pointer, intent(out) :: obs1_iptr
type(prt_t), pointer, intent(out) :: p1
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS1_INT)
if (associated (var)) then
call var_entry_assign_obs1_int_ptr (obs1_iptr, var)
p1 => var_entry_get_prt1_ptr (var)
else
obs1_iptr => null ()
p1 => null ()
end if
end subroutine var_list_get_obs1_iptr
module subroutine var_list_get_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_int), pointer, intent(out) :: obs2_iptr
type(prt_t), pointer, intent(out) :: p1, p2
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS2_INT)
if (associated (var)) then
call var_entry_assign_obs2_int_ptr (obs2_iptr, var)
p1 => var_entry_get_prt1_ptr (var)
p2 => var_entry_get_prt2_ptr (var)
else
obs2_iptr => null ()
p1 => null ()
p2 => null ()
end if
end subroutine var_list_get_obs2_iptr
module subroutine var_list_get_obsev_iptr (var_list, name, obsev_iptr, pval)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_int), pointer, intent(out) :: obsev_iptr
type(subevt_t), pointer, intent(out) :: pval
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBSEV_INT)
if (associated (var)) then
call var_entry_assign_obsev_int_ptr (obsev_iptr, var)
pval => var_entry_get_pval_ptr (var)
else
obsev_iptr => null ()
pval => null ()
end if
end subroutine var_list_get_obsev_iptr
module subroutine var_list_get_obs1_rptr (var_list, name, obs1_rptr, p1)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_real), pointer, intent(out) :: obs1_rptr
type(prt_t), pointer, intent(out) :: p1
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS1_REAL)
if (associated (var)) then
call var_entry_assign_obs1_real_ptr (obs1_rptr, var)
p1 => var_entry_get_prt1_ptr (var)
else
obs1_rptr => null ()
p1 => null ()
end if
end subroutine var_list_get_obs1_rptr
module subroutine var_list_get_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_real), pointer, intent(out) :: obs2_rptr
type(prt_t), pointer, intent(out) :: p1, p2
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS2_REAL)
if (associated (var)) then
call var_entry_assign_obs2_real_ptr (obs2_rptr, var)
p1 => var_entry_get_prt1_ptr (var)
p2 => var_entry_get_prt2_ptr (var)
else
obs2_rptr => null ()
p1 => null ()
p2 => null ()
end if
end subroutine var_list_get_obs2_rptr
module subroutine var_list_get_obsev_rptr (var_list, name, obsev_rptr, pval)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_real), pointer, intent(out) :: obsev_rptr
type(subevt_t), pointer, intent(out) :: pval
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBSEV_REAL)
if (associated (var)) then
call var_entry_assign_obsev_real_ptr (obsev_rptr, var)
pval => var_entry_get_pval_ptr (var)
else
obsev_rptr => null ()
pval => null ()
end if
end subroutine var_list_get_obsev_rptr
@ %def var_list_get_obs1_iptr
@ %def var_list_get_obs2_iptr
@ %def var_list_get_obsev_iptr
@ %def var_list_get_obs1_rptr
@ %def var_list_get_obs2_rptr
@ %def var_list_get_obsev_rptr
@
\subsection{Process Result Variables}
These variables are associated to process (integration) runs and their
results. Their names contain brackets (so they look like function
evaluations), therefore we need to special-case them.
<<Variables: var list: TBP>>=
procedure :: set_procvar_int => var_list_set_procvar_int
procedure :: set_procvar_real => var_list_set_procvar_real
<<Variables: sub interfaces>>=
module subroutine var_list_set_procvar_int (var_list, proc_id, name, ival)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
end subroutine var_list_set_procvar_int
module subroutine var_list_set_procvar_real (var_list, proc_id, name, rval)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
end subroutine var_list_set_procvar_real
<<Variables: procedures>>=
module subroutine var_list_set_procvar_int (var_list, proc_id, name, ival)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
type(string_t) :: var_name
type(var_entry_t), pointer :: var
var_name = name // "(" // proc_id // ")"
var => var_list_get_var_ptr (var_list, var_name)
if (.not. associated (var)) then
call var_list%append_int (var_name, ival, intrinsic=.true.)
else if (present (ival)) then
call var_list%set_int (var_name, ival, is_known=.true.)
end if
end subroutine var_list_set_procvar_int
module subroutine var_list_set_procvar_real (var_list, proc_id, name, rval)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
type(string_t) :: var_name
type(var_entry_t), pointer :: var
var_name = name // "(" // proc_id // ")"
var => var_list_get_var_ptr (var_list, var_name)
if (.not. associated (var)) then
call var_list%append_real (var_name, rval, intrinsic=.true.)
else if (present (rval)) then
call var_list%set_real (var_name, rval, is_known=.true.)
end if
end subroutine var_list_set_procvar_real
@ %def var_list_set_procvar_int
@ %def var_list_set_procvar_real
@
\subsection{Observable initialization}
Observables are formally treated as variables, which however are
evaluated each time the observable is used. The arguments (pointers)
to evaluate and the function are part of the variable-list entry.
<<Variables: var list: TBP>>=
procedure :: append_obs1_iptr => var_list_append_obs1_iptr
procedure :: append_obs2_iptr => var_list_append_obs2_iptr
procedure :: append_obs1_rptr => var_list_append_obs1_rptr
procedure :: append_obs2_rptr => var_list_append_obs2_rptr
procedure :: append_obsev_iptr => var_list_append_obsev_iptr
procedure :: append_obsev_rptr => var_list_append_obsev_rptr
<<Variables: sub interfaces>>=
module subroutine var_list_append_obs1_iptr &
(var_list, name, obs1_iptr, p1)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_int) :: obs1_iptr
type(prt_t), intent(in), target :: p1
end subroutine var_list_append_obs1_iptr
module subroutine var_list_append_obs2_iptr &
(var_list, name, obs2_iptr, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_int) :: obs2_iptr
type(prt_t), intent(in), target :: p1, p2
end subroutine var_list_append_obs2_iptr
module subroutine var_list_append_obsev_iptr &
(var_list, name, obsev_iptr, sev)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_int) :: obsev_iptr
type(subevt_t), intent(in), target :: sev
end subroutine var_list_append_obsev_iptr
module subroutine var_list_append_obs1_rptr &
(var_list, name, obs1_rptr, p1)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_real) :: obs1_rptr
type(prt_t), intent(in), target :: p1
end subroutine var_list_append_obs1_rptr
module subroutine var_list_append_obs2_rptr &
(var_list, name, obs2_rptr, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_real) :: obs2_rptr
type(prt_t), intent(in), target :: p1, p2
end subroutine var_list_append_obs2_rptr
module subroutine var_list_append_obsev_rptr &
(var_list, name, obsev_rptr, sev)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_real) :: obsev_rptr
type(subevt_t), intent(in), target :: sev
end subroutine var_list_append_obsev_rptr
<<Variables: procedures>>=
module subroutine var_list_append_obs1_iptr &
(var_list, name, obs1_iptr, p1)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_int) :: obs1_iptr
type(prt_t), intent(in), target :: p1
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS1_INT, p1)
var%obs1_int => obs1_iptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs1_iptr
module subroutine var_list_append_obs2_iptr &
(var_list, name, obs2_iptr, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_int) :: obs2_iptr
type(prt_t), intent(in), target :: p1, p2
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS2_INT, p1, p2)
var%obs2_int => obs2_iptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs2_iptr
module subroutine var_list_append_obsev_iptr &
(var_list, name, obsev_iptr, sev)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_int) :: obsev_iptr
type(subevt_t), intent(in), target :: sev
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs_sev (var, name, V_OBSEV_INT, sev)
var%obsev_int => obsev_iptr
call var_list_append (var_list, var)
end subroutine var_list_append_obsev_iptr
module subroutine var_list_append_obs1_rptr &
(var_list, name, obs1_rptr, p1)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_real) :: obs1_rptr
type(prt_t), intent(in), target :: p1
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS1_REAL, p1)
var%obs1_real => obs1_rptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs1_rptr
module subroutine var_list_append_obs2_rptr &
(var_list, name, obs2_rptr, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_real) :: obs2_rptr
type(prt_t), intent(in), target :: p1, p2
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS2_REAL, p1, p2)
var%obs2_real => obs2_rptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs2_rptr
module subroutine var_list_append_obsev_rptr &
(var_list, name, obsev_rptr, sev)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_sev_real) :: obsev_rptr
type(subevt_t), intent(in), target :: sev
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs_sev (var, name, V_OBSEV_REAL, sev)
var%obsev_real => obsev_rptr
call var_list_append (var_list, var)
end subroutine var_list_append_obsev_rptr
@ %def var_list_append_obs1_iptr
@ %def var_list_append_obs2_iptr
@ %def var_list_append_obs1_rptr
@ %def var_list_append_obs2_rptr
@ User observables: no pointer needs to be stored.
<<Variables: var list: TBP>>=
procedure :: append_uobs_int => var_list_append_uobs_int
procedure :: append_uobs_real => var_list_append_uobs_real
<<Variables: sub interfaces>>=
module subroutine var_list_append_uobs_int (var_list, name, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(prt_t), intent(in), target :: p1
type(prt_t), intent(in), target, optional :: p2
end subroutine var_list_append_uobs_int
module subroutine var_list_append_uobs_real (var_list, name, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(prt_t), intent(in), target :: p1
type(prt_t), intent(in), target, optional :: p2
end subroutine var_list_append_uobs_real
<<Variables: procedures>>=
module subroutine var_list_append_uobs_int (var_list, name, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(prt_t), intent(in), target :: p1
type(prt_t), intent(in), target, optional :: p2
type(var_entry_t), pointer :: var
allocate (var)
if (present (p2)) then
call var_entry_init_obs (var, name, V_UOBS2_INT, p1, p2)
else
call var_entry_init_obs (var, name, V_UOBS1_INT, p1)
end if
call var_list_append (var_list, var)
end subroutine var_list_append_uobs_int
module subroutine var_list_append_uobs_real (var_list, name, p1, p2)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(prt_t), intent(in), target :: p1
type(prt_t), intent(in), target, optional :: p2
type(var_entry_t), pointer :: var
allocate (var)
if (present (p2)) then
call var_entry_init_obs (var, name, V_UOBS2_REAL, p1, p2)
else
call var_entry_init_obs (var, name, V_UOBS1_REAL, p1)
end if
call var_list_append (var_list, var)
end subroutine var_list_append_uobs_real
@ %def var_list_append_uobs_int
@ %def var_list_append_uobs_real
@
\subsection{API for variable lists}
Set a new value. If the variable holds a pointer, this pointer is
followed, e.g., a model parameter is actually set. If [[ignore]] is
set, do nothing if the variable does not exist. If [[verbose]] is
set, echo the new value.
Clear a variable (all variables), i.e., undefine the value.
<<Variables: var list: TBP>>=
procedure :: unset => var_list_clear
<<Variables: sub interfaces>>=
module subroutine var_list_clear (vars, name, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
logical, intent(in), optional :: follow_link
end subroutine var_list_clear
<<Variables: procedures>>=
module subroutine var_list_clear (vars, name, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_clear (var)
end if
end subroutine var_list_clear
@ %def var_list_clear
@
Setting the value, concise specific versions (implementing deferred TBP):
<<Variables: var list: TBP>>=
procedure :: set_ival => var_list_set_ival
procedure :: set_rval => var_list_set_rval
procedure :: set_cval => var_list_set_cval
procedure :: set_lval => var_list_set_lval
procedure :: set_sval => var_list_set_sval
<<Variables: sub interfaces>>=
module subroutine var_list_set_ival (vars, name, ival, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
integer, intent(in) :: ival
logical, intent(in), optional :: follow_link
end subroutine var_list_set_ival
module subroutine var_list_set_rval (vars, name, rval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in), optional :: follow_link
end subroutine var_list_set_rval
module subroutine var_list_set_cval (vars, name, cval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
complex(default), intent(in) :: cval
logical, intent(in), optional :: follow_link
end subroutine var_list_set_cval
module subroutine var_list_set_lval (vars, name, lval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
logical, intent(in) :: lval
logical, intent(in), optional :: follow_link
end subroutine var_list_set_lval
module subroutine var_list_set_sval (vars, name, sval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
type(string_t), intent(in) :: sval
logical, intent(in), optional :: follow_link
end subroutine var_list_set_sval
<<Variables: procedures>>=
module subroutine var_list_set_ival (vars, name, ival, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
integer, intent(in) :: ival
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_int (var, ival, is_known=.true.)
end if
end subroutine var_list_set_ival
module subroutine var_list_set_rval (vars, name, rval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_real (var, rval, is_known=.true.)
end if
end subroutine var_list_set_rval
module subroutine var_list_set_cval (vars, name, cval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
complex(default), intent(in) :: cval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_cmplx (var, cval, is_known=.true.)
end if
end subroutine var_list_set_cval
module subroutine var_list_set_lval (vars, name, lval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
logical, intent(in) :: lval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_log (var, lval, is_known=.true.)
end if
end subroutine var_list_set_lval
module subroutine var_list_set_sval (vars, name, sval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
type(string_t), intent(in) :: sval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_string (var, sval, is_known=.true.)
end if
end subroutine var_list_set_sval
@ %def var_list_set_ival
@ %def var_list_set_rval
@ %def var_list_set_cval
@ %def var_list_set_lval
@ %def var_list_set_sval
@
Setting the value, verbose specific versions (as subroutines):
<<Variables: var list: TBP>>=
procedure :: set_log => var_list_set_log
procedure :: set_int => var_list_set_int
procedure :: set_real => var_list_set_real
procedure :: set_cmplx => var_list_set_cmplx
procedure :: set_subevt => var_list_set_subevt
procedure :: set_pdg_array => var_list_set_pdg_array
procedure :: set_string => var_list_set_string
<<Variables: sub interfaces>>=
module subroutine var_list_set_log &
(var_list, name, lval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
logical, intent(in) :: lval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
end subroutine var_list_set_log
module subroutine var_list_set_int &
(var_list, name, ival, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
integer, intent(in) :: ival
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
end subroutine var_list_set_int
module subroutine var_list_set_real &
(var_list, name, rval, is_known, ignore, force, &
verbose, model_name, pacified)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose, pacified
type(string_t), intent(in), optional :: model_name
end subroutine var_list_set_real
module subroutine var_list_set_cmplx &
(var_list, name, cval, is_known, ignore, force, &
verbose, model_name, pacified)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in) :: cval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose, pacified
type(string_t), intent(in), optional :: model_name
end subroutine var_list_set_cmplx
module subroutine var_list_set_pdg_array &
(var_list, name, aval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in) :: aval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
end subroutine var_list_set_pdg_array
module subroutine var_list_set_subevt &
(var_list, name, pval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in) :: pval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
end subroutine var_list_set_subevt
module subroutine var_list_set_string &
(var_list, name, sval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in) :: sval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
end subroutine var_list_set_string
<<Variables: procedures>>=
module subroutine var_list_set_log &
(var_list, name, lval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
logical, intent(in) :: lval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_LOG)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_LOG)
call var_entry_set_log (var, lval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_log
module subroutine var_list_set_int &
(var_list, name, ival, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
integer, intent(in) :: ival
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_INT)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_INT)
call var_entry_set_int (var, ival, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_int
module subroutine var_list_set_real &
(var_list, name, rval, is_known, ignore, force, &
verbose, model_name, pacified)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose, pacified
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_REAL)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_REAL)
call var_entry_set_real &
(var, rval, is_known, verbose, model_name, pacified)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_real
module subroutine var_list_set_cmplx &
(var_list, name, cval, is_known, ignore, force, &
verbose, model_name, pacified)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in) :: cval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose, pacified
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_CMPLX)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_CMPLX)
call var_entry_set_cmplx &
(var, cval, is_known, verbose, model_name, pacified)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_cmplx
module subroutine var_list_set_pdg_array &
(var_list, name, aval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in) :: aval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_PDG)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_PDG)
call var_entry_set_pdg_array &
(var, aval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_pdg_array
module subroutine var_list_set_subevt &
(var_list, name, pval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in) :: pval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_SEV)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_SEV)
call var_entry_set_subevt &
(var, pval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_subevt
module subroutine var_list_set_string &
(var_list, name, sval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in) :: sval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_STR)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_STR)
call var_entry_set_string &
(var, sval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_string
subroutine var_mismatch_error (name)
type(string_t), intent(in) :: name
call msg_fatal ("Type mismatch for variable '" // char (name) // "'")
end subroutine var_mismatch_error
subroutine var_locked_error (name)
type(string_t), intent(in) :: name
call msg_error ("Variable '" // char (name) // "' is not user-definable")
end subroutine var_locked_error
subroutine var_missing_error (name, ignore)
type(string_t), intent(in) :: name
logical, intent(in), optional :: ignore
logical :: error
if (present (ignore)) then
error = .not. ignore
else
error = .true.
end if
if (error) then
call msg_fatal ("Variable '" // char (name) // "' has not been declared")
end if
end subroutine var_missing_error
@ %def var_list_set_log
@ %def var_list_set_int
@ %def var_list_set_real
@ %def var_list_set_cmplx
@ %def var_list_set_subevt
@ %def var_list_set_pdg_array
@ %def var_list_set_string
@ %def var_mismatch_error
@ %def var_missing_error
@
Import values for the current variable list from another list.
<<Variables: var list: TBP>>=
procedure :: import => var_list_import
<<Variables: sub interfaces>>=
module subroutine var_list_import (var_list, src_list)
class(var_list_t), intent(inout) :: var_list
type(var_list_t), intent(in) :: src_list
end subroutine var_list_import
<<Variables: procedures>>=
module subroutine var_list_import (var_list, src_list)
class(var_list_t), intent(inout) :: var_list
type(var_list_t), intent(in) :: src_list
type(var_entry_t), pointer :: var, src
var => var_list%first
do while (associated (var))
src => var_list_get_var_ptr (src_list, var%name)
if (associated (src)) then
call var_entry_copy_value (var, src)
end if
var => var%next
end do
end subroutine var_list_import
@ %def var_list_import
@ Mark all entries in the current variable list as undefined. This is done
when a local variable list is discarded. If the local list is used again (by
a loop), the entries will be re-initialized.
<<Variables: var list: TBP>>=
procedure :: undefine => var_list_undefine
<<Variables: sub interfaces>>=
recursive module subroutine var_list_undefine (var_list, follow_link)
class(var_list_t), intent(inout) :: var_list
logical, intent(in), optional :: follow_link
end subroutine var_list_undefine
<<Variables: procedures>>=
recursive module subroutine var_list_undefine (var_list, follow_link)
class(var_list_t), intent(inout) :: var_list
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
logical :: rec
rec = .true.; if (present (follow_link)) rec = follow_link
var => var_list%first
do while (associated (var))
call var_entry_undefine (var)
var => var%next
end do
if (rec .and. associated (var_list%next)) then
call var_list_undefine (var_list%next, follow_link=follow_link)
end if
end subroutine var_list_undefine
@ %def var_list_undefine
@ Make a deep copy of a variable list.
<<Variables: var list: TBP>>=
procedure :: init_snapshot => var_list_init_snapshot
<<Variables: sub interfaces>>=
recursive module subroutine var_list_init_snapshot &
(var_list, vars_in, follow_link)
class(var_list_t), intent(out) :: var_list
type(var_list_t), intent(in) :: vars_in
logical, intent(in), optional :: follow_link
end subroutine var_list_init_snapshot
<<Variables: procedures>>=
recursive module subroutine var_list_init_snapshot &
(var_list, vars_in, follow_link)
class(var_list_t), intent(out) :: var_list
type(var_list_t), intent(in) :: vars_in
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var, var_in
type(var_list_t), pointer :: var_list_next
logical :: rec
rec = .true.; if (present (follow_link)) rec = follow_link
var_in => vars_in%first
do while (associated (var_in))
allocate (var)
call var_entry_init_copy (var, var_in)
call var_entry_copy_value (var, var_in)
call var_list_append (var_list, var)
var_in => var_in%next
end do
if (rec .and. associated (vars_in%next)) then
allocate (var_list_next)
call var_list_init_snapshot (var_list_next, vars_in%next)
call var_list%link (var_list_next)
end if
end subroutine var_list_init_snapshot
@ %def var_list_init_snapshot
@ Check if a user variable can be set. The [[new]] flag is set if the user
variable has an explicit declaration. If an error occurs, return [[V_NONE]]
as variable type.
Also determine the actual type of generic numerical variables, which enter the
procedure with type [[V_NONE]].
<<Variables: var list: TBP>>=
procedure :: check_user_var => var_list_check_user_var
<<Variables: sub interfaces>>=
module subroutine var_list_check_user_var (var_list, name, type, new)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(inout) :: type
logical, intent(in) :: new
end subroutine var_list_check_user_var
<<Variables: procedures>>=
module subroutine var_list_check_user_var (var_list, name, type, new)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(inout) :: type
logical, intent(in) :: new
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name)
if (associated (var)) then
if (type == V_NONE) then
type = var_entry_get_type (var)
end if
if (var_entry_is_locked (var)) then
call msg_fatal ("Variable '" // char (name) &
// "' is not user-definable")
type = V_NONE
return
else if (new) then
if (var_entry_is_intrinsic (var)) then
call msg_fatal ("Intrinsic variable '" &
// char (name) // "' redeclared")
type = V_NONE
return
end if
if (var_entry_get_type (var) /= type) then
call msg_fatal ("Variable '" // char (name) // "' " &
// "redeclared with different type")
type = V_NONE
return
end if
end if
end if
end subroutine var_list_check_user_var
@ %def var_list_check_user_var
@
\subsection{Default values for global var list}
<<Variables: var list: TBP>>=
procedure :: init_defaults => var_list_init_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_init_defaults (var_list, seed, paths)
class(var_list_t), intent(out) :: var_list
integer, intent(in) :: seed
type(paths_t), intent(in), optional :: paths
end subroutine var_list_init_defaults
<<Variables: procedures>>=
module subroutine var_list_init_defaults (var_list, seed, paths)
class(var_list_t), intent(out) :: var_list
integer, intent(in) :: seed
type(paths_t), intent(in), optional :: paths
call var_list%set_beams_defaults (paths)
call var_list%set_core_defaults (seed)
call var_list%set_integration_defaults ()
call var_list%set_phase_space_defaults ()
call var_list%set_gamelan_defaults ()
call var_list%set_clustering_defaults ()
call var_list%set_isolation_recomb_defaults ()
call var_list%set_eio_defaults ()
call var_list%set_shower_defaults ()
call var_list%set_hadronization_defaults ()
call var_list%set_tauola_defaults ()
call var_list%set_mlm_matching_defaults ()
call var_list%set_powheg_matching_defaults ()
call var_list%append_log (var_str ("?ckkw_matching"), .false., &
intrinsic=.true., description=var_str ('Master flag that switches ' // &
'on the CKKW(-L) (LO) matching between hard scattering matrix ' // &
'elements and QCD parton showers. Note that this is not yet ' // &
'(completely) implemented in \whizard. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})'))
call var_list%set_openmp_defaults ()
call var_list%set_mpi_defaults ()
call var_list%set_nlo_defaults ()
end subroutine var_list_init_defaults
@ %def var_list_init_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_beams_defaults => var_list_set_beams_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_beams_defaults (var_list, paths)
type(paths_t), intent(in), optional :: paths
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_beams_defaults
<<Variables: procedures>>=
module subroutine var_list_set_beams_defaults (var_list, paths)
type(paths_t), intent(in), optional :: paths
class(var_list_t), intent(inout) :: var_list
call var_list%append_real (var_str ("sqrts"), &
intrinsic=.true., &
description=var_str ('Real variable in order to set the center-of-mass ' // &
'energy for the collisions (collider energy $\sqrt{s}$, not ' // &
'hard interaction energy $\sqrt{\hat{s}}$): \ttt{sqrts = {\em ' // &
'<num>} [ {\em <phys\_unit>} ]}. The physical unit can be one ' // &
'of the following \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV}, ' // &
'and \ttt{TeV}. If absent, \whizard\ takes \ttt{GeV} as its ' // &
'standard unit. Note that this variable is absolutely mandatory ' // &
'for integration and simulation of scattering processes.'))
call var_list%append_real (var_str ("luminosity"), 0._default, &
intrinsic=.true., &
description=var_str ('This specifier \ttt{luminosity = {\em ' // &
'<num>}} sets the integrated luminosity (in inverse femtobarns, ' // &
'fb${}^{-1}$) for the event generation of the processes in the ' // &
'\sindarin\ input files. Note that WHIZARD itself chooses the ' // &
'number from the \ttt{luminosity} or from the \ttt{n\_events} ' // &
'specifier, whichever would give the larger number of events. ' // &
'As this depends on the cross section under consideration, it ' // &
'might be different for different processes in the process list. ' // &
'(cf. \ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format}, \ttt{?unweighted})'))
call var_list%append_log (var_str ("?sf_trace"), .false., &
intrinsic=.true., &
description=var_str ('Debug flag that writes out detailed information ' // &
'about the structure function setup into the file \ttt{{\em ' // &
'<proc\_name>}\_sftrace.dat}. This file name can be changed ' // &
'with ($\to$) \ttt{\$sf\_trace\_file}.'))
call var_list%append_string (var_str ("$sf_trace_file"), var_str (""), &
intrinsic=.true., &
description=var_str ('\ttt{\$sf\_trace\_file = "{\em <file\_name>}"} ' // &
'allows to change the detailed structure function information ' // &
'switched on by the debug flag ($\to$) \ttt{?sf\_trace} into ' // &
'a different file \ttt{{\em <file\_name>}} than the default ' // &
'\ttt{{\em <proc\_name>}\_sftrace.dat}.'))
call var_list%append_log (var_str ("?sf_allow_s_mapping"), .true., &
intrinsic=.true., &
description=var_str ('Flag that determines whether special mappings ' // &
'for processes with structure functions and $s$-channel resonances ' // &
'are applied, e.g. Drell-Yan at hadron colliders, or $Z$ production ' // &
'at linear colliders with beamstrahlung and ISR.'))
if (present (paths)) then
call var_list%append_string (var_str ("$lhapdf_dir"), paths%lhapdfdir, &
intrinsic=.true., &
description=var_str ('String variable that tells the path ' // &
'where the \lhapdf\ library and PDF sets can be found. When ' // &
'the library has been correctly recognized during configuration, ' // &
'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // &
'\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
'\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})'))
else
call var_list%append_string (var_str ("$lhapdf_dir"), var_str(""), &
intrinsic=.true., &
description=var_str ('String variable that tells the path ' // &
'where the \lhapdf\ library and PDF sets can be found. When ' // &
'the library has been correctly recognized during configuration, ' // &
'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // &
'\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
'\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})'))
end if
call var_list%append_string (var_str ("$lhapdf_file"), var_str (""), &
intrinsic=.true., &
description=var_str ('This string variable \ttt{\$lhapdf\_file ' // &
'= "{\em <pdf\_set>}"} allows to specify the PDF set \ttt{{\em ' // &
'<pdf\_set>}} from the external \lhapdf\ library. It must match ' // &
'the exact name of the PDF set from the \lhapdf\ library. The ' // &
'default is empty, and the default set from \lhapdf\ is taken. ' // &
'Only one argument is possible, the PDF set must be identical ' // &
'for both beams, unless there are fundamentally different beam ' // &
'particles like proton and photon. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
'\ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_photon\_scheme}, ' // &
'\ttt{lhapdf\_member})'))
call var_list%append_string (var_str ("$lhapdf_photon_file"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable \ttt{\$lhapdf\_photon\_file ' // &
'= "{\em <pdf\_set>}"} analagous to ($\to$) \ttt{\$lhapdf\_file} ' // &
'for photon PDF structure functions from the external \lhapdf\ ' // &
'library. The name must exactly match the one of the set from ' // &
'\lhapdf. (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
'\ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member}, ' // &
'\ttt{lhapdf\_photon\_scheme})'))
call var_list%append_int (var_str ("lhapdf_member"), 0, &
intrinsic=.true., &
description=var_str ('Integer variable that specifies the number ' // &
'of the corresponding PDF set chosen via the command ($\to$) ' // &
'\ttt{\$lhapdf\_file} or ($\to$) \ttt{\$lhapdf\_photon\_file} ' // &
'from the external \lhapdf\ library. E.g. error PDF sets can ' // &
'be chosen by this. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
'\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
'\ttt{lhapdf\_photon\_scheme})'))
call var_list%append_int (var_str ("lhapdf_photon_scheme"), 0, &
intrinsic=.true., &
description=var_str ('Integer parameter that controls the different ' // &
'available schemes for photon PDFs inside the external \lhapdf\ ' // &
'library. For more details see the \lhapdf\ manual. (cf. also ' // &
'\ttt{lhapdf}, \ttt{\$lhapdf\_dir}, \ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, ' // &
'\ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member})'))
call var_list%append_string (var_str ("$pdf_builtin_set"), var_str ("CTEQ6L"), &
intrinsic=.true., &
description=var_str ("For \whizard's internal PDF structure functions " // &
'for hadron colliders, this string variable allows to set the ' // &
'particular PDF set. (cf. also \ttt{pdf\_builtin}, \ttt{pdf\_builtin\_photon})'))
call var_list%append_log (var_str ("?hoppet_b_matching"), .false., &
intrinsic=.true., &
description=var_str ('Flag that switches on the matching between ' // &
'4- and 5-flavor schemes for hadron collider $b$-parton initiated ' // &
'processes. Works either with builtin PDFs or with the external ' // &
'\lhapdf\ interface. Needs the external \ttt{HOPPET} library ' // &
'to be linked. (cf. \ttt{beams}, \ttt{pdf\_builtin}, \ttt{lhapdf})'))
call var_list%append_real (var_str ("isr_alpha"), 0._default, &
intrinsic=.true., &
description=var_str ('For lepton collider initial-state QED ' // &
'radiation (ISR), this real parameter sets the value of $\alpha_{em}$ ' // &
'used in the structure function. If not set, it is taken from ' // &
'the parameter set of the physics model in use (cf. also \ttt{isr}, ' // &
'\ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // &
'\ttt{?isr\_keep\_energy})'))
call var_list%append_real (var_str ("isr_q_max"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set the ' // &
'scale of the initial-state QED radiation (ISR) structure function. ' // &
'If not set, it is taken internally to be $\sqrt{s}$. (cf. ' // &
'also \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // &
'\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})'))
call var_list%append_real (var_str ("isr_mass"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set by hand ' // &
'the mass of the incoming particle for lepton collider initial-state ' // &
'QED radiation (ISR). If not set, the mass for the initial beam ' // &
'particle is taken from the model in use. (cf. also \ttt{isr}, ' // &
'\ttt{isr\_q\_max}, \ttt{isr\_alpha}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // &
'\ttt{?isr\_keep\_energy}, \ttt{isr\_log\_order})'))
call var_list%append_int (var_str ("isr_order"), 3, &
intrinsic=.true., &
description=var_str ('For lepton collider initial-state QED ' // &
'radiation (ISR), this integer parameter allows to set the order ' // &
'up to which hard-collinear radiation is taken into account. ' // &
'Default is the highest available, namely third order. (cf. ' // &
'also \ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_alpha}, ' // &
'\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy}, \ttt{isr\_log\_order})'))
call var_list%append_int (var_str ("isr_log_order"), 0, &
intrinsic=.true., &
description=var_str ('For lepton collider initial-state QED ' // &
'radiation (ISR), this integer parameters sets the logarithmic ' // &
'order: 0 (default) is LL, 1 is NLL. (cf. ' // &
'also \ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_alpha}, ' // &
'\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy}, \ttt{isr\_order})'))
call var_list%append_real (var_str ("isr_q_in"), -1._default, &
intrinsic=.true., &
description=var_str ('This is the starting scale for the running ' // &
'of the QED coupling alpha. If negative, the electron mass is taken. ' // &
'(cf. also \ttt{isr}, ' // &
'\ttt{isr\_q\_max}, \ttt{isr\_alpha}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // &
'\ttt{?isr\_keep\_energy}, \ttt{isr\_log\_order})'))
call var_list%append_log (var_str ("?isr_recoil"), .false., &
intrinsic=.true., &
description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
'$p_T$-kick for the lepton collider initial-state QED radiation ' // &
'(ISR). (cf. also \ttt{isr}, \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, ' // &
'\ttt{isr\_order}, \ttt{isr\_q\_max}, \ttt{isr\_log\_order})'))
call var_list%append_log (var_str ("?isr_keep_energy"), .false., &
intrinsic=.true., &
description=var_str ('As the splitting kinematics for the ISR ' // &
'structure function violates Lorentz invariance when the recoil ' // &
'is switched on, this flag forces energy conservation when set ' // &
'to true, otherwise violating energy conservation. (cf. also ' // &
'\ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // &
'\ttt{?isr\_recoil}, \ttt{?isr\_alpha})'))
call var_list%append_log (var_str ("?isr_handler"), .false., &
intrinsic=.true., &
description=var_str ('Activate ISR ' // &
'handler for event generation (no effect on integration). ' // &
'Requires \ttt{isr\_recoil = false}'))
call var_list%append_string (var_str ("$isr_handler_mode"), &
var_str ("trivial"), &
intrinsic=.true., &
description=var_str ('Operation mode for the ISR ' // &
'event handler. Allowed values: \ttt{trivial} (no effect), ' // &
'\ttt{recoil} (recoil kinematics with two photons)'))
call var_list%append_log (var_str ("?isr_handler_keep_mass"), .true., &
intrinsic=.true., &
description=var_str ('If \ttt{true} (default), force the incoming ' // &
'partons of the hard process (after radiation) on their mass ' // &
'shell. Otherwise, insert massless on-shell momenta. This ' // &
'applies only for event generation (no effect on integration, ' // &
'cf.\ also \ttt{?isr\_handler})'))
call var_list%append_string (var_str ("$epa_mode"), &
var_str ("default"), intrinsic=.true., &
description=var_str ('For the equivalent photon approximation ' // &
'(EPA), this string variable defines the mode, i.e. the explicit ' // &
'formula for the EPA distribution. For more details cf. the manual. ' // &
'Possible are \ttt{default} (\ttt{Budnev\_617}), \ttt{Budnev\_616e}, ' // &
'\ttt{log\_power}, \ttt{log\_simple}, and \ttt{log}. ' // &
'(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, ' // &
'\ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, ' // &
'\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_real (var_str ("epa_alpha"), 0._default, &
intrinsic=.true., &
description=var_str ('For the equivalent photon approximation ' // &
'(EPA), this real parameter sets the value of $\alpha_{em}$ ' // &
'used in the structure function. If not set, it is taken from ' // &
'the parameter set of the physics model in use (cf. also \ttt{epa}, ' // &
'\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, \ttt{epa\_q\_min}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}, ' // &
'\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_real (var_str ("epa_x_min"), 0._default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the lower cutoff ' // &
'for the energy fraction in the splitting for the equivalent-photon ' // &
'approximation (EPA). This parameter has to be set by the user ' // &
'to a non-zero value smaller than one. (cf. also \ttt{epa}, ' // &
'\ttt{epa\_e\_max}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}, ' // &
'\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_real (var_str ("epa_q_min"), 0._default, &
intrinsic=.true., &
description=var_str ('In the equivalent-photon approximation ' // &
'(EPA), this real parameters sets the minimal value for the ' // &
'transferred momentum. Either this parameter or the mass of ' // &
'the beam particle has to be non-zero. (cf. also \ttt{epa}, ' // &
'\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_max}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}, ' // &
'\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_real (var_str ("epa_q_max"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set the ' // &
'upper energy cutoff for the equivalent-photon approximation ' // &
'(EPA). If not set, \whizard\ simply takes the collider energy, ' // &
'$\sqrt{s}$. (cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, ' // &
'\ttt{epa\_alpha}, \ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{\$epa\_mode}, ' // &
'\ttt{?epa\_keep\_energy}, \ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_real (var_str ("epa_mass"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set by hand ' // &
'the mass of the incoming particle for the equivalent-photon ' // &
'approximation (EPA). If not set, the mass for the initial beam ' // &
'particle is taken from the model in use. (cf. also \ttt{epa}, ' // &
'\ttt{epa\_x\_min}, \ttt{epa\_e\_max}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy}, \ttt{\$epa\_mode}. ' // &
'\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_log (var_str ("?epa_recoil"), .false., &
intrinsic=.true., &
description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
'$p_T$-kick for the equivalent-photon approximation (EPA). ' // &
'(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
'\ttt{epa\_e\_max}, \ttt{epa\_q\_min}, \ttt{?epa\_keep\_energy}, ' // &
'\ttt{\$epa\_mode}, \ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_log (var_str ("?epa_keep_energy"), .false., &
intrinsic=.true., &
description=var_str ('As the splitting kinematics for the EPA ' // &
'structure function violates Lorentz invariance when the recoil ' // &
'is switched on, this flag forces energy conservation when set ' // &
'to true, otherwise violating energy conservation. (cf. also ' // &
'\ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
'\ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{\$epa\_mode}, ' // &
'\ttt{?epa\_handler}, \ttt{\$epa\_handler\_mode})'))
call var_list%append_log (var_str ("?epa_handler"), .false., &
intrinsic=.true., &
description=var_str ('Activate EPA ' // &
'handler for event generation (no effect on integration). ' // &
'Requires \ttt{epa\_recoil = false}'))
call var_list%append_string (var_str ("$epa_handler_mode"), &
var_str ("trivial"), &
intrinsic=.true., &
description=var_str ('Operation mode for the EPA ' // &
'event handler. Allowed values: \ttt{trivial} (no effect), ' // &
'\ttt{recoil} (recoil kinematics with two beams)'))
call var_list%append_real (var_str ("ewa_x_min"), 0._default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the lower cutoff ' // &
'for the energy fraction in the splitting for the equivalent ' // &
'$W$ approximation (EWA). This parameter has to be set by the ' // &
'user to a non-zero value smaller than one. (cf. also \ttt{ewa}, ' // &
'\ttt{ewa\_pt\_max}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
'\ttt{?ewa\_recoil})'))
call var_list%append_real (var_str ("ewa_pt_max"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set the ' // &
'upper $p_T$ cutoff for the equivalent $W$ approximation (EWA). ' // &
'If not set, \whizard\ simply takes the collider energy, $\sqrt{s}$. ' // &
'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
'\ttt{?ewa\_recoil})'))
call var_list%append_real (var_str ("ewa_mass"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set by hand ' // &
'the mass of the incoming particle for the equivalent $W$ approximation ' // &
'(EWA). If not set, the mass for the initial beam particle is ' // &
'taken from the model in use. (cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, ' // &
'\ttt{ewa\_pt\_max}, \ttt{?ewa\_keep\_energy}, \ttt{?ewa\_recoil})'))
call var_list%append_log (var_str ("?ewa_recoil"), .false., &
intrinsic=.true., &
description=var_str ('For the equivalent $W$ approximation (EWA), ' // &
'this flag switches on recoil, i.e. non-collinear splitting. ' // &
'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // &
'\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy})'))
call var_list%append_log (var_str ("?ewa_keep_energy"), .false., &
intrinsic=.true., &
description=var_str ('As the splitting kinematics for the equivalent ' // &
'$W$ approximation (EWA) violates Lorentz invariance when the ' // &
'recoil is switched on, this flag forces energy conservation ' // &
'when set to true, otherwise violating energy conservation. ' // &
'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // &
'\ttt{ewa\_mass}, \ttt{?ewa\_recoil})'))
call var_list%append_log (var_str ("?circe1_photon1"), .false., &
intrinsic=.true., &
description=var_str ('Flag to tell \whizard\ to use the photon ' // &
'of the \circeone\ beamstrahlung structure function as initiator ' // &
'for the hard scattering process in the first beam. (cf. also ' // &
'\ttt{circe1}, \ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_photon2"), .false., &
intrinsic=.true., &
description=var_str ('Flag to tell \whizard\ to use the photon ' // &
'of the \circeone\ beamstrahlung structure function as initiator ' // &
'for the hard scattering process in the second beam. (cf. also ' // &
'\ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{circe1\_sqrts}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
'\newline\ttt{?circe1\_with\_radiation})'))
call var_list%append_real (var_str ("circe1_sqrts"), &
intrinsic=.true., &
description=var_str ('Real parameter that allows to set the ' // &
'value of the collider energy for the lepton collider beamstrahlung ' // &
'structure function \circeone. If not set, $\sqrt{s}$ is taken. ' // &
'(cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_generate"), .true., &
intrinsic=.true., &
description=var_str ('Flag that determines whether the \circeone\ ' // &
'structure function for lepton collider beamstrahlung uses the ' // &
'generator mode for the spectrum, or a pre-defined (semi-)analytical ' // &
'parameterization. Default is the generator mode. (cf. also ' // &
'\ttt{circe1}, \ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_map}, \ttt{circe1\_mapping\_slope}, ' // &
'\ttt{circe1\_eps}, \newline \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_map"), .true., &
intrinsic=.true., &
description=var_str ('Flag that determines whether the \circeone\ ' // &
'structure function for lepton collider beamstrahlung uses special ' // &
'mappings for $s$-channel resonances. (cf. also \ttt{circe1}, ' // &
'\ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_eps}, \newline ' // &
'\ttt{circe1\_ver}, \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, ' // &
'\ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_real (var_str ("circe1_mapping_slope"), 2._default, &
intrinsic=.true., &
description=var_str ('Real parameter that allows to vary the ' // &
'slope of the mapping function for the \circeone\ structure ' // &
'function for lepton collider beamstrahlung from the default ' // &
'value \ttt{2.}. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
'\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
'\ttt{?circe1\_map}, \ttt{circe1\_eps}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_real (var_str ("circe1_eps"), 1e-5_default, &
intrinsic=.true., &
description=var_str ('Real parameter, that takes care of the ' // &
'mapping of the peak in the lepton collider beamstrahlung structure ' // &
'function spectrum of \circeone. (cf. also \ttt{circe1}, \ttt{?circe1\_photons}, ' // &
'\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
'\ttt{?circe1\_map}, \ttt{circe1\_eps}, \newline ' // &
'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline\ttt{?circe1\_with\_radiation})'))
call var_list%append_int (var_str ("circe1_ver"), 0, intrinsic=.true., &
description=var_str ('Integer parameter that sets the internal ' // &
'versioning number of the \circeone\ structure function for lepton-collider ' // &
'beamstrahlung. It has to be set by the user explicitly, it takes ' // &
'values from one to ten. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
'\ttt{?circe1\_photon2}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_int (var_str ("circe1_rev"), 0, intrinsic=.true., &
description=var_str ('Integer parameter that sets the internal ' // &
'revision number of the \circeone\ structure function for lepton-collider ' // &
'beamstrahlung. The default \ttt{0} translates always into the ' // &
'most recent version; older versions have to be accessed through ' // &
'the explicit revision date. For more details cf.~the \circeone ' // &
'manual. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, \ttt{circe1\_ver}, ' // &
'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_string (var_str ("$circe1_acc"), var_str ("SBAND"), &
intrinsic=.true., &
description=var_str ('String variable that specifies the accelerator ' // &
'type for the \circeone\ structure function for lepton-collider ' // &
'beamstrahlung. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\newline \ttt{circe1\_rev}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_int (var_str ("circe1_chat"), 0, intrinsic=.true., &
description=var_str ('Chattiness of the \circeone\ structure ' // &
'function for lepton-collider beamstrahlung. The higher the integer ' // &
'value, the more information will be given out by the \circeone\ ' // &
'package. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_with_radiation"), .false., &
intrinsic=.true., &
description=var_str ('This logical decides whether the additional photon ' // &
'or electron ("beam remnant") will be considered in the event record or ' // &
'not. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc})'))
call var_list%append_log (var_str ("?circe2_polarized"), .true., &
intrinsic=.true., &
description=var_str ('Flag whether the photon spectra from the ' // &
'\circetwo\ structure function for lepton colliders should be ' // &
'treated polarized. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, ' // &
'\ttt{\$circe2\_design})'))
call var_list%append_string (var_str ("$circe2_file"), &
intrinsic=.true., &
description=var_str ('String variable by which the corresponding ' // &
'photon collider spectrum for the \circetwo\ structure function ' // &
'can be selected. (cf. also \ttt{circe2}, \ttt{?circe2\_polarized}, ' // &
'\ttt{\$circe2\_design})'))
call var_list%append_string (var_str ("$circe2_design"), var_str ("*"), &
intrinsic=.true., &
description=var_str ('String variable that sets the collider ' // &
'design for the \circetwo\ structure function for photon collider ' // &
'spectra. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, \ttt{?circe2\_polarized})'))
call var_list%append_real (var_str ("gaussian_spread1"), 0._default, &
intrinsic=.true., &
description=var_str ('Parameter that sets the energy spread ' // &
'($\sigma$ value) of the first beam for a Gaussian spectrum. ' // &
'(cf. \ttt{gaussian})'))
call var_list%append_real (var_str ("gaussian_spread2"), 0._default, &
intrinsic=.true., &
description=var_str ('Ditto, for the second beam.'))
call var_list%append_string (var_str ("$beam_events_file"), &
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
"name of the external file from which a beamstrahlung's spectrum " // &
'for lepton colliders as pairs of energy fractions is read in. ' // &
'(cf. also \ttt{beam\_events}, \ttt{?beam\_events\_warn\_eof})'))
call var_list%append_log (var_str ("?beam_events_warn_eof"), .true., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to ' // &
'issue a warning when in a simulation the end of an external ' // &
"file for beamstrahlung's spectra for lepton colliders are reached, " // &
'and energy fractions from the beginning of the file are reused. ' // &
'(cf. also \ttt{beam\_events}, \ttt{\$beam\_events\_file})'))
call var_list%append_log (var_str ("?energy_scan_normalize"), .false., &
intrinsic=.true., &
description=var_str ('Normalization flag for the energy scan ' // &
'structure function: if set the total cross section is normalized ' // &
'to unity. (cf. also \ttt{energy\_scan})'))
call var_list%append_string (var_str ("$negative_sf"), var_str ("default"), &
intrinsic=.true., &
description=var_str ('String variable to set the behavior to either ' // &
'keep negative structure function/PDF values or set them to zero. ' // &
'The default (\ttt{"default"}) takes the first option for NLO and the ' // &
'second for LO processes. Explicit behavior can be set with ' // &
'\ttt{"positive"} or \ttt{"negative"}.'))
end subroutine var_list_set_beams_defaults
@ %def var_list_set_beams_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_core_defaults => var_list_set_core_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_core_defaults (var_list, seed)
class(var_list_t), intent(inout) :: var_list
integer, intent(in) :: seed
end subroutine var_list_set_core_defaults
<<Variables: procedures>>=
module subroutine var_list_set_core_defaults (var_list, seed)
class(var_list_t), intent(inout) :: var_list
integer, intent(in) :: seed
logical, target, save :: known = .true. !!! ??????
real(default), parameter :: real_specimen = 1.
call var_list_append_log_ptr &
(var_list, var_str ("?logging"), logging, known, &
intrinsic=.true., &
description=var_str ('This logical -- when set to \ttt{false} ' // &
'-- suppresses writing out a logfile (default: \ttt{whizard.log}) ' // &
'for the whole \whizard\ run, or when \whizard\ is run with the ' // &
'\ttt{--no-logging} option, to suppress parts of the logging ' // &
'when setting it to \ttt{true} again at a later part of the ' // &
'\sindarin\ input file. Mainly for debugging purposes. ' // &
'(cf. also \ttt{?openmp\_logging}, \ttt{?mpi\_logging})'))
call var_list%append_string (var_str ("$job_id"), &
intrinsic=.true., &
description=var_str ('Arbitrary string that can be used for ' // &
'creating unique names. The variable is initialized with the ' // &
'value of the \ttt{job\_id} option on startup. (cf. also ' // &
'\ttt{\$compile\_workspace}, \ttt{\$run\_id})'))
call var_list%append_string (var_str ("$compile_workspace"), &
intrinsic=.true., &
description=var_str ('If set, create process source code ' // &
'and process-driver library code in a subdirectory with this ' // &
'name. If non-existent, the directory will be created. (cf. ' // &
'also \ttt{\$job\_id}, \ttt{\$run\_id}, \ttt{\$integrate\_workspace})'))
call var_list%append_int (var_str ("seed"), seed, &
intrinsic=.true., &
description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
'that allows to set a specific random seed \ttt{num}. If not ' // &
'set, \whizard\ takes the time from the system clock to determine ' // &
'the random seed.'))
call var_list%append_string (var_str ("$model_name"), &
intrinsic=.true., &
description=var_str ('This variable makes the locally used physics ' // &
'model available as a string, e.g. as \ttt{show (\$model\_name)}. ' // &
'However, the user is not able to change the current model by ' // &
'setting this variable to a different string. (cf. also \ttt{model}, ' // &
'\ttt{\$library\_name}, \ttt{printf}, \ttt{show})'))
call var_list%append_int (var_str ("process_num_id"), &
intrinsic=.true., &
description=var_str ('Using the integer \ttt{process\_num\_id ' // &
'= {\em <int\_var>}} one can set a numerical identifier for processes ' // &
'within a process library. This can be set either just before ' // &
'the corresponding \ttt{process} definition or as an optional ' // &
'local argument of the latter. (cf. also \ttt{process}, ' // &
'\ttt{?proc\_as\_run\_id}, \ttt{lcio\_run\_id})'))
call var_list%append_log (var_str ("?proc_as_run_id"), .true., &
intrinsic=.true., &
description=var_str ('Normally, for LCIO the process ID (cf. ' // &
'\ttt{process\_num\_id}) is used as run ID, unless this flag is ' // &
'set to \ttt{false}, cf. also \ttt{process}, \ttt{lcio\_run\_id}.'))
call var_list%append_int (var_str ("lcio_run_id"), 0, &
intrinsic=.true., &
description=var_str ('Allows to set an integer run ID for the LCIO ' // &
'event format. Normally, the process ID is taken as run ID, unless ' // &
'the flag (cf.) \ttt{?proc\_as\_run\_id} is set to \ttt{false}, ' // &
'cf. also \ttt{process}.'))
call var_list%append_string (var_str ("$method"), var_str ("omega"), &
intrinsic=.true., &
description=var_str ('This string variable specifies the method ' // &
'for the matrix elements to be used in the evaluation. The default ' // &
"is the intrinsic \oMega\ matrix element generator " // &
'(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // &
'\ttt{"template\_unity"}, \ttt{"threshold"}. For processes defined ' // &
'\ttt{"template"}, with \ttt{nlo\_calculation = ...}, please refer to ' // &
'\ttt{\$born\_me\_method}, \ttt{\$real\_tree\_me\_method}, ' // &
'\ttt{\$loop\_me\_method} and \ttt{\$correlation\_me\_method}.'))
call var_list%append_log (var_str ("?report_progress"), .true., &
intrinsic=.true., &
description=var_str ('Flag for the \oMega\ matrix element generator ' // &
'whether to print out status messages about progress during ' // &
'matrix element generation. (cf. also \ttt{\$method}, \ttt{\$omega\_flags})'))
call var_list%append_log (var_str ("?me_verbose"), .false., &
description=var_str ("Flag determining whether " // &
"the makefile command for generating and compiling the \oMega\ matrix " // &
"element code is silent or verbose. Default is silent."))
call var_list%append_string (var_str ("$restrictions"), var_str (""), &
intrinsic=.true., &
description=var_str ('This is an optional argument for process ' // &
'definitions for the matrix element method \ttt{"omega"}. Using ' // &
'the following construction, it defines a string variable, \ttt{process ' // &
'\newline {\em <process\_name>} = {\em <particle1>}, {\em <particle2>} ' // &
'=> {\em <particle3>}, {\em <particle4>}, ... \{ \$restrictions ' // &
'= "{\em <restriction\_def>}" \}}. The string argument \ttt{{\em ' // &
'<restriction\_def>}} is directly transferred during the code ' // &
'generation to the ME generator \oMega. It has to be of the form ' // &
'\ttt{n1 + n2 + ... \url{~} {\em <particle (list)>}}, where ' // &
'\ttt{n1} and so on are the numbers of the particles above in ' // &
'the process definition. The tilde specifies a certain intermediate ' // &
'state to be equal to the particle(s) in \ttt{particle (list)}. ' // &
'An example is \ttt{process eemm\_z = e1, E1 => e2, E2 ' // &
'\{ \$restrictions = "1+2 \url{~} Z" \} } restricts the code ' // &
'to be generated for the process $e^- e^+ \to \mu^- \mu^+$ to ' // &
'the $s$-channel $Z$-boson exchange. For more details see Sec.~\ref{sec:omega_me} ' // &
'(cf. also \ttt{process})'))
call var_list%append_log (var_str ("?omega_write_phs_output"), .false., &
intrinsic=.true., &
description=var_str ('This flag decides whether a the phase-space ' // &
'output is produced by the \oMega\ matrix element generator. This ' // &
'output is written to file(s) and contains the Feynman diagrams ' // &
'which belong to the process(es) under consideration. The file is ' // &
'mandatory whenever the variable \ttt{\$phs\_method} has the value ' // &
'\ttt{fast\_wood}, i.e. if the phase-space file is provided by ' // &
'cascades2.'))
call var_list%append_string (var_str ("$omega_flags"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable that allows to pass flags ' // &
'to the \oMega\ matrix element generator. Normally, \whizard\ ' // &
'takes care of all flags automatically. Note that for restrictions ' // &
'of intermediate states, there is a special string variable: ' // &
'(cf. $\to$) \ttt{\$restrictions}.'))
call var_list%append_log (var_str ("?read_color_factors"), .true., &
intrinsic=.true., &
description=var_str ('This flag decides whether to read QCD ' // &
'color factors from the matrix element provided by each method, ' // &
'or to try and calculate the color factors in \whizard\ internally.'))
call var_list%append_log (var_str ("?slha_read_input"), .true., &
intrinsic=.true., &
description=var_str ('Flag which decides whether \whizard\ reads ' // &
'in the SM and parameter information from the \ttt{SMINPUTS} ' // &
'and \ttt{MINPAR} common blocks of the SUSY Les Houches Accord ' // &
'files. (cf. also \ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, ' // &
'\ttt{?slha\_read\_decays})'))
call var_list%append_log (var_str ("?slha_read_spectrum"), .true., &
intrinsic=.true., &
description=var_str ('Flag which decides whether \whizard\ reads ' // &
'in the whole spectrum and mixing angle information from the ' // &
'common blocks of the SUSY Les Houches Accord files. (cf. also ' // &
'\ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_decays}, ' // &
'\ttt{?slha\_read\_input})'))
call var_list%append_log (var_str ("?slha_read_decays"), .false., &
intrinsic=.true., &
description=var_str ('Flag which decides whether \whizard\ reads ' // &
'in the widths and branching ratios from the \ttt{DCINFO} common ' // &
'block of the SUSY Les Houches Accord files. (cf. also \ttt{read\_slha}, ' // &
'\ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, \ttt{?slha\_read\_input})'))
call var_list%append_string (var_str ("$library_name"), &
intrinsic=.true., &
description=var_str ('Similar to \ttt{\$model\_name}, this string ' // &
'variable is used solely to access the name of the active process ' // &
'library, e.g. in \ttt{printf} statements. (cf. \ttt{compile}, ' // &
'\ttt{library}, \ttt{printf}, \ttt{show}, \ttt{\$model\_name})'))
call var_list%append_log (var_str ("?alphas_is_fixed"), .true., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use a non-running ' // &
'QCD $\alpha_s$. Note that this has to be set explicitly to $\ttt{false}$ ' // &
'if the user wants to use one of the running $\alpha_s$ options. ' // &
'(cf. also \ttt{alphas\_order}, \ttt{?alphas\_from\_lhapdf}, ' // &
'\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alpha_is_fixed"), .true., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use a non-running ' // &
'QED $\alpha$. Note that this has to be set explicitly to $\ttt{false}$ ' // &
'if the user wants to use one of the running $\alpha$ options. ' // &
'(cf. also \ttt{alpha\_order}, \ttt{alpha\_nf}, \ttt{alpha\_lep}, ' // &
'\ttt{?alphas\_from\_me}'))
call var_list%append_log (var_str ("?alphas_from_lhapdf"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use a running ' // &
'$\alpha_s$ from the \lhapdf\ library (which has to be correctly ' // &
'linked). Note that \ttt{?alphas\_is\_fixed} has to be set ' // &
'explicitly to $\ttt{false}$. (cf. also \ttt{alphas\_order}, ' // &
'\ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
'\ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alphas_from_pdf_builtin"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use a running ' // &
'$\alpha_s$ from the internal PDFs. Note that in that case \ttt{?alphas\_is\_fixed} ' // &
'has to be set explicitly to $\ttt{false}$. (cf. also ' // &
'\ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
'\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \newline \ttt{?alphas\_from\_lambda\_qcd}, ' // &
'\ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alpha_evolve_analytic"), .true., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use analytic running ' // &
'formulae for $\alpha$ instead of a numeric Runge-Kutta. ' // &
'(cf. also \ttt{alpha\_order}, \ttt{?alpha\_is\_fixed}, ' // &
'\ttt{alpha\_nf}, \ttt{alpha\_nlep}, \ttt{?alpha\_from\_me}) '))
call var_list%append_int (var_str ("alphas_order"), 0, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the order ' // &
'of the internal evolution for running $\alpha_s$ in \whizard: ' // &
'the default, \ttt{0}, is LO running, \ttt{1} is NLO, \ttt{2} ' // &
'is NNLO. (cf. also \ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
'\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_int (var_str ("alpha_order"), 0, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the order ' // &
'of the internal evolution for running $\alpha$ in \whizard: ' // &
'the default, \ttt{0}, is LO running, \ttt{1} is NLO. ' // &
'(cf. also \ttt{alpha\_is\_fixed}, \ttt{alpha\_nf}, \ttt{alphas\_lep}, ' // &
'\ttt{?alpha\_from\_me})'))
call var_list%append_int (var_str ("alphas_nf"), 5, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the number ' // &
'of active quark flavors for the internal evolution for running ' // &
'$\alpha_s$ in \whizard. (cf. also ' // &
'\ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\ttt{alphas\_order}, \ttt{?alphas\_from\_mz}, \newline ' // &
'\ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_int (var_str ("alpha_nf"), -1, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the number ' // &
'of active quark flavors for the internal evolution for running ' // &
'$\alpha$ in \whizard. The default, \ttt{-1}, keeps it equal to \ttt{alphas\_nf} ' // &
'\ttt{alpha\_is\_fixed}, \ttt{alphas\_order}, \ttt{?alpha\_from\_me}, ' // &
'\ttt{?alpha\_evolve\_analytic}'))
call var_list%append_int (var_str ("alpha_nlep"), 1, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the number ' // &
'of active leptons in the running of $\alpha$ in \whizard. The deffault is' // &
'one, with only the electron considered massless (cf. also ' // &
'\ttt{alpha\_is\_fixed}, \ttt{alpha\_nf}, ' // &
'\ttt{alpha\_order}, \ttt{?alpha\_from\_me}, \ttt{?alpha\_evolve\_analytic})'))
call var_list%append_log (var_str ("?alphas_from_mz"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use its internal ' // &
'running $\alpha_s$ from $\alpha_s(M_Z)$. Note that in that ' // &
'case \ttt{?alphas\_is\_fixed} has to be set explicitly to ' // &
'$\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alphas_from_lambda_qcd"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use its internal ' // &
'running $\alpha_s$ from $\alpha_s(\Lambda_{QCD})$. Note that ' // &
'in that case \ttt{?alphas\_is\_fixed} has to be set explicitly ' // &
'to $\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\newline \ttt{?alphas\_from\_mz}, \ttt{lambda\_qcd})'))
call var_list%append_real (var_str ("lambda_qcd"), 200.e-3_default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the value for ' // &
'$\Lambda_{QCD}$ used in the internal evolution for running ' // &
'$\alpha_s$ in \whizard. (cf. also \ttt{alphas\_is\_fixed}, ' // &
'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, ' // &
'\newline \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
'\ttt{alphas\_order})'))
call var_list%append_log (var_str ("?fatal_beam_decay"), .true., &
intrinsic=.true., &
description=var_str ('Logical variable that let the user decide ' // &
'whether the possibility of a beam decay is treated as a fatal ' // &
'error or only as a warning. An example is a process $b t \to ' // &
'X$, where the bottom quark as an inital state particle appears ' // &
'as a possible decay product of the second incoming particle, ' // &
'the top quark. This might trigger inconsistencies or instabilities ' // &
'in the phase space set-up.'))
call var_list%append_log (var_str ("?helicity_selection_active"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether \whizard\ uses ' // &
'a numerical selection rule for vanishing helicities: if active, ' // &
'then, if a certain helicity combination yields an absolute ' // &
'(\oMega) matrix element smaller than a certain threshold ($\to$ ' // &
'\ttt{helicity\_selection\_threshold}) more often than a certain ' // &
'cutoff ($\to$ \ttt{helicity\_selection\_cutoff}), it will be dropped.'))
call var_list%append_real (var_str ("helicity_selection_threshold"), &
1E10_default, &
intrinsic=.true., &
description=var_str ('Real parameter that gives the threshold ' // &
'for the absolute value of a certain helicity combination of ' // &
'an (\oMega) amplitude. If a certain number ($\to$ ' // &
'\ttt{helicity\_selection\_cutoff}) of calls stays below this ' // &
'threshold, that combination will be dropped from then on. (cf. ' // &
'also \ttt{?helicity\_selection\_active})'))
call var_list%append_int (var_str ("helicity_selection_cutoff"), 1000, &
intrinsic=.true., &
description=var_str ('Integer parameter that gives the number ' // &
"a certain helicity combination of an (\oMega) amplitude has " // &
'to be below a certain threshold ($\to$ \ttt{helicity\_selection\_threshold}) ' // &
'in order to be dropped from then on. (cf. also \ttt{?helicity\_selection\_active})'))
call var_list%append_string (var_str ("$rng_method"), var_str ("tao"), &
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
'method for the random number generation. Default is Donald ' // &
"Knuth' RNG method \ttt{TAO}."))
call var_list%append_log (var_str ("?vis_diags"), .false., &
intrinsic=.true., &
description=var_str ('Logical variable that allows to give out ' // &
"a Postscript or PDF file for the Feynman diagrams for a \oMega\ " // &
'process. (cf. \ttt{?vis\_diags\_color}).'))
call var_list%append_log (var_str ("?vis_diags_color"), .false., &
intrinsic=.true., &
description=var_str ('Same as \ttt{?vis\_diags}, but switches ' // &
'on color flow instead of Feynman diagram generation. (cf. \ttt{?vis\_diags}).'))
call var_list%append_log (var_str ("?check_event_file"), .true., &
intrinsic=.true., &
description=var_str ('Setting this to false turns off all sanity ' // &
'checks when reading a raw event file with previously generated ' // &
'events. Use this at your own risk; the program may return ' // &
'wrong results or crash if data do not match. (cf. also \ttt{?check\_grid\_file}, ' // &
'\ttt{?check\_phs\_file})'))
call var_list%append_string (var_str ("$event_file_version"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
'format version of the \whizard\ internal binary event format.'))
call var_list%append_int (var_str ("n_events"), 0, &
intrinsic=.true., &
description=var_str ('This specifier \ttt{n\_events = {\em <num>}} ' // &
'sets the number of events for the event generation of the processes ' // &
'in the \sindarin\ input files. Note that WHIZARD itself chooses ' // &
'the number from the \ttt{n\_events} or from the \ttt{luminosity} ' // &
'specifier, whichever would give the larger number of events. ' // &
'As this depends on the cross section under consideration, it ' // &
'might be different for different processes in the process list. ' // &
'(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
'\ttt{?unweighted}, \ttt{event\_index\_offset})'))
call var_list%append_int (var_str ("event_index_offset"), 0, &
intrinsic=.true., &
description=var_str ('The value ' // &
'\ttt{event\_index\_offset = {\em <num>}} ' // &
'initializes the event counter for a subsequent ' // &
'event sample. By default (value 0), the first event ' // &
'gets index value 1, incrementing by one for each generated event ' // &
'within a sample. The event counter is initialized again ' // &
'for each new sample (i.e., \ttt{integrate} command). ' // &
'If events are read from file, and the ' // &
'event file format supports event numbering, the event numbers ' // &
'will be taken from file instead, and the value of ' // &
'\ttt{event\_index\_offset} has no effect. ' // &
'(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
'\ttt{?unweighted}, \ttt{n\_events})'))
call var_list%append_log (var_str ("?unweighted"), .true., &
intrinsic=.true., &
description=var_str ('Flag that distinguishes between unweighted ' // &
'and weighted event generation. (cf. also \ttt{simulate}, \ttt{n\_events}, ' // &
'\ttt{luminosity}, \ttt{event\_index\_offset})'))
call var_list%append_real (var_str ("safety_factor"), 1._default, &
intrinsic=.true., &
description=var_str ('This real variable \ttt{safety\_factor ' // &
'= {\em <num>}} reduces the acceptance probability for unweighting. ' // &
'If greater than one, excess events become less likely, but ' // &
'the reweighting efficiency also drops. (cf. \ttt{simulate}, \ttt{?unweighted})'))
call var_list%append_log (var_str ("?negative_weights"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to allow negative ' // &
'weights in integration and simulation. (cf. also \ttt{simulate}, ' // &
'\ttt{?unweighted})'))
call var_list%append_log (var_str ("?resonance_history"), .false., &
intrinsic=.true., &
description=var_str ( &
'The logical variable \texttt{?resonance\_history ' // &
'= true/false} specifies whether during a simulation pass, ' // &
'the event generator should try to reconstruct intermediate ' // &
'resonances. If activated, appropriate resonant subprocess ' // &
'matrix element code will be automatically generated. '))
call var_list%append_real (var_str ("resonance_on_shell_limit"), &
4._default, &
intrinsic=.true., &
description=var_str ( &
'The real variable \texttt{resonance\_on\_shell\_limit ' // &
'= {\em <num>}} specifies the maximum relative distance from a ' // &
'resonance peak, such that the kinematical configuration ' // &
'can still be considered on-shell. This is relevant only if ' // &
'\texttt{?resonance\_history = true}.'))
call var_list%append_real (var_str ("resonance_on_shell_turnoff"), &
0._default, &
intrinsic=.true., &
description=var_str ( &
'The real variable \texttt{resonance\_on\_shell\_turnoff ' // &
'= {\em <num>}}, if positive, ' // &
'controls the smooth transition from resonance-like ' // &
'to background-like events. The relative strength of a ' // &
'resonance is reduced by a Gaussian with width given by this ' // &
'variable. In any case, events are treated as background-like ' // &
'when the off-shellness is greater than ' // &
'\texttt{resonance\_on\_shell\_limit}. All of this applies ' // &
'only if \texttt{?resonance\_history = true}.'))
call var_list%append_real (var_str ("resonance_background_factor"), &
1._default, &
intrinsic=.true., &
description=var_str ( &
'The real variable \texttt{resonance\_background\_factor} ' // &
'controls resonance insertion if a resonance ' // &
'history applies to a particular event. In determining '// &
'whether event kinematics qualifies as resonant or non-resonant, ' //&
'the non-resonant probability is multiplied by this factor ' // &
'Setting the factor to zero removes the background ' // &
'configuration as long as the kinematics qualifies as on-shell ' // &
'as qualified by \texttt{resonance\_on\_shell\_limit}.'))
call var_list%append_log (var_str ("?keep_beams"), .false., &
intrinsic=.true., &
description=var_str ('The logical variable \ttt{?keep\_beams ' // &
'= true/false} specifies whether beam particles and beam remnants ' // &
'are included when writing event files. For example, in order ' // &
'to read Les Houches accord event files into \pythia, no beam ' // &
'particles are allowed.'))
call var_list%append_log (var_str ("?keep_remnants"), .true., &
intrinsic=.true., &
description=var_str ('The logical variable \ttt{?keep\_beams ' // &
'= true/false} is respected only if \ttt{?keep\_beams} is set. ' // &
'If \ttt{true}, beam remnants are tagged as outgoing particles ' // &
'if they have been neither showered nor hadronized, i.e., have ' // &
'no children. If \ttt{false}, beam remnants are also included ' // &
'in the event record, but tagged as unphysical. Note that for ' // &
'ISR and/or beamstrahlung spectra, the radiated photons are ' // &
'considered as beam remnants.'))
call var_list%append_log (var_str ("?rescan_force"), .false., &
intrinsic=.true., &
description=var_str ('Flag that allows to bypass essential ' // &
'checks on the particle set when reading event/rescanning files ' // &
'into \whizard. (cf. \ttt{rescan}, \ttt{?update\_event}, \ttt{?update\_sqme}, ' // &
'\newline \ttt{?update\_weight})'))
call var_list%append_log (var_str ("?recover_beams"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the beam particles ' // &
'should be reconstructed when reading event/rescanning files ' // &
'into \whizard. (cf. \ttt{rescan}, \ttt{?update\_event}, \ttt{?update\_sqme}, ' // &
'\newline \ttt{?update\_weight})'))
call var_list%append_log (var_str ("?update_event"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the events in ' // &
'an event file should be rebuilt from the hard process when ' // &
'reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
'\ttt{?recover\_beams}, \ttt{?update\_sqme}, \ttt{?update\_weight})'))
call var_list%append_log (var_str ("?update_sqme"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the squared ' // &
'matrix element in an event file should be updated/recalculated ' // &
'when reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
'\newline \ttt{?recover\_beams}, \ttt{?update\_event}, \ttt{?update\_weight})'))
call var_list%append_log (var_str ("?update_weight"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the weights ' // &
'in an event file should be updated/recalculated when reading ' // &
'event/rescanning files into \whizard. (cf. \ttt{rescan}, \ttt{?recover\_beams}, ' // &
'\newline \ttt{?update\_event}, \ttt{?update\_sqme})'))
call var_list%append_log (var_str ("?use_alphas_from_file"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the current ' // &
'$\alpha_s$ definition should be used when recalculating matrix ' // &
'elements for events read from file, or the value that is stored ' // &
'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
'\ttt{?use\_scale\_from\_file})'))
call var_list%append_log (var_str ("?use_scale_from_file"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the current ' // &
'energy-scale expression should be used when recalculating matrix ' // &
'elements for events read from file, or the value that is stored ' // &
'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
'\ttt{?use\_alphas\_from\_file})'))
call var_list%append_log (var_str ("?allow_decays"), .true., &
intrinsic=.true., &
description=var_str ('Master flag to switch on cascade decays ' // &
'for final state particles as an event transform. As a default, ' // &
'it is switched on. (cf. also \ttt{?auto\_decays}, ' // &
'\ttt{auto\_decays\_multiplicity}, \ttt{?auto\_decays\_radiative}, ' // &
'\ttt{?decay\_rest\_frame})'))
call var_list%append_log (var_str ("?auto_decays"), .false., &
intrinsic=.true., &
description=var_str ('Flag, particularly as optional argument of the ($\to$) ' // &
'\ttt{unstable} command, that tells \whizard\ to automatically ' // &
'determine the decays of that particle up to the final state ' // &
'multplicity ($\to$) \ttt{auto\_decays\_multiplicity}. Depending ' // &
'on the flag ($\to$) \ttt{?auto\_decays\_radiative}, radiative ' // &
'decays will be taken into account or not. (cf. also \ttt{unstable}, ' // &
'\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay})'))
call var_list%append_int (var_str ("auto_decays_multiplicity"), 2, &
intrinsic=.true., &
description=var_str ('Integer parameter, that sets -- ' // &
'for the ($\to$) \ttt{?auto\_decays} option to let \whizard\ ' // &
'automatically determine the decays of a particle set as ($\to$) ' // &
'\ttt{unstable} -- the maximal final state multiplicity that ' // &
'is taken into account. The default is \ttt{2}. The flag \ttt{?auto\_decays\_radiative} ' // &
'decides whether radiative decays are taken into account. (cf.\ ' // &
'also \ttt{unstable}, \ttt{?auto\_decays})'))
call var_list%append_log (var_str ("?auto_decays_radiative"), .false., &
intrinsic=.true., &
description=var_str ("If \whizard's automatic detection " // &
'of decay channels are switched on ($\to$ \ttt{?auto\_decays} ' // &
'for the ($\to$) \ttt{unstable} command, this flags decides ' // &
'whether radiative decays (e.g. containing additional photon(s)/gluon(s)) ' // &
'are taken into account or not. (cf. also \ttt{unstable}, \ttt{auto\_decays\_multiplicity})'))
call var_list%append_log (var_str ("?decay_rest_frame"), .false., &
intrinsic=.true., &
description=var_str ('Flag that allows to force a particle decay ' // &
'to be simulated in its rest frame. This simplifies the calculation ' // &
'for decays as stand-alone processes, but makes the process ' // &
'unsuitable for use in a decay chain.'))
call var_list%append_log (var_str ("?isotropic_decay"), .false., &
intrinsic=.true., &
description=var_str ('Flag that -- in case of using factorized ' // &
'production and decays using the ($\to$) \ttt{unstable} command ' // &
'-- tells \whizard\ to switch off spin correlations completely ' // &
'(isotropic decay). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
'\ttt{decay\_helicity}, \ttt{?diagonal\_decay})'))
call var_list%append_log (var_str ("?diagonal_decay"), .false., &
intrinsic=.true., &
description=var_str ('Flag that -- in case of using factorized ' // &
'production and decays using the ($\to$) \ttt{unstable} command ' // &
'-- tells \whizard\ instead of full spin correlations to take ' // &
'only the diagonal entries in the spin-density matrix (i.e. ' // &
'classical spin correlations). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
'\ttt{decay\_helicity}, \ttt{?isotropic\_decay})'))
call var_list%append_int (var_str ("decay_helicity"), &
intrinsic=.true., &
description=var_str ('If this parameter is given an integer ' // &
'value, any particle decay triggered by a subsequent \ttt{unstable} ' // &
'declaration will receive a projection on the given helicity ' // &
'state for the unstable particle. (cf. also \ttt{unstable}, ' // &
'\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay}. The latter ' // &
'parameters, if true, take precdence over any \ttt{?decay\_helicity} setting.)'))
call var_list%append_log (var_str ("?polarized_events"), .false., &
intrinsic=.true., &
description=var_str ('Flag that allows to select certain helicity ' // &
'combinations in final state particles in the event files, ' // &
'and perform analysis on polarized event samples. (cf. also ' // &
'\ttt{simulate}, \ttt{polarized}, \ttt{unpolarized})'))
call var_list%append_string (var_str ("$polarization_mode"), &
var_str ("helicity"), &
intrinsic=.true., &
description=var_str ('String variable that specifies the mode in ' // &
'which the polarization of particles is handled when polarized events ' // &
'are written out. Possible options are \ttt{"ignore"}, \ttt{"helicity"}, ' // &
'\ttt{"factorized"}, and \ttt{"correlated"}. For more details cf. the ' // &
'detailed section.'))
call var_list%append_log (var_str ("?colorize_subevt"), .false., &
intrinsic=.true., &
description=var_str ('Flag that enables color-index tracking ' // &
'in the subevent (\ttt{subevt}) objects that are used for ' // &
'internal event analysis.'))
call var_list%append_real (var_str ("tolerance"), 0._default, &
intrinsic=.true., &
description=var_str ('Real variable that defines the absolute ' // &
'tolerance with which the (logical) function \ttt{expect} accepts ' // &
'equality or inequality: \ttt{tolerance = {\em <num>}}. This ' // &
'can e.g. be used for cross-section tests and backwards compatibility ' // &
'checks. (cf. also \ttt{expect})'))
call var_list%append_int (var_str ("checkpoint"), 0, &
intrinsic = .true., &
description=var_str ('Setting this integer variable to a positive ' // &
'integer $n$ instructs simulate to print out a progress summary ' // &
'every $n$ events.'))
call var_list%append_int (var_str ("event_callback_interval"), 0, &
intrinsic = .true., &
description=var_str ('Setting this integer variable to a positive ' // &
'integer $n$ instructs simulate to print out a progress summary ' // &
'every $n$ events.'))
call var_list%append_log (var_str ("?pacify"), .false., &
intrinsic=.true., &
description=var_str ('Flag that allows to suppress numerical ' // &
'noise and give screen and log file output with a lower number ' // &
'of significant digits. Mainly for debugging purposes. (cf. also ' // &
'\ttt{?sample\_pacify})'))
call var_list%append_string (var_str ("$out_file"), var_str (""), &
intrinsic=.true., &
description=var_str ('This character variable allows to specify ' // &
'the name of the data file to which the histogram and plot data ' // &
'are written (cf. also \ttt{write\_analysis}, \ttt{open\_out}, ' // &
'\ttt{close\_out})'))
call var_list%append_log (var_str ("?out_advance"), .true., &
intrinsic=.true., &
description=var_str ('Flag that sets advancing in the \ttt{printf} ' // &
'output commands, i.e. continuous printing with no line feed ' // &
'etc. (cf. also \ttt{printf})'))
call var_list%append_int (var_str ("real_range"), &
range (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This integer gives the decimal exponent ' // &
'range of the numeric model for the real float type in use. It cannot ' // &
'be set by the user. (cf. also \ttt{real\_precision}, ' // &
'\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
call var_list%append_int (var_str ("real_precision"), &
precision (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This integer gives the precision of ' // &
'the numeric model for the real float type in use. It cannot ' // &
'be set by the user. (cf. also \ttt{real\_range}, ' // &
'\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
call var_list%append_real (var_str ("real_epsilon"), &
epsilon (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This gives the smallest number $E$ ' // &
'of the same kind as the float type for which $1 + E > 1$. ' // &
'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
'\ttt{real\_tiny}, \ttt{real\_precision}).'))
call var_list%append_real (var_str ("real_tiny"), &
tiny (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This gives the smallest positive (non-zero) ' // &
'number in the numeric model for the real float type in use. ' // &
'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
'\ttt{real\_epsilon}, \ttt{real\_precision}).'))
end subroutine var_list_set_core_defaults
@ %def var_list_set_core_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_integration_defaults => var_list_set_integration_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_integration_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_integration_defaults
<<Variables: procedures>>=
module subroutine var_list_set_integration_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_string (var_str ("$integration_method"), var_str ("vamp"), &
intrinsic=.true., &
description=var_str ('This string variable specifies the method ' // &
'for performing the multi-dimensional phase-space integration. ' // &
'The default is the \vamp\ algorithm (\ttt{"vamp"}), other options ' // &
'are via the numerical midpoint rule (\ttt{"midpoint"}) or an ' // &
'alternate \vamptwo\ implementation that is MPI-parallelizable ' // &
'(\ttt{"vamp2"}).'))
call var_list%append_int (var_str ("threshold_calls"), 10, &
intrinsic=.true., &
description=var_str ('This integer variable gives a limit for ' // &
'the number of calls in a given channel which acts as a lower ' // &
'threshold for the channel weight. If the number of calls in ' // &
'that channel falls below this threshold, the weight is not ' // &
'lowered further but kept at this threshold. (cf. also ' // &
'\ttt{channel\_weights\_power})'))
call var_list%append_int (var_str ("min_calls_per_channel"), 10, &
intrinsic=.true., &
description=var_str ('Integer parameter that modifies the settings ' // &
"of the \vamp\ integrator's grid parameters. It sets the minimal " // &
'number every channel must be called. If the number of calls ' // &
'from the iterations is too small, \whizard\ will automatically ' // &
'increase the number of calls. (cf. \ttt{iterations}, \ttt{min\_calls\_per\_bin}, ' // &
'\ttt{min\_bins}, \ttt{max\_bins})'))
call var_list%append_int (var_str ("min_calls_per_bin"), 10, &
intrinsic=.true., &
description=var_str ('Integer parameter that modifies the settings ' // &
"of the \vamp\ integrator's grid parameters. It sets the minimal " // &
'number every bin in an integration dimension must be called. ' // &
'If the number of calls from the iterations is too small, \whizard\ ' // &
'will automatically increase the number of calls. (cf. \ttt{iterations}, ' // &
'\ttt{min\_calls\_per\_channel}, \ttt{min\_bins}, \ttt{max\_bins})'))
call var_list%append_int (var_str ("min_bins"), 3, &
intrinsic=.true., &
description=var_str ('Integer parameter that modifies the settings ' // &
"of the \vamp\ integrator's grid parameters. It sets the minimal " // &
'number of bins per integration dimension. (cf. \ttt{iterations}, ' // &
'\ttt{max\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})'))
call var_list%append_int (var_str ("max_bins"), 20, &
intrinsic=.true., &
description=var_str ('Integer parameter that modifies the settings ' // &
"of the \vamp\ integrator's grid parameters. It sets the maximal " // &
'number of bins per integration dimension. (cf. \ttt{iterations}, ' // &
'\ttt{min\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})'))
call var_list%append_log (var_str ("?stratified"), .true., &
intrinsic=.true., &
description=var_str ('Flag that switches between stratified ' // &
'and importance sampling for the \vamp\ integration method.'))
call var_list%append_log (var_str ("?use_vamp_equivalences"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether equivalence ' // &
'relations (symmetries) between different integration channels ' // &
'are used by the \vamp\ integrator.'))
call var_list%append_log (var_str ("?vamp_verbose"), .false., &
intrinsic=.true., &
description=var_str ('Flag that sets the chattiness of the \vamp\ ' // &
'integrator. If set, not only errors, but also all warnings and ' // &
'messages will be written out (not the default). (cf. also \newline ' // &
'\ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_global\_verbose}, ' // &
'\ttt{?vamp\_history\_channels}, \newline \ttt{?vamp\_history\_channels\_verbose})'))
call var_list%append_log (var_str ("?vamp_history_global"), &
.true., intrinsic=.true., &
description=var_str ('Flag that decides whether the global history ' // &
'of the grid adaptation of the \vamp\ integrator are written ' // &
'into the process logfiles. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // &
'\ttt{?vamp\_history\_channels}, \ttt{?vamp\_history\_channels\_verbose}, ' // &
'\ttt{?vamp\_verbose})'))
call var_list%append_log (var_str ("?vamp_history_global_verbose"), &
.false., intrinsic=.true., &
description=var_str ('Flag that decides whether the global history ' // &
'of the grid adaptation of the \vamp\ integrator are written ' // &
'into the process logfiles in an extended version. Only for debugging ' // &
'purposes. (cf. also \ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_channels}, ' // &
'\ttt{?vamp\_verbose}, \ttt{?vamp\_history\_channels\_verbose})'))
call var_list%append_log (var_str ("?vamp_history_channels"), &
.false., intrinsic=.true., &
description=var_str ('Flag that decides whether the history of ' // &
'the grid adaptation of the \vamp\ integrator for every single ' // &
'channel are written into the process logfiles. Only for debugging ' // &
'purposes. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // &
'\ttt{?vamp\_history\_global}, \ttt{?vamp\_verbose}, \newline ' // &
'\ttt{?vamp\_history\_channels\_verbose})'))
call var_list%append_log (var_str ("?vamp_history_channels_verbose"), &
.false., intrinsic=.true., &
description=var_str ('Flag that decides whether the history of ' // &
'the grid adaptation of the \vamp\ integrator for every single ' // &
'channel are written into the process logfiles in an extended ' // &
'version. Only for debugging purposes. (cf. also \ttt{?vamp\_history\_global}, ' // &
'\ttt{?vamp\_history\_channels}, \ttt{?vamp\_verbose}, \ttt{?vamp\_history\_global\_verbose})'))
call var_list%append_string (var_str ("$run_id"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable \ttt{\$run\_id = "{\em ' // &
'<id>}"} that allows to set a special ID for a particular process ' // &
'run, e.g. in a scan. The run ID is then attached to the process ' // &
'log file: \newline \ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em ' // &
'<id>}.log}, the \vamp\ grid file: \newline \ttt{{\em <proc\_name>}\_{\em ' // &
'<proc\_comp>}.{\em <id>}.vg}, and the phase space file: \newline ' // &
'\ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em <id>}.phs}. ' // &
'The run ID string distinguishes among several runs for the ' // &
'same process. It identifies process instances with respect ' // &
'to adapted integration grids and similar run-specific data. ' // &
'The run ID is kept when copying processes for creating instances, ' // &
'however, so it does not distinguish event samples. (cf.\ also ' // &
'\ttt{\$job\_id}, \ttt{\$compile\_workspace}'))
call var_list%append_int (var_str ("n_calls_test"), 0, &
intrinsic=.true., &
description=var_str ('Integer variable that allows to set a ' // &
'certain number of matrix element sampling test calls without ' // &
'actually integrating the process under consideration. (cf. ' // &
'\ttt{integrate})'))
call var_list%append_log (var_str ("?integration_timer"), .true., &
intrinsic=.true., &
description=var_str ('This flag switches the integration timer ' // &
'on and off, that gives the estimate for the duration of the ' // &
'generation of 10,000 unweighted events for each integrated ' // &
'process.'))
call var_list%append_log (var_str ("?check_grid_file"), .true., &
intrinsic=.true., &
description=var_str ('Setting this to false turns off all sanity ' // &
'checks when reading a grid file with previous integration data. ' // &
'Use this at your own risk; the program may return wrong results ' // &
'or crash if data do not match. (cf. also \ttt{?check\_event\_file}, \ttt{?check\_phs\_file}) '))
call var_list%append_real (var_str ("accuracy_goal"), 0._default, &
intrinsic=.true., &
description=var_str ('Real parameter that allows the user to ' // &
'set a minimal accuracy that should be achieved in the Monte-Carlo ' // &
'integration of a certain process. If that goal is reached, ' // &
'grid and weight adapation stop, and this result is used for ' // &
'simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
'\ttt{error\_goal}, \ttt{relative\_error\_goal}, ' // &
'\ttt{error\_threshold})'))
call var_list%append_real (var_str ("error_goal"), 0._default, &
intrinsic=.true., &
description=var_str ('Real parameter that allows the user to ' // &
'set a minimal absolute error that should be achieved in the ' // &
'Monte-Carlo integration of a certain process. If that goal ' // &
'is reached, grid and weight adapation stop, and this result ' // &
'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
'\ttt{accuracy\_goal}, \ttt{relative\_error\_goal}, \ttt{error\_threshold})'))
call var_list%append_real (var_str ("relative_error_goal"), 0._default, &
intrinsic=.true., &
description=var_str ('Real parameter that allows the user to ' // &
'set a minimal relative error that should be achieved in the ' // &
'Monte-Carlo integration of a certain process. If that goal ' // &
'is reached, grid and weight adaptation stop, and this result ' // &
'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
'\ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{error\_threshold})'))
call var_list%append_int (var_str ("integration_results_verbosity"), 1, &
intrinsic=.true., &
description=var_str ('Integer parameter for the verbosity of ' // &
'the integration results in the process-specific logfile.'))
call var_list%append_real (var_str ("error_threshold"), &
0._default, intrinsic=.true., &
description=var_str ('The real parameter \ttt{error\_threshold ' // &
'= {\em <num>}} declares that any error value (in absolute numbers) ' // &
'smaller than \ttt{{\em <num>}} is to be considered zero. The ' // &
'units are \ttt{fb} for scatterings and \ttt{GeV} for decays. ' // &
'(cf. also \ttt{integrate}, \ttt{iterations}, \ttt{accuracy\_goal}, ' // &
'\ttt{error\_goal}, \ttt{relative\_error\_goal})'))
call var_list%append_real (var_str ("channel_weights_power"), 0.25_default, &
intrinsic=.true., &
description=var_str ('Real parameter that allows to vary the ' // &
'exponent of the channel weights for the \vamp\ integrator.'))
call var_list%append_string (var_str ("$integrate_workspace"), &
intrinsic=.true., &
description=var_str ('Character string that tells \whizard\ ' // &
'the subdirectory where to find the run-specific phase-space ' // &
'configuration and the \vamp\ and \vamptwo\ grid files. ' // &
'If undefined (as per default), \whizard\ creates them and ' // &
'searches for them in the ' // &
'current directory. (cf. also \ttt{\$job\_id}, ' // &
'\ttt{\$run\_id}, \ttt{\$compile\_workspace})'))
call var_list%append_int (var_str ("vamp_grid_checkpoint"), 1, &
intrinsic=.true., &
description=var_str ('Integer parameter for setting checkpoints to save ' // &
'the current state of the grids and the results so far of the integration. ' // &
'Allowed are all positive integer. Zero values corresponds to a checkpoint ' // &
'after each integration pass, a one value to a checkpoint after each iteration ' // &
'(default) and an \(N\) value correspond to a checkpoint after \(N\) iterations ' // &
' or after each pass, respectively.'))
call var_list%append_string (var_str ("$vamp_grid_format"), var_str ("ascii"), &
intrinsic=.true., &
description=var_str ('Character string that tells \whizard\ ' // &
'the file format for \ttt{vamp2} to use for writing and reading ' // &
'the configuration for the multi-channel integration setup and the ' // &
'\vamptwo\ (only) grid data. The values can be \ttt{ascii} for a single ' // &
'human-readable grid file with ending \ttt{.vg2} or \ttt{binary} for two files, ' // &
'a human-readable header file with ending \ttt{.vg2} and binary file with ending ' // &
'\ttt{.vgx2} storing the grid data.' // &
'The main purpose of the binary format is to perform faster I/O, e.g. for HPC runs.' // &
'\whizard\ can convert between the different file formats automatically.'))
call var_list%append_string (var_str ("$vamp_parallel_method"), var_str ("simple"), &
intrinsic=.true., &
description=var_str ('Character string that tells \whizard\ ' // &
'the parallel method to use for parallel integration within \ttt{vamp2}.' // &
' (i) \ttt{simple} (default) is a local work sharing approach without the need of communication ' // &
'between all workers except for the communication during result collection.' // &
' (ii) \ttt{load} is a global queue approach where the master worker acts as a' // &
'governor listening and providing work for each worker. The queue is filled and assigned with workers ' // &
'a-priori with respect to the assumed computational impact of each channel.' // &
'Both approaches use the same mechanism for result collection using non-blocking ' // &
'communication allowing for a efficient usage of the computing resources.'))
end subroutine var_list_set_integration_defaults
@ %def var_list_set_integration_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_phase_space_defaults => var_list_set_phase_space_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_phase_space_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_phase_space_defaults
<<Variables: procedures>>=
module subroutine var_list_set_phase_space_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_string (var_str ("$phs_method"), var_str ("default"), &
intrinsic=.true., &
description=var_str ('String variable that allows to choose ' // &
'the phase-space parameterization method. The default is the ' // &
'\ttt{"wood"} method that takes into account electroweak/BSM ' // &
'resonances. Note that this might not be the best choice for ' // &
'(pure) QCD amplitudes. (cf. also \ttt{\$phs\_file})'))
call var_list%append_log (var_str ("?vis_channels"), .false., &
intrinsic=.true., &
description=var_str ('Optional logical argument for the \ttt{integrate} ' // &
'command that demands \whizard\ to generate a PDF or postscript ' // &
'output showing the classification of the found phase space ' // &
'channels (if the phase space method \ttt{wood} has been used) ' // &
'according to their properties: \ttt{integrate (foo) \{ iterations=3:10000 ' // &
'?vis\_channels = true \}}. The default is \ttt{false}. (cf. ' // &
'also \ttt{integrate}, \ttt{?vis\_history})'))
call var_list%append_log (var_str ("?check_phs_file"), .true., &
intrinsic=.true., &
description=var_str ('Setting this to false turns off all sanity ' // &
'checks when reading a previously generated phase-space configuration ' // &
'file. Use this at your own risk; the program may return wrong ' // &
'results or crash if data do not match. (cf. also \ttt{?check\_event\_file}, ' // &
'\ttt{?check\_grid\_file})'))
call var_list%append_string (var_str ("$phs_file"), var_str (""), &
intrinsic=.true., &
description=var_str ('This string variable allows the user to ' // &
'set an individual file name for the phase space parameterization ' // &
'for a particular process: \ttt{\$phs\_file = "{\em <file\_name>}"}. ' // &
'If not set, the default is \ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em ' // &
'<run\_id>}.phs}. (cf. also \ttt{\$phs\_method})'))
call var_list%append_log (var_str ("?phs_only"), .false., &
intrinsic=.true., &
description=var_str ('Flag (particularly as optional argument ' // &
'of the $\to$ \ttt{integrate} command) that allows to only generate ' // &
'the phase space file, but not perform the integration. (cf. ' // &
'also \ttt{\$phs\_method}, \ttt{\$phs\_file})'))
call var_list%append_real (var_str ("phs_threshold_s"), 50._default, &
intrinsic=.true., &
description=var_str ('For the phase space method \ttt{wood}, ' // &
'this real parameter sets the threshold below which particles ' // &
'are assumed to be massless in the $s$-channel like kinematic ' // &
'regions. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_off\_shell}, ' // &
'\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // &
'\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
'\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})'))
call var_list%append_real (var_str ("phs_threshold_t"), 100._default, &
intrinsic=.true., &
description=var_str ('For the phase space method \ttt{wood}, ' // &
'this real parameter sets the threshold below which particles ' // &
'are assumed to be massless in the $t$-channel like kinematic ' // &
'regions. (cf. also \ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, ' // &
'\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // &
'\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
'\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})'))
call var_list%append_int (var_str ("phs_off_shell"), 2, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the number ' // &
'of off-shell (not $t$-channel-like, non-resonant) lines that ' // &
'are taken into account to find a valid phase-space setup in ' // &
'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // &
'\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, ' // &
'\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
'\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // &
'\ttt{?phs\_s\_mapping})'))
call var_list%append_int (var_str ("phs_t_channel"), 6, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the number ' // &
'of $t$-channel propagators in multi-peripheral diagrams that ' // &
'are taken into account to find a valid phase-space setup in ' // &
'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // &
'\ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
'\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
'\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // &
'\ttt{?phs\_s\_mapping})'))
call var_list%append_real (var_str ("phs_e_scale"), 10._default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the energy scale ' // &
'that acts as a cutoff for parameterizing radiation-like kinematics ' // &
'in the \ttt{wood} phase space method. \whizard\ takes the maximum ' // &
'of this value and the width of the propagating particle as ' // &
'a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // &
'\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
'\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
call var_list%append_real (var_str ("phs_m_scale"), 10._default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the mass scale ' // &
'that acts as a cutoff for parameterizing collinear and infrared ' // &
'kinematics in the \ttt{wood} phase space method. \whizard\ ' // &
'takes the maximum of this value and the mass of the propagating ' // &
'particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
'\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
'\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
call var_list%append_real (var_str ("phs_q_scale"), 10._default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the momentum ' // &
'transfer scale that acts as a cutoff for parameterizing $t$- ' // &
'and $u$-channel like kinematics in the \ttt{wood} phase space ' // &
'method. \whizard\ takes the maximum of this value and the mass ' // &
'of the propagating particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, ' // &
'\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, ' // &
'\ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
'\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp}, ' // &
'\newline \ttt{?phs\_s\_mapping})'))
call var_list%append_log (var_str ("?phs_keep_nonresonant"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the \ttt{wood} ' // &
'phase space method takes into account also non-resonant contributions. ' // &
'(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // &
'\ttt{phs\_q\_scale}, \ttt{phs\_e\_scale}, \ttt{?phs\_step\_mapping}, ' // &
'\newline \ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
call var_list%append_log (var_str ("?phs_step_mapping"), .true., &
intrinsic=.true., &
description=var_str ('Flag that switches on (or off) a particular ' // &
'phase space mapping for resonances, where the mass and width ' // &
'of the resonance are explicitly set as channel cutoffs. (cf. ' // &
'also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, ' // &
'\ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, \newline \ttt{phs\_m\_scale}, ' // &
'\ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, \ttt{?phs\_step\_mapping\_exp}, ' // &
'\newline \ttt{?phs\_s\_mapping})'))
call var_list%append_log (var_str ("?phs_step_mapping_exp"), .true., &
intrinsic=.true., &
description=var_str ('Flag that switches on (or off) a particular ' // &
'phase space mapping for resonances, where the mass and width ' // &
'of the resonance are explicitly set as channel cutoffs. This ' // &
'is an exponential mapping in contrast to ($\to$) \ttt{?phs\_step\_mapping}. ' // &
'(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
'\ttt{phs\_m\_scale}, \newline \ttt{?phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
'\ttt{?phs\_step\_mapping}, \ttt{?phs\_s\_mapping})'))
call var_list%append_log (var_str ("?phs_s_mapping"), .true., &
intrinsic=.true., &
description=var_str ('Flag that allows special mapping for $s$-channel ' // &
'resonances. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
'\ttt{phs\_m\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, ' // &
'\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp})'))
call var_list%append_log (var_str ("?vis_history"), .false., &
intrinsic=.true., &
description=var_str ('Optional logical argument for the \ttt{integrate} ' // &
'command that demands \whizard\ to generate a PDF or postscript ' // &
'output showing the adaptation history of the Monte-Carlo integration ' // &
'of the process under consideration. (cf. also \ttt{integrate}, ' // &
'\ttt{?vis\_channels})'))
end subroutine var_list_set_phase_space_defaults
@ %def var_list_set_phase_space_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_gamelan_defaults => var_list_set_gamelan_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_gamelan_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_gamelan_defaults
<<Variables: procedures>>=
module subroutine var_list_set_gamelan_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_int (&
var_str ("n_bins"), 20, &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: integer value that sets the number of bins in histograms. ' // &
'(cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
'\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
'\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, ' // &
'\ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, ' // &
'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
'\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
'\ttt{\$symbol})'))
call var_list%append_log (&
var_str ("?normalize_bins"), .false., &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that determines whether the weights shall be normalized ' // &
'to the bin width or not. (cf. also \ttt{n\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
'\newline \ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \newline ' // &
'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
'\ttt{\$err\_options})'))
call var_list%append_string (var_str ("$obs_label"), var_str (""), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: this is a string variable \ttt{\$obs\_label = "{\em ' // &
'<LaTeX\_Code>}"} that allows to attach a label to a plotted ' // &
'or histogrammed observable. (cf. also \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
'\ttt{graph\_height\_mm}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
'\ttt{?draw\_histogram}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
call var_list%append_string (var_str ("$obs_unit"), var_str (""), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: this is a string variable \ttt{\$obs\_unit = "{\em ' // &
'<LaTeX\_Code>}"} that allows to attach a \LaTeX\ physical unit ' // &
'to a plotted or histogrammed observable. (cf. also \ttt{n\_bins}, ' // &
'\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
'\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
'\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
call var_list%append_string (var_str ("$title"), var_str (""), &
intrinsic=.true., &
description=var_str ('This string variable sets the title of ' // &
'a plot in a \whizard\ analysis setup, e.g. a histogram or an ' // &
'observable. The syntax is \ttt{\$title = "{\em <your title>}"}. ' // &
'This title appears as a section header in the analysis file, ' // &
'but not in the screen output of the analysis. (cf. also \ttt{n\_bins}, ' // &
'\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
'\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
'\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \newline \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
call var_list%append_string (var_str ("$description"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable that allows to specify ' // &
'a description text for the analysis, \ttt{\$description = "{\em ' // &
'<LaTeX analysis descr.>}"}. This line appears below the title ' // &
'of a corresponding analysis, on top of the respective plot. ' // &
'(cf. also \ttt{analysis}, \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, ' // &
'\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
'\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
call var_list%append_string (var_str ("$x_label"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable, \ttt{\$x\_label = "{\em ' // &
'<LaTeX code>}"}, that sets the $x$ axis label in a plot or ' // &
'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // &
'\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$y\_label}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
'\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
call var_list%append_string (var_str ("$y_label"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable, \ttt{\$y\_label = "{\em ' // &
'<LaTeX\_code>}"}, that sets the $y$ axis label in a plot or ' // &
'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // &
'\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{?y\_log}, ' // &
'\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
'\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
'\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
call var_list%append_int (var_str ("graph_width_mm"), 130, &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: integer value that sets the width of a graph or histogram ' // &
'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // &
'\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_int (var_str ("graph_height_mm"), 90, &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: integer value that sets the height of a graph or histogram ' // &
'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // &
'\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_log (var_str ("?y_log"), .false., &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that makes the $y$ axis logarithmic. (cf. also ' // &
'\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
'\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
'\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // &
'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
'\ttt{\$symbol})'))
call var_list%append_log (var_str ("?x_log"), .false., &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that makes the $x$ axis logarithmic. (cf. also ' // &
'\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
'\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
'\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // &
'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
'\ttt{\$symbol})'))
call var_list%append_real (var_str ("x_min"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: real parameter that sets the lower limit of the $x$ ' // &
'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_real (var_str ("x_max"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: real parameter that sets the upper limit of the $x$ ' // &
'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
'\ttt{x\_min}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_real (var_str ("y_min"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: real parameter that sets the lower limit of the $y$ ' // &
'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
'\ttt{x\_max}, \ttt{y\_max}, \ttt{x\_min}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_real (var_str ("y_max"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: real parameter that sets the upper limit of the $y$ ' // &
'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
'\ttt{x\_max}, \ttt{x\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_string (var_str ("$gmlcode_bg"), var_str (""), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: string variable that allows to define a background ' // &
'for plots and histograms (i.e. it is overwritten by the plot/histogram), ' // &
'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // &
'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
'\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
'\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // &
'\ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_string (var_str ("$gmlcode_fg"), var_str (""), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: string variable that allows to define a foreground ' // &
'for plots and histograms (i.e. it overwrites the plot/histogram), ' // &
'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // &
'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
'\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // &
'\ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_log (var_str ("?draw_histogram"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that tells \whizard\ to either plot data as a ' // &
'histogram or as a continuous line (if $\to$ \ttt{?draw\_curve} ' // &
'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
'\ttt{\$symbol})'))
call var_list%append_log (var_str ("?draw_base"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that tells \whizard\ to insert a \ttt{base} statement ' // &
'in the analysis code to calculate the plot data from a data ' // &
'set. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
'\ttt{\$symbol}, \newline \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
'\newline \ttt{\$err\_options})'))
call var_list%append_log (var_str ("?draw_piecewise"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that tells \whizard\ to data from a data set piecewise, ' // &
'i.e. histogram style. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, ' // &
'\ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_base}, \ttt{?fill\_curve}, ' // &
'\ttt{\$symbol}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
'\ttt{\$err\_options})'))
call var_list%append_log (var_str ("?fill_curve"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that tells \whizard\ to fill data curves (e.g. ' // &
'as a histogram). The style can be set with $\to$ \ttt{\$fill\_options ' // &
'= "{\em <LaTeX\_code>}"}. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, ' // &
'\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
'\ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_log (var_str ("?draw_curve"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that tells \whizard\ to either plot data as a ' // &
'continuous line or as a histogram (if $\to$ \ttt{?draw\_histogram} ' // &
'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
'\ttt{?draw\_histogram}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
'\ttt{\$symbol})'))
call var_list%append_log (var_str ("?draw_errors"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that determines whether error bars should be drawn ' // &
'or not. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
'\newline \ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_log (var_str ("?draw_symbols"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: flag that determines whether particular symbols (specified ' // &
'by $\to$ \ttt{\$symbol = "{\em <LaTeX\_code>}"}) should be ' // &
'used for plotting data points (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
'\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
'\ttt{?fill\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_curve}, ' // &
'\ttt{?draw\_errors}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
'\newline \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_string (var_str ("$fill_options"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: \ttt{\$fill\_options = "{\em <LaTeX\_code>}"} is a ' // &
'string variable that allows to set fill options when plotting ' // &
'data as filled curves with the $\to$ \ttt{?fill\_curve} flag. ' // &
'For more details see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
'\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
'\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
'\newline \ttt{?draw\_symbols}, \ttt{?fill\_curve}, \ttt{\$draw\_options}, ' // &
'\ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_string (var_str ("$draw_options"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: \ttt{\$draw\_options = "{\em <LaTeX\_code>}"} is a ' // &
'string variable that allows to set specific drawing options ' // &
'for plots and histograms. For more details see the \gamelan\ ' // &
'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
'\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
'\ttt{?draw\_histogram}, \ttt{\$err\_options}, \ttt{\$symbol})'))
call var_list%append_string (var_str ("$err_options"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: \ttt{\$err\_options = "{\em <LaTeX\_code>}"} is a string ' // &
'variable that allows to set specific drawing options for errors ' // &
'in plots and histograms. For more details see the \gamelan\ ' // &
'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
'\ttt{?draw\_histogram}, \ttt{\$draw\_options}, \ttt{\$symbol})'))
call var_list%append_string (var_str ("$symbol"), &
intrinsic=.true., &
description=var_str ("Settings for \whizard's internal graphics " // &
'output: \ttt{\$symbol = "{\em <LaTeX\_code>}"} is a string ' // &
'variable for the symbols that should be used for plotting data ' // &
'points. (cf. also \ttt{\$obs\_label}, \ttt{?normalize\_bins}, ' // &
'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
'\ttt{\$y\_label}, \newline \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
'\newline \ttt{?draw\_histogram}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \newline \ttt{\$err\_options}, ' // &
'\ttt{?draw\_symbols})'))
call var_list%append_log (&
var_str ("?analysis_file_only"), .false., &
intrinsic=.true., &
description=var_str ('Allows to specify that only \LaTeX\ files ' // &
"for \whizard's graphical analysis are written out, but not processed. " // &
'(cf. \ttt{compile\_analysis}, \ttt{write\_analysis})'))
end subroutine var_list_set_gamelan_defaults
@ %def var_list_set_gamelan_defaults
@ FastJet parameters and friends
<<Variables: var list: TBP>>=
procedure :: set_clustering_defaults => var_list_set_clustering_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_clustering_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_clustering_defaults
<<Variables: procedures>>=
module subroutine var_list_set_clustering_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_int (&
var_str ("kt_algorithm"), &
kt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the ' // &
'interfaced external \fastjet\ package. (cf. also ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
'\ttt{plugin\_algorithm}, ' // &
'\newline\ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
call var_list%append_int (&
var_str ("cambridge_algorithm"), &
cambridge_algorithm, intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("antikt_algorithm"), &
antikt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("genkt_algorithm"), &
genkt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_for\_passive\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r}), \ttt{jet\_p}'))
call var_list%append_int (&
var_str ("cambridge_for_passive_algorithm"), &
cambridge_for_passive_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_algorithm}, \ttt{plugin\_algorithm}, \newline ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("genkt_for_passive_algorithm"), &
genkt_for_passive_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
call var_list%append_int (&
var_str ("ee_kt_algorithm"), &
ee_kt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_genkt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("ee_genkt_algorithm"), &
ee_genkt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_kt\_algorithm}, ' // &
'\ttt{jet\_r}), \ttt{jet\_p})'))
call var_list%append_int (&
var_str ("plugin_algorithm"), &
plugin_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("undefined_jet_algorithm"), &
undefined_jet_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('This is just a place holder for any kind of jet ' // &
'jet algorithm that is not further specified. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r}, \ttt{plugin\_algorithm})'))
call var_list%append_int (&
var_str ("jet_algorithm"), undefined_jet_algorithm, &
intrinsic = .true., &
description=var_str ('Variable that allows to set the type of ' // &
'jet algorithm when using the external \fastjet\ library. It ' // &
'accepts one of the following algorithms: ($\to$) \ttt{kt\_algorithm}, ' // &
'\newline ($\to$) \ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
'($\to$) \ttt{antikt\_algorithm}, ($\to$) \ttt{plugin\_algorithm}, ' // &
'($\to$) \ttt{genkt\_[for\_passive\_]algorithm}, ($\to$) ' // &
'\ttt{ee\_[gen]kt\_algorithm}). (cf. also \ttt{cluster}, ' // &
'\ttt{jet\_p}, \ttt{jet\_r}, \ttt{jet\_ycut})'))
call var_list%append_real (&
var_str ("jet_r"), 0._default, &
intrinsic = .true., &
description=var_str ('Value for the distance measure $R$ used in ' // &
'some algorithms that are available via the interface ' // &
'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
'\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_ycut})'))
call var_list%append_real (&
var_str ("jet_p"), 0._default, &
intrinsic = .true., &
description=var_str ('Value for the exponent of the distance measure $R$ in ' // &
'the generalized $k_T$ algorithms that are available via the interface ' // &
'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
'\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r}, \newline\ttt{jet\_ycut})'))
call var_list%append_real (&
var_str ("jet_ycut"), 0._default, &
intrinsic = .true., &
description=var_str ('Value for the $y$ separation measure used in ' // &
'the Cambridge-Aachen algorithms that are available via the interface ' // &
'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
'\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})'))
call var_list%append_real (&
var_str ("jet_dcut"), 0._default, &
intrinsic = .true., &
description=var_str ('Value for the $d_{ij}$ separation measure used in ' // &
'the $e^+e^- k_T$ algorithms that are available via the interface ' // &
'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
'\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})'))
call var_list%append_log (&
var_str ("?keep_flavors_when_clustering"), .false., &
intrinsic = .true., &
description=var_str ('The logical variable \ttt{?keep\_flavors\_when\_clustering ' // &
'= true/false} specifies whether the flavor of a jet should be ' // &
'kept during \ttt{cluster} when a jet consists of one quark and ' // &
'zero or more gluons. Especially useful for cuts on b-tagged ' // &
'jets (cf. also \ttt{cluster}).'))
end subroutine var_list_set_clustering_defaults
@ %def var_list_set_clustering_defaults
@ Frixione isolation and photon recombination parameters and all that:
<<Variables: var list: TBP>>=
procedure :: set_isolation_recomb_defaults => &
var_list_set_isolation_recomb_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_isolation_recomb_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_isolation_recomb_defaults
<<Variables: procedures>>=
module subroutine var_list_set_isolation_recomb_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_real (var_str ("photon_iso_eps"), 1._default, &
intrinsic=.true., &
description=var_str ('Photon isolation parameter $\epsilon_\gamma$ ' // &
'(energy fraction) from hep-ph/9801442 (cf. also ' // &
'\ttt{photon\_iso\_n}, \ttt{photon\_iso\_r0})'))
call var_list%append_real (var_str ("photon_iso_n"), 1._default, &
intrinsic=.true., &
description=var_str ('Photon isolation parameter $n$ ' // &
'(cone function exponent) from hep-ph/9801442 (cf. also ' // &
'\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_r0})'))
call var_list%append_real (var_str ("photon_iso_r0"), 0.4_default, &
intrinsic=.true., &
description=var_str ('Photon isolation parameter $R_0^\gamma$ ' // &
'(isolation cone radius) from hep-ph/9801442 (cf. also ' // &
'\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_n})'))
call var_list%append_real (var_str ("photon_rec_r0"), 0.1_default, &
intrinsic=.true., &
description=var_str ('Photon recombination parameter $R_0^\gamma$ ' // &
'for photon recombination in NLO EW calculations'))
call var_list%append_log (&
var_str ("?keep_flavors_when_recombining"), .true., &
intrinsic = .true., &
description=var_str ('The logical variable \ttt{?keep\_flavors\_when\_recombining ' // &
'= true/false} specifies whether the flavor of a particle should be ' // &
'kept during \ttt{photon\_recombination} when a jet/lepton consists of one lepton/quark ' // &
'and zero or more photons (cf. also \ttt{photon\_recombination}).'))
end subroutine var_list_set_isolation_recomb_defaults
@ %def var_list_set_isolation_recomb_defaults
<<Variables: var list: TBP>>=
procedure :: set_eio_defaults => var_list_set_eio_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_eio_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_eio_defaults
<<Variables: procedures>>=
module subroutine var_list_set_eio_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_string (var_str ("$sample"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable to set the (base) name ' // &
'of the event output format, e.g. \ttt{\$sample = "foo"} will ' // &
'result in an intrinsic binary format event file \ttt{foo.evx}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{simulate}, \ttt{hepevt}, ' // &
'\ttt{ascii}, \ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, ' // &
'\ttt{hepmc}, \ttt{lhef}, \ttt{lha}, \ttt{stdhep}, \ttt{stdhep\_up}, ' // &
'\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, \ttt{sample\_max\_tries})'))
call var_list%append_string (var_str ("$sample_normalization"), var_str ("auto"),&
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
'normalization of generated events. There are four options: ' // &
'option \ttt{"1"} (events normalized to one), \ttt{"1/n"} (sum ' // &
'of all events in a sample normalized to one), \ttt{"sigma"} ' // &
'(events normalized to the cross section of the process), and ' // &
'\ttt{"sigma/n"} (sum of all events normalized to the cross ' // &
'section). The default is \ttt{"auto"} where unweighted events ' // &
'are normalized to one, and weighted ones to the cross section. ' // &
'(cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
'\ttt{?sample\_pacify}, \ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // &
'\ttt{sample\_split\_n\_kbytes})'))
call var_list%append_log (var_str ("?sample_pacify"), .false., &
intrinsic=.true., &
description=var_str ('Flag, mainly for debugging purposes: suppresses ' // &
'numerical noise in the output of a simulation. (cf. also \ttt{simulate}, ' // &
'\ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}, ' // &
'\ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // &
'\ttt{sample\_split\_n\_kbytes})'))
call var_list%append_log (var_str ("?sample_select"), .true., &
intrinsic=.true., &
description=var_str ('Logical that determines whether a selection should ' // &
'be applied to the output event format or not. If set to \ttt{false} a ' // &
'selection is only considered for the evaluation of observables. (cf. ' // &
'\ttt{select}, \ttt{selection}, \ttt{analysis})'))
call var_list%append_int (var_str ("sample_max_tries"), 10000, &
intrinsic = .true., &
description=var_str ('Integer variable that sets the maximal ' // &
'number of tries for generating a single event. The event might ' // &
'be vetoed because of a very low unweighting efficiency, errors ' // &
'in the event transforms like decays, shower, matching, hadronization ' // &
'etc. (cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
'\ttt{?sample\_pacify}, \ttt{\$sample\_normalization}, ' // &
'\ttt{sample\_split\_n\_evt}, \newline\ttt{sample\_split\_n\_kbytes})'))
call var_list%append_int (var_str ("sample_split_n_evt"), 0, &
intrinsic = .true., &
description=var_str ('When generating events, this integer parameter ' // &
'\ttt{sample\_split\_n\_evt = {\em <num>}} gives the number \ttt{{\em ' // &
'<num>}} of breakpoints in the event files, i.e. it splits the ' // &
'event files into \ttt{{\em <num>} + 1} parts. The parts are ' // &
'denoted by \ttt{{\em <proc\_name>}.{\em <split\_index>}.{\em ' // &
'<evt\_extension>}}. Here, \ttt{{\em <split\_index>}} is an integer ' // &
'running from \ttt{0} to \ttt{{\em <num>}}. The start can be ' // &
'reset by ($\to$) \ttt{sample\_split\_index}. (cf. also \ttt{simulate}, ' // &
'\ttt{\$sample}, \ttt{sample\_format}, \ttt{sample\_max\_tries}, ' // &
'\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, ' // &
'\ttt{sample\_split\_n\_kbytes})'))
call var_list%append_int (var_str ("sample_split_n_kbytes"), 0, &
intrinsic = .true., &
description=var_str ('When generating events, this integer parameter ' // &
'\ttt{sample\_split\_n\_kbytes = {\em <num>}} limits the file ' // &
'size of event files. Whenever an event file has exceeded this ' // &
'size, counted in kilobytes, the following events will be written ' // &
'to a new file. The naming conventions are the same as for ' // &
'\ttt{sample\_split\_n\_evt}. (cf. also \ttt{simulate}, \ttt{\$sample}, ' // &
'\ttt{sample\_format}, \ttt{sample\_max\_tries}, \ttt{\$sample\_normalization}, ' // &
'\ttt{?sample\_pacify})'))
call var_list%append_int (var_str ("sample_split_index"), 0, &
intrinsic = .true., &
description=var_str ('Integer number that gives the starting ' // &
'index \ttt{sample\_split\_index = {\em <split\_index>}} for ' // &
'the numbering of event samples \ttt{{\em <proc\_name>}.{\em ' // &
'<split\_index>}.{\em <evt\_extension>}} split by the \ttt{sample\_split\_n\_evt ' // &
'= {\em <num>}}. The index runs from \ttt{{\em <split\_index>}} ' // &
'to \newline \ttt{{\em <split\_index>} + {\em <num>}}. (cf. also \ttt{simulate}, ' // &
'\ttt{\$sample}, \ttt{sample\_format}, \newline\ttt{\$sample\_normalization}, ' // &
'\ttt{sample\_max\_tries}, \ttt{?sample\_pacify})'))
call var_list%append_string (var_str ("$rescan_input_format"), var_str ("raw"), &
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
'event format of the event file that is to be rescanned by the ' // &
'($\to$) \ttt{rescan} command.'))
call var_list%append_log (var_str ("?read_raw"), .true., &
intrinsic=.true., &
description=var_str ('This flag demands \whizard\ to (try to) ' // &
'read events (from the internal binary format) first before ' // &
'generating new ones. (cf. \ttt{simulate}, \ttt{?write\_raw}, ' // &
'\ttt{\$sample}, \ttt{sample\_format})'))
call var_list%append_log (var_str ("?write_raw"), .true., &
intrinsic=.true., &
description=var_str ("Flag to write out events in \whizard's " // &
'internal binary format. (cf. \ttt{simulate}, \ttt{?read\_raw}, ' // &
'\ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_raw"), var_str ("evx"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_raw ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
"to which events in \whizard's internal format are written. If " // &
'not set, the default file name and suffix is \ttt{{\em <process\_name>}.evx}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_default"), var_str ("evt"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_default ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in a the standard \whizard\ verbose ASCII format ' // &
'are written. If not set, the default file name and suffix is ' // &
'\ttt{{\em <process\_name>}.evt}. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample})'))
call var_list%append_string (var_str ("$debug_extension"), var_str ("debug"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$debug\_extension ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in a long verbose format with debugging information ' // &
'are written. If not set, the default file name and suffix is ' // &
'\ttt{{\em <process\_name>}.debug}. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample}, \ttt{?debug\_process}, \ttt{?debug\_transforms}, ' // &
'\ttt{?debug\_decay}, \ttt{?debug\_verbose})'))
call var_list%append_log (var_str ("?debug_process"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether process information ' // &
'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // &
'\ttt{?debug\_decay}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})'))
call var_list%append_log (var_str ("?debug_transforms"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether information ' // &
'about event transforms will be displayed in the ASCII debug ' // &
'event format ($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample}, \ttt{?debug\_decay}, \ttt{\$debug\_extension}, ' // &
'\ttt{?debug\_process}, \ttt{?debug\_verbose})'))
call var_list%append_log (var_str ("?debug_decay"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether decay information ' // &
'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // &
'\ttt{?debug\_process}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})'))
call var_list%append_log (var_str ("?debug_verbose"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether extensive verbose ' // &
'information will be included in the ASCII debug event format ' // &
'($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, \ttt{\$sample}, ' // &
'\ttt{\$debug\_extension}, \ttt{?debug\_decay}, \ttt{?debug\_transforms}, ' // &
'\ttt{?debug\_process})'))
call var_list%append_string (var_str ("$dump_extension"), var_str ("pset.dat"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$dump\_extension ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
"to which events in \whizard's internal particle set format " // &
'are written. If not set, the default file name and suffix is ' // &
'\ttt{{\em <process\_name>}.pset.dat}. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
'\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
call var_list%append_log (var_str ("?dump_compressed"), .false., &
intrinsic=.true., &
description=var_str ('Flag that, if set to \ttt{true}, issues ' // &
'a very compressed and clear version of the \ttt{dump} ($\to$) ' // &
'event format. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample}, \ttt{dump}, \ttt{\$dump\_extension}, ' // &
'\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
call var_list%append_log (var_str ("?dump_weights"), .false., &
intrinsic=.true., &
description=var_str ('Flag that, if set to \ttt{true}, includes ' // &
'cross sections, weights and excess in the \ttt{dump} ($\to$) ' // &
'event format. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
'\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_summary})'))
call var_list%append_log (var_str ("?dump_summary"), .false., &
intrinsic=.true., &
description=var_str ('Flag that, if set to \ttt{true}, includes ' // &
'a summary with momentum sums for incoming and outgoing particles ' // &
'as well as for beam remnants in the \ttt{dump} ($\to$) ' // &
'event format. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
'\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_weights})'))
call var_list%append_log (var_str ("?dump_screen"), .false., &
intrinsic=.true., &
description=var_str ('Flag that, if set to \ttt{true}, outputs ' // &
'events for the \ttt{dump} ($\to$) event format on screen ' // &
' instead of to a file. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
'\ttt{\$dump\_extension}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
call var_list%append_log (var_str ("?hepevt_ensure_order"), .false., &
intrinsic=.true., &
description=var_str ('Flag to ensure that the particle set confirms ' // &
'the HEPEVT standard. This involves some copying and reordering ' // &
'to guarantee that mothers and daughters are always next to ' // &
'each other. Usually this is not necessary.'))
call var_list%append_string (var_str ("$extension_hepevt"), var_str ("hepevt"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_hepevt ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the \whizard\ version 1 style HEPEVT ASCII ' // &
'format are written. If not set, the default file name and suffix ' // &
'is \ttt{{\em <process\_name>}.hepevt}. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_ascii_short"), &
var_str ("short.evt"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_short ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the so called short variant of the \whizard\ ' // &
'version 1 style HEPEVT ASCII format are written. If not set, ' // &
'the default file name and suffix is \ttt{{\em <process\_name>}.short.evt}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_ascii_long"), &
var_str ("long.evt"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_long ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the so called long variant of the \whizard\ ' // &
'version 1 style HEPEVT ASCII format are written. If not set, ' // &
'the default file name and suffix is \ttt{{\em <process\_name>}.long.evt}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_athena"), &
var_str ("athena.evt"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_athena ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the ATHENA file format are written. If not ' // &
'set, the default file name and suffix is \ttt{{\em <process\_name>}.athena.evt}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_mokka"), &
var_str ("mokka.evt"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_mokka ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the MOKKA format are written. If not set, ' // &
'the default file name and suffix is \ttt{{\em <process\_name>}.mokka.evt}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$lhef_version"), var_str ("2.0"), &
intrinsic = .true., &
description=var_str ('Specifier for the Les Houches Accord (LHEF) ' // &
'event format files with XML headers to discriminate among different ' // &
'versions of this format. (cf. also \ttt{\$sample}, \ttt{sample\_format}, ' // &
'\ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
'\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref}, ' // &
'\ttt{?lhef\_write\_sqme\_alt})'))
call var_list%append_string (var_str ("$lhef_extension"), var_str ("lhe"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$lhef\_extension ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the LHEF format are written. If not set, ' // &
'the default file name and suffix is \ttt{{\em <process\_name>}.lhe}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{lhef}, ' // &
'\ttt{\$lhef\_extension}, \ttt{\$lhef\_version}, \ttt{?lhef\_write\_sqme\_prc}, ' // &
'\ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})'))
call var_list%append_log (var_str ("?lhef_write_sqme_prc"), .true., &
intrinsic = .true., &
description=var_str ('Flag that decides whether in the ($\to$) ' // &
'\ttt{lhef} event format the weights of the squared matrix element ' // &
'of the corresponding process shall be written in the LHE file. ' // &
'(cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{lhef}, ' // &
'\ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_ref}, ' // &
'\newline \ttt{?lhef\_write\_sqme\_alt})'))
call var_list%append_log (var_str ("?lhef_write_sqme_ref"), .false., &
intrinsic = .true., &
description=var_str ('Flag that decides whether in the ($\to$) ' // &
'\ttt{lhef} event format reference weights of the squared matrix ' // &
'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // &
'\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
'\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_alt})'))
call var_list%append_log (var_str ("?lhef_write_sqme_alt"), .true., &
intrinsic = .true., &
description=var_str ('Flag that decides whether in the ($\to$) ' // &
'\ttt{lhef} event format alternative weights of the squared matrix ' // &
'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // &
'\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
'\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref})'))
call var_list%append_string (var_str ("$extension_lha"), var_str ("lha"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_lha ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the (deprecated) LHA format are written. ' // &
'If not set, the default file name and suffix is \ttt{{\em <process\_name>}.lha}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_hepmc"), var_str ("hepmc"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_hepmc ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the HepMC format are written. If not set, ' // &
'the default file name and suffix is \ttt{{\em <process\_name>}.hepmc}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_log (var_str ("?hepmc_output_cross_section"), .false., &
intrinsic = .true., &
description=var_str ('Flag for the HepMC event format that allows ' // &
'to write out the cross section (and error) from the integration ' // &
'together with each HepMC event. This can be used by programs ' // &
'like Rivet to scale histograms according to the cross section. ' // &
'(cf. also \ttt{hepmc})'))
call var_list%append_log (var_str ("?hepmc3_write_flows"), .false., &
intrinsic = .true., &
description=var_str ('Flag for the HepMC3 event format that decides' // &
'whether to write out color flows. The default is \ttt{false}. ' // &
'(cf. also \ttt{hepmc})'))
call var_list%append_string (var_str ("$hepmc3_mode"), var_str ("HepMC3"), &
intrinsic = .true., &
description=var_str ('This specifies the writer mode for HepMC3. ' // &
'Possible values are \ttt{HepMC2}, \ttt{HepMC3} (default), ' // &
'\ttt{HepEVT}, \ttt{Root}. and \ttt{RootTree} (cf. also \ttt{hepmc})'))
call var_list%append_string (var_str ("$extension_lcio"), var_str ("slcio"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_lcio ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the LCIO format are written. If not set, ' // &
'the default file name and suffix is \ttt{{\em <process\_name>}.slcio}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_stdhep"), var_str ("hep"), &
intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_stdhep ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the StdHEP format via the HEPEVT common ' // &
'block are written. If not set, the default file name and suffix ' // &
'is \ttt{{\em <process\_name>}.hep}. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_stdhep_up"), &
var_str ("up.hep"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_up ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the StdHEP format via the HEPRUP/HEPEUP ' // &
'common blocks are written. \ttt{{\em <process\_name>}.up.hep} ' // &
'is the default file name and suffix, if this variable not set. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_stdhep_ev4"), &
var_str ("ev4.hep"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_ev4 ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the StdHEP format via the HEPEVT/HEPEV4 ' // &
'common blocks are written. \ttt{{\em <process\_name>}.up.hep} ' // &
'is the default file name and suffix, if this variable not set. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_hepevt_verb"), &
var_str ("hepevt.verb"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_hepevt\_verb ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the \whizard\ version 1 style extended or ' // &
'verbose HEPEVT ASCII format are written. If not set, the default ' // &
'file name and suffix is \ttt{{\em <process\_name>}.hepevt.verb}. ' // &
'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
call var_list%append_string (var_str ("$extension_lha_verb"), &
var_str ("lha.verb"), intrinsic=.true., &
description=var_str ('String variable that allows via \ttt{\$extension\_lha\_verb ' // &
'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
'to which events in the (deprecated) extended or verbose LHA ' // &
'format are written. If not set, the default file name and suffix ' // &
'is \ttt{{\em <process\_name>}.lha.verb}. (cf. also \ttt{sample\_format}, ' // &
'\ttt{\$sample})'))
end subroutine var_list_set_eio_defaults
@ %def var_list_set_eio_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_shower_defaults => var_list_set_shower_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_shower_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_shower_defaults
<<Variables: procedures>>=
module subroutine var_list_set_shower_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log (var_str ("?allow_shower"), .true., &
intrinsic=.true., &
description=var_str ('Master flag to switch on (initial and ' // &
'final state) parton shower, matching/merging as an event ' // &
'transform. As a default, it is switched on. (cf. also \ttt{?ps\_ ' // &
'....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?ps_fsr_active"), .false., &
intrinsic=.true., &
description=var_str ('Flag that switches final-state QCD radiation ' // &
'(FSR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
'\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?ps_isr_active"), .false., &
intrinsic=.true., &
description=var_str ('Flag that switches initial-state QCD ' // &
'radiation (ISR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?ps_taudec_active"), .false., &
intrinsic=.true., &
description=var_str ('Flag to switch on $\tau$ decays, at ' // &
'the moment only via the included external package \ttt{TAUOLA} ' // &
'and \ttt{PHOTOS}. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?muli_active"), .false., &
intrinsic=.true., &
description=var_str ("Master flag that switches on \whizard's " // &
'module for multiple interaction with interleaved QCD parton ' // &
'showers for hadron colliders. Note that this feature is still ' // &
'experimental. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})'))
call var_list%append_string (var_str ("$shower_method"), var_str ("WHIZARD"), &
intrinsic=.true., &
description=var_str ('String variable that allows to specify ' // &
'which parton shower is being used, the default, \ttt{"WHIZARD"}, ' // &
'is one of the in-house showers of \whizard. Other possibilities ' // &
'at the moment are only \ttt{"PYTHIA6"}.'))
call var_list%append_log (var_str ("?shower_verbose"), .false., &
intrinsic=.true., &
description=var_str ('Flag to switch on verbose messages when ' // &
'using shower and/or hadronization. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...},'))
call var_list%append_string (var_str ("$ps_PYTHIA_PYGIVE"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable that allows to pass options ' // &
'for tunes etc. to the attached \pythia\ parton shower or hadronization, ' // &
'e.g.: \ttt{\$ps\_PYTHIA\_PYGIVE = "MSTJ(41)=1"}. (cf. also ' // &
'\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_string (var_str ("$ps_PYTHIA8_config"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable that allows to pass options ' // &
'for tunes etc. to the attached \pythia\ttt{8} parton shower or hadronization, ' // &
'e.g.: \ttt{\$ps\_PYTHIA8\_config = "PartonLevel:MPI = off"}. (cf. also ' // &
'\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_string (var_str ("$ps_PYTHIA8_config_file"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable that allows to pass a filename to a ' // &
'\pythia\ttt{8} configuration file.'))
call var_list%append_real (&
var_str ("ps_mass_cutoff"), 1._default, intrinsic = .true., &
description=var_str ('Real value that sets the QCD parton shower ' // &
'lower cutoff scale, where hadronization sets in. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (&
var_str ("ps_fsr_lambda"), 0.29_default, intrinsic = .true., &
description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // &
'used in running $\alpha_s$ for time-like showers is set (except ' // &
'for showers in the decay of a resonance). (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (&
var_str ("ps_isr_lambda"), 0.29_default, intrinsic = .true., &
description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // &
'used in running $\alpha_s$ for space-like showers is set. (cf. ' // &
'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_int (&
var_str ("ps_max_n_flavors"), 5, intrinsic = .true., &
description=var_str ('This integer parameter sets the maxmimum ' // &
'number of flavors that can be produced in a QCD shower $g\to ' // &
'q\bar q$. It is also used as the maximal number of active flavors ' // &
'for the running of $\alpha_s$ in the shower (with a minimum ' // &
'of 3). (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?ps_isr_alphas_running"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether a running ' // &
'$\alpha_s$ is taken in space-like QCD parton showers. (cf. ' // &
'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?ps_fsr_alphas_running"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether a running ' // &
'$\alpha_s$ is taken in time-like QCD parton showers. (cf. ' // &
'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str ("ps_fixed_alphas"), &
0._default, intrinsic = .true., &
description=var_str ('This real parameter sets the value of $\alpha_s$ ' // &
'if it is (cf. $\to$ \ttt{?ps\_isr\_alphas\_running}, \newline ' // &
'\ttt{?ps\_fsr\_alphas\_running}) not running in initial and/or ' // &
'final-state QCD showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?ps_isr_pt_ordered"), .false., &
intrinsic=.true., &
description=var_str ('By this flag, it can be switched between ' // &
'the analytic QCD ISR shower (\ttt{false}, default) and the ' // &
'$p_T$ ISR QCD shower (\ttt{true}). (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str ("?ps_isr_angular_ordered"), .true., &
intrinsic=.true., &
description=var_str ('If switched one, this flag forces opening ' // &
'angles of emitted partons in the QCD ISR shower to be strictly ' // &
'ordered, i.e. increasing towards the hard interaction. (cf. ' // &
'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("ps_isr_primordial_kt_width"), 0._default, intrinsic = .true., &
description=var_str ('This real parameter sets the width $\sigma ' // &
'= \braket{k_T^2}$ for the Gaussian primordial $k_T$ distribution ' // &
'inside the hadron, given by: $\exp[-k_T^2/\sigma^2] k_T dk_T$. ' // &
'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("ps_isr_primordial_kt_cutoff"), 5._default, intrinsic = .true., &
description=var_str ('Real parameter that sets the upper cutoff ' // &
'for the primordial $k_T$ distribution inside a hadron. (cf. ' // &
'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
'\ttt{?hadronization\_active}, \ttt{?mlm\_ ...})'))
call var_list%append_real (var_str &
("ps_isr_z_cutoff"), 0.999_default, intrinsic = .true., &
description=var_str ('This real parameter allows to set the upper ' // &
'cutoff on the splitting variable $z$ in space-like QCD parton ' // &
'showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
'\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("ps_isr_minenergy"), 1._default, intrinsic = .true., &
description=var_str ('By this real parameter, the minimal effective ' // &
'energy (in the c.m. frame) of a time-like or on-shell-emitted ' // &
'parton in a space-like QCD shower is set. For a hard subprocess ' // &
'that is not in the rest frame, this number is roughly reduced ' // &
'by a boost factor $1/\gamma$ to the rest frame of the hard scattering ' // &
'process. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
'\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("ps_isr_tscalefactor"), 1._default, intrinsic = .true., &
description=var_str ('The $Q^2$ scale of the hard scattering ' // &
'process is multiplied by this real factor to define the maximum ' // &
'parton virtuality allowed in time-like QCD showers. This does ' // &
'only apply to $t$- and $u$-channels, while for $s$-channel resonances ' // &
'the maximum virtuality is set by $m^2$. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_log (var_str &
("?ps_isr_only_onshell_emitted_partons"), .false., intrinsic=.true., &
description=var_str ('This flag if set true sets all emitted ' // &
'partons off space-like showers on-shell, i.e. it would not allow ' // &
'associated time-like showers. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
end subroutine var_list_set_shower_defaults
@ %def var_list_set_shower_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_hadronization_defaults => var_list_set_hadronization_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_hadronization_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_hadronization_defaults
<<Variables: procedures>>=
module subroutine var_list_set_hadronization_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log &
(var_str ("?allow_hadronization"), .true., intrinsic=.true., &
description=var_str ('Master flag to switch on hadronization ' // &
'as an event transform. As a default, it is switched on. (cf. ' // &
'also \ttt{?ps\_ ....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, ' // &
'\ttt{?hadronization\_active})'))
call var_list%append_log &
(var_str ("?hadronization_active"), .false., intrinsic=.true., &
description=var_str ('Master flag to switch hadronization (through ' // &
'the attached \pythia\ package) on or off. As a default, it is ' // &
'off. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...})'))
call var_list%append_string &
(var_str ("$hadronization_method"), var_str ("PYTHIA6"), intrinsic = .true., &
description=var_str ("Determines whether \whizard's own " // &
"hadronization or the (internally included) \pythiasix\ should be used."))
call var_list%append_real &
(var_str ("hadron_enhanced_fraction"), 0.01_default, intrinsic = .true., &
description=var_str ('Fraction of Lund strings that break with enhanced ' // &
'width. [not yet active]'))
call var_list%append_real &
(var_str ("hadron_enhanced_width"), 2.0_default, intrinsic = .true., &
description=var_str ('Enhancement factor for the width of breaking ' // &
'Lund strings. [not yet active]'))
end subroutine var_list_set_hadronization_defaults
@ %def var_list_set_hadronization_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_tauola_defaults => var_list_set_tauola_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_tauola_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_tauola_defaults
<<Variables: procedures>>=
module subroutine var_list_set_tauola_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log (&
var_str ("?ps_tauola_photos"), .false., intrinsic=.true., &
description=var_str ('Flag to switch on \ttt{PHOTOS} for photon ' // &
'showering inside the \ttt{TAUOLA} package. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
call var_list%append_log (&
var_str ("?ps_tauola_transverse"), .false., intrinsic=.true., &
description=var_str ('Flag to switch transverse $\tau$ polarization ' // &
'on or off for Higgs decays into $\tau$ leptons. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
call var_list%append_log (&
var_str ("?ps_tauola_dec_rad_cor"), .true., intrinsic=.true., &
description=var_str ('Flag to switch radiative corrections for ' // &
'$\tau$ decays in \ttt{TAUOLA} on or off. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
call var_list%append_int (&
var_str ("ps_tauola_dec_mode1"), 0, intrinsic = .true., &
description=var_str ('Integer code to request a specific $\tau$ ' // &
'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // &
'in correlated decays -- for the second $\tau$. For more information ' // &
'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // &
'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
call var_list%append_int (&
var_str ("ps_tauola_dec_mode2"), 0, intrinsic = .true., &
description=var_str ('Integer code to request a specific $\tau$ ' // &
'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // &
'in correlated decays -- for the second $\tau$. For more information ' // &
'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // &
'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
call var_list%append_real (&
var_str ("ps_tauola_mh"), 125._default, intrinsic = .true., &
description=var_str ('Real option to set the Higgs mass for Higgs ' // &
'decays into $\tau$ leptons in the interface to \ttt{TAUOLA}. ' // &
'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
call var_list%append_real (&
var_str ("ps_tauola_mix_angle"), 90._default, intrinsic = .true., &
description=var_str ('Option to set the mixing angle between ' // &
'scalar and pseudoscalar Higgs bosons for Higgs decays into $\tau$ ' // &
'leptons in the interface to \ttt{TAUOLA}. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
call var_list%append_log (&
var_str ("?ps_tauola_pol_vector"), .false., intrinsic = .true., &
description=var_str ('Flag to decide whether for transverse $\tau$ ' // &
'polarization, polarization information should be taken from ' // &
'\ttt{TAUOLA} or not. The default is just based on random numbers. ' // &
'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
end subroutine var_list_set_tauola_defaults
@ %def var_list_set_tauola_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_mlm_matching_defaults => var_list_set_mlm_matching_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_mlm_matching_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_mlm_matching_defaults
<<Variables: procedures>>=
module subroutine var_list_set_mlm_matching_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log (var_str ("?mlm_matching"), .false., &
intrinsic=.true., &
description=var_str ('Master flag to switch on MLM (LO) jet ' // &
'matching between hard matrix elements and the QCD parton ' // &
'shower. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
'\ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_Qcut_ME"), 0._default, intrinsic = .true., &
description=var_str ('Real parameter that in the MLM jet matching ' // &
'between hard matrix elements and QCD parton shower sets a possible ' // &
'virtuality cut on jets from the hard matrix element. (cf. also ' // &
'\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // &
'...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_Qcut_PS"), 0._default, intrinsic = .true., &
description=var_str ('Real parameter that in the MLM jet matching ' // &
'between hard matrix elements and QCD parton shower sets a possible ' // &
'virtuality cut on jets from the parton shower. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_ptmin"), 0._default, intrinsic = .true., &
description=var_str ('This real parameter sets a minimal $p_T$ ' // &
'that enters the $y_{cut}$ jet clustering measure in the MLM ' // &
'jet matching between hard matrix elements and QCD parton showers. ' // &
'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_etamax"), 0._default, intrinsic = .true., &
description=var_str ('This real parameter sets a maximal pseudorapidity ' // &
'that enters the MLM jet matching between hard matrix elements ' // &
'and QCD parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
'...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_Rmin"), 0._default, intrinsic = .true., &
description=var_str ('Real parameter that sets a minimal $R$ ' // &
'distance value that enters the $y_{cut}$ jet clustering measure ' // &
'in the MLM jet matching between hard matrix elements and QCD ' // &
'parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
'...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_Emin"), 0._default, intrinsic = .true., &
description=var_str ('Real parameter that sets a minimal energy ' // &
'$E_{min}$ value as an infrared cutoff in the MLM jet matching ' // &
'between hard matrix elements and QCD parton showers. (cf. also ' // &
'\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // &
'...}, \ttt{?hadronization\_active})'))
call var_list%append_int (var_str &
("mlm_nmaxMEjets"), 0, intrinsic = .true., &
description=var_str ('This integer sets the maximal number of ' // &
'jets that are available from hard matrix elements in the MLM ' // &
'jet matching between hard matrix elements and QCD parton shower. ' // &
'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
'...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_ETclusfactor"), 0.2_default, intrinsic = .true., &
description=var_str ('This real parameter is a factor that enters ' // &
'the calculation of the $y_{cut}$ measure for jet clustering ' // &
'after the parton shower in the MLM jet matching between hard ' // &
'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_ETclusminE"), 5._default, intrinsic = .true., &
description=var_str ('This real parameter is a minimal energy ' // &
'that enters the calculation of the $y_{cut}$ measure for jet ' // &
'clustering after the parton shower in the MLM jet matching between ' // &
'hard matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_etaclusfactor"), 1._default, intrinsic = .true., &
description=var_str ('This real parameter is a factor that enters ' // &
'the calculation of the $y_{cut}$ measure for jet clustering ' // &
'after the parton shower in the MLM jet matching between hard ' // &
'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_Rclusfactor"), 1._default, intrinsic = .true., &
description=var_str ('This real parameter is a factor that enters ' // &
'the calculation of the $y_{cut}$ measure for jet clustering ' // &
'after the parton shower in the MLM jet matching between hard ' // &
'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
call var_list%append_real (var_str &
("mlm_Eclusfactor"), 1._default, intrinsic = .true., &
description=var_str ('This real parameter is a factor that enters ' // &
'the calculation of the $y_{cut}$ measure for jet clustering ' // &
'after the parton shower in the MLM jet matching between hard ' // &
'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
end subroutine var_list_set_mlm_matching_defaults
@ %def var_list_set_mlm_matching_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_powheg_matching_defaults => &
var_list_set_powheg_matching_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_powheg_matching_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_powheg_matching_defaults
<<Variables: procedures>>=
module subroutine var_list_set_powheg_matching_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log (var_str ("?powheg_matching"), &
.false., intrinsic = .true., &
description=var_str ('Activates Powheg matching. Needs to be ' // &
'combined with the \ttt{?combined\_nlo\_integration}-method.'))
call var_list%append_log (var_str ("?powheg_use_singular_jacobian"), &
.false., intrinsic = .true., &
description=var_str ('This allows to give a different ' // &
'normalization of the Jacobian, resulting in an alternative ' // &
'POWHEG damping in the singular regions.'))
call var_list%append_int (var_str ("powheg_grid_size_xi"), &
5, intrinsic = .true., &
description=var_str ('Number of $\xi$ points in the POWHEG grid.'))
call var_list%append_int (var_str ("powheg_grid_size_y"), &
5, intrinsic = .true., &
description=var_str ('Number of $y$ points in the POWHEG grid.'))
call var_list%append_real (var_str ("powheg_pt_min"), &
1._default, intrinsic = .true., &
description=var_str ('Lower $p_T$-cut-off for the POWHEG ' // &
'hardest emission.'))
call var_list%append_real (var_str ("powheg_lambda"), &
- LAMBDA_QCD_REF, intrinsic = .true., &
+ 0._default, intrinsic = .true., &
description=var_str ('Reference scale of the $\alpha_s$ evolution ' // &
- 'in the POWHEG matching algorithm.'))
+ 'in the POWHEG matching algorithm. Per default we use ' // &
+ '$\Lambda^{n_f=5}_{\overline{MS}}$.' ))
call var_list%append_log (var_str ("?powheg_test_sudakov"), &
.false., intrinsic = .true., &
description=var_str ('Performs an internal consistency check ' // &
'on the POWHEG event generation.'))
call var_list%append_log (var_str ("?powheg_disable_sudakov"), &
.false., intrinsic = .true., &
description=var_str ('This flag allows to set the Sudakov form ' // &
'factor to one. This effectively results in a version of ' // &
'the matrix-element method (MEM) at NLO.'))
end subroutine var_list_set_powheg_matching_defaults
@ %def var_list_set_powheg_matching_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_openmp_defaults => var_list_set_openmp_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_openmp_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_openmp_defaults
<<Variables: procedures>>=
module subroutine var_list_set_openmp_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log (var_str ("?omega_openmp"), &
openmp_is_active (), &
intrinsic=.true., &
description=var_str ('Flag to switch on or off OpenMP multi-threading ' // &
"for \oMega\ matrix elements. (cf. also \ttt{\$method}, \ttt{\$omega\_flag})"))
call var_list%append_log (var_str ("?openmp_is_active"), &
openmp_is_active (), &
locked=.true., intrinsic=.true., &
description=var_str ('Flag to switch on or off OpenMP multi-threading ' // &
'for \whizard. (cf. also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, ' // &
'\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})'))
call var_list%append_int (var_str ("openmp_num_threads_default"), &
openmp_get_default_max_threads (), &
locked=.true., intrinsic=.true., &
description=var_str ('Integer parameter that shows the number ' // &
'of default OpenMP threads for multi-threading. Note that this ' // &
'parameter can only be accessed, but not reset by the user. (cf. ' // &
'also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, \ttt{?omega\_openmp})'))
call var_list%append_int (var_str ("openmp_num_threads"), &
openmp_get_max_threads (), &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the number ' // &
'of OpenMP threads for multi-threading. (cf. also \ttt{?openmp\_logging}, ' // &
'\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})'))
call var_list%append_log (var_str ("?openmp_logging"), &
.true., intrinsic=.true., &
description=var_str ('This logical -- when set to \ttt{false} ' // &
'-- suppresses writing out messages about OpenMP parallelization ' // &
'(number of used threads etc.) on screen and into the logfile ' // &
'(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // &
'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // &
'\ttt{?mpi\_logging})'))
end subroutine var_list_set_openmp_defaults
@ %def var_list_set_openmp_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_mpi_defaults => var_list_set_mpi_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_mpi_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_mpi_defaults
<<Variables: procedures>>=
module subroutine var_list_set_mpi_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log (var_str ("?mpi_logging"), &
.false., intrinsic=.true., &
description=var_str('This logical -- when set to \ttt{false} ' // &
'-- suppresses writing out messages about MPI parallelization ' // &
'(number of used workers etc.) on screen and into the logfile ' // &
'(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // &
'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // &
'\ttt{?openmp\_logging})'))
end subroutine var_list_set_mpi_defaults
@ %def var_list_set_mpi_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_nlo_defaults => var_list_set_nlo_defaults
<<Variables: sub interfaces>>=
module subroutine var_list_set_nlo_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
end subroutine var_list_set_nlo_defaults
<<Variables: procedures>>=
module subroutine var_list_set_nlo_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_string (var_str ("$born_me_method"), &
var_str (""), intrinsic = .true., &
description=var_str ("This string variable specifies the method " // &
"for the matrix elements to be used in the evaluation of the " // &
"Born part of the NLO computation. The default is the empty string, " // &
"i.e. the \ttt{\$method} being the intrinsic \oMega\ matrix element " // &
'generator (\ttt{"omega"}), other options ' // &
'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, ' // &
'\ttt{"template\_unity"}, \ttt{"threshold"}, \ttt{"gosam"}, ' // &
'\ttt{"openloops"}. Note that this option is inoperative if ' // &
'no NLO calculation is specified in the process definition. ' // &
'If you want ot use different matrix element methods in a LO ' // &
'computation, use the usual \ttt{method} command. (cf. also ' // &
'\ttt{\$correlation\_me\_method}, ' // &
'\ttt{\$dglap\_me\_method}, \ttt{\$loop\_me\_method} and ' // &
'\ttt{\$real\_tree\_me\_method}.)'))
call var_list%append_string (var_str ("$loop_me_method"), &
var_str (""), intrinsic = .true., &
description=var_str ('This string variable specifies the method ' // &
'for the matrix elements to be used in the evaluation of the ' // &
'virtual part of the NLO computation. The default is the empty string, ' // &
'i.e. the same as \ttt{\$method}. Working options are: ' // &
'\ttt{"threshold"}, \ttt{"openloops"}, \ttt{"recola"}, \ttt{"gosam"}. ' // &
'(cf. also \ttt{\$real\_tree\_me\_method}, \ttt{\$correlation\_me\_method} ' // &
'and \ttt{\$born\_me\_method}.)'))
call var_list%append_string (var_str ("$correlation_me_method"), &
var_str (""), intrinsic = .true., &
description=var_str ('This string variable specifies ' // &
'the method for the matrix elements to be used in the evaluation ' // &
'of the color (and helicity) correlated part of the NLO computation. ' // &
"The default is the same as the \ttt{\$method}, i.e. the intrinsic " // &
"\oMega\ matrix element generator " // &
'(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // &
'\ttt{"template"}, \ttt{"template\_unity"}, \ttt{"threshold"}, ' // &
'\ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // &
'\ttt{\$born\_me\_method}, \ttt{\$dglap\_me\_method}, ' // &
'\ttt{\$loop\_me\_method} and \newline' // &
'\ttt{\$real\_tree\_me\_method}.)'))
call var_list%append_string (var_str ("$real_tree_me_method"), &
var_str (""), intrinsic = .true., &
description=var_str ('This string variable specifies the method ' // &
'for the matrix elements to be used in the evaluation of the ' // &
'real part of the NLO computation. The default is the same as ' // &
'the \ttt{\$method}, i.e. the intrinsic ' // &
"\oMega\ matrix element generator " // &
'(\ttt{"omega"}), other options ' // &
'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // &
'\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // &
'\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // &
'\ttt{\$dglap\_me\_method} and \ttt{\$loop\_me\_method}.)'))
call var_list%append_string (var_str ("$dglap_me_method"), &
var_str (""), intrinsic = .true., &
description=var_str ('This string variable specifies the method ' // &
'for the matrix elements to be used in the evaluation of the ' // &
'DGLAP remnants of the NLO computation. The default is the same as ' // &
"\ttt{\$method}, i.e. the \oMega\ matrix element generator " // &
'(\ttt{"omega"}), other options ' // &
'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // &
'\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also \newline' // &
'\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // &
'\ttt{\$loop\_me\_method} and \ttt{\$real\_tree\_me\_method}.)'))
call var_list%append_log (&
var_str ("?test_soft_limit"), .false., intrinsic = .true., &
description=var_str ('Sets the fixed values $\tilde{\xi} = 0.00001$ ' // &
'and $y = 0.5$ as radiation variables. This way, only soft, ' // &
'but non-collinear phase space points are generated, which allows ' // &
'for testing subtraction in this region.'))
call var_list%append_log (&
var_str ("?test_coll_limit"), .false., intrinsic = .true., &
description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // &
'and $y = 0.9999999$ as radiation variables. This way, only collinear, ' // &
'but non-soft phase space points are generated, which allows ' // &
'for testing subtraction in this region. Can be combined with ' // &
'\ttt{?test\_soft\_limit} to probe soft-collinear regions.'))
call var_list%append_log (&
var_str ("?test_anti_coll_limit"), .false., intrinsic = .true., &
description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // &
'and $y = -0.9999999$ as radiation variables. This way, only anti-collinear, ' // &
'but non-soft phase space points are generated, which allows ' // &
'for testing subtraction in this region. Can be combined with ' // &
'\ttt{?test\_soft\_limit} to probe soft-collinear regions.'))
call var_list%append_string (var_str ("$select_alpha_regions"), &
var_str (""), intrinsic = .true., &
description=var_str ('Fixes the $\alpha_r$ in the real ' // &
'subtraction as well as the DGLAP component. Allows for ' // &
'testing in a list of selected singular regions.'))
call var_list%append_string (var_str ("$virtual_selection"), &
var_str ("Full"), intrinsic = .true., &
description=var_str ('String variable to select either the full ' // &
'or only parts of the virtual components of an NLO calculation. ' // &
'Possible modes are \ttt{"Full"}, \ttt{"OLP"} and ' // &
'\ttt{"Subtraction."}. Mainly for debugging purposes.'))
call var_list%append_log (var_str ("?virtual_collinear_resonance_aware"), &
.true., intrinsic = .true., &
description=var_str ('This flag allows to switch between two ' // &
'different implementations of the collinear subtraction in the ' // &
'resonance-aware FKS setup.'))
call var_list%append_real (&
var_str ("blha_top_yukawa"), -1._default, intrinsic = .true., &
description=var_str ('If this value is set, the given value will ' // &
'be used as the top Yukawa coupling instead of the top mass. ' // &
'Note that having different values for $y_t$ and $m_t$ must be ' // &
'supported by your OLP-library and yield errors if this is not the case.'))
call var_list%append_string (var_str ("$blha_ew_scheme"), &
var_str ("alpha_internal"), intrinsic = .true., &
description=var_str ('String variable that transfers the electroweak ' // &
'renormalization scheme via BLHA to the one-loop provider. Possible ' // &
'values are \ttt{GF} or \ttt{Gmu} for the $G_\mu$ scheme, ' // &
'\ttt{alpha\_internal} (default, $G_\mu$ scheme, but value of ' // &
'$\alpha_S$ calculated internally by \whizard), \ttt{alpha\_mz} ' // &
'and \ttt{alpha\_0} (or \ttt{alpha\_thompson}) for different schemes ' // &
'with $\alpha$ as input.'))
call var_list%append_int (var_str ("openloops_verbosity"), 1, &
intrinsic = .true., &
description=var_str ('Decides how much \openloops\ output is printed. ' // &
'Can have values 0, 1 and 2, where 2 is the highest verbosity level.'))
call var_list%append_log (var_str ("?openloops_use_cms"), &
.true., intrinsic = .true., &
description=var_str ('Activates the complex mass scheme in ' // &
'\openloops. (cf. also ' // &
'\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
'\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // &
'\ttt{openloops\_stability\_log}, \newline' // &
'\ttt{\$openloops\_extra\_cmd})'))
call var_list%append_int (var_str ("openloops_phs_tolerance"), 7, &
intrinsic = .true., &
description=var_str ('This integer parameter gives via ' // &
'\ttt{openloops\_phs\_tolerance = <n>} the relative numerical ' // &
'tolerance $10^{-n}$ for the momentum conservation of the ' // &
'external particles within \openloops. (cf. also ' // &
'\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
'\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // &
'\newline\ttt{openloops\_stability\_log}, ' // &
'\ttt{\$openloops\_extra\_cmd})'))
call var_list%append_int (var_str ("openloops_stability_log"), 0, &
intrinsic = .true., &
description=var_str ('Creates the directory \ttt{stability\_log} ' // &
'containing information about the performance of the \openloops ' // &
'matrix elements. Possible values are 0 (No output), 1 (On ' // &
'\ttt{finish()}-call), 2 (Adaptive) and 3 (Always).'))
call var_list%append_log (var_str ("?openloops_switch_off_muon_yukawa"), &
.false., intrinsic = .true., &
description=var_str ('Sets the Yukawa coupling of muons for ' // &
'\openloops\ to zero. (cf. also ' // &
'\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
'\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
'\ttt{\$openloops\_extra\_cmd})'))
call var_list%append_string (var_str ("$openloops_extra_cmd"), &
var_str (""), intrinsic = .true., &
description=var_str ('String variable to transfer customized ' // &
'special commands to \openloops. The three supported examples ' // &
'\ttt{\$openloops\_extra\_command = "extra approx top/stop/not"} ' // &
'are for selection of subdiagrams in top production. (cf. also ' // &
'\ttt{\$method}, \ttt{openloos\_verbosity}, ' // &
'\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
'\ttt{?openloops\_switch\_off\_muon\_yukawa})'))
call var_list%append_string (var_str ("$openloops_allowed_libs"), &
var_str (""), intrinsic = .true., &
description=var_str ('String variable to restrict the ' // &
'allowed \openloops process libraries for a process. ' // &
'(cf. also \ttt{\$method}, \ttt{openloos\_verbosity}, ' // &
'\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
'\ttt{?openloops\_switch\_off\_muon\_yukawa})'))
call var_list%append_real (var_str ("ellis_sexton_scale"), &
-1._default, intrinsic = .true., &
description = var_str ('Real positive paramter for the Ellis-Sexton scale' // &
'$\mathcal{Q}$ used both in the finite one-loop contribution provided by' // &
'the OLP and in the virtual counter terms. The NLO cross section is' // &
'independent of $\mathcal{Q}$. Therefore, this allows for debugging of' // &
'the implemention of the virtual counter terms. As the default' // &
'$\mathcal{Q} = \mu_{\rm{R}}$ is chosen. So far, setting this parameter' // &
'only works for OpenLoops2, otherwise the default behaviour is invoked.'))
call var_list%append_log (var_str ("?disable_subtraction"), &
.false., intrinsic = .true., &
description=var_str ('Disables the subtraction of soft and collinear ' // &
'divergences from the real matrix element.'))
call var_list%append_real (var_str ("fks_dij_exp1"), &
1._default, intrinsic = .true., &
description=var_str ('Fine-tuning parameters of the FKS ' // &
'final state partition functions. The exact meaning depends ' // &
'on the mapping implementation. (cf. also \ttt{fks\_dij\_exp2}, ' // &
'\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
call var_list%append_real (var_str ("fks_dij_exp2"), &
1._default, intrinsic = .true., &
description=var_str ('Fine-tuning parameters of the FKS ' // &
'initial state partition functions. The exact meaning depends ' // &
'on the mapping implementation. (cf. also \ttt{fks\_dij\_exp1}, ' // &
'\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
call var_list%append_real (var_str ("fks_xi_min"), &
0._default, intrinsic = .true., &
description=var_str ('Real parameter for the FKS ' // &
'phase space that sets the numerical lower value of the $\xi$ ' // &
'variable. Valid for the value range $[\texttt{tiny\_07},1]$, where ' // &
'value inputs out of bounds will take the value of the closest bound. ' // &
'Here, $\texttt{tiny\_07} = \texttt{1E0\_default * epsilon (0.\_default)}$, where ' // &
'\ttt{epsilon} is an intrinsic Fortran function. (cf. also \ttt{fks\_dij\_exp1}, ' // &
'\ttt{fks\_dij\_exp2}, \ttt{\$fks\_mapping\_type}, \ttt{fks\_y\_max})'))
call var_list%append_real (var_str ("fks_y_max"), &
1._default, intrinsic = .true., &
description=var_str ('Real parameter for the FKS ' // &
'phase space that sets the numerical upper value of the $\left|y\right|$ ' // &
'variable. Valid for ranges $[0,1]$, where value inputs out of bounds will take ' // &
'the value of the closest bound. Only supported for massless FSR. ' // &
'(cf. also \ttt{fks\_dij\_exp1}, \ttt{\$fks\_mapping\_type}, \ttt{fks\_dij\_exp2})'))
call var_list%append_log (var_str ("?vis_fks_regions"), &
.false., intrinsic = .true., &
description=var_str ('Logical variable that, if set to ' // &
'\ttt{true}, generates \LaTeX\ code and executes it into a PDF ' // &
' to produce a table of all singular FKS regions and their ' // &
' flavor structures. The default is \ttt{false}.'))
call var_list%append_real (var_str ("fks_xi_cut"), &
1.0_default, intrinsic = .true., &
description = var_str ('(Experimental) Real parameter for the FKS ' // &
'phase space that applies a cut to $\xi$ variable with $0 < \xi_{\text{cut}}' // &
'\leq \xi_{\text{max}}$. The dependence on the parameter vanishes between ' // &
'real subtraction and integrated subtraction term. Could thus be used for debugging. ' // &
'This is not implemented properly, use at your own risk!'))
call var_list%append_real (var_str ("fks_delta_o"), &
2._default, intrinsic = .true., &
description = var_str ('Real parameter for the FKS ' // &
'phase space that applies a cut to the $y$ variable with $0 < \delta_o \leq 2$ ' // &
'for final state singularities only. ' // &
'The dependence on the parameter vanishes between real subtraction and integrated ' // &
'subtraction term. For debugging purposes.'))
call var_list%append_real (var_str ("fks_delta_i"), &
2._default, intrinsic = .true., &
description = var_str ('Real parameter for the FKS ' // &
'phase space that applies a cut to the $y$ variable with ' // &
'$0 < \delta_{\mathrm{I}} \leq 2$ '// &
'for initial state singularities only. ' // &
'The dependence on the parameter vanishes between real subtraction and integrated ' // &
'subtraction term. For debugging purposes.'))
call var_list%append_string (var_str ("$fks_mapping_type"), &
var_str ("default"), intrinsic = .true., &
description=var_str ('Sets the FKS mapping type. Possible values ' // &
'are \ttt{"default"} and \ttt{"resonances"}. The latter option ' // &
'activates the resonance-aware subtraction mode and induces the ' // &
'generation of a soft mismatch component. (cf. also ' // &
'\ttt{fks\_dij\_exp1}, \ttt{fks\_dij\_exp2}, \ttt{fks\_xi\_min}, ' // &
'\ttt{fks\_y\_max})'))
call var_list%append_string (var_str ("$resonances_exclude_particles"), &
var_str ("default"), intrinsic = .true., &
description=var_str ('Accepts a string of particle names. These ' // &
'particles will be ignored when the resonance histories are generated. ' // &
'If \ttt{\$fks\_mapping\_type} is not \ttt{"resonances"}, this ' // &
'option does nothing.'))
call var_list%append_int (var_str ("alpha_power"), &
2, intrinsic = .true., &
description=var_str ('Fixes the electroweak coupling ' // &
'powers used by BLHA matrix element generators. Setting these ' // &
'values is necessary for the correct generation of OLP-files. ' // &
'Having inconsistent values yields to error messages by the corresponding ' // &
'OLP-providers.'))
call var_list%append_int (var_str ("alphas_power"), &
0, intrinsic = .true., &
description=var_str ('Fixes the strong coupling ' // &
'powers used by BLHA matrix element generators. Setting these ' // &
'values is necessary for the correct generation of OLP-files. ' // &
'Having inconsistent values yields to error messages by the corresponding ' // &
'OLP-providers.'))
call var_list%append_log (var_str ("?combined_nlo_integration"), &
.false., intrinsic = .true., &
description=var_str ('When this option is set to \ttt{true}, ' // &
'the NLO integration will not be performed in the separate components, ' // &
'but instead the sum of all components will be integrated directly. ' // &
'When fixed-order NLO events are requested, this integration ' // &
'mode is possible, but not necessary. However, it is necessary ' // &
'for POWHEG events.'))
call var_list%append_log (var_str ("?fixed_order_nlo_events"), &
.false., intrinsic = .true., &
description=var_str ('Induces the generation of fixed-order ' // &
'NLO events.'))
call var_list%append_log (var_str ("?check_event_weights_against_xsection"), &
.false., intrinsic = .true., &
description=var_str ('Activates an internal recording of event ' // &
'weights when unweighted events are generated. At the end of ' // &
'the simulation, the mean value of the weights and its standard ' // &
'deviation are displayed. This allows to cross-check event generation ' // &
'and integration, because the value displayed must be equal to ' // &
'the integration result.'))
call var_list%append_log (var_str ("?keep_failed_events"), &
.false., intrinsic = .true., &
description=var_str ('In the context of weighted event generation, ' // &
'if set to \ttt{true}, events with failed kinematics will be ' // &
'written to the event output with an associated weight of zero. ' // &
'This way, the total cross section can be reconstructed from the event output.'))
call var_list%append_int (var_str ("gks_multiplicity"), &
0, intrinsic = .true., &
description=var_str ('Jet multiplicity for the GKS merging scheme.'))
call var_list%append_string (var_str ("$gosam_filter_lo"), &
var_str (""), intrinsic = .true., &
description=var_str ('The filter string given to \gosam\ in order to ' // &
'filter out tree-level diagrams. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
'\ttt{\$gosam\_symmetries})'))
call var_list%append_string (var_str ("$gosam_filter_nlo"), &
var_str (""), intrinsic = .true., &
description=var_str ('The same as \ttt{\$gosam\_filter\_lo}, but for ' // &
'loop matrix elements. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
'\ttt{\$gosam\_symmetries})'))
call var_list%append_string (var_str ("$gosam_symmetries"), &
var_str ("family,generation"), intrinsic = .true., &
description=var_str ('String variable that is transferred to \gosam\ ' // &
'configuration file to determine whether certain helicity configurations ' // &
'are considered to be equal. Possible values are \ttt{flavour}, ' // &
'\ttt{family} etc. For more info see the \gosam\ manual.'))
call var_list%append_int (var_str ("form_threads"), &
2, intrinsic = .true., &
description=var_str ('The number of threads used by \gosam\ when ' // &
'matrix elements are evaluated using \ttt{FORM}'))
call var_list%append_int (var_str ("form_workspace"), &
1000, intrinsic = .true., &
description=var_str ('The size of the workspace \gosam\ requires ' // &
'from \ttt{FORM}. Inside \ttt{FORM}, it corresponds to the heap ' // &
'size used by the algebra processor.'))
call var_list%append_string (var_str ("$gosam_fc"), &
var_str (""), intrinsic = .true., &
description=var_str ('The Fortran compiler used by \gosam.'))
call var_list%append_real (&
var_str ("mult_call_real"), 1._default, &
intrinsic = .true., &
description=var_str ('(Real-valued) multiplier for the number ' // &
'of calls used in the integration of the real subtraction ' // &
'NLO component. This way, a higher accuracy can be achieved for ' // &
'the real component, while simultaneously avoiding redundant ' // &
'integration calls for the other components. (cf. also ' // &
'\ttt{mult\_call\_dglap}, \ttt{mult\_call\_virt})'))
call var_list%append_real (&
var_str ("mult_call_virt"), 1._default, &
intrinsic = .true., &
description=var_str ('(Real-valued) multiplier for the number ' // &
'of calls used in the integration of the virtual NLO ' // &
'component. This way, a higher accuracy can be achieved for ' // &
'this component, while simultaneously avoiding redundant ' // &
'integration calls for the other components. (cf. also ' // &
'\ttt{mult\_call\_dglap}, \ttt{mult\_call\_real})'))
call var_list%append_real (&
var_str ("mult_call_dglap"), 1._default, &
intrinsic = .true., &
description=var_str ('(Real-valued) multiplier for the number ' // &
'of calls used in the integration of the DGLAP remnant NLO ' // &
'component. This way, a higher accuracy can be achieved for ' // &
'this component, while simultaneously avoiding redundant ' // &
'integration calls for the other components. (cf. also ' // &
'\ttt{mult\_call\_real}, \ttt{mult\_call\_virt})'))
call var_list%append_string (var_str ("$dalitz_plot"), &
var_str (''), intrinsic = .true., &
description=var_str ('This string variable has two purposes: ' // &
'when different from the empty string, it switches on generation ' // &
'of the Dalitz plot file (ASCII tables) for the real emitters. ' // &
'The string variable itself provides the file name.'))
call var_list%append_string (var_str ("$nlo_correction_type"), &
var_str ("QCD"), intrinsic = .true., &
description=var_str ('String variable which sets the NLO correction ' // &
'type via \ttt{nlo\_correction\_type = "{\em <type>}"} to either ' // &
'\ttt{"QCD"}, \ttt{"EW"}, or to all with \ttt{\em{<type>}} ' // &
'set to \ttt{"Full"}. Must be set before the \texttt{process} statement.'))
call var_list%append_string (var_str ("$exclude_gauge_splittings"), &
var_str ("c:b:t:e2:e3"), intrinsic = .true., &
description=var_str ('String variable that allows via ' // &
'\ttt{\$exclude\_gauge\_splittings = "{\em <prt1>:<prt2>:\dots}"} ' // &
'to exclude fermion flavors from gluon/photon splitting into ' // &
'fermion pairs beyond LO. For example \ttt{\$exclude\_gauge\_splittings ' // &
'= "c:s:b:t"} would lead to \ttt{gl => u U} and \ttt{gl => d ' // &
'D} as possible splittings in QCD. It is important to keep in ' // &
'mind that only the particles listed in the string are excluded! ' // &
'In QED this string would additionally allow for all splittings into ' // &
'lepton pairs \ttt{A => l L}. Therefore, once set the variable ' // &
'acts as a replacement of the default value, not as an addition! ' // &
'Note: \ttt{"\em <prt>"} can be both particle or antiparticle. It ' // &
'will always exclude the corresponding fermion pair. An empty ' // &
'string allows for all fermion flavors to take part in the splitting! ' // &
'Also, particles included in an \ttt{alias} are not excluded by ' // &
'\ttt{\$exclude\_gauge\_splittings}!'))
call var_list%append_log (var_str ("?nlo_use_born_scale"), &
.false., intrinsic = .true., &
description=var_str ('Flag that decides whether a scale expression ' // &
'defined for the Born component of an NLO process shall be applied ' // &
'to all other components as well or not. ' // &
'(cf. also \ttt{?nlo\_cut\_all\_real\_sqmes})'))
call var_list%append_log (var_str ("?nlo_cut_all_real_sqmes"), &
.false., intrinsic = .true., &
description=var_str ('Flag that decides whether in the case that ' // &
'the real component does not pass a cut, its subtraction term ' // &
'shall be discarded for that phase space point as well or not. ' // &
'(cf. also \ttt{?nlo\_use\_born\_scale})'))
call var_list%append_string (var_str ("$real_partition_mode"), var_str ("default"), &
intrinsic=.true., &
description=var_str ('String variable to choose which parts of the real cross ' // &
'section are to be integrated. With the default value (\ttt{"default"}) ' // &
'or \ttt{"off"} the real cross section is integrated as usual without partition. ' // &
'If set to \ttt{"on"} or \ttt{"all"}, the real cross section is split into singular ' // &
'and finite part using a partition function $F$, such that $\mathcal{R} ' // &
'= [1-F(p_T^2)]\mathcal{R} + F(p_T^2)\mathcal{R} = \mathcal{R}_{\text{fin}} ' // &
'+ \mathcal{R}_{\text{sing}}$. The emission generation is then performed ' // &
'using $\mathcal{R}_{\text{sing}}$, whereas $\mathcal{R}_{\text{fin}}$ ' // &
'is treated separately. If set to \ttt{"singular"} (\ttt{"finite"}), ' // &
'only the singular (finite) real component is integrated.' // &
'(cf. also \ttt{real\_partition\_scale})'))
call var_list%append_real (var_str ("real_partition_scale"), &
10._default, intrinsic = .true., &
description=var_str ('This real variable sets the invariant mass ' // &
'of the FKS pair used as a separator between the singular and the ' // &
'finite part of the real subtraction terms in an NLO calculation, ' // &
'e.g. in $e^+e^- \to t\bar tj$. (cf. also \ttt{\$real\_partition\_mode})'))
call var_list%append_log (var_str ("?nlo_reuse_amplitudes_fks"), &
.false., intrinsic = .true., &
description=var_str ('Only compute real and virtual amplitudes for ' // &
'subprocesses that give a different amplitude and reuse the result ' // &
'for equivalent subprocesses. ' // &
'Might give a speed-up for some processes. Might ' // &
'break others, especially in cases where resonance histories are needed. ' // &
'Experimental feature, use at your own risk!'))
end subroutine var_list_set_nlo_defaults
@ %def var_list_set_nlo_defaults
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Observables}
In this module we define concrete variables and operators (observables)
that we want to support in expressions.
<<[[observables.f90]]>>=
<<File header>>
module observables
<<Use kinds>>
<<Use strings>>
use subevents
use variables
<<Standard module head>>
<<Observables: public>>
interface
<<Observables: sub interfaces>>
end interface
end module observables
@ %def observables
@
<<[[observables_sub.f90]]>>=
<<File header>>
submodule (observables) observables_s
use io_units
use diagnostics
use lorentz
implicit none
contains
<<Observables: procedures>>
end submodule observables_s
@ %def observables_s
@
\subsection{Observables}
These are analogous to the unary and binary numeric functions listed
above. An observable takes the [[pval]] component(s) of its one or
two argument nodes and produces an integer or real value.
\subsubsection{Integer-valued unary observables}
The PDG code
<<Observables: procedures>>=
integer function obs_pdg1 (prt1) result (pdg)
type(prt_t), intent(in) :: prt1
pdg = prt_get_pdg (prt1)
end function obs_pdg1
@ %def obs_pdg
@ The helicity. The return value is meaningful only if the particle
is polarized, otherwise an invalid value is returned (-9).
<<Observables: procedures>>=
integer function obs_helicity1 (prt1) result (h)
type(prt_t), intent(in) :: prt1
if (prt_is_polarized (prt1)) then
h = prt_get_helicity (prt1)
else
h = -9
end if
end function obs_helicity1
@ %def obs_helicity1
@ The number of open color (anticolor) lines. The return value is meaningful
only if the particle is colorized (i.e., the subevent has been given color
information), otherwise the function returns zero.
<<Observables: procedures>>=
integer function obs_n_col1 (prt1) result (n)
type(prt_t), intent(in) :: prt1
if (prt_is_colorized (prt1)) then
n = prt_get_n_col (prt1)
else
n = 0
end if
end function obs_n_col1
integer function obs_n_acl1 (prt1) result (n)
type(prt_t), intent(in) :: prt1
if (prt_is_colorized (prt1)) then
n = prt_get_n_acl (prt1)
else
n = 0
end if
end function obs_n_acl1
@ %def obs_n_col1
@ %def obs_n_acl1
@
\subsubsection{Real-valued unary observables}
The invariant mass squared, obtained from the separately stored value.
<<Observables: procedures>>=
real(default) function obs_mass_squared1 (prt1) result (p2)
type(prt_t), intent(in) :: prt1
p2 = prt_get_msq (prt1)
end function obs_mass_squared1
@ %def obs_mass_squared1
@ The signed invariant mass, which is the signed square root of the
previous observable.
<<Observables: procedures>>=
real(default) function obs_signed_mass1 (prt1) result (m)
type(prt_t), intent(in) :: prt1
real(default) :: msq
msq = prt_get_msq (prt1)
m = sign (sqrt (abs (msq)), msq)
end function obs_signed_mass1
@ %def obs_signed_mass1
@ The particle energy
<<Observables: procedures>>=
real(default) function obs_energy1 (prt1) result (e)
type(prt_t), intent(in) :: prt1
e = energy (prt_get_momentum (prt1))
end function obs_energy1
@ %def obs_energy1
@ Particle momentum (components)
<<Observables: procedures>>=
real(default) function obs_px1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = vector4_get_component (prt_get_momentum (prt1), 1)
end function obs_px1
real(default) function obs_py1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = vector4_get_component (prt_get_momentum (prt1), 2)
end function obs_py1
real(default) function obs_pz1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = vector4_get_component (prt_get_momentum (prt1), 3)
end function obs_pz1
real(default) function obs_p1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = space_part_norm (prt_get_momentum (prt1))
end function obs_p1
real(default) function obs_pl1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = longitudinal_part (prt_get_momentum (prt1))
end function obs_pl1
real(default) function obs_pt1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = transverse_part (prt_get_momentum (prt1))
end function obs_pt1
@ %def obs_px1 obs_py1 obs_pz1
@ %def obs_p1 obs_pl1 obs_pt1
@ Polar and azimuthal angle (lab frame).
<<Observables: procedures>>=
real(default) function obs_theta1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = polar_angle (prt_get_momentum (prt1))
end function obs_theta1
real(default) function obs_phi1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = azimuthal_angle (prt_get_momentum (prt1))
end function obs_phi1
@ %def obs_theta1 obs_phi1
@ Rapidity and pseudorapidity
<<Observables: procedures>>=
real(default) function obs_rap1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = rapidity (prt_get_momentum (prt1))
end function obs_rap1
real(default) function obs_eta1 (prt1) result (p)
type(prt_t), intent(in) :: prt1
p = pseudorapidity (prt_get_momentum (prt1))
end function obs_eta1
@ %def obs_rap1 obs_eta1
@ Meaningless: Polar angle in the rest frame of the two arguments
combined.
<<Observables: procedures>>=
real(default) function obs_theta_star1 (prt1) result (dist)
type(prt_t), intent(in) :: prt1
call msg_fatal (" 'Theta_star' is undefined as unary observable")
dist = 0
end function obs_theta_star1
@ %def obs_theta_star1
@ [Obsolete] Meaningless: Polar angle in the rest frame of the 2nd argument.
<<XXX Observables: procedures>>=
real(default) function obs_theta_rf1 (prt1) result (dist)
type(prt_t), intent(in) :: prt1
call msg_fatal (" 'Theta_RF' is undefined as unary observable")
dist = 0
end function obs_theta_rf1
@ %def obs_theta_rf1
@ Meaningless: Distance on the $\eta$-$\phi$ cylinder.
<<Observables: procedures>>=
real(default) function obs_dist1 (prt1) result (dist)
type(prt_t), intent(in) :: prt1
call msg_fatal (" 'Dist' is undefined as unary observable")
dist = 0
end function obs_dist1
@ %def obs_dist1
@
\subsubsection{Integer-valued binary observables}
These observables are meaningless as binary functions.
<<Observables: procedures>>=
integer function obs_pdg2 (prt1, prt2) result (pdg)
type(prt_t), intent(in) :: prt1, prt2
call msg_fatal (" PDG_Code is undefined as binary observable")
pdg = 0
end function obs_pdg2
integer function obs_helicity2 (prt1, prt2) result (h)
type(prt_t), intent(in) :: prt1, prt2
call msg_fatal (" Helicity is undefined as binary observable")
h = 0
end function obs_helicity2
integer function obs_n_col2 (prt1, prt2) result (n)
type(prt_t), intent(in) :: prt1, prt2
call msg_fatal (" Ncol is undefined as binary observable")
n = 0
end function obs_n_col2
integer function obs_n_acl2 (prt1, prt2) result (n)
type(prt_t), intent(in) :: prt1, prt2
call msg_fatal (" Nacl is undefined as binary observable")
n = 0
end function obs_n_acl2
@ %def obs_pdg2
@ %def obs_helicity2
@ %def obs_n_col2
@ %def obs_n_acl2
@
\subsubsection{Real-valued binary observables}
The invariant mass squared, obtained from the separately stored value.
<<Observables: procedures>>=
real(default) function obs_mass_squared2 (prt1, prt2) result (p2)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p2 = prt_get_msq (prt)
end function obs_mass_squared2
@ %def obs_mass_squared2
@ The signed invariant mass, which is the signed square root of the
previous observable.
<<Observables: procedures>>=
real(default) function obs_signed_mass2 (prt1, prt2) result (m)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
real(default) :: msq
call prt_init_combine (prt, prt1, prt2)
msq = prt_get_msq (prt)
m = sign (sqrt (abs (msq)), msq)
end function obs_signed_mass2
@ %def obs_signed_mass2
@ The particle energy
<<Observables: procedures>>=
real(default) function obs_energy2 (prt1, prt2) result (e)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
e = energy (prt_get_momentum (prt))
end function obs_energy2
@ %def obs_energy2
@ Particle momentum (components)
<<Observables: procedures>>=
real(default) function obs_px2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = vector4_get_component (prt_get_momentum (prt), 1)
end function obs_px2
real(default) function obs_py2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = vector4_get_component (prt_get_momentum (prt), 2)
end function obs_py2
real(default) function obs_pz2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = vector4_get_component (prt_get_momentum (prt), 3)
end function obs_pz2
real(default) function obs_p2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = space_part_norm (prt_get_momentum (prt))
end function obs_p2
real(default) function obs_pl2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = longitudinal_part (prt_get_momentum (prt))
end function obs_pl2
real(default) function obs_pt2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = transverse_part (prt_get_momentum (prt))
end function obs_pt2
@ %def obs_px2 obs_py2 obs_pz2
@ %def obs_p2 obs_pl2 obs_pt2
@ Enclosed angle and azimuthal distance (lab frame).
<<Observables: procedures>>=
real(default) function obs_theta2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
p = enclosed_angle (prt_get_momentum (prt1), prt_get_momentum (prt2))
end function obs_theta2
real(default) function obs_phi2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = azimuthal_distance (prt_get_momentum (prt1), prt_get_momentum (prt2))
end function obs_phi2
@ %def obs_theta2 obs_phi2
@ Rapidity and pseudorapidity distance
<<Observables: procedures>>=
real(default) function obs_rap2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
p = rapidity_distance &
(prt_get_momentum (prt1), prt_get_momentum (prt2))
end function obs_rap2
real(default) function obs_eta2 (prt1, prt2) result (p)
type(prt_t), intent(in) :: prt1, prt2
type(prt_t) :: prt
call prt_init_combine (prt, prt1, prt2)
p = pseudorapidity_distance &
(prt_get_momentum (prt1), prt_get_momentum (prt2))
end function obs_eta2
@ %def obs_rap2 obs_eta2
@ [This doesn't work! The principle of no common particle for momentum
combination prohibits us from combining a decay particle with the momentum
of its parent.] Polar angle in the rest frame of the 2nd argument.
<<XXX Observables: procedures>>=
real(default) function obs_theta_rf2 (prt1, prt2) result (theta)
type(prt_t), intent(in) :: prt1, prt2
theta = enclosed_angle_rest_frame &
(prt_get_momentum (prt1), prt_get_momentum (prt2))
end function obs_theta_rf2
@ %def obs_theta_rf2
@ Polar angle of the first particle in the rest frame of the two particles
combined.
<<Observables: procedures>>=
real(default) function obs_theta_star2 (prt1, prt2) result (theta)
type(prt_t), intent(in) :: prt1, prt2
theta = enclosed_angle_rest_frame &
(prt_get_momentum (prt1), &
prt_get_momentum (prt1) + prt_get_momentum (prt2))
end function obs_theta_star2
@ %def obs_theta_star2
@ Distance on the $\eta$-$\phi$ cylinder.
<<Observables: procedures>>=
real(default) function obs_dist2 (prt1, prt2) result (dist)
type(prt_t), intent(in) :: prt1, prt2
dist = eta_phi_distance &
(prt_get_momentum (prt1), prt_get_momentum (prt2))
end function obs_dist2
@ %def obs_dist2
@ Durham kT measure.
<<Observables: procedures>>=
real(default) function obs_ktmeasure (prt1, prt2) result (kt)
type(prt_t), intent(in) :: prt1, prt2
real (default) :: q2, e1, e2
! Normalized scale to one for now! (#67)
q2 = 1
e1 = energy (prt_get_momentum (prt1))
e2 = energy (prt_get_momentum (prt2))
kt = (2/q2) * min(e1**2,e2**2) * &
(1 - enclosed_angle_ct(prt_get_momentum (prt1), &
prt_get_momentum (prt2)))
end function obs_ktmeasure
@ %def obs_ktmeasure
@ Subeventary observables, e.g. the transverse mass $H_T$.
<<Observables: procedures>>=
real(default) function obs_ht (sev) result (ht)
type(subevt_t), intent(in) :: sev
integer :: i, n
type(prt_t) :: prt
n = sev%get_length ()
ht = 0
do i = 1, n
prt = sev%get_prt (i)
ht = ht + &
sqrt (obs_pt1(prt)**2 + obs_mass_squared1(prt))
end do
end function obs_ht
@ %def obs_ht
\subsection{Process-specific variables}
We allow the user to set a numeric process ID for each declared process.
<<Observables: public>>=
public :: var_list_init_num_id
<<Observables: sub interfaces>>=
module subroutine var_list_init_num_id (var_list, proc_id, num_id)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
integer, intent(in), optional :: num_id
end subroutine var_list_init_num_id
<<Observables: procedures>>=
module subroutine var_list_init_num_id (var_list, proc_id, num_id)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
integer, intent(in), optional :: num_id
call var_list%set_procvar_int (proc_id, var_str ("num_id"), num_id)
end subroutine var_list_init_num_id
@ %def var_list_init_num_id
@
Integration results are stored in special variables. They are
initialized by this subroutine. The values may or may not already
known.
Note: the values which are accessible are those that are unique for a
process with multiple MCI records. The rest has been discarded.
<<Observables: public>>=
public :: var_list_init_process_results
<<Observables: sub interfaces>>=
module subroutine var_list_init_process_results (var_list, proc_id, &
n_calls, integral, error, accuracy, chi2, efficiency)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
integer, intent(in), optional :: n_calls
real(default), intent(in), optional :: integral, error, accuracy
real(default), intent(in), optional :: chi2, efficiency
end subroutine var_list_init_process_results
<<Observables: procedures>>=
module subroutine var_list_init_process_results (var_list, proc_id, &
n_calls, integral, error, accuracy, chi2, efficiency)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
integer, intent(in), optional :: n_calls
real(default), intent(in), optional :: integral, error, accuracy
real(default), intent(in), optional :: chi2, efficiency
call var_list%set_procvar_real (proc_id, var_str ("integral"), integral)
call var_list%set_procvar_real (proc_id, var_str ("error"), error)
end subroutine var_list_init_process_results
@ %def var_list_init_process_results
@
\subsection{Observables as Pseudo-Variables}
Unary and binary observables are different. Most unary observables
can be equally well evaluated for particle pairs. Binary observables
cannot be evaluated for single particles.
<<Observables: public>>=
public :: var_list_set_observables_unary
public :: var_list_set_observables_binary
public :: var_list_set_observables_sev
<<Observables: sub interfaces>>=
module subroutine var_list_set_observables_unary (var_list, prt1)
type(var_list_t), intent(inout) :: var_list
type(prt_t), intent(in), target :: prt1
end subroutine var_list_set_observables_unary
module subroutine var_list_set_observables_binary (var_list, prt1, prt2)
type(var_list_t), intent(inout) :: var_list
type(prt_t), intent(in), target :: prt1
type(prt_t), intent(in), optional, target :: prt2
end subroutine var_list_set_observables_binary
module subroutine var_list_set_observables_sev (var_list, pval)
type(var_list_t), intent(inout) :: var_list
type(subevt_t), intent(in), target:: pval
end subroutine var_list_set_observables_sev
<<Observables: procedures>>=
module subroutine var_list_set_observables_unary (var_list, prt1)
type(var_list_t), intent(inout) :: var_list
type(prt_t), intent(in), target :: prt1
call var_list%append_obs1_iptr (var_str ("PDG"), obs_pdg1, prt1)
call var_list%append_obs1_iptr (var_str ("Hel"), obs_helicity1, prt1)
call var_list%append_obs1_iptr (var_str ("Ncol"), obs_n_col1, prt1)
call var_list%append_obs1_iptr (var_str ("Nacl"), obs_n_acl1, prt1)
call var_list%append_obs1_rptr &
(var_str ("M"), obs_signed_mass1, prt1)
call var_list%append_obs1_rptr &
(var_str ("M2"), obs_mass_squared1, prt1)
call var_list%append_obs1_rptr (var_str ("E"), obs_energy1, prt1)
call var_list%append_obs1_rptr (var_str ("Px"), obs_px1, prt1)
call var_list%append_obs1_rptr (var_str ("Py"), obs_py1, prt1)
call var_list%append_obs1_rptr (var_str ("Pz"), obs_pz1, prt1)
call var_list%append_obs1_rptr (var_str ("P"), obs_p1, prt1)
call var_list%append_obs1_rptr (var_str ("Pl"), obs_pl1, prt1)
call var_list%append_obs1_rptr (var_str ("Pt"), obs_pt1, prt1)
call var_list%append_obs1_rptr (var_str ("Theta"), obs_theta1, prt1)
call var_list%append_obs1_rptr (var_str ("Phi"), obs_phi1, prt1)
call var_list%append_obs1_rptr (var_str ("Rap"), obs_rap1, prt1)
call var_list%append_obs1_rptr (var_str ("Eta"), obs_eta1, prt1)
call var_list%append_obs1_rptr &
(var_str ("Theta_star"), obs_theta_star1, prt1)
call var_list%append_obs1_rptr (var_str ("Dist"), obs_dist1, prt1)
call var_list%append_uobs_real (var_str ("_User_obs_real"), prt1)
call var_list%append_uobs_int (var_str ("_User_obs_int"), prt1)
end subroutine var_list_set_observables_unary
module subroutine var_list_set_observables_binary (var_list, prt1, prt2)
type(var_list_t), intent(inout) :: var_list
type(prt_t), intent(in), target :: prt1
type(prt_t), intent(in), optional, target :: prt2
call var_list%append_obs2_iptr (var_str ("PDG"), obs_pdg2, prt1, prt2)
call var_list%append_obs2_iptr (var_str ("Hel"), obs_helicity2, prt1, prt2)
call var_list%append_obs2_iptr (var_str ("Ncol"), obs_n_col2, prt1, prt2)
call var_list%append_obs2_iptr (var_str ("Nacl"), obs_n_acl2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("M"), obs_signed_mass2, prt1, prt2)
call var_list%append_obs2_rptr &
(var_str ("M2"), obs_mass_squared2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("E"), obs_energy2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Px"), obs_px2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Py"), obs_py2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Pz"), obs_pz2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("P"), obs_p2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Pl"), obs_pl2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Pt"), obs_pt2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Theta"), obs_theta2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Phi"), obs_phi2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Rap"), obs_rap2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Eta"), obs_eta2, prt1, prt2)
call var_list%append_obs2_rptr &
(var_str ("Theta_star"), obs_theta_star2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("Dist"), obs_dist2, prt1, prt2)
call var_list%append_obs2_rptr (var_str ("kT"), obs_ktmeasure, prt1, prt2)
call var_list%append_uobs_real (var_str ("_User_obs_real"), prt1, prt2)
call var_list%append_uobs_int (var_str ("_User_obs_int"), prt1, prt2)
end subroutine var_list_set_observables_binary
module subroutine var_list_set_observables_sev (var_list, pval)
type(var_list_t), intent(inout) :: var_list
type(subevt_t), intent(in), target:: pval
call var_list%append_obsev_rptr (var_str ("Ht"), obs_ht, pval)
end subroutine var_list_set_observables_sev
@ %def var_list_set_observables_unary var_list_set_observables_binary
@ %def var_list_set_observables_nary
\subsection{Checks}
<<Observables: public>>=
public :: var_list_check_observable
<<Observables: sub interfaces>>=
module subroutine var_list_check_observable (var_list, name, type)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(inout) :: type
end subroutine var_list_check_observable
<<Observables: procedures>>=
module subroutine var_list_check_observable (var_list, name, type)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(inout) :: type
if (string_is_observable_id (name)) then
call msg_fatal ("Variable name '" // char (name) &
// "' is reserved for an observable")
type = V_NONE
return
end if
end subroutine var_list_check_observable
@ %def var_list_check_observable
@
Check if a variable name is defined as an observable:
<<Observables: procedures>>=
function string_is_observable_id (string) result (flag)
logical :: flag
type(string_t), intent(in) :: string
select case (char (string))
case ("PDG", "Hel", "Ncol", "Nacl", &
"M", "M2", "E", "Px", "Py", "Pz", "P", "Pl", "Pt", &
"Theta", "Phi", "Rap", "Eta", "Theta_star", "Dist", "kT", &
"Ht")
flag = .true.
case default
flag = .false.
end select
end function string_is_observable_id
@ %def string_is_observable_id
@ Check for result and process variables.
<<Observables: public>>=
public :: var_list_check_result_var
<<Observables: sub interfaces>>=
module subroutine var_list_check_result_var (var_list, name, type)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(inout) :: type
end subroutine var_list_check_result_var
<<Observables: procedures>>=
module subroutine var_list_check_result_var (var_list, name, type)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(inout) :: type
if (string_is_integer_result_var (name)) type = V_INT
if (.not. var_list%contains (name)) then
if (string_is_result_var (name)) then
call msg_fatal ("Result variable '" // char (name) // "' " &
// "set without prior integration")
type = V_NONE
return
else if (string_is_num_id (name)) then
call msg_fatal ("Numeric process ID '" // char (name) // "' " &
// "set without process declaration")
type = V_NONE
return
end if
end if
end subroutine var_list_check_result_var
@ %def var_list_check_result_var
@
Check if a variable name is a result variable of integer type:
<<Observables: procedures>>=
function string_is_integer_result_var (string) result (flag)
logical :: flag
type(string_t), intent(in) :: string
type(string_t) :: buffer, name, separator
buffer = string
call split (buffer, name, "(", separator=separator) ! ")"
if (separator == "(") then
select case (char (name))
case ("num_id", "n_calls")
flag = .true.
case default
flag = .false.
end select
else
flag = .false.
end if
end function string_is_integer_result_var
@ %def string_is_integer_result_var
@
Check if a variable name is an integration-result variable:
<<Observables: procedures>>=
function string_is_result_var (string) result (flag)
logical :: flag
type(string_t), intent(in) :: string
type(string_t) :: buffer, name, separator
buffer = string
call split (buffer, name, "(", separator=separator) ! ")"
if (separator == "(") then
select case (char (name))
case ("integral", "error")
flag = .true.
case default
flag = .false.
end select
else
flag = .false.
end if
end function string_is_result_var
@ %def string_is_result_var
@
Check if a variable name is a numeric process ID:
<<Observables: procedures>>=
function string_is_num_id (string) result (flag)
logical :: flag
type(string_t), intent(in) :: string
type(string_t) :: buffer, name, separator
buffer = string
call split (buffer, name, "(", separator=separator) ! ")"
if (separator == "(") then
select case (char (name))
case ("num_id")
flag = .true.
case default
flag = .false.
end select
else
flag = .false.
end if
end function string_is_num_id
@ %def string_is_num_id
@
Index: trunk/src/phase_space/phase_space.nw
===================================================================
--- trunk/src/phase_space/phase_space.nw (revision 8819)
+++ trunk/src/phase_space/phase_space.nw (revision 8820)
@@ -1,31078 +1,31078 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: phase space
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Phase Space}
\includemodulegraph{phase_space}
The abstract representation of a type that parameterizes phase space,
with methods for construction and evaluation.
\begin{description}
\item[phs\_base]
Abstract phase-space representation.
\end{description}
A simple implementation:
\begin{description}
\item[phs\_none]
This implements a non-functional dummy module for the phase space.
A process which uses this module cannot be integrated. The purpose
of this module is to provide a placeholder for processes which do
not require phase-space evaluation. They may still allow for evaluating
matrix elements.
\item[phs\_single]
Parameterize the phase space of a single particle, i.e., the solid
angle. This is useful only for very restricted problems, but it
avoids the complexity of a generic approach in those trivial cases.
\end{description}
The standard implementation is called \emph{wood} phase space. It
consists of several auxiliary modules and the actual implementation
module.
\begin{description}
\item[mappings]
Generate invariant masses and decay angles from given
random numbers (or the inverse operation). Each mapping pertains to a
particular node in a phase-space tree. Different mappings account for
uniform distributions, resonances, zero-mass behavior, and so on.
\item[phs\_trees]
Phase space parameterizations for scattering
processes are defined recursively as if there was an initial particle
decaying. This module sets up a representation in terms of abstract
trees, where each node gets a unique binary number. Each tree is
stored as an array of branches, where integers indicate the
connections. This emulates pointers in a transparent way. Real
pointers would also be possible, but seem to be less efficient for
this particular case.
\item[phs\_forests]
The type defined by this module collects the
decay trees corresponding to a given process and the applicable
mappings. To set this up, a file is read which is either written by
the user or by the \textbf{cascades} module functions. The module
also contains the routines that evaluate phase space, i.e., generate
momenta from random numbers and back.
\item[cascades]
This module is a pseudo Feynman diagram generator with the
particular purpose of finding the phase space parameterizations best
suited for a given process. It uses a model file to set up the
possible vertices, generates all possible diagrams, identifies
resonances and singularities, and simplifies the list by merging
equivalent diagrams and dropping irrelevant ones. This process can be
controlled at several points by user-defined parameters. Note that it
depends on the particular values of particle masses, so it cannot be
done before reading the input file.
\item[phs\_wood]
Make the functionality available in form of an implementation of the
abstract phase-space type.
\item[phs\_fks]
Phase-space parameterization with modifications for the FKS scheme.
\end{description}
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Abstract phase-space module}
In this module we define an abstract base type (and a trivial test
implementation) for multi-channel phase-space parameterizations.
<<[[phs_base.f90]]>>=
<<File header>>
module phs_base
<<Use kinds>>
<<Use strings>>
use lorentz
use model_data
use flavors
use process_constants
<<Standard module head>>
<<PHS base: public>>
<<PHS base: types>>
<<PHS base: interfaces>>
interface
<<PHS base: sub interfaces>>
end interface
contains
<<PHS base: main procedures>>
end module phs_base
@ %def phs_base
@
<<[[phs_base_sub.f90]]>>=
<<File header>>
submodule (phs_base) phs_base_s
use io_units
use constants, only: TWOPI, TWOPI4
use string_utils, only: split_string
use format_defs, only: FMT_19
use numeric_utils
use diagnostics
use md5
use physics_defs
implicit none
contains
<<PHS base: procedures>>
end submodule phs_base_s
@ %def phs_base_s
@
\subsection{Phase-space channels}
The kinematics configuration may generate multiple parameterizations of phase
space. Some of those have specific properties, such as a resonance in the s
channel.
\subsubsection{Channel properties}
This is the abstract type for the channel properties. We need them as
a data transfer container, so everything is public and transparent.
<<PHS base: public>>=
public :: channel_prop_t
<<PHS base: types>>=
type, abstract :: channel_prop_t
contains
procedure (channel_prop_to_string), deferred :: to_string
generic :: operator (==) => is_equal
procedure (channel_eq), deferred :: is_equal
end type channel_prop_t
@ %def channel_prop_t
<<PHS base: interfaces>>=
abstract interface
function channel_prop_to_string (object) result (string)
import
class(channel_prop_t), intent(in) :: object
type(string_t) :: string
end function channel_prop_to_string
end interface
@ %def channel_prop_to_string
<<PHS base: interfaces>>=
abstract interface
function channel_eq (prop1, prop2) result (flag)
import
class(channel_prop_t), intent(in) :: prop1, prop2
logical :: flag
end function channel_eq
end interface
@ %def channel_prop_to_string
@
Here is a resonance as a channel property. Mass and width are stored
here in physical units.
<<PHS base: public>>=
public :: resonance_t
<<PHS base: types>>=
type, extends (channel_prop_t) :: resonance_t
real(default) :: mass = 0
real(default) :: width = 0
contains
procedure :: to_string => resonance_to_string
procedure :: is_equal => resonance_is_equal
end type resonance_t
@ %def resonance_t
@ Print mass and width.
<<PHS base: sub interfaces>>=
module function resonance_to_string (object) result (string)
class(resonance_t), intent(in) :: object
type(string_t) :: string
end function resonance_to_string
<<PHS base: procedures>>=
module function resonance_to_string (object) result (string)
class(resonance_t), intent(in) :: object
type(string_t) :: string
character(32) :: buffer
string = "resonant: m ="
write (buffer, "(" // FMT_19 // ")") object%mass
string = string // trim (buffer) // " GeV, w ="
write (buffer, "(" // FMT_19 // ")") object%width
string = string // trim (buffer) // " GeV"
end function resonance_to_string
@ %def resonance_to_string
@ Equality.
<<PHS base: sub interfaces>>=
module function resonance_is_equal (prop1, prop2) result (flag)
class(resonance_t), intent(in) :: prop1
class(channel_prop_t), intent(in) :: prop2
logical :: flag
end function resonance_is_equal
<<PHS base: procedures>>=
module function resonance_is_equal (prop1, prop2) result (flag)
class(resonance_t), intent(in) :: prop1
class(channel_prop_t), intent(in) :: prop2
logical :: flag
select type (prop2)
type is (resonance_t)
flag = prop1%mass == prop2%mass .and. prop1%width == prop2%width
class default
flag = .false.
end select
end function resonance_is_equal
@ %def resonance_is_equal
@
This is the limiting case of a resonance, namely an on-shell particle.
We just store the mass in physical units.
<<PHS base: public>>=
public :: on_shell_t
<<PHS base: types>>=
type, extends (channel_prop_t) :: on_shell_t
real(default) :: mass = 0
contains
procedure :: to_string => on_shell_to_string
procedure :: is_equal => on_shell_is_equal
end type on_shell_t
@ %def on_shell_t
@ Print mass and width.
<<PHS base: sub interfaces>>=
module function on_shell_to_string (object) result (string)
class(on_shell_t), intent(in) :: object
type(string_t) :: string
end function on_shell_to_string
<<PHS base: procedures>>=
module function on_shell_to_string (object) result (string)
class(on_shell_t), intent(in) :: object
type(string_t) :: string
character(32) :: buffer
string = "on shell: m ="
write (buffer, "(" // FMT_19 // ")") object%mass
string = string // trim (buffer) // " GeV"
end function on_shell_to_string
@ %def on_shell_to_string
@ Equality.
<<PHS base: sub interfaces>>=
module function on_shell_is_equal (prop1, prop2) result (flag)
class(on_shell_t), intent(in) :: prop1
class(channel_prop_t), intent(in) :: prop2
logical :: flag
end function on_shell_is_equal
<<PHS base: procedures>>=
module function on_shell_is_equal (prop1, prop2) result (flag)
class(on_shell_t), intent(in) :: prop1
class(channel_prop_t), intent(in) :: prop2
logical :: flag
select type (prop2)
type is (on_shell_t)
flag = prop1%mass == prop2%mass
class default
flag = .false.
end select
end function on_shell_is_equal
@ %def on_shell_is_equal
@
\subsubsection{Channel equivalences}
This type describes an equivalence. The current channel is equivalent
to channel [[c]]. The equivalence involves a permutation [[perm]] of
integration dimensions and, within each integration dimension, a
mapping [[mode]].
<<PHS base: types>>=
type :: phs_equivalence_t
integer :: c = 0
integer, dimension(:), allocatable :: perm
integer, dimension(:), allocatable :: mode
contains
<<PHS base: phs equivalence: TBP>>
end type phs_equivalence_t
@ %def phs_equivalence_t
@
The mapping modes are
<<PHS base: types>>=
integer, parameter, public :: &
EQ_IDENTITY = 0, EQ_INVERT = 1, EQ_SYMMETRIC = 2, EQ_INVARIANT = 3
@ %def EQ_IDENTITY EQ_INVERT EQ_SYMMETRIC
@ In particular, if a channel is equivalent to itself in the
[[EQ_SYMMETRIC]] mode, the integrand can be assumed to be symmetric
w.r.t.\ a reflection $x\to 1 - x$ of the correponding integration variable.
These are the associated tags, for output:
<<PHS base: types>>=
character, dimension(0:3), parameter :: TAG = ["+", "-", ":", "x"]
@ %def TAG
@ Write an equivalence.
<<PHS base: phs equivalence: TBP>>=
procedure :: write => phs_equivalence_write
<<PHS base: sub interfaces>>=
module subroutine phs_equivalence_write (object, unit)
class(phs_equivalence_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine phs_equivalence_write
<<PHS base: procedures>>=
module subroutine phs_equivalence_write (object, unit)
class(phs_equivalence_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, j
u = given_output_unit (unit)
write (u, "(5x,'=',1x,I0,1x)", advance = "no") object%c
if (allocated (object%perm)) then
write (u, "(A)", advance = "no") "("
do j = 1, size (object%perm)
if (j > 1) write (u, "(1x)", advance = "no")
write (u, "(I0,A1)", advance = "no") &
object%perm(j), TAG(object%mode(j))
end do
write (u, "(A)") ")"
else
write (u, "(A)")
end if
end subroutine phs_equivalence_write
@ %def phs_equivalence_write
@ Initialize an equivalence. This allocates the [[perm]] and [[mode]]
arrays with equal size.
<<PHS base: phs equivalence: TBP>>=
procedure :: init => phs_equivalence_init
<<PHS base: sub interfaces>>=
module subroutine phs_equivalence_init (eq, n_dim)
class(phs_equivalence_t), intent(out) :: eq
integer, intent(in) :: n_dim
end subroutine phs_equivalence_init
<<PHS base: procedures>>=
module subroutine phs_equivalence_init (eq, n_dim)
class(phs_equivalence_t), intent(out) :: eq
integer, intent(in) :: n_dim
allocate (eq%perm (n_dim), source = 0)
allocate (eq%mode (n_dim), source = EQ_IDENTITY)
end subroutine phs_equivalence_init
@ %def phs_equivalence_init
@
\subsubsection{Channel objects}
The channel entry holds (optionally) specific properties.
[[sf_channel]] is the structure-function channel that corresponds to this
phase-space channel. The structure-function channel may be set up with a
specific mapping that depends on the phase-space channel properties. (The
default setting is to leave the properties empty.)
<<PHS base: public>>=
public :: phs_channel_t
<<PHS base: types>>=
type :: phs_channel_t
class(channel_prop_t), allocatable :: prop
integer :: sf_channel = 1
type(phs_equivalence_t), dimension(:), allocatable :: eq
contains
<<PHS base: phs channel: TBP>>
end type phs_channel_t
@ %def phs_channel_t
@ Output.
<<PHS base: phs channel: TBP>>=
procedure :: write => phs_channel_write
<<PHS base: sub interfaces>>=
module subroutine phs_channel_write (object, unit)
class(phs_channel_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine phs_channel_write
<<PHS base: procedures>>=
module subroutine phs_channel_write (object, unit)
class(phs_channel_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, j
u = given_output_unit (unit)
write (u, "(1x,I0)", advance="no") object%sf_channel
if (allocated (object%prop)) then
write (u, "(1x,A)") char (object%prop%to_string ())
else
write (u, *)
end if
if (allocated (object%eq)) then
do j = 1, size (object%eq)
call object%eq(j)%write (u)
end do
end if
end subroutine phs_channel_write
@ %def phs_channel_write
@ Identify the channel with an s-channel resonance.
Gfortran 7/8/9 bug: has to remain in the main module.
<<PHS base: phs channel: TBP>>=
procedure :: set_resonant => channel_set_resonant
<<PHS base: main procedures>>=
subroutine channel_set_resonant (channel, mass, width)
class(phs_channel_t), intent(inout) :: channel
real(default), intent(in) :: mass, width
allocate (resonance_t :: channel%prop)
select type (prop => channel%prop)
type is (resonance_t)
prop%mass = mass
prop%width = width
end select
end subroutine channel_set_resonant
@ %def channel_set_resonant
@ Identify the channel with an on-shell particle.
Gfortran 7/8/9 bug: has to remain in the main module.
<<PHS base: phs channel: TBP>>=
procedure :: set_on_shell => channel_set_on_shell
<<PHS base: main procedures>>=
subroutine channel_set_on_shell (channel, mass)
class(phs_channel_t), intent(inout) :: channel
real(default), intent(in) :: mass
allocate (on_shell_t :: channel%prop)
select type (prop => channel%prop)
type is (on_shell_t)
prop%mass = mass
end select
end subroutine channel_set_on_shell
@ %def channel_set_on_shell
@
\subsection{Property collection}
We can set up a list of all distinct channel properties for a given
set of channels.
<<PHS base: public>>=
public :: phs_channel_collection_t
<<PHS base: types>>=
type :: prop_entry_t
integer :: i = 0
class(channel_prop_t), allocatable :: prop
type(prop_entry_t), pointer :: next => null ()
end type prop_entry_t
type :: phs_channel_collection_t
integer :: n = 0
type(prop_entry_t), pointer :: first => null ()
contains
<<PHS base: phs channel collection: TBP>>
end type phs_channel_collection_t
@ %def prop_entry_t
@ %def phs_channel_collection_t
@ Finalizer for the list.
<<PHS base: phs channel collection: TBP>>=
procedure :: final => phs_channel_collection_final
<<PHS base: sub interfaces>>=
module subroutine phs_channel_collection_final (object)
class(phs_channel_collection_t), intent(inout) :: object
end subroutine phs_channel_collection_final
<<PHS base: procedures>>=
module subroutine phs_channel_collection_final (object)
class(phs_channel_collection_t), intent(inout) :: object
type(prop_entry_t), pointer :: entry
do while (associated (object%first))
entry => object%first
object%first => entry%next
deallocate (entry)
end do
end subroutine phs_channel_collection_final
@ %def phs_channel_collection_final
@ Output.
<<PHS base: phs channel collection: TBP>>=
procedure :: write => phs_channel_collection_write
<<PHS base: sub interfaces>>=
module subroutine phs_channel_collection_write (object, unit)
class(phs_channel_collection_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine phs_channel_collection_write
<<PHS base: procedures>>=
module subroutine phs_channel_collection_write (object, unit)
class(phs_channel_collection_t), intent(in) :: object
integer, intent(in), optional :: unit
type(prop_entry_t), pointer :: entry
integer :: u
u = given_output_unit (unit)
entry => object%first
do while (associated (entry))
if (allocated (entry%prop)) then
write (u, "(1x,I0,1x,A)") entry%i, char (entry%prop%to_string ())
else
write (u, "(1x,I0)") entry%i
end if
entry => entry%next
end do
end subroutine phs_channel_collection_write
@ %def phs_channel_collection_write
@ Push a new property to the stack if it is not yet included.
Simultaneously, set the [[sf_channel]] entry in the phase-space
channel object to the index of the matching entry, or the new entry if
there was no match.
<<PHS base: phs channel collection: TBP>>=
procedure :: push => phs_channel_collection_push
<<PHS base: sub interfaces>>=
module subroutine phs_channel_collection_push (coll, channel)
class(phs_channel_collection_t), intent(inout) :: coll
type(phs_channel_t), intent(inout) :: channel
end subroutine phs_channel_collection_push
<<PHS base: procedures>>=
module subroutine phs_channel_collection_push (coll, channel)
class(phs_channel_collection_t), intent(inout) :: coll
type(phs_channel_t), intent(inout) :: channel
type(prop_entry_t), pointer :: entry, new
if (associated (coll%first)) then
entry => coll%first
do
if (allocated (entry%prop)) then
if (allocated (channel%prop)) then
if (entry%prop == channel%prop) then
channel%sf_channel = entry%i
return
end if
end if
else if (.not. allocated (channel%prop)) then
channel%sf_channel = entry%i
return
end if
if (associated (entry%next)) then
entry => entry%next
else
exit
end if
end do
allocate (new)
entry%next => new
else
allocate (new)
coll%first => new
end if
coll%n = coll%n + 1
new%i = coll%n
channel%sf_channel = new%i
if (allocated (channel%prop)) then
allocate (new%prop, source = channel%prop)
end if
end subroutine phs_channel_collection_push
@ %def phs_channel_collection_push
@ Return the number of collected distinct channels.
<<PHS base: phs channel collection: TBP>>=
procedure :: get_n => phs_channel_collection_get_n
<<PHS base: sub interfaces>>=
module function phs_channel_collection_get_n (coll) result (n)
class(phs_channel_collection_t), intent(in) :: coll
integer :: n
end function phs_channel_collection_get_n
<<PHS base: procedures>>=
module function phs_channel_collection_get_n (coll) result (n)
class(phs_channel_collection_t), intent(in) :: coll
integer :: n
n = coll%n
end function phs_channel_collection_get_n
@ %def phs_channel_collection_get_n
@ Return a specific channel (property object).
<<PHS base: phs channel collection: TBP>>=
procedure :: get_entry => phs_channel_collection_get_entry
<<PHS base: sub interfaces>>=
module subroutine phs_channel_collection_get_entry (coll, i, prop)
class(phs_channel_collection_t), intent(in) :: coll
integer, intent(in) :: i
class(channel_prop_t), intent(out), allocatable :: prop
end subroutine phs_channel_collection_get_entry
<<PHS base: procedures>>=
module subroutine phs_channel_collection_get_entry (coll, i, prop)
class(phs_channel_collection_t), intent(in) :: coll
integer, intent(in) :: i
class(channel_prop_t), intent(out), allocatable :: prop
type(prop_entry_t), pointer :: entry
integer :: k
if (i > 0 .and. i <= coll%n) then
entry => coll%first
do k = 2, i
entry => entry%next
end do
if (allocated (entry%prop)) then
if (allocated (prop)) deallocate (prop)
allocate (prop, source = entry%prop)
end if
else
call msg_bug ("PHS channel collection: get entry: illegal index")
end if
end subroutine phs_channel_collection_get_entry
@ %def phs_channel_collection_get_entry
@
\subsection{Kinematics configuration}
Here, we store the universal information that is specifically relevant
for phase-space generation. It is a subset of the process data,
supplemented by basic information on phase-space parameterization
channels.
A concrete implementation will contain more data, that describe the
phase space in detail.
MD5 sums: the phase space setup depends on the process, it depends on
the model parameters (the masses, that is), and on the configuration
parameters. (It does not depend on the QCD setup.)
<<PHS base: public>>=
public :: phs_config_t
<<PHS base: types>>=
type, abstract :: phs_config_t
! private
type(string_t) :: id
integer :: n_in = 0
integer :: n_out = 0
integer :: n_tot = 0
integer :: n_state = 0
integer :: n_par = 0
integer :: n_channel = 0
real(default) :: sqrts = 0
logical :: sqrts_fixed = .true.
logical :: lab_is_cm = .true.
logical :: azimuthal_dependence = .false.
integer, dimension(:), allocatable :: dim_flat
logical :: provides_equivalences = .false.
logical :: provides_chains = .false.
logical :: vis_channels = .false.
integer, dimension(:), allocatable :: chain
class(model_data_t), pointer :: model => null ()
type(flavor_t), dimension(:,:), allocatable :: flv
type(phs_channel_t), dimension(:), allocatable :: channel
character(32) :: md5sum_process = ""
character(32) :: md5sum_model_par = ""
character(32) :: md5sum_phs_config = ""
integer :: nlo_type
contains
<<PHS base: phs config: TBP>>
end type phs_config_t
@ %def phs_config_t
@ Finalizer, deferred.
<<PHS base: phs config: TBP>>=
procedure (phs_config_final), deferred :: final
<<PHS base: interfaces>>=
abstract interface
subroutine phs_config_final (object)
import
class(phs_config_t), intent(inout) :: object
end subroutine phs_config_final
end interface
@ %def phs_config_final
@ Output. We provide an implementation for the output of the base-type
contents and an interface for the actual write method.
<<PHS base: phs config: TBP>>=
procedure (phs_config_write), deferred :: write
procedure :: base_write => phs_config_write
<<PHS base: sub interfaces>>=
module subroutine phs_config_write (object, unit, include_id)
class(phs_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
end subroutine phs_config_write
<<PHS base: procedures>>=
module subroutine phs_config_write (object, unit, include_id)
class(phs_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
integer :: u, i, j
integer :: n_tot_flv
logical :: use_id
n_tot_flv = object%n_tot
u = given_output_unit (unit)
use_id = .true.; if (present (include_id)) use_id = include_id
if (use_id) write (u, "(3x,A,A,A)") "ID = '", char (object%id), "'"
write (u, "(3x,A,I0)") "n_in = ", object%n_in
write (u, "(3x,A,I0)") "n_out = ", object%n_out
write (u, "(3x,A,I0)") "n_tot = ", object%n_tot
write (u, "(3x,A,I0)") "n_state = ", object%n_state
write (u, "(3x,A,I0)") "n_par = ", object%n_par
write (u, "(3x,A,I0)") "n_channel = ", object%n_channel
write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", object%sqrts
write (u, "(3x,A,L1)") "s_fixed = ", object%sqrts_fixed
write (u, "(3x,A,L1)") "lab_is_cm = ", object%lab_is_cm
write (u, "(3x,A,L1)") "azim.dep. = ", object%azimuthal_dependence
if (allocated (object%dim_flat)) then
write (u, "(3x,A,I0)") "flat dim. = ", object%dim_flat
end if
write (u, "(1x,A)") "Flavor combinations:"
do i = 1, object%n_state
write (u, "(3x,I0,':')", advance="no") i
! do j = 1, object%n_tot
do j = 1, n_tot_flv
write (u, "(1x,A)", advance="no") char (object%flv(j,i)%get_name ())
end do
write (u, "(A)")
end do
if (allocated (object%channel)) then
write (u, "(1x,A)") "Phase-space / structure-function channels:"
do i = 1, object%n_channel
write (u, "(3x,I0,':')", advance="no") i
call object%channel(i)%write (u)
end do
end if
if (object%md5sum_process /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (process) = '", &
object%md5sum_process, "'"
end if
if (object%md5sum_model_par /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (model par) = '", &
object%md5sum_model_par, "'"
end if
if (object%md5sum_phs_config /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (phs config) = '", &
object%md5sum_phs_config, "'"
end if
end subroutine phs_config_write
@ %def phs_config_write
@ Similarly, a basic initializer and an interface. The model pointer is taken
as an argument; we may verify that this has the expected model name.
The intent is [[inout]]. We want to be able to set parameters in advance.
<<PHS base: phs config: TBP>>=
procedure :: init => phs_config_init
<<PHS base: sub interfaces>>=
module subroutine phs_config_init (phs_config, data, model)
class(phs_config_t), intent(inout) :: phs_config
type(process_constants_t), intent(in) :: data
class(model_data_t), intent(in), target :: model
end subroutine phs_config_init
<<PHS base: procedures>>=
module subroutine phs_config_init (phs_config, data, model)
class(phs_config_t), intent(inout) :: phs_config
type(process_constants_t), intent(in) :: data
class(model_data_t), intent(in), target :: model
integer :: i, j
phs_config%id = data%id
phs_config%n_in = data%n_in
phs_config%n_out = data%n_out
phs_config%n_tot = data%n_in + data%n_out
phs_config%n_state = data%n_flv
if (data%model_name == model%get_name ()) then
phs_config%model => model
else
call msg_bug ("phs_config_init: model name mismatch")
end if
allocate (phs_config%flv (phs_config%n_tot, phs_config%n_state))
do i = 1, phs_config%n_state
do j = 1, phs_config%n_tot
call phs_config%flv(j,i)%init (data%flv_state(j,i), &
phs_config%model)
end do
end do
phs_config%md5sum_process = data%md5sum
end subroutine phs_config_init
@ %def phs_config_init
@
WK 2018-04-05: This procedure appears to be redundant?
<<XXX PHS base: phs config: TBP>>=
procedure :: set_component_index => phs_config_set_component_index
<<XXX PHS base: procedures>>=
subroutine phs_config_set_component_index (phs_config, index)
class(phs_config_t), intent(inout) :: phs_config
integer, intent(in) :: index
type(string_t), dimension(:), allocatable :: id
type(string_t) :: suffix
integer :: i, n
suffix = var_str ('i') // int2string (index)
call split_string (phs_config%id, var_str ('_'), id)
phs_config%id = var_str ('')
n = size (id) - 1
do i = 1, n
phs_config%id = phs_config%id // id(i) // var_str ('_')
end do
phs_config%id = phs_config%id // suffix
end subroutine phs_config_set_component_index
@ %def phs_config_set_component_index
@ This procedure should complete the phase-space configuration. We
need the [[sqrts]] value as overall scale, which is known only after
the beams have been defined. The procedure should determine the number of
channels, their properties (if any), and allocate and fill the [[channel]]
array accordingly.
<<PHS base: phs config: TBP>>=
procedure (phs_config_configure), deferred :: configure
<<PHS base: interfaces>>=
abstract interface
subroutine phs_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, ignore_mismatch, &
nlo_type, subdir)
import
class(phs_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
end subroutine phs_config_configure
end interface
@ %def phs_config_configure
@ Manually assign structure-function channel indices to the phase-space
channel objects. (Used by a test routine.)
<<PHS base: phs config: TBP>>=
procedure :: set_sf_channel => phs_config_set_sf_channel
<<PHS base: sub interfaces>>=
module subroutine phs_config_set_sf_channel (phs_config, sf_channel)
class(phs_config_t), intent(inout) :: phs_config
integer, dimension(:), intent(in) :: sf_channel
end subroutine phs_config_set_sf_channel
<<PHS base: procedures>>=
module subroutine phs_config_set_sf_channel (phs_config, sf_channel)
class(phs_config_t), intent(inout) :: phs_config
integer, dimension(:), intent(in) :: sf_channel
phs_config%channel%sf_channel = sf_channel
end subroutine phs_config_set_sf_channel
@ %def phs_config_set_sf_channel
@ Collect new channels not yet in the collection from this phase-space
configuration object. At the same time, assign structure-function channels.
<<PHS base: phs config: TBP>>=
procedure :: collect_channels => phs_config_collect_channels
<<PHS base: sub interfaces>>=
module subroutine phs_config_collect_channels (phs_config, coll)
class(phs_config_t), intent(inout) :: phs_config
type(phs_channel_collection_t), intent(inout) :: coll
end subroutine phs_config_collect_channels
<<PHS base: procedures>>=
module subroutine phs_config_collect_channels (phs_config, coll)
class(phs_config_t), intent(inout) :: phs_config
type(phs_channel_collection_t), intent(inout) :: coll
integer :: c
do c = 1, phs_config%n_channel
call coll%push (phs_config%channel(c))
end do
end subroutine phs_config_collect_channels
@ %def phs_config_collect_channels
@ Compute the MD5 sum. We abuse the [[write]] method. In
type implementations, [[write]] should only display information that is
relevant for the MD5 sum. The data include the process MD5 sum which is taken
from the process constants, and the MD5 sum of the model parameters. This may
change, so it is computed here.
<<PHS base: phs config: TBP>>=
procedure :: compute_md5sum => phs_config_compute_md5sum
<<PHS base: sub interfaces>>=
module subroutine phs_config_compute_md5sum (phs_config, include_id)
class(phs_config_t), intent(inout) :: phs_config
logical, intent(in), optional :: include_id
end subroutine phs_config_compute_md5sum
<<PHS base: procedures>>=
module subroutine phs_config_compute_md5sum (phs_config, include_id)
class(phs_config_t), intent(inout) :: phs_config
logical, intent(in), optional :: include_id
integer :: u
phs_config%md5sum_model_par = phs_config%model%get_parameters_md5sum ()
phs_config%md5sum_phs_config = ""
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call phs_config%write (u, include_id)
rewind (u)
phs_config%md5sum_phs_config = md5sum (u)
close (u)
end subroutine phs_config_compute_md5sum
@ %def phs_config_compute_md5sum
@ Print an informative message after phase-space configuration.
<<PHS base: phs config: TBP>>=
procedure (phs_startup_message), deferred :: startup_message
procedure :: base_startup_message => phs_startup_message
<<PHS base: sub interfaces>>=
module subroutine phs_startup_message (phs_config, unit)
class(phs_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
end subroutine phs_startup_message
<<PHS base: procedures>>=
module subroutine phs_startup_message (phs_config, unit)
class(phs_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
write (msg_buffer, "(A,3(1x,I0,1x,A))") &
"Phase space:", &
phs_config%n_channel, "channels,", &
phs_config%n_par, "dimensions"
call msg_message (unit = unit)
end subroutine phs_startup_message
@ %def phs_startup_message
@ This procedure should be implemented such that the phase-space
configuration object allocates a phase-space instance of matching type.
<<PHS base: phs config: TBP>>=
procedure (phs_config_allocate_instance), nopass, deferred :: &
allocate_instance
<<PHS base: interfaces>>=
abstract interface
subroutine phs_config_allocate_instance (phs)
import
class(phs_t), intent(inout), pointer :: phs
end subroutine phs_config_allocate_instance
end interface
@ %def phs_config_allocate_instance
@
\subsection{Extract data}
Return the number of MC input parameters.
<<PHS base: phs config: TBP>>=
procedure :: get_n_par => phs_config_get_n_par
<<PHS base: sub interfaces>>=
module function phs_config_get_n_par (phs_config) result (n)
class(phs_config_t), intent(in) :: phs_config
integer :: n
end function phs_config_get_n_par
<<PHS base: procedures>>=
module function phs_config_get_n_par (phs_config) result (n)
class(phs_config_t), intent(in) :: phs_config
integer :: n
n = phs_config%n_par
end function phs_config_get_n_par
@ %def phs_config_get_n_par
@ Return dimensions (parameter indices) for which the phase-space
dimension is flat, so integration and event generation can be simplified.
<<PHS base: phs config: TBP>>=
procedure :: get_flat_dimensions => phs_config_get_flat_dimensions
<<PHS base: sub interfaces>>=
module function phs_config_get_flat_dimensions &
(phs_config) result (dim_flat)
class(phs_config_t), intent(in) :: phs_config
integer, dimension(:), allocatable :: dim_flat
end function phs_config_get_flat_dimensions
<<PHS base: procedures>>=
module function phs_config_get_flat_dimensions &
(phs_config) result (dim_flat)
class(phs_config_t), intent(in) :: phs_config
integer, dimension(:), allocatable :: dim_flat
if (allocated (phs_config%dim_flat)) then
allocate (dim_flat (size (phs_config%dim_flat)))
dim_flat = phs_config%dim_flat
else
allocate (dim_flat (0))
end if
end function phs_config_get_flat_dimensions
@ %def phs_config_get_flat_dimensions
@ Return the number of phase-space channels.
<<PHS base: phs config: TBP>>=
procedure :: get_n_channel => phs_config_get_n_channel
<<PHS base: sub interfaces>>=
module function phs_config_get_n_channel (phs_config) result (n)
class(phs_config_t), intent(in) :: phs_config
integer :: n
end function phs_config_get_n_channel
<<PHS base: procedures>>=
module function phs_config_get_n_channel (phs_config) result (n)
class(phs_config_t), intent(in) :: phs_config
integer :: n
n = phs_config%n_channel
end function phs_config_get_n_channel
@ %def phs_config_get_n_channel
@ Return the structure-function channel that corresponds to the
phase-space channel [[c]]. If the channel array is not allocated (which
happens if there is no structure function), return zero.
<<PHS base: phs config: TBP>>=
procedure :: get_sf_channel => phs_config_get_sf_channel
<<PHS base: sub interfaces>>=
module function phs_config_get_sf_channel (phs_config, c) result (c_sf)
class(phs_config_t), intent(in) :: phs_config
integer, intent(in) :: c
integer :: c_sf
end function phs_config_get_sf_channel
<<PHS base: procedures>>=
module function phs_config_get_sf_channel (phs_config, c) result (c_sf)
class(phs_config_t), intent(in) :: phs_config
integer, intent(in) :: c
integer :: c_sf
if (allocated (phs_config%channel)) then
c_sf = phs_config%channel(c)%sf_channel
else
c_sf = 0
end if
end function phs_config_get_sf_channel
@ %def phs_config_get_sf_channel
@ Return the mass(es) of the incoming particle(s). We take the first flavor
combination in the array, assuming that masses must be degenerate among
flavors.
<<PHS base: phs config: TBP>>=
procedure :: get_masses_in => phs_config_get_masses_in
<<PHS base: sub interfaces>>=
module subroutine phs_config_get_masses_in (phs_config, m)
class(phs_config_t), intent(in) :: phs_config
real(default), dimension(:), intent(out) :: m
end subroutine phs_config_get_masses_in
<<PHS base: procedures>>=
module subroutine phs_config_get_masses_in (phs_config, m)
class(phs_config_t), intent(in) :: phs_config
real(default), dimension(:), intent(out) :: m
integer :: i
do i = 1, phs_config%n_in
m(i) = phs_config%flv(i,1)%get_mass ()
end do
end subroutine phs_config_get_masses_in
@ %def phs_config_get_masses_in
@ Return the MD5 sum of the configuration.
<<PHS base: phs config: TBP>>=
procedure :: get_md5sum => phs_config_get_md5sum
<<PHS base: sub interfaces>>=
module function phs_config_get_md5sum (phs_config) result (md5sum)
class(phs_config_t), intent(in) :: phs_config
character(32) :: md5sum
end function phs_config_get_md5sum
<<PHS base: procedures>>=
module function phs_config_get_md5sum (phs_config) result (md5sum)
class(phs_config_t), intent(in) :: phs_config
character(32) :: md5sum
md5sum = phs_config%md5sum_phs_config
end function phs_config_get_md5sum
@ %def phs_config_get_md5sum
@
\subsection{Phase-space point instance}
The [[phs_t]] object holds the workspace for phase-space generation.
In the base object, we have the MC input parameters [[r]] and the
Jacobian factor [[f]], for each channel, and the incoming and outgoing
momenta.
Note: The [[active_channel]] array is not used yet, all elements are
initialized with [[.true.]]. It should be touched by the integrator if it
decides to drop irrelevant channels.
<<PHS base: public>>=
public :: phs_t
<<PHS base: types>>=
type, abstract :: phs_t
class(phs_config_t), pointer :: config => null ()
logical :: r_defined = .false.
integer :: selected_channel = 0
logical, dimension(:), allocatable :: active_channel
real(default), dimension(:,:), allocatable :: r
real(default), dimension(:), allocatable :: f
real(default), dimension(:), allocatable :: m_in
real(default), dimension(:), allocatable :: m_out
real(default) :: flux = 0
real(default) :: volume = 0
type(lorentz_transformation_t) :: lt_cm_to_lab
logical :: p_defined = .false.
real(default) :: sqrts_hat = 0
type(vector4_t), dimension(:), allocatable :: p
logical :: q_defined = .false.
type(vector4_t), dimension(:), allocatable :: q
contains
<<PHS base: phs: TBP>>
end type phs_t
@ %def phs_t
@ Output. Since phase space may get complicated, we include a
[[verbose]] option for the abstract [[write]] procedure.
<<PHS base: phs: TBP>>=
procedure (phs_write), deferred :: write
<<PHS base: interfaces>>=
abstract interface
subroutine phs_write (object, unit, verbose)
import
class(phs_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine phs_write
end interface
@ %def phs_write
@ This procedure can be called to print the contents of the base type.
<<PHS base: phs: TBP>>=
procedure :: base_write => phs_base_write
<<PHS base: sub interfaces>>=
module subroutine phs_base_write (object, unit)
class(phs_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine phs_base_write
<<PHS base: procedures>>=
module subroutine phs_base_write (object, unit)
class(phs_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, c, i
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "Partonic phase space: parameters"
if (object%r_defined) then
write (u, *)
else
write (u, "(1x,A)") "[undefined]"
end if
write (u, "(3x,A,999(1x," // FMT_19 // "))") "m_in =", object%m_in
write (u, "(3x,A,999(1x," // FMT_19 // "))") "m_out =", object%m_out
write (u, "(3x,A," // FMT_19 // ")") "Flux = ", object%flux
write (u, "(3x,A," // FMT_19 // ")") "Volume = ", object%volume
if (allocated (object%f)) then
do c = 1, size (object%r, 2)
write (u, "(1x,A,I0,A)", advance="no") "Channel #", c, ":"
if (c == object%selected_channel) then
write (u, "(1x,A)") "[selected]"
else
write (u, *)
end if
write (u, "(3x,A)", advance="no") "r ="
do i = 1, size (object%r, 1)
write (u, "(1x,F9.7)", advance="no") object%r(i,c)
end do
write (u, *)
write (u, "(3x,A,1x,ES13.7)") "f =", object%f(c)
end do
end if
write (u, "(1x,A)") "Partonic phase space: momenta"
if (object%p_defined) then
write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", object%sqrts_hat
end if
write (u, "(1x,A)", advance="no") "Incoming:"
if (object%p_defined) then
write (u, *)
else
write (u, "(1x,A)") "[undefined]"
end if
if (allocated (object%p)) then
do i = 1, size (object%p)
call vector4_write (object%p(i), u)
end do
end if
write (u, "(1x,A)", advance="no") "Outgoing:"
if (object%q_defined) then
write (u, *)
else
write (u, "(1x,A)") "[undefined]"
end if
if (allocated (object%q)) then
do i = 1, size (object%q)
call vector4_write (object%q(i), u)
end do
end if
if (object%p_defined .and. .not. object%config%lab_is_cm) then
write (u, "(1x,A)") "Transformation c.m -> lab frame"
call lorentz_transformation_write (object%lt_cm_to_lab, u)
end if
end subroutine phs_base_write
@ %def phs_base_write
@ Finalizer. The base type does not need it, but extensions may.
<<PHS base: phs: TBP>>=
procedure (phs_final), deferred :: final
<<PHS base: interfaces>>=
abstract interface
subroutine phs_final (object)
import
class(phs_t), intent(inout) :: object
end subroutine phs_final
end interface
@ %def phs_final
@ Initializer. Everything should be contained in the [[process_data]]
configuration object, so we can require a universal interface.
<<PHS base: phs: TBP>>=
procedure (phs_init), deferred :: init
<<PHS base: interfaces>>=
abstract interface
subroutine phs_init (phs, phs_config)
import
class(phs_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
end subroutine phs_init
end interface
@ %def phs_init
@ The base version will just allocate the arrays. It should be called
at the beginning of the implementation of [[phs_init]].
<<PHS base: phs: TBP>>=
procedure :: base_init => phs_base_init
<<PHS base: sub interfaces>>=
module subroutine phs_base_init (phs, phs_config)
class(phs_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
end subroutine phs_base_init
<<PHS base: procedures>>=
module subroutine phs_base_init (phs, phs_config)
class(phs_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
phs%config => phs_config
allocate (phs%active_channel (phs%config%n_channel))
phs%active_channel = .true.
allocate (phs%r (phs%config%n_par, phs%config%n_channel)); phs%r = 0
allocate (phs%f (phs%config%n_channel)); phs%f = 0
allocate (phs%p (phs%config%n_in))
allocate (phs%m_in (phs%config%n_in), &
source = phs_config%flv(:phs_config%n_in, 1)%get_mass ())
allocate (phs%q (phs%config%n_out))
allocate (phs%m_out (phs%config%n_out), &
source = phs_config%flv(phs_config%n_in+1:, 1)%get_mass ())
call phs%compute_flux ()
end subroutine phs_base_init
@ %def phs_base_init
@ Manually select a channel.
<<PHS base: phs: TBP>>=
procedure :: select_channel => phs_base_select_channel
<<PHS base: sub interfaces>>=
module subroutine phs_base_select_channel (phs, channel)
class(phs_t), intent(inout) :: phs
integer, intent(in), optional :: channel
end subroutine phs_base_select_channel
<<PHS base: procedures>>=
module subroutine phs_base_select_channel (phs, channel)
class(phs_t), intent(inout) :: phs
integer, intent(in), optional :: channel
if (present (channel)) then
phs%selected_channel = channel
else
phs%selected_channel = 0
end if
end subroutine phs_base_select_channel
@ %def phs_base_select_channel
@ Set incoming momenta. Assume that array shapes match. If
requested, compute the Lorentz transformation from the c.m.\ to the
lab frame and apply that transformation to the incoming momenta.
In the c.m.\ frame, the sum of three-momenta is zero. In a scattering
process, the $z$ axis is the direction of the first beam, the second
beam is along the negative $z$ axis. The transformation from the
c.m.\ to the lab frame is a rotation from the $z$ axis to the boost
axis followed by a boost, such that the c.m.\ momenta are transformed
into the lab-frame momenta. In a decay process, we just boost along
the flight direction, without rotation.
<<PHS base: phs: TBP>>=
procedure :: set_incoming_momenta => phs_set_incoming_momenta
<<PHS base: sub interfaces>>=
module subroutine phs_set_incoming_momenta (phs, p)
class(phs_t), intent(inout) :: phs
type(vector4_t), dimension(:), intent(in) :: p
end subroutine phs_set_incoming_momenta
<<PHS base: procedures>>=
module subroutine phs_set_incoming_momenta (phs, p)
class(phs_t), intent(inout) :: phs
type(vector4_t), dimension(:), intent(in) :: p
type(vector4_t) :: p0, p1
type(lorentz_transformation_t) :: lt0
integer :: i
phs%p = p
if (phs%config%lab_is_cm) then
phs%sqrts_hat = phs%config%sqrts
phs%p = p
phs%lt_cm_to_lab = identity
else
p0 = sum (p)
if (phs%config%sqrts_fixed) then
phs%sqrts_hat = phs%config%sqrts
else
phs%sqrts_hat = p0 ** 1
end if
lt0 = boost (p0, phs%sqrts_hat)
select case (phs%config%n_in)
case (1)
phs%lt_cm_to_lab = lt0
case (2)
p1 = inverse (lt0) * p(1)
phs%lt_cm_to_lab = lt0 * rotation_to_2nd (3, space_part (p1))
end select
phs%p = inverse (phs%lt_cm_to_lab) * p
end if
phs%p_defined = .true.
end subroutine phs_set_incoming_momenta
@ %def phs_set_incoming_momenta
@ Set outgoing momenta. Assume that array shapes match. The incoming
momenta must be known, so we can apply the Lorentz transformation from
c.m.\ to lab (inverse) to the momenta.
<<PHS base: phs: TBP>>=
procedure :: set_outgoing_momenta => phs_set_outgoing_momenta
<<PHS base: sub interfaces>>=
module subroutine phs_set_outgoing_momenta (phs, q)
class(phs_t), intent(inout) :: phs
type(vector4_t), dimension(:), intent(in) :: q
end subroutine phs_set_outgoing_momenta
<<PHS base: procedures>>=
module subroutine phs_set_outgoing_momenta (phs, q)
class(phs_t), intent(inout) :: phs
type(vector4_t), dimension(:), intent(in) :: q
integer :: i
if (phs%p_defined) then
if (phs%config%lab_is_cm) then
phs%q = q
else
phs%q = inverse (phs%lt_cm_to_lab) * q
end if
phs%q_defined = .true.
end if
end subroutine phs_set_outgoing_momenta
@ %def phs_set_outgoing_momenta
@ Return outgoing momenta. Apply the c.m.\ to lab transformation if
necessary.
<<PHS base: phs: TBP>>=
procedure :: get_outgoing_momenta => phs_get_outgoing_momenta
<<PHS base: sub interfaces>>=
module subroutine phs_get_outgoing_momenta (phs, q)
class(phs_t), intent(in) :: phs
type(vector4_t), dimension(:), intent(out) :: q
end subroutine phs_get_outgoing_momenta
<<PHS base: procedures>>=
module subroutine phs_get_outgoing_momenta (phs, q)
class(phs_t), intent(in) :: phs
type(vector4_t), dimension(:), intent(out) :: q
if (phs%p_defined .and. phs%q_defined) then
if (phs%config%lab_is_cm) then
q = phs%q
else
q = phs%lt_cm_to_lab * phs%q
end if
else
q = vector4_null
end if
end subroutine phs_get_outgoing_momenta
@ %def phs_get_outgoing_momenta
@
<<PHS base: phs: TBP>>=
procedure :: lab_is_cm => phs_lab_is_cm
<<PHS base: sub interfaces>>=
module function phs_lab_is_cm (phs) result (lab_is_cm)
logical :: lab_is_cm
class(phs_t), intent(in) :: phs
end function phs_lab_is_cm
<<PHS base: procedures>>=
module function phs_lab_is_cm (phs) result (lab_is_cm)
logical :: lab_is_cm
class(phs_t), intent(in) :: phs
lab_is_cm = phs%config%lab_is_cm
end function phs_lab_is_cm
@ %def phs_lab_is_cm
@
<<PHS base: phs: TBP>>=
procedure :: get_n_tot => phs_get_n_tot
<<PHS base: sub interfaces>>=
elemental module function phs_get_n_tot (phs) result (n_tot)
integer :: n_tot
class(phs_t), intent(in) :: phs
end function phs_get_n_tot
<<PHS base: procedures>>=
elemental module function phs_get_n_tot (phs) result (n_tot)
integer :: n_tot
class(phs_t), intent(in) :: phs
n_tot = phs%config%n_tot
end function phs_get_n_tot
@ %def phs_get_n_tot
@
<<PHS base: phs: TBP>>=
procedure :: set_lorentz_transformation => phs_set_lorentz_transformation
<<PHS base: sub interfaces>>=
module subroutine phs_set_lorentz_transformation (phs, lt)
class(phs_t), intent(inout) :: phs
type(lorentz_transformation_t), intent(in) :: lt
end subroutine phs_set_lorentz_transformation
<<PHS base: procedures>>=
module subroutine phs_set_lorentz_transformation (phs, lt)
class(phs_t), intent(inout) :: phs
type(lorentz_transformation_t), intent(in) :: lt
phs%lt_cm_to_lab = lt
end subroutine phs_set_lorentz_transformation
@ %def phs_set_lorentz_transformation
@
<<PHS base: phs: TBP>>=
procedure :: get_lorentz_transformation => phs_get_lorentz_transformation
<<PHS base: sub interfaces>>=
module function phs_get_lorentz_transformation (phs) result (lt)
type(lorentz_transformation_t) :: lt
class(phs_t), intent(in) :: phs
end function phs_get_lorentz_transformation
<<PHS base: procedures>>=
module function phs_get_lorentz_transformation (phs) result (lt)
type(lorentz_transformation_t) :: lt
class(phs_t), intent(in) :: phs
lt = phs%lt_cm_to_lab
end function phs_get_lorentz_transformation
@ %def phs_get_lorentz_transformation
@ Return the input parameter array for a channel.
<<PHS base: phs: TBP>>=
procedure :: get_mcpar => phs_get_mcpar
<<PHS base: sub interfaces>>=
module subroutine phs_get_mcpar (phs, c, r)
class(phs_t), intent(in) :: phs
integer, intent(in) :: c
real(default), dimension(:), intent(out) :: r
end subroutine phs_get_mcpar
<<PHS base: procedures>>=
module subroutine phs_get_mcpar (phs, c, r)
class(phs_t), intent(in) :: phs
integer, intent(in) :: c
real(default), dimension(:), intent(out) :: r
if (phs%r_defined) then
r = phs%r(:,c)
else
r = 0
end if
end subroutine phs_get_mcpar
@ %def phs_get_mcpar
@ Return the Jacobian factor for a channel.
<<PHS base: phs: TBP>>=
procedure :: get_f => phs_get_f
<<PHS base: sub interfaces>>=
module function phs_get_f (phs, c) result (f)
class(phs_t), intent(in) :: phs
integer, intent(in) :: c
real(default) :: f
end function phs_get_f
<<PHS base: procedures>>=
module function phs_get_f (phs, c) result (f)
class(phs_t), intent(in) :: phs
integer, intent(in) :: c
real(default) :: f
if (phs%r_defined) then
f = phs%f(c)
else
f = 0
end if
end function phs_get_f
@ %def phs_get_f
@ Return the overall factor, which is the product of the flux factor for the
incoming partons and the phase-space volume for the outgoing partons.
<<PHS base: phs: TBP>>=
procedure :: get_overall_factor => phs_get_overall_factor
<<PHS base: sub interfaces>>=
module function phs_get_overall_factor (phs) result (f)
class(phs_t), intent(in) :: phs
real(default) :: f
end function phs_get_overall_factor
<<PHS base: procedures>>=
module function phs_get_overall_factor (phs) result (f)
class(phs_t), intent(in) :: phs
real(default) :: f
f = phs%flux * phs%volume
end function phs_get_overall_factor
@ %def phs_get_overall_factor
@ Compute flux factor. We do this during initialization (when the
incoming momenta [[p]] are undefined), unless [[sqrts]] is variable. We do
this again once for each phase-space point, but then we skip the calculation
if [[sqrts]] is fixed.
There are three different flux factors.
\begin{enumerate}
\item
For a decaying massive particle, the factor is
\begin{equation}
f = (2\pi)^4 / (2M)
\end{equation}
\item
For a $2\to n$ scattering process with $n>1$, the factor is
\begin{equation}
f = (2\pi)^4 / (2\sqrt{\lambda})
\end{equation}
where for massless incoming particles, $\sqrt{\lambda} = s$.
\item For a $2\to 1$ on-shell production process, the factor includes
an extra $1/(2\pi)^3$ factor and a $1/m^2$ factor from the
phase-space delta function $\delta (x_1x_2 - m^2/s)$, which
originate from the one-particle phase space that we integrate out.
\begin{equation}
f = 2\pi / (2s m^2)
\end{equation}
The delta function is handled by the structure-function
parameterization.
\end{enumerate}
<<PHS base: phs: TBP>>=
procedure :: compute_flux => phs_compute_flux
procedure :: compute_base_flux => phs_compute_flux
<<PHS base: sub interfaces>>=
module subroutine phs_compute_flux (phs)
class(phs_t), intent(inout) :: phs
end subroutine phs_compute_flux
<<PHS base: procedures>>=
module subroutine phs_compute_flux (phs)
class(phs_t), intent(inout) :: phs
real(default) :: s_hat, lda
select case (phs%config%n_in)
case (1)
if (.not. phs%p_defined) then
phs%flux = twopi4 / (2 * phs%m_in(1))
end if
case (2)
if (phs%p_defined) then
if (phs%config%sqrts_fixed) then
return
else
s_hat = sum (phs%p) ** 2
end if
else
if (phs%config%sqrts_fixed) then
s_hat = phs%config%sqrts ** 2
else
return
end if
end if
select case (phs%config%n_out)
case (2:)
lda = lambda (s_hat, phs%m_in(1) ** 2, phs%m_in(2) ** 2)
if (lda > 0) then
phs%flux = conv * twopi4 / (2 * sqrt (lda))
else
phs%flux = 0
end if
case (1)
phs%flux = conv * twopi &
/ (2 * phs%config%sqrts ** 2 * phs%m_out(1) ** 2)
case default
phs%flux = 0
end select
end select
end subroutine phs_compute_flux
@ %def phs_compute_flux
@ Evaluate the phase-space point for a particular channel and compute momenta,
Jacobian, and phase-space volume. This is, of course, deferred to
the implementation.
<<PHS base: phs: TBP>>=
procedure (phs_evaluate_selected_channel), deferred :: &
evaluate_selected_channel
<<PHS base: interfaces>>=
abstract interface
subroutine phs_evaluate_selected_channel (phs, c_in, r_in)
import
class(phs_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), dimension(:), intent(in) :: r_in
end subroutine phs_evaluate_selected_channel
end interface
@ %def phs_evaluate_selected_channel
@ Compute the inverse mappings to completely fill the [[r]] and [[f]] arrays,
for the non-selected channels.
<<PHS base: phs: TBP>>=
procedure (phs_evaluate_other_channels), deferred :: &
evaluate_other_channels
<<PHS base: interfaces>>=
abstract interface
subroutine phs_evaluate_other_channels (phs, c_in)
import
class(phs_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_evaluate_other_channels
end interface
@ %def phs_evaluate_other_channels
@ Inverse evaluation. If all momenta are known, we compute the
inverse mappings to fill the [[r]] and [[f]] arrays.
<<PHS base: phs: TBP>>=
procedure (phs_inverse), deferred :: inverse
<<PHS base: interfaces>>=
abstract interface
subroutine phs_inverse (phs)
import
class(phs_t), intent(inout) :: phs
end subroutine phs_inverse
end interface
@ %def phs_inverse
@
<<PHS base: phs: TBP>>=
procedure :: get_sqrts => phs_get_sqrts
<<PHS base: sub interfaces>>=
module function phs_get_sqrts (phs) result (sqrts)
real(default) :: sqrts
class(phs_t), intent(in) :: phs
end function phs_get_sqrts
<<PHS base: procedures>>=
module function phs_get_sqrts (phs) result (sqrts)
real(default) :: sqrts
class(phs_t), intent(in) :: phs
sqrts = phs%config%sqrts
end function phs_get_sqrts
@ %def phs_get_sqrts
@
\subsubsection{Uniform angular distribution}
These procedures implement the uniform angular distribution, generated
from two parameters $x_1$ and $x_2$:
\begin{equation}
\cos\theta = 1 - 2x_1, \qquad \phi = 2\pi x_2
\end{equation}
We generate a rotation (Lorentz transformation) which rotates the
positive $z$ axis into this point on the unit sphere. This rotation
is applied to the [[p]] momenta, which are assumed to be
back-to-back, on-shell, and with the correct mass.
We do not compute a Jacobian (constant). The uniform distribution is
assumed to be normalized.
<<PHS base: public>>=
public :: compute_kinematics_solid_angle
<<PHS base: sub interfaces>>=
module subroutine compute_kinematics_solid_angle (p, q, x)
type(vector4_t), dimension(2), intent(in) :: p
type(vector4_t), dimension(2), intent(out) :: q
real(default), dimension(2), intent(in) :: x
end subroutine compute_kinematics_solid_angle
<<PHS base: procedures>>=
module subroutine compute_kinematics_solid_angle (p, q, x)
type(vector4_t), dimension(2), intent(in) :: p
type(vector4_t), dimension(2), intent(out) :: q
real(default), dimension(2), intent(in) :: x
real(default) :: ct, st, phi
type(lorentz_transformation_t) :: rot
integer :: i
ct = 1 - 2*x(1)
st = sqrt (1 - ct**2)
phi = twopi * x(2)
rot = rotation (phi, 3) * rotation (ct, st, 2)
do i = 1, 2
q(i) = rot * p(i)
end do
end subroutine compute_kinematics_solid_angle
@ %def compute_kinematics_solid_angle
@ This is the inverse transformation. We assume that the outgoing
momenta are rotated versions of the incoming momenta, back-to-back.
Thus, we determine the angles from $q(1)$ alone. [[p]] is unused.
<<PHS base: public>>=
public :: inverse_kinematics_solid_angle
<<PHS base: sub interfaces>>=
module subroutine inverse_kinematics_solid_angle (p, q, x)
type(vector4_t), dimension(:), intent(in) :: p
type(vector4_t), dimension(2), intent(in) :: q
real(default), dimension(2), intent(out) :: x
end subroutine inverse_kinematics_solid_angle
<<PHS base: procedures>>=
module subroutine inverse_kinematics_solid_angle (p, q, x)
type(vector4_t), dimension(:), intent(in) :: p
type(vector4_t), dimension(2), intent(in) :: q
real(default), dimension(2), intent(out) :: x
real(default) :: ct, phi
ct = polar_angle_ct (q(1))
phi = azimuthal_angle (q(1))
x(1) = (1 - ct) / 2
x(2) = phi / twopi
end subroutine inverse_kinematics_solid_angle
@ %def inverse_kinematics_solid_angle
@
\subsection{Auxiliary stuff}
The [[pacify]] subroutine, which is provided by the Lorentz module,
has the purpose of setting numbers to zero which are (by comparing
with a [[tolerance]] parameter) considered equivalent with zero. This
is useful for numerical checks.
<<PHS base: public>>=
public :: pacify
<<PHS base: interfaces>>=
interface pacify
module procedure pacify_phs
end interface pacify
<<PHS base: sub interfaces>>=
module subroutine pacify_phs (phs)
class(phs_t), intent(inout) :: phs
end subroutine pacify_phs
<<PHS base: procedures>>=
module subroutine pacify_phs (phs)
class(phs_t), intent(inout) :: phs
if (phs%p_defined) then
call pacify (phs%p, 30 * epsilon (1._default) * phs%config%sqrts)
call pacify (phs%lt_cm_to_lab, 30 * epsilon (1._default))
end if
if (phs%q_defined) then
call pacify (phs%q, 30 * epsilon (1._default) * phs%config%sqrts)
end if
end subroutine pacify_phs
@ %def pacify
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[phs_base_ut.f90]]>>=
<<File header>>
module phs_base_ut
use unit_tests
use phs_base_uti
<<Standard module head>>
<<PHS base: public test>>
<<PHS base: public test auxiliary>>
contains
<<PHS base: test driver>>
end module phs_base_ut
@ %def phs_base_ut
@
<<[[phs_base_uti.f90]]>>=
<<File header>>
module phs_base_uti
<<Use kinds>>
<<Use strings>>
use diagnostics
use io_units
use format_defs, only: FMT_19
use physics_defs, only: BORN
use lorentz
use flavors
use model_data
use process_constants
use phs_base
<<Standard module head>>
<<PHS base: public test auxiliary>>
<<PHS base: test declarations>>
<<PHS base: test types>>
contains
<<PHS base: tests>>
<<PHS base: test auxiliary>>
end module phs_base_uti
@ %def phs_base_ut
@ API: driver for the unit tests below.
<<PHS base: public test>>=
public :: phs_base_test
<<PHS base: test driver>>=
subroutine phs_base_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS base: execute tests>>
end subroutine phs_base_test
@ %def phs_base_test
@
\subsubsection{Test process data}
We provide a procedure that initializes a test case for the process
constants. This set of process data contains just the minimal
contents that we need for the phase space. The rest is left
uninitialized.
<<PHS base: public test auxiliary>>=
public :: init_test_process_data
<<PHS base: test auxiliary>>=
subroutine init_test_process_data (id, data)
type(process_constants_t), intent(out) :: data
type(string_t), intent(in), optional :: id
if (present (id)) then
data%id = id
else
data%id = "testproc"
end if
data%model_name = "Test"
data%n_in = 2
data%n_out = 2
data%n_flv = 1
allocate (data%flv_state (data%n_in + data%n_out, data%n_flv))
data%flv_state = 25
end subroutine init_test_process_data
@ %def init_test_process_data
@ This is the variant for a decay process.
<<PHS base: public test auxiliary>>=
public :: init_test_decay_data
<<PHS base: test auxiliary>>=
subroutine init_test_decay_data (id, data)
type(process_constants_t), intent(out) :: data
type(string_t), intent(in), optional :: id
if (present (id)) then
data%id = id
else
data%id = "testproc"
end if
data%model_name = "Test"
data%n_in = 1
data%n_out = 2
data%n_flv = 1
allocate (data%flv_state (data%n_in + data%n_out, data%n_flv))
data%flv_state(:,1) = [25, 6, -6]
end subroutine init_test_decay_data
@ %def init_test_decay_data
@
\subsubsection{Test kinematics configuration}
This is a trivial implementation of the [[phs_config_t]] configuration object.
<<PHS base: public test auxiliary>>=
public :: phs_test_config_t
<<PHS base: test types>>=
type, extends (phs_config_t) :: phs_test_config_t
logical :: create_equivalences = .false.
contains
procedure :: final => phs_test_config_final
procedure :: write => phs_test_config_write
procedure :: configure => phs_test_config_configure
procedure :: startup_message => phs_test_config_startup_message
procedure, nopass :: allocate_instance => phs_test_config_allocate_instance
end type phs_test_config_t
@ %def phs_test_config_t
@ The finalizer is empty.
<<PHS base: test auxiliary>>=
subroutine phs_test_config_final (object)
class(phs_test_config_t), intent(inout) :: object
end subroutine phs_test_config_final
@ %def phs_test_config_final
@ The [[lab_is_cm]] parameter is not tested here; we defer this to the
[[phs_single]] implementation.
<<PHS base: test auxiliary>>=
subroutine phs_test_config_write (object, unit, include_id)
class(phs_test_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Partonic phase-space configuration:"
call object%base_write (unit)
end subroutine phs_test_config_write
subroutine phs_test_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_test_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
phs_config%n_channel = 2
phs_config%n_par = 2
phs_config%sqrts = sqrts
if (.not. present (nlo_type)) &
phs_config%nlo_type = BORN
if (present (sqrts_fixed)) then
phs_config%sqrts_fixed = sqrts_fixed
end if
if (present (lab_is_cm)) then
phs_config%lab_is_cm = lab_is_cm
end if
if (present (azimuthal_dependence)) then
phs_config%azimuthal_dependence = azimuthal_dependence
end if
if (allocated (phs_config%channel)) deallocate (phs_config%channel)
allocate (phs_config%channel (phs_config%n_channel))
if (phs_config%create_equivalences) then
call setup_test_equivalences (phs_config)
call setup_test_channel_props (phs_config)
end if
call phs_config%compute_md5sum ()
end subroutine phs_test_config_configure
@ %def phs_test_config_write
@ %def phs_test_config_configure
@ If requested, we make up an arbitrary set of equivalences.
<<PHS base: test auxiliary>>=
subroutine setup_test_equivalences (phs_config)
class(phs_test_config_t), intent(inout) :: phs_config
integer :: i
associate (channel => phs_config%channel(1))
allocate (channel%eq (2))
do i = 1, size (channel%eq)
call channel%eq(i)%init (phs_config%n_par)
end do
associate (eq => channel%eq(1))
eq%c = 1; eq%perm = [1, 2]; eq%mode = [EQ_IDENTITY, EQ_SYMMETRIC]
end associate
associate (eq => channel%eq(2))
eq%c = 2; eq%perm = [2, 1]; eq%mode = [EQ_INVARIANT, EQ_IDENTITY]
end associate
end associate
end subroutine setup_test_equivalences
@ %def setup_test_equivalences
@ Ditto, for channel properties.
<<PHS base: test auxiliary>>=
subroutine setup_test_channel_props (phs_config)
class(phs_test_config_t), intent(inout) :: phs_config
associate (channel => phs_config%channel(2))
call channel%set_resonant (140._default, 3.1415_default)
end associate
end subroutine setup_test_channel_props
@ %def setup_test_channel_props
@ Startup message
<<PHS base: test auxiliary>>=
subroutine phs_test_config_startup_message (phs_config, unit)
class(phs_test_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
call phs_config%base_startup_message (unit)
write (msg_buffer, "(A)") "Phase space: Test"
call msg_message (unit = unit)
end subroutine phs_test_config_startup_message
@ %def phs_test_config_startup_message
@ The instance type that matches [[phs_test_config_t]] is [[phs_test_t]].
<<PHS base: test auxiliary>>=
subroutine phs_test_config_allocate_instance (phs)
class(phs_t), intent(inout), pointer :: phs
allocate (phs_test_t :: phs)
end subroutine phs_test_config_allocate_instance
@ %def phs_test_config_allocate_instance
@
\subsubsection{Test kinematics implementation}
This implementation of kinematics generates a simple two-particle
configuration from the incoming momenta. The incoming momenta must be
in the c.m.\ system, all masses equal.
There are two channels: one generates $\cos\theta$ and $\phi$
uniformly, in the other channel we map the $r_1$ parameter which
belongs to $\cos\theta$.
We should store the mass parameter that we need.
<<PHS base: public test auxiliary>>=
public :: phs_test_t
<<PHS base: test types>>=
type, extends (phs_t) :: phs_test_t
real(default) :: m = 0
real(default), dimension(:), allocatable :: x
contains
<<PHS base: phs test: TBP>>
end type phs_test_t
@ %def phs_test_t
@ Output. The specific data are displayed only if [[verbose]] is set.
<<PHS base: phs test: TBP>>=
procedure :: write => phs_test_write
<<PHS base: test auxiliary>>=
subroutine phs_test_write (object, unit, verbose)
class(phs_test_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
logical :: verb
u = given_output_unit (unit)
verb = .false.; if (present (verbose)) verb = verbose
if (verb) then
write (u, "(1x,A)") "Partonic phase space: data"
write (u, "(3x,A," // FMT_19 // ")") "m = ", object%m
end if
call object%base_write (u)
end subroutine phs_test_write
@ %def phs_test_write
@ The finalizer is empty.
<<PHS base: phs test: TBP>>=
procedure :: final => phs_test_final
<<PHS base: test auxiliary>>=
subroutine phs_test_final (object)
class(phs_test_t), intent(inout) :: object
end subroutine phs_test_final
@ %def phs_test_final
@ Initialization: set the mass value.
<<PHS base: phs test: TBP>>=
procedure :: init => phs_test_init
<<PHS base: test auxiliary>>=
subroutine phs_test_init (phs, phs_config)
class(phs_test_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
call phs%base_init (phs_config)
phs%m = phs%config%flv(1,1)%get_mass ()
allocate (phs%x (phs_config%n_par), source = 0._default)
end subroutine phs_test_init
@ %def phs_test_init
@ Evaluation. In channel 1, we uniformly generate $\cos\theta$ and
$\phi$, with Jacobian normalized to one. In channel 2, we prepend a
mapping $r_1 \to r_1^(1/3)$ with Jacobian $f=3r_1^2$.
The component [[x]] is allocated in the first subroutine, used and deallocated
in the second one.
<<PHS base: phs test: TBP>>=
procedure :: evaluate_selected_channel => phs_test_evaluate_selected_channel
procedure :: evaluate_other_channels => phs_test_evaluate_other_channels
<<PHS base: test auxiliary>>=
subroutine phs_test_evaluate_selected_channel (phs, c_in, r_in)
class(phs_test_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
if (phs%p_defined) then
call phs%select_channel (c_in)
phs%r(:,c_in) = r_in
select case (c_in)
case (1)
phs%x = r_in
case (2)
phs%x(1) = r_in(1) ** (1 / 3._default)
phs%x(2) = r_in(2)
end select
call compute_kinematics_solid_angle (phs%p, phs%q, phs%x)
phs%volume = 1
phs%q_defined = .true.
end if
end subroutine phs_test_evaluate_selected_channel
subroutine phs_test_evaluate_other_channels (phs, c_in)
class(phs_test_t), intent(inout) :: phs
integer, intent(in) :: c_in
integer :: c, n_channel
if (phs%p_defined) then
n_channel = phs%config%n_channel
do c = 1, n_channel
if (c /= c_in) then
call inverse_kinematics_solid_angle (phs%p, phs%q, phs%x)
select case (c)
case (1)
phs%r(:,c) = phs%x
case (2)
phs%r(1,c) = phs%x(1) ** 3
phs%r(2,c) = phs%x(2)
end select
end if
end do
phs%f(1) = 1
if (phs%r(1,2) /= 0) then
phs%f(2) = 1 / (3 * phs%r(1,2) ** (2/3._default))
else
phs%f(2) = 0
end if
phs%r_defined = .true.
end if
end subroutine phs_test_evaluate_other_channels
@ %def phs_test_evaluate_selected_channels
@ %def phs_test_evaluate_other_channels
@ Inverse evaluation.
<<PHS base: phs test: TBP>>=
procedure :: inverse => phs_test_inverse
<<PHS base: test auxiliary>>=
subroutine phs_test_inverse (phs)
class(phs_test_t), intent(inout) :: phs
integer :: c, n_channel
real(default), dimension(:), allocatable :: x
if (phs%p_defined .and. phs%q_defined) then
call phs%select_channel ()
n_channel = phs%config%n_channel
allocate (x (phs%config%n_par))
do c = 1, n_channel
call inverse_kinematics_solid_angle (phs%p, phs%q, x)
select case (c)
case (1)
phs%r(:,c) = x
case (2)
phs%r(1,c) = x(1) ** 3
phs%r(2,c) = x(2)
end select
end do
phs%f(1) = 1
if (phs%r(1,2) /= 0) then
phs%f(2) = 1 / (3 * phs%r(1,2) ** (2/3._default))
else
phs%f(2) = 0
end if
phs%volume = 1
phs%r_defined = .true.
end if
end subroutine phs_test_inverse
@ %def phs_test_inverse
@
\subsubsection{Phase-space configuration data}
Construct and display a test phase-space configuration object.
<<PHS base: execute tests>>=
call test (phs_base_1, "phs_base_1", &
"phase-space configuration", &
u, results)
<<PHS base: test declarations>>=
public :: phs_base_1
<<PHS base: tests>>=
subroutine phs_base_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
write (u, "(A)") "* Test output: phs_base_1"
write (u, "(A)") "* Purpose: initialize and display &
&test phase-space configuration data"
write (u, "(A)")
call model%init_test ()
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_base_1"), process_data)
allocate (phs_test_config_t :: phs_data)
call phs_data%init (process_data, model)
call phs_data%write (u)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_base_1"
end subroutine phs_base_1
@ %def phs_base_1
@
\subsubsection{Phase space evaluation}
Compute kinematics for given parameters, also invert the calculation.
<<PHS base: execute tests>>=
call test (phs_base_2, "phs_base_2", &
"phase-space evaluation", &
u, results)
<<PHS base: test declarations>>=
public :: phs_base_2
<<PHS base: tests>>=
subroutine phs_base_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
real(default) :: sqrts, E
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(2) :: p, q
write (u, "(A)") "* Test output: phs_base_2"
write (u, "(A)") "* Purpose: test simple two-channel phase space"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_base_2"), process_data)
allocate (phs_test_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
select type (phs)
type is (phs_test_t)
call phs%init (phs_data)
end select
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta"
write (u, "(A)")
E = sqrts / 2
p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point in channel 1 &
&for x = 0.5, 0.125"
write (u, "(A)")
call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
call phs%evaluate_other_channels (1)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point in channel 2 &
&for x = 0.125, 0.125"
write (u, "(A)")
call phs%evaluate_selected_channel (2, [0.125_default, 0.125_default])
call phs%evaluate_other_channels (2)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
sqrts = 1000._default
select type (phs_data)
type is (phs_test_config_t)
call phs_data%configure (sqrts)
end select
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call phs%write (u)
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_base_2"
end subroutine phs_base_2
@ %def phs_base_2
@
\subsubsection{Phase-space equivalences}
Construct a test phase-space configuration which contains channel
equivalences.
<<PHS base: execute tests>>=
call test (phs_base_3, "phs_base_3", &
"channel equivalences", &
u, results)
<<PHS base: test declarations>>=
public :: phs_base_3
<<PHS base: tests>>=
subroutine phs_base_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
write (u, "(A)") "* Test output: phs_base_3"
write (u, "(A)") "* Purpose: construct phase-space configuration data &
&with equivalences"
write (u, "(A)")
call model%init_test ()
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_base_3"), process_data)
allocate (phs_test_config_t :: phs_data)
call phs_data%init (process_data, model)
select type (phs_data)
type is (phs_test_config_t)
phs_data%create_equivalences = .true.
end select
call phs_data%configure (1000._default)
call phs_data%write (u)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_base_3"
end subroutine phs_base_3
@ %def phs_base_3
@
\subsubsection{MD5 sum checks}
Construct a test phase-space configuration, compute and compare MD5 sums.
<<PHS base: execute tests>>=
call test (phs_base_4, "phs_base_4", &
"MD5 sum", &
u, results)
<<PHS base: test declarations>>=
public :: phs_base_4
<<PHS base: tests>>=
subroutine phs_base_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
write (u, "(A)") "* Test output: phs_base_4"
write (u, "(A)") "* Purpose: compute and compare MD5 sums"
write (u, "(A)")
call model%init_test ()
write (u, "(A)") "* Model parameters"
write (u, "(A)")
call model%write (unit = u, &
show_parameters = .true., &
show_particles = .false., show_vertices = .false.)
write (u, "(A)")
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_base_4"), process_data)
process_data%md5sum = "test_process_data_m6sum_12345678"
allocate (phs_test_config_t :: phs_data)
call phs_data%init (process_data, model)
call phs_data%compute_md5sum ()
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Modify model parameter"
write (u, "(A)")
call model%set_par (var_str ("ms"), 100._default)
call model%write (show_parameters = .true., &
show_particles = .false., show_vertices = .false.)
write (u, "(A)")
write (u, "(A)") "* PHS configuration"
write (u, "(A)")
call phs_data%compute_md5sum ()
call phs_data%write (u)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_base_4"
end subroutine phs_base_4
@ %def phs_base_4
@
\subsubsection{Phase-space channel collection}
Set up an array of various phase-space channels and collect them in a list.
<<PHS base: execute tests>>=
call test (phs_base_5, "phs_base_5", &
"channel collection", &
u, results)
<<PHS base: test declarations>>=
public :: phs_base_5
<<PHS base: tests>>=
subroutine phs_base_5 (u)
integer, intent(in) :: u
type(phs_channel_t), dimension(:), allocatable :: channel
type(phs_channel_collection_t) :: coll
integer :: i, n
write (u, "(A)") "* Test output: phs_base_5"
write (u, "(A)") "* Purpose: collect channel properties"
write (u, "(A)")
write (u, "(A)") "* Set up an array of channels"
write (u, "(A)")
n = 6
allocate (channel (n))
call channel(2)%set_resonant (75._default, 3._default)
call channel(4)%set_resonant (130._default, 1._default)
call channel(5)%set_resonant (75._default, 3._default)
call channel(6)%set_on_shell (33._default)
do i = 1, n
write (u, "(1x,I0)", advance="no") i
call channel(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Collect distinct properties"
write (u, "(A)")
do i = 1, n
call coll%push (channel(i))
end do
write (u, "(1x,A,I0)") "n = ", coll%get_n ()
write (u, "(A)")
call coll%write (u)
write (u, "(A)")
write (u, "(A)") "* Channel array with collection index assigned"
write (u, "(A)")
do i = 1, n
write (u, "(1x,I0)", advance="no") i
call channel(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call coll%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_base_5"
end subroutine phs_base_5
@ %def phs_base_5
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\clearpage
\section{Dummy phase space}
This module implements a dummy phase space module for cases where the
program structure demands the existence of a phase-space module, but
no phase space integration is performed.
<<[[phs_none.f90]]>>=
<<File header>>
module phs_none
<<Use kinds>>
<<Use strings>>
use phs_base, only: phs_config_t, phs_t
<<Standard module head>>
<<PHS none: public>>
<<PHS none: types>>
interface
<<PHS none: sub interfaces>>
end interface
contains
<<PHS none: main procedures>>
end module phs_none
@ %def phs_none
@
<<[[phs_none_sub.f90]]>>=
<<File header>>
submodule (phs_none) phs_none_s
use io_units, only: given_output_unit
use diagnostics, only: msg_message, msg_fatal
implicit none
contains
<<PHS none: procedures>>
end submodule phs_none_s
@ %def phs_none_s
@
\subsection{Configuration}
Nothing to configure, but we provide the type and methods.
<<PHS none: public>>=
public :: phs_none_config_t
<<PHS none: types>>=
type, extends (phs_config_t) :: phs_none_config_t
contains
<<PHS none: phs none config: TBP>>
end type phs_none_config_t
@ %def phs_none_config_t
@ The finalizer is empty.
<<PHS none: phs none config: TBP>>=
procedure :: final => phs_none_config_final
<<PHS none: sub interfaces>>=
module subroutine phs_none_config_final (object)
class(phs_none_config_t), intent(inout) :: object
end subroutine phs_none_config_final
<<PHS none: procedures>>=
module subroutine phs_none_config_final (object)
class(phs_none_config_t), intent(inout) :: object
end subroutine phs_none_config_final
@ %def phs_none_final
@ Output. No contents, just an informative line.
<<PHS none: phs none config: TBP>>=
procedure :: write => phs_none_config_write
<<PHS none: sub interfaces>>=
module subroutine phs_none_config_write (object, unit, include_id)
class(phs_none_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
end subroutine phs_none_config_write
<<PHS none: procedures>>=
module subroutine phs_none_config_write (object, unit, include_id)
class(phs_none_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") &
"Partonic phase-space configuration: non-functional dummy"
end subroutine phs_none_config_write
@ %def phs_none_config_write
@ Configuration: we have to implement this method, but it obviously
does nothing.
<<PHS none: phs none config: TBP>>=
procedure :: configure => phs_none_config_configure
<<PHS none: sub interfaces>>=
module subroutine phs_none_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_none_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
end subroutine phs_none_config_configure
<<PHS none: procedures>>=
module subroutine phs_none_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_none_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
end subroutine phs_none_config_configure
@ %def phs_none_config_configure
@ Startup message, after configuration is complete.
<<PHS none: phs none config: TBP>>=
procedure :: startup_message => phs_none_config_startup_message
<<PHS none: sub interfaces>>=
module subroutine phs_none_config_startup_message (phs_config, unit)
class(phs_none_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
end subroutine phs_none_config_startup_message
<<PHS none: procedures>>=
module subroutine phs_none_config_startup_message (phs_config, unit)
class(phs_none_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
call msg_message ("Phase space: none")
end subroutine phs_none_config_startup_message
@ %def phs_none_config_startup_message
@ Allocate an instance: the actual phase-space object.
Gfortran 7/8/9 bug: has to remain in the main module.
<<PHS none: phs none config: TBP>>=
procedure, nopass :: allocate_instance => phs_none_config_allocate_instance
<<PHS none: main procedures>>=
subroutine phs_none_config_allocate_instance (phs)
class(phs_t), intent(inout), pointer :: phs
allocate (phs_none_t :: phs)
end subroutine phs_none_config_allocate_instance
@ %def phs_none_config_allocate_instance
@
\subsection{Kinematics implementation}
This is considered as empty, but we have to implement the minimal set of methods.
<<PHS none: public>>=
public :: phs_none_t
<<PHS none: types>>=
type, extends (phs_t) :: phs_none_t
contains
<<PHS none: phs none: TBP>>
end type phs_none_t
@ %def phs_none_t
@ Output.
<<PHS none: phs none: TBP>>=
procedure :: write => phs_none_write
<<PHS none: sub interfaces>>=
module subroutine phs_none_write (object, unit, verbose)
class(phs_none_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine phs_none_write
<<PHS none: procedures>>=
module subroutine phs_none_write (object, unit, verbose)
class(phs_none_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
write (u, "(A)") "Partonic phase space: none"
end subroutine phs_none_write
@ %def phs_none_write
@ The finalizer is empty.
<<PHS none: phs none: TBP>>=
procedure :: final => phs_none_final
<<PHS none: sub interfaces>>=
module subroutine phs_none_final (object)
class(phs_none_t), intent(inout) :: object
end subroutine phs_none_final
<<PHS none: procedures>>=
module subroutine phs_none_final (object)
class(phs_none_t), intent(inout) :: object
end subroutine phs_none_final
@ %def phs_none_final
@ Initialization, trivial.
<<PHS none: phs none: TBP>>=
procedure :: init => phs_none_init
<<PHS none: sub interfaces>>=
module subroutine phs_none_init (phs, phs_config)
class(phs_none_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
end subroutine phs_none_init
<<PHS none: procedures>>=
module subroutine phs_none_init (phs, phs_config)
class(phs_none_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
call phs%base_init (phs_config)
end subroutine phs_none_init
@ %def phs_none_init
@ Evaluation. This must not be called at all.
<<PHS none: phs none: TBP>>=
procedure :: evaluate_selected_channel => phs_none_evaluate_selected_channel
procedure :: evaluate_other_channels => phs_none_evaluate_other_channels
<<PHS none: sub interfaces>>=
module subroutine phs_none_evaluate_selected_channel (phs, c_in, r_in)
class(phs_none_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
end subroutine phs_none_evaluate_selected_channel
module subroutine phs_none_evaluate_other_channels (phs, c_in)
class(phs_none_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_none_evaluate_other_channels
<<PHS none: procedures>>=
module subroutine phs_none_evaluate_selected_channel (phs, c_in, r_in)
class(phs_none_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
call msg_fatal &
("Phase space: attempt to evaluate with the 'phs_none' method")
end subroutine phs_none_evaluate_selected_channel
module subroutine phs_none_evaluate_other_channels (phs, c_in)
class(phs_none_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_none_evaluate_other_channels
@ %def phs_none_evaluate_selected_channel
@ %def phs_none_evaluate_other_channels
@ Inverse evaluation, likewise.
<<PHS none: phs none: TBP>>=
procedure :: inverse => phs_none_inverse
<<PHS none: sub interfaces>>=
module subroutine phs_none_inverse (phs)
class(phs_none_t), intent(inout) :: phs
end subroutine phs_none_inverse
<<PHS none: procedures>>=
module subroutine phs_none_inverse (phs)
class(phs_none_t), intent(inout) :: phs
call msg_fatal ("Phase space: attempt to evaluate inverse " // &
"with the 'phs_none' method")
end subroutine phs_none_inverse
@ %def phs_none_inverse
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[phs_none_ut.f90]]>>=
<<File header>>
module phs_none_ut
use unit_tests
use phs_none_uti
<<Standard module head>>
<<PHS none: public test>>
contains
<<PHS none: test driver>>
end module phs_none_ut
@ %def phs_none_ut
@
<<[[phs_none_uti.f90]]>>=
<<File header>>
module phs_none_uti
<<Use kinds>>
<<Use strings>>
use flavors
use lorentz
use model_data
use process_constants
use phs_base
use phs_none
use phs_base_ut, only: init_test_process_data, init_test_decay_data
<<Standard module head>>
<<PHS none: test declarations>>
contains
<<PHS none: tests>>
end module phs_none_uti
@ %def phs_none_ut
@ API: driver for the unit tests below.
<<PHS none: public test>>=
public :: phs_none_test
<<PHS none: test driver>>=
subroutine phs_none_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS none: execute tests>>
end subroutine phs_none_test
@ %def phs_none_test
@
\subsubsection{Phase-space configuration data}
Construct and display a test phase-space configuration object. Also
check the [[azimuthal_dependence]] flag.
<<PHS none: execute tests>>=
call test (phs_none_1, "phs_none_1", &
"phase-space configuration dummy", &
u, results)
<<PHS none: test declarations>>=
public :: phs_none_1
<<PHS none: tests>>=
subroutine phs_none_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
real(default) :: sqrts
write (u, "(A)") "* Test output: phs_none_1"
write (u, "(A)") "* Purpose: display &
&phase-space configuration data"
write (u, "(A)")
allocate (phs_none_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts, azimuthal_dependence=.false.)
call phs_data%write (u)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_none_1"
end subroutine phs_none_1
@ %def phs_none_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\clearpage
\section{Single-particle phase space}
This module implements the phase space for a single particle, i.e., the solid
angle, in a straightforward parameterization with a single channel. The
phase-space implementation may be used either for $1\to 2$ decays or for $2\to
2$ scattering processes, so the number of incoming particles is the only free
parameter in the configuration. In the latter case, we should restrict its
use to non-resonant s-channel processes, because there is no mapping of the
scattering angle.
(We might extend this later to account for generic $2\to 2$ situations, e.g.,
account for a Coulomb singularity or detect an s-channel resonance structure
that requires matching structure-function mappings.)
This is derived from the [[phs_test]] implementation in the
[[phs_base]] module above, even more simplified, but intended for
actual use.
<<[[phs_single.f90]]>>=
<<File header>>
module phs_single
<<Use kinds>>
<<Use strings>>
use lorentz
use phs_base
<<Standard module head>>
<<PHS single: public>>
<<PHS single: types>>
interface
<<PHS single: sub interfaces>>
end interface
contains
<<PHS single: main procedures>>
end module phs_single
@ %def phs_single
@
<<[[phs_single_sub.f90]]>>=
<<File header>>
submodule (phs_single) phs_single_s
use io_units
use constants
use numeric_utils
use diagnostics
use physics_defs
implicit none
contains
<<PHS single: procedures>>
end submodule phs_single_s
@ %def phs_single_s
@
\subsection{Configuration}
<<PHS single: public>>=
public :: phs_single_config_t
<<PHS single: types>>=
type, extends (phs_config_t) :: phs_single_config_t
contains
<<PHS single: phs single config: TBP>>
end type phs_single_config_t
@ %def phs_single_config_t
@ The finalizer is empty.
<<PHS single: phs single config: TBP>>=
procedure :: final => phs_single_config_final
<<PHS single: sub interfaces>>=
module subroutine phs_single_config_final (object)
class(phs_single_config_t), intent(inout) :: object
end subroutine phs_single_config_final
<<PHS single: procedures>>=
module subroutine phs_single_config_final (object)
class(phs_single_config_t), intent(inout) :: object
end subroutine phs_single_config_final
@ %def phs_single_final
@ Output.
<<PHS single: phs single config: TBP>>=
procedure :: write => phs_single_config_write
<<PHS single: sub interfaces>>=
module subroutine phs_single_config_write (object, unit, include_id)
class(phs_single_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
end subroutine phs_single_config_write
<<PHS single: procedures>>=
module subroutine phs_single_config_write (object, unit, include_id)
class(phs_single_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Partonic phase-space configuration (single-particle):"
call object%base_write (unit)
end subroutine phs_single_config_write
@ %def phs_single_config_write
@ Configuration: there is only one channel and two parameters. The
second parameter is the azimuthal angle, which may be a flat dimension.
<<PHS single: phs single config: TBP>>=
procedure :: configure => phs_single_config_configure
<<PHS single: sub interfaces>>=
module subroutine phs_single_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_single_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
end subroutine phs_single_config_configure
<<PHS single: procedures>>=
module subroutine phs_single_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_single_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
if (.not. present (nlo_type)) &
phs_config%nlo_type = BORN
if (phs_config%n_out == 2) then
phs_config%n_channel = 1
phs_config%n_par = 2
phs_config%sqrts = sqrts
if (present (sqrts_fixed)) phs_config%sqrts_fixed = sqrts_fixed
if (present (lab_is_cm)) phs_config%lab_is_cm = lab_is_cm
if (present (azimuthal_dependence)) then
phs_config%azimuthal_dependence = azimuthal_dependence
if (.not. azimuthal_dependence) then
allocate (phs_config%dim_flat (1))
phs_config%dim_flat(1) = 2
end if
end if
if (allocated (phs_config%channel)) deallocate (phs_config%channel)
allocate (phs_config%channel (1))
call phs_config%compute_md5sum ()
else
call msg_fatal ("Single-particle phase space requires n_out = 2")
end if
end subroutine phs_single_config_configure
@ %def phs_single_config_configure
@ Startup message, after configuration is complete.
<<PHS single: phs single config: TBP>>=
procedure :: startup_message => phs_single_config_startup_message
<<PHS single: sub interfaces>>=
module subroutine phs_single_config_startup_message (phs_config, unit)
class(phs_single_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
end subroutine phs_single_config_startup_message
<<PHS single: procedures>>=
module subroutine phs_single_config_startup_message (phs_config, unit)
class(phs_single_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
call phs_config%base_startup_message (unit)
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Phase space: single-particle"
call msg_message (unit = unit)
end subroutine phs_single_config_startup_message
@ %def phs_single_config_startup_message
@ Allocate an instance: the actual phase-space object.
Gfortran 7/8/9 bug, has to remain in the main module.
<<PHS single: phs single config: TBP>>=
procedure, nopass :: allocate_instance => phs_single_config_allocate_instance
<<PHS single: main procedures>>=
subroutine phs_single_config_allocate_instance (phs)
class(phs_t), intent(inout), pointer :: phs
allocate (phs_single_t :: phs)
end subroutine phs_single_config_allocate_instance
@ %def phs_single_config_allocate_instance
@
\subsection{Kinematics implementation}
We generate $\cos\theta$ and $\phi$ uniformly, covering the solid angle.
Note: The incoming momenta must be in the c.m. system.
<<PHS single: public>>=
public :: phs_single_t
<<PHS single: types>>=
type, extends (phs_t) :: phs_single_t
contains
<<PHS single: phs single: TBP>>
end type phs_single_t
@ %def phs_single_t
@ Output. The [[verbose]] setting is irrelevant, we just display the contents
of the base object.
<<PHS single: phs single: TBP>>=
procedure :: write => phs_single_write
<<PHS single: sub interfaces>>=
module subroutine phs_single_write (object, unit, verbose)
class(phs_single_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine phs_single_write
<<PHS single: procedures>>=
module subroutine phs_single_write (object, unit, verbose)
class(phs_single_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
call object%base_write (u)
end subroutine phs_single_write
@ %def phs_single_write
@ The finalizer is empty.
<<PHS single: phs single: TBP>>=
procedure :: final => phs_single_final
<<PHS single: sub interfaces>>=
module subroutine phs_single_final (object)
class(phs_single_t), intent(inout) :: object
end subroutine phs_single_final
<<PHS single: procedures>>=
module subroutine phs_single_final (object)
class(phs_single_t), intent(inout) :: object
end subroutine phs_single_final
@ %def phs_single_final
@ Initialization. We allocate arrays ([[base_init]]) and adjust the
phase-space volume. The massless two-particle phase space volume is
\begin{equation}
\Phi_2 = \frac{1}{4(2\pi)^5} = 2.55294034614 \times 10^{-5}
\end{equation}
For a decay with nonvanishing masses ($m_3$, $m_4$), there is a correction
factor
\begin{equation}
\Phi_2(m) / \Phi_2(0) = \frac{1}{\hat s}
\lambda^{1/2}(\hat s, m_3^2, m_4^2).
\end{equation}
For a scattering process with nonvanishing masses, the correction
factor is
\begin{equation}
\Phi_2(m) / \Phi_2(0) = \frac{1}{\hat s ^ 2}
\lambda^{1/2}(\hat s, m_1^2, m_2^2)\,
\lambda^{1/2}(\hat s, m_3^2, m_4^2).
\end{equation}
If the energy is fixed, this is constant. Otherwise, we have to account for
varying $\hat s$.
<<PHS single: phs single: TBP>>=
procedure :: init => phs_single_init
<<PHS single: sub interfaces>>=
module subroutine phs_single_init (phs, phs_config)
class(phs_single_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
end subroutine phs_single_init
<<PHS single: procedures>>=
module subroutine phs_single_init (phs, phs_config)
class(phs_single_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
call phs%base_init (phs_config)
phs%volume = 1 / (4 * twopi5)
call phs%compute_factor ()
end subroutine phs_single_init
@ %def phs_single_init
@ Compute the correction factor for nonzero masses. We do this during
initialization (when the incoming momenta [[p]] are undefined), unless
[[sqrts]] is variable. We do this again once for each phase-space point, but
then we skip the calculation if [[sqrts]] is fixed.
<<PHS single: phs single: TBP>>=
procedure :: compute_factor => phs_single_compute_factor
<<PHS single: sub interfaces>>=
module subroutine phs_single_compute_factor (phs)
class(phs_single_t), intent(inout) :: phs
end subroutine phs_single_compute_factor
<<PHS single: procedures>>=
module subroutine phs_single_compute_factor (phs)
class(phs_single_t), intent(inout) :: phs
real(default) :: s_hat
select case (phs%config%n_in)
case (1)
if (.not. phs%p_defined) then
if (sum (phs%m_out) < phs%m_in(1)) then
s_hat = phs%m_in(1) ** 2
phs%f(1) = 1 / s_hat &
* sqrt (lambda (s_hat, phs%m_out(1)**2, phs%m_out(2)**2))
else
print *, "m_in = ", phs%m_in
print *, "m_out = ", phs%m_out
call msg_fatal ("Decay is kinematically forbidden")
end if
end if
case (2)
if (phs%config%sqrts_fixed) then
if (phs%p_defined) return
s_hat = phs%config%sqrts ** 2
else
if (.not. phs%p_defined) return
s_hat = sum (phs%p) ** 2
end if
if (sum (phs%m_in)**2 < s_hat .and. sum (phs%m_out)**2 < s_hat) then
phs%f(1) = 1 / s_hat * &
( lambda (s_hat, phs%m_in (1)**2, phs%m_in (2)**2) &
* lambda (s_hat, phs%m_out(1)**2, phs%m_out(2)**2) ) &
** 0.25_default
else
phs%f(1) = 0
end if
end select
end subroutine phs_single_compute_factor
@ %def phs_single_compute_factor
@ Evaluation. We uniformly generate $\cos\theta$ and
$\phi$, with Jacobian normalized to one.
There is only a single channel, so the second subroutine does nothing.
Note: the current implementation works for elastic scattering only.
<<PHS single: phs single: TBP>>=
procedure :: evaluate_selected_channel => phs_single_evaluate_selected_channel
procedure :: evaluate_other_channels => phs_single_evaluate_other_channels
<<PHS single: sub interfaces>>=
module subroutine phs_single_evaluate_selected_channel (phs, c_in, r_in)
class(phs_single_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
end subroutine phs_single_evaluate_selected_channel
module subroutine phs_single_evaluate_other_channels (phs, c_in)
class(phs_single_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_single_evaluate_other_channels
<<PHS single: procedures>>=
module subroutine phs_single_evaluate_selected_channel (phs, c_in, r_in)
class(phs_single_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
if (phs%p_defined) then
call phs%select_channel (c_in)
phs%r(:,c_in) = r_in
select case (phs%config%n_in)
case (2)
if (all (phs%m_in == phs%m_out)) then
call compute_kinematics_solid_angle (phs%p, phs%q, r_in)
else
call msg_bug ("PHS single: inelastic scattering not implemented")
end if
case (1)
call compute_kinematics_solid_angle (phs%decay_p (), phs%q, r_in)
end select
call phs%compute_factor ()
phs%q_defined = .true.
phs%r_defined = .true.
end if
end subroutine phs_single_evaluate_selected_channel
module subroutine phs_single_evaluate_other_channels (phs, c_in)
class(phs_single_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_single_evaluate_other_channels
@ %def phs_single_evaluate_selected_channel
@ %def phs_single_evaluate_other_channels
@ Auxiliary: split a decaying particle at rest into the decay products,
aligned along the $z$ axis.
<<PHS single: phs single: TBP>>=
procedure :: decay_p => phs_single_decay_p
<<PHS single: sub interfaces>>=
module function phs_single_decay_p (phs) result (p)
class(phs_single_t), intent(in) :: phs
type(vector4_t), dimension(2) :: p
end function phs_single_decay_p
<<PHS single: procedures>>=
module function phs_single_decay_p (phs) result (p)
class(phs_single_t), intent(in) :: phs
type(vector4_t), dimension(2) :: p
real(default) :: k
real(default), dimension(2) :: E
k = sqrt (lambda (phs%m_in(1) ** 2, phs%m_out(1) ** 2, phs%m_out(2) ** 2)) &
/ (2 * phs%m_in(1))
E = sqrt (phs%m_out ** 2 + k ** 2)
p(1) = vector4_moving (E(1), k, 3)
p(2) = vector4_moving (E(2),-k, 3)
end function phs_single_decay_p
@ %def phs_single_decay_p
@ Inverse evaluation.
<<PHS single: phs single: TBP>>=
procedure :: inverse => phs_single_inverse
<<PHS single: sub interfaces>>=
module subroutine phs_single_inverse (phs)
class(phs_single_t), intent(inout) :: phs
end subroutine phs_single_inverse
<<PHS single: procedures>>=
module subroutine phs_single_inverse (phs)
class(phs_single_t), intent(inout) :: phs
real(default), dimension(:), allocatable :: x
if (phs%p_defined .and. phs%q_defined) then
call phs%select_channel ()
allocate (x (phs%config%n_par))
call inverse_kinematics_solid_angle (phs%p, phs%q, x)
phs%r(:,1) = x
call phs%compute_factor ()
phs%r_defined = .true.
end if
end subroutine phs_single_inverse
@ %def phs_single_inverse
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[phs_single_ut.f90]]>>=
<<File header>>
module phs_single_ut
use unit_tests
use phs_single_uti
<<Standard module head>>
<<PHS single: public test>>
contains
<<PHS single: test driver>>
end module phs_single_ut
@ %def phs_single_ut
@
<<[[phs_single_uti.f90]]>>=
<<File header>>
module phs_single_uti
<<Use kinds>>
<<Use strings>>
use flavors
use lorentz
use model_data
use process_constants
use phs_base
use phs_single
use phs_base_ut, only: init_test_process_data, init_test_decay_data
<<Standard module head>>
<<PHS single: test declarations>>
contains
<<PHS single: tests>>
end module phs_single_uti
@ %def phs_single_ut
@ API: driver for the unit tests below.
<<PHS single: public test>>=
public :: phs_single_test
<<PHS single: test driver>>=
subroutine phs_single_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS single: execute tests>>
end subroutine phs_single_test
@ %def phs_single_test
@
\subsubsection{Phase-space configuration data}
Construct and display a test phase-space configuration object. Also
check the [[azimuthal_dependence]] flag.
<<PHS single: execute tests>>=
call test (phs_single_1, "phs_single_1", &
"phase-space configuration", &
u, results)
<<PHS single: test declarations>>=
public :: phs_single_1
<<PHS single: tests>>=
subroutine phs_single_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
real(default) :: sqrts
write (u, "(A)") "* Test output: phs_single_1"
write (u, "(A)") "* Purpose: initialize and display &
&phase-space configuration data"
write (u, "(A)")
call model%init_test ()
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_single_1"), process_data)
allocate (phs_single_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts, azimuthal_dependence=.false.)
call phs_data%write (u)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_single_1"
end subroutine phs_single_1
@ %def phs_single_1
@
\subsubsection{Phase space evaluation}
Compute kinematics for given parameters, also invert the calculation.
<<PHS single: execute tests>>=
call test (phs_single_2, "phs_single_2", &
"phase-space evaluation", &
u, results)
<<PHS single: test declarations>>=
public :: phs_single_2
<<PHS single: tests>>=
subroutine phs_single_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
real(default) :: sqrts, E
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(2) :: p, q
write (u, "(A)") "* Test output: phs_single_2"
write (u, "(A)") "* Purpose: test simple two-channel phase space"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_single_2"), process_data)
allocate (phs_single_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta"
write (u, "(A)")
E = sqrts / 2
p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point &
&for x = 0.5, 0.125"
write (u, "(A)")
call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
call phs%evaluate_other_channels (1)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call phs%write (u)
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_single_2"
end subroutine phs_single_2
@ %def phs_single_2
@
\subsubsection{Phase space for non-c.m. system}
Compute kinematics for given parameters, also invert the calculation.
Since this will involve cancellations, we call [[pacify]] to eliminate
numerical noise.
<<PHS single: execute tests>>=
call test (phs_single_3, "phs_single_3", &
"phase-space evaluation in lab frame", &
u, results)
<<PHS single: test declarations>>=
public :: phs_single_3
<<PHS single: tests>>=
subroutine phs_single_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
real(default) :: sqrts, E
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(2) :: p, q
type(lorentz_transformation_t) :: lt
write (u, "(A)") "* Test output: phs_single_3"
write (u, "(A)") "* Purpose: test simple two-channel phase space"
write (u, "(A)") "* without c.m. kinematics assumption"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_single_3"), process_data)
allocate (phs_single_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts, lab_is_cm=.false., sqrts_fixed=.false.)
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta in lab system"
write (u, "(A)")
lt = boost (0.1_default, 1) * boost (0.3_default, 3)
E = sqrts / 2
p(1) = lt * vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
p(2) = lt * vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
call vector4_write (p(1), u)
call vector4_write (p(2), u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point &
&for x = 0.5, 0.125"
write (u, "(A)")
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
call phs%evaluate_other_channels (1)
call pacify (phs)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract outgoing momenta in lab system"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
call vector4_write (q(1), u)
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call pacify (phs)
call phs%write (u)
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_single_3"
end subroutine phs_single_3
@ %def phs_single_3
@
\subsubsection{Decay Phase space evaluation}
Compute kinematics for given parameters, also invert the calculation. This
time, implement a decay process.
<<PHS single: execute tests>>=
call test (phs_single_4, "phs_single_4", &
"decay phase-space evaluation", &
u, results)
<<PHS single: test declarations>>=
public :: phs_single_4
<<PHS single: tests>>=
subroutine phs_single_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(1) :: p
type(vector4_t), dimension(2) :: q
write (u, "(A)") "* Test output: phs_single_4"
write (u, "(A)") "* Purpose: test simple two-channel phase space"
write (u, "(A)")
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
call flv%init (25, model)
write (u, "(A)") "* Initialize a decay and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_decay_data (var_str ("phs_single_4"), process_data)
allocate (phs_single_config_t :: phs_data)
call phs_data%init (process_data, model)
call phs_data%configure (flv%get_mass ())
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta"
write (u, "(A)")
p(1) = vector4_at_rest (flv%get_mass ())
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point &
&for x = 0.5, 0.125"
write (u, "(A)")
call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
call phs%evaluate_other_channels (1)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs_data%configure (flv%get_mass ())
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call phs%write (u)
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_single_4"
end subroutine phs_single_4
@ %def phs_single_4
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Flat RAMBO phase space}
This module implements the flat \texttt{RAMBO} phase space for
massless and massive particles using the minimal d.o.f $3n - 4$ in a
straightforward parameterization with a single channel.
We generate $n$ mass systems $M_i$ with $M_0 = \sqrt{s}$ and $M_{n} =
0$. We let each mass system decay $1 \rightarrow 2$ in a four-momentum
conserving way. The four-momenta of the two particles are generated
back-to-back where we map the d.o.f. to energy, azimuthal and polar
angle. The particle momenta are then boosted to CMS by an appriopriate
boost using the kinematics of the parent mass system.
<<[[phs_rambo.f90]]>>=
<<File header>>
module phs_rambo
<<Use kinds>>
<<Use strings>>
use lorentz
use phs_base
<<Standard module head>>
<<PHS rambo: types>>
<<PHS rambo: public>>
interface
<<PHS rambo: sub interfaces>>
end interface
contains
<<PHS rambo: main procedures>>
end module phs_rambo
@ %def phs_rambo
@
<<[[phs_rambo_sub.f90]]>>=
<<File header>>
submodule (phs_rambo) phs_rambo_s
use io_units
use constants
use numeric_utils
use format_defs, only: FMT_19
use permutations, only: factorial
use diagnostics
use physics_defs
implicit none
<<PHS rambo: parameters>>
contains
<<PHS rambo: procedures>>
end submodule phs_rambo_s
@ %def phs_rambo_s
@
\subsection{Configuration}
<<PHS rambo: public>>=
public :: phs_rambo_config_t
<<PHS rambo: types>>=
type, extends (phs_config_t) :: phs_rambo_config_t
contains
<<PHS rambo: phs rambo config: TBP>>
end type phs_rambo_config_t
@ %def phs_rambo_config_t
@ The finalizer is empty.
<<PHS rambo: phs rambo config: TBP>>=
procedure :: final => phs_rambo_config_final
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_config_final (object)
class(phs_rambo_config_t), intent(inout) :: object
end subroutine phs_rambo_config_final
<<PHS rambo: procedures>>=
module subroutine phs_rambo_config_final (object)
class(phs_rambo_config_t), intent(inout) :: object
end subroutine phs_rambo_config_final
@ %def phs_rambo_final
@ Output.
<<PHS rambo: phs rambo config: TBP>>=
procedure :: write => phs_rambo_config_write
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_config_write (object, unit, include_id)
class(phs_rambo_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
end subroutine phs_rambo_config_write
<<PHS rambo: procedures>>=
module subroutine phs_rambo_config_write (object, unit, include_id)
class(phs_rambo_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Partonic, flat phase-space configuration (RAMBO):"
call object%base_write (unit)
end subroutine phs_rambo_config_write
@ %def phs_rambo_config_write
@ Configuration: there is only one channel and $3n - 4$ parameters.
<<PHS rambo: phs rambo config: TBP>>=
procedure :: configure => phs_rambo_config_configure
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_rambo_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
end subroutine phs_rambo_config_configure
<<PHS rambo: procedures>>=
module subroutine phs_rambo_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_rambo_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
if (.not. present (nlo_type)) &
phs_config%nlo_type = BORN
if (phs_config%n_out < 2) then
call msg_fatal ("RAMBO phase space requires n_out >= 2")
end if
phs_config%n_channel = 1
phs_config%n_par = 3 * phs_config%n_out - 4
phs_config%sqrts = sqrts
if (present (sqrts_fixed)) phs_config%sqrts_fixed = sqrts_fixed
if (present (lab_is_cm)) phs_config%lab_is_cm = lab_is_cm
if (allocated (phs_config%channel)) deallocate (phs_config%channel)
allocate (phs_config%channel (1))
call phs_config%compute_md5sum ()
end subroutine phs_rambo_config_configure
@ %def phs_rambo_config_configure
@ Startup message, after configuration is complete.
<<PHS rambo: phs rambo config: TBP>>=
procedure :: startup_message => phs_rambo_config_startup_message
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_config_startup_message (phs_config, unit)
class(phs_rambo_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
end subroutine phs_rambo_config_startup_message
<<PHS rambo: procedures>>=
module subroutine phs_rambo_config_startup_message (phs_config, unit)
class(phs_rambo_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
call phs_config%base_startup_message (unit)
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Phase space: flat (RAMBO)"
call msg_message (unit = unit)
end subroutine phs_rambo_config_startup_message
@ %def phs_rambo_config_startup_message
@ Allocate an instance: the actual phase-space object.
Gfortran 7/8/9 bug, has to remain in the main module.
<<PHS rambo: phs rambo config: TBP>>=
procedure, nopass :: allocate_instance => phs_rambo_config_allocate_instance
<<PHS rambo: main procedures>>=
subroutine phs_rambo_config_allocate_instance (phs)
class(phs_t), intent(inout), pointer :: phs
allocate (phs_rambo_t :: phs)
end subroutine phs_rambo_config_allocate_instance
@ %def phs_rambo_config_allocate_instance
@
\subsection{Kinematics implementation}
We generate $n - 2$ mass systems $M_i$ with $M_0 = \sqrt{s}$ and $M_n = 0$...
Note: The incoming momenta must be in the c.m. system.
<<PHS rambo: public>>=
public :: phs_rambo_t
<<PHS rambo: types>>=
type, extends (phs_t) :: phs_rambo_t
real(default), dimension(:), allocatable :: k
real(default), dimension(:), allocatable :: m
contains
<<PHS rambo: phs rambo: TBP>>
end type phs_rambo_t
@ %def phs_rambo_t
@ Output.
<<PHS rambo: phs rambo: TBP>>=
procedure :: write => phs_rambo_write
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_write (object, unit, verbose)
class(phs_rambo_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine phs_rambo_write
<<PHS rambo: procedures>>=
module subroutine phs_rambo_write (object, unit, verbose)
class(phs_rambo_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
call object%base_write (u)
write (u, "(1X,A)") "Intermediate masses (massless):"
write (u, "(3X,999(" // FMT_19 // "))") object%k
write (u, "(1X,A)") "Intermediate masses (massive):"
write (u, "(3X,999(" // FMT_19 // "))") object%m
end subroutine phs_rambo_write
@ %def phs_rambo_write
@ The finalizer is empty.
<<PHS rambo: phs rambo: TBP>>=
procedure :: final => phs_rambo_final
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_final (object)
class(phs_rambo_t), intent(inout) :: object
end subroutine phs_rambo_final
<<PHS rambo: procedures>>=
module subroutine phs_rambo_final (object)
class(phs_rambo_t), intent(inout) :: object
end subroutine phs_rambo_final
@ %def phs_rambo_final
@ Initialization. We allocate arrays ([[base_init]]) and adjust the
phase-space volume.
The energy dependent factor of $s^{n - 2}$ is applied later.
<<PHS rambo: phs rambo: TBP>>=
procedure :: init => phs_rambo_init
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_init (phs, phs_config)
class(phs_rambo_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
end subroutine phs_rambo_init
<<PHS rambo: procedures>>=
module subroutine phs_rambo_init (phs, phs_config)
class(phs_rambo_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
call phs%base_init (phs_config)
associate (n => phs%config%n_out)
select case (n)
case (1)
if (sum (phs%m_out) > phs%m_in (1)) then
print *, "m_in = ", phs%m_in
print *, "m_out = ", phs%m_out
call msg_fatal &
("[phs_rambo_init] Decay is kinematically forbidden.")
end if
end select
allocate (phs%k(n), source = 0._default)
allocate (phs%m(n), source = 0._default)
phs%volume = 1. / (twopi)**(3 * n) &
* (pi / 2.)**(n - 1) / (factorial(n - 1) * factorial(n - 2))
end associate
end subroutine phs_rambo_init
@ %def phs_rambo_init
@ Evaluation. There is only one channel for RAMBO, so the second subroutine does nothing.
Note: the current implementation works for elastic scattering only.
<<PHS rambo: phs rambo: TBP>>=
procedure :: evaluate_selected_channel => phs_rambo_evaluate_selected_channel
procedure :: evaluate_other_channels => phs_rambo_evaluate_other_channels
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_evaluate_selected_channel (phs, c_in, r_in)
class(phs_rambo_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
end subroutine phs_rambo_evaluate_selected_channel
module subroutine phs_rambo_evaluate_other_channels (phs, c_in)
class(phs_rambo_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_rambo_evaluate_other_channels
<<PHS rambo: procedures>>=
module subroutine phs_rambo_evaluate_selected_channel (phs, c_in, r_in)
class(phs_rambo_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
type(vector4_t), dimension(2) :: p_rest, p_boosted
type(vector4_t) :: q
real(default), dimension(2) :: r_angle
integer :: i
if (.not. phs%p_defined) return
call phs%select_channel (c_in)
phs%r(:,c_in) = r_in
associate (n => phs%config%n_out, m => phs%m)
call phs%generate_intermediates (r_in(:n - 2))
q = sum (phs%p)
do i = 2, n
r_angle(1) = r_in(n - 5 + 2 * i)
r_angle(2) = r_in(n - 4 + 2 * i)
call phs%decay_intermediate (i, r_angle, p_rest)
p_boosted = boost(q, m(i - 1)) * p_rest
q = p_boosted(1)
phs%q(i - 1) = p_boosted(2)
end do
phs%q(n) = q
end associate
phs%q_defined = .true.
phs%r_defined = .true.
end subroutine phs_rambo_evaluate_selected_channel
module subroutine phs_rambo_evaluate_other_channels (phs, c_in)
class(phs_rambo_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_rambo_evaluate_other_channels
@ %def phs_rambo_evaluate_selected_channel
@ %def phs_rambo_evaluate_other_channels
@ Decay intermediate mass system $M_{i - 1}$ into a on-shell particle with mass
$m_{i - 1}$ and subsequent intermediate mass system with fixed $M_i$.
<<PHS rambo: phs rambo: TBP>>=
procedure, private :: decay_intermediate => phs_rambo_decay_intermediate
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_decay_intermediate (phs, i, r_angle, p)
class(phs_rambo_t), intent(in) :: phs
integer, intent(in) :: i
real(default), dimension(2), intent(in) :: r_angle
type(vector4_t), dimension(2), intent(out) :: p
end subroutine phs_rambo_decay_intermediate
<<PHS rambo: procedures>>=
module subroutine phs_rambo_decay_intermediate (phs, i, r_angle, p)
class(phs_rambo_t), intent(in) :: phs
integer, intent(in) :: i
real(default), dimension(2), intent(in) :: r_angle
type(vector4_t), dimension(2), intent(out) :: p
real(default) :: k_abs, cos_theta, phi
type(vector3_t):: k
real(default), dimension(2) :: E
cos_theta = 2. * r_angle(1) - 1.
phi = twopi * r_angle(2)
if (phi > pi) phi = phi - twopi
k_abs = sqrt (lambda (phs%m(i - 1)**2, phs%m(i)**2, phs%m_out(i - 1)**2)) &
/ (2. * phs%m(i - 1))
k = k_abs * [cos(phi) * sqrt(1. - cos_theta**2), &
sin(phi) * sqrt(1. - cos_theta**2), cos_theta]
E(1) = sqrt (phs%m(i)**2 + k_abs**2)
E(2) = sqrt (phs%m_out(i - 1)**2 + k_abs**2)
p(1) = vector4_moving (E(1), -k)
p(2) = vector4_moving (E(2), k)
end subroutine phs_rambo_decay_intermediate
@ %def phs_rambo_decay_intermediate
@ Generate intermediate masses.
<<PHS rambo: parameters>>=
integer, parameter :: BISECT_MAX_ITERATIONS = 1000
real(default), parameter :: BISECT_MIN_PRECISION = tiny_10
<<PHS rambo: phs rambo: TBP>>=
procedure, private :: generate_intermediates => &
phs_rambo_generate_intermediates
procedure, private :: invert_intermediates => phs_rambo_invert_intermediates
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_generate_intermediates (phs, r)
class(phs_rambo_t), intent(inout) :: phs
real(default), dimension(:), intent(in) :: r
end subroutine phs_rambo_generate_intermediates
module subroutine phs_rambo_invert_intermediates (phs)
class(phs_rambo_t), intent(inout) :: phs
end subroutine phs_rambo_invert_intermediates
<<PHS rambo: procedures>>=
module subroutine phs_rambo_generate_intermediates (phs, r)
class(phs_rambo_t), intent(inout) :: phs
real(default), dimension(:), intent(in) :: r
integer :: i, j
associate (n => phs%config%n_out, k => phs%k, m => phs%m)
m(1) = invariant_mass (sum (phs%p))
m(n) = phs%m_out (n)
call calculate_k (r)
do i = 2, n - 1
m(i) = k(i) + sum (phs%m_out (i:n))
end do
! Massless volume times reweighting for massive volume
phs%f(1) = k(1)**(2 * n - 4) &
* 8. * rho(m(n - 1), phs%m_out(n), phs%m_out(n - 1))
do i = 2, n - 1
phs%f(1) = phs%f(1) * &
rho(m(i - 1), m(i), phs%m_out(i - 1)) / &
rho(k(i - 1), k(i), 0._default) * &
M(i) / K(i)
end do
end associate
contains
subroutine calculate_k (r)
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), allocatable :: u
integer :: i
associate (n => phs%config%n_out, k => phs%k, m => phs%m)
k = 0
k(1) = m(1) - sum(phs%m_out(1:n))
allocate (u(2:n - 1), source=0._default)
call solve_for_u (r, u)
do i = 2, n - 1
k(i) = sqrt (u(i) * k(i - 1)**2)
end do
end associate
end subroutine calculate_k
subroutine solve_for_u (r, u)
real(default), dimension(phs%config%n_out - 2), intent(in) :: r
real(default), dimension(2:phs%config%n_out - 1), intent(out) :: u
integer :: i, j
real(default) :: f, f_mid, xl, xr, xmid
associate (n => phs%config%n_out)
do i = 2, n - 1
xl = 0
xr = 1
if (r(i - 1) == 1 .or. r(i - 1) == 0) then
u(i) = r(i - 1)
else
do j = 1, BISECT_MAX_ITERATIONS
xmid = (xl + xr) / 2.
f = f_rambo (xl, n - i) - r(i - 1)
f_mid = f_rambo (xmid, n - i) - r(i - 1)
if (f * f_mid > 0) then
xl = xmid
else
xr = xmid
end if
if (abs(xl - xr) < BISECT_MIN_PRECISION) exit
end do
u(i) = xmid
end if
end do
end associate
end subroutine solve_for_u
real(default) function f_rambo(u, n)
real(default), intent(in) :: u
integer, intent(in) :: n
f_rambo = (n + 1) * u**n - n * u**(n + 1)
end function f_rambo
real(default) function rho (M1, M2, m)
real(default), intent(in) :: M1, M2, m
real(default) :: MP, MM
rho = sqrt ((M1**2 - (M2 + m)**2) * (M1**2 - (M2 - m)**2))
! MP = (M1 - (M2 + m)) * (M1 + (M2 + m))
! MM = (M1 - (M2 - m)) * (M1 + (M2 - m))
! rho = sqrt (MP) * sqrt (MM)
rho = rho / (8._default * M1**2)
end function rho
end subroutine phs_rambo_generate_intermediates
module subroutine phs_rambo_invert_intermediates (phs)
class(phs_rambo_t), intent(inout) :: phs
real(default) :: u
integer :: i
associate (n => phs%config%n_out, k => phs%k, m => phs%m)
k = m
do i = 1, n - 1
k(i) = k(i) - sum (phs%m_out(i:n))
end do
do i = 2, n - 1
u = (k(i) / k(i - 1))**2
phs%r(i - 1, 1) = (n + 1 - i) * u**(n - i) &
- (n - i) * u**(n + 1 - i)
end do
end associate
end subroutine phs_rambo_invert_intermediates
@ %def phs_rambo_generate_intermediates
@ Inverse evaluation.
<<PHS rambo: phs rambo: TBP>>=
procedure :: inverse => phs_rambo_inverse
<<PHS rambo: sub interfaces>>=
module subroutine phs_rambo_inverse (phs)
class(phs_rambo_t), intent(inout) :: phs
end subroutine phs_rambo_inverse
<<PHS rambo: procedures>>=
module subroutine phs_rambo_inverse (phs)
class(phs_rambo_t), intent(inout) :: phs
type(vector4_t), dimension(:), allocatable :: q
type(vector4_t) :: p
type(lorentz_transformation_t) :: L
real(default) :: phi, cos_theta
integer :: i
if (.not. (phs%p_defined .and. phs%q_defined)) return
call phs%select_channel ()
associate (n => phs%config%n_out, m => phs%m)
allocate(q(n))
m(1) = invariant_mass (sum (phs%p))
q(1) = vector4_at_rest (m(1))
q(n) = phs%q(n)
do i = 2, n - 1
q(i) = q(i) + sum (phs%q(i:n))
m(i) = invariant_mass (q(i))
end do
call phs%invert_intermediates ()
do i = 2, n
L = inverse (boost (q(i - 1), m(i - 1)))
p = L * phs%q(i - 1)
phi = azimuthal_angle (p); cos_theta = polar_angle_ct (p)
phs%r(n - 5 + 2 * i, 1) = (cos_theta + 1.) / 2.
phs%r(n - 4 + 2 * i, 1) = phi / twopi
end do
end associate
phs%r_defined = .true.
end subroutine phs_rambo_inverse
@ %def phs_rambo_inverse
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[phs_rambo_ut.f90]]>>=
<<File header>>
module phs_rambo_ut
use unit_tests
use phs_rambo_uti
<<Standard module head>>
<<PHS rambo: public test>>
contains
<<PHS rambo: test driver>>
end module phs_rambo_ut
@ %def phs_rambo_ut
@
<<[[phs_rambo_uti.f90]]>>=
<<File header>>
module phs_rambo_uti
<<Use kinds>>
<<Use strings>>
use flavors
use lorentz
use model_data
use process_constants
use phs_base
use phs_rambo
use phs_base_ut, only: init_test_process_data, init_test_decay_data
<<Standard module head>>
<<PHS rambo: test declarations>>
contains
<<PHS rambo: tests>>
end module phs_rambo_uti
@ %def phs_rambo_ut
@ API: driver for the unit tests below.
<<PHS rambo: public test>>=
public :: phs_rambo_test
<<PHS rambo: test driver>>=
subroutine phs_rambo_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS rambo: execute tests>>
end subroutine phs_rambo_test
@ %def phs_rambo_test
@
\subsubsection{Phase-space configuration data}
Construct and display a test phase-space configuration object. Also
check the [[azimuthal_dependence]] flag.
<<PHS rambo: execute tests>>=
call test (phs_rambo_1, "phs_rambo_1", &
"phase-space configuration", &
u, results)
<<PHS rambo: test declarations>>=
public :: phs_rambo_1
<<PHS rambo: tests>>=
subroutine phs_rambo_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
real(default) :: sqrts
write (u, "(A)") "* Test output: phs_rambo_1"
write (u, "(A)") "* Purpose: initialize and display &
&phase-space configuration data"
write (u, "(A)")
call model%init_test ()
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_rambo_1"), process_data)
allocate (phs_rambo_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs_data%write (u)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_rambo_1"
end subroutine phs_rambo_1
@ %def phs_rambo_1
@
\subsubsection{Phase space evaluation}
Compute kinematics for given parameters, also invert the calculation.
<<PHS rambo: execute tests>>=
call test (phs_rambo_2, "phs_rambo_2", &
"phase-space evaluation", &
u, results)
<<PHS rambo: test declarations>>=
public :: phs_rambo_2
<<PHS rambo: tests>>=
subroutine phs_rambo_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
real(default) :: sqrts, E
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(2) :: p, q
write (u, "(A)") "* Test output: phs_rambo_2"
write (u, "(A)") "* Purpose: test simple two-channel phase space"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_rambo_2"), process_data)
allocate (phs_rambo_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta"
write (u, "(A)")
E = sqrts / 2
p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point &
&for x = 0.5, 0.125"
write (u, "(A)")
call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
call phs%evaluate_other_channels (1)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call phs%write (u)
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_rambo_2"
end subroutine phs_rambo_2
@ %def phs_rambo_2
@
\subsubsection{Phase space for non-c.m. system}
Compute kinematics for given parameters, also invert the calculation.
Since this will involve cancellations, we call [[pacify]] to eliminate
numerical noise.
<<PHS rambo: execute tests>>=
call test (phs_rambo_3, "phs_rambo_3", &
"phase-space evaluation in lab frame", &
u, results)
<<PHS rambo: test declarations>>=
public :: phs_rambo_3
<<PHS rambo: tests>>=
subroutine phs_rambo_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
real(default) :: sqrts, E
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(2) :: p, q
type(lorentz_transformation_t) :: lt
write (u, "(A)") "* Test output: phs_rambo_3"
write (u, "(A)") "* Purpose: phase-space evaluation in lab frame"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_rambo_3"), process_data)
allocate (phs_rambo_config_t :: phs_data)
call phs_data%init (process_data, model)
sqrts = 1000._default
call phs_data%configure (sqrts, lab_is_cm=.false., sqrts_fixed=.false.)
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta in lab system"
write (u, "(A)")
lt = boost (0.1_default, 1) * boost (0.3_default, 3)
E = sqrts / 2
p(1) = lt * vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
p(2) = lt * vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
call vector4_write (p(1), u)
call vector4_write (p(2), u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point &
&for x = 0.5, 0.125"
write (u, "(A)")
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
call phs%evaluate_other_channels (1)
call pacify (phs)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract outgoing momenta in lab system"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
call vector4_write (q(1), u)
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call pacify (phs)
call phs%write (u)
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_rambo_3"
end subroutine phs_rambo_3
@ %def phs_rambo_3
@
\subsubsection{Decay Phase space evaluation}
Compute kinematics for given parameters, also invert the calculation. This
time, implement a decay process.
<<PHS rambo: execute tests>>=
call test (phs_rambo_4, "phs_rambo_4", &
"decay phase-space evaluation", &
u, results)
<<PHS rambo: test declarations>>=
public :: phs_rambo_4
<<PHS rambo: tests>>=
subroutine phs_rambo_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(1) :: p
type(vector4_t), dimension(2) :: q
write (u, "(A)") "* Test output: phs_rambo_4"
write (u, "(A)") "* Purpose: test simple two-channel phase space"
write (u, "(A)")
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
call flv%init (25, model)
write (u, "(A)") "* Initialize a decay and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_decay_data (var_str ("phs_rambo_4"), process_data)
allocate (phs_rambo_config_t :: phs_data)
call phs_data%init (process_data, model)
call phs_data%configure (flv%get_mass ())
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta"
write (u, "(A)")
p(1) = vector4_at_rest (flv%get_mass ())
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point &
&for x = 0.5, 0.125"
write (u, "(A)")
call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
call phs%evaluate_other_channels (1)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs_data%configure (flv%get_mass ())
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call phs%write (u)
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_rambo_4"
end subroutine phs_rambo_4
@ %def phs_rambo_4
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Resonance Handler}
For various purposes (e.g., shower histories), we should extract the set of
resonances and resonant channels from a phase-space tree set. A few methods
do kinematics calculations specifically for those resonance data.
<<[[resonances.f90]]>>=
<<File header>>
module resonances
<<Use kinds>>
<<Use strings>>
use lorentz
use model_data, only: model_data_t
use flavors, only: flavor_t
<<Standard module head>>
<<Resonances: public>>
<<Resonances: parameters>>
<<Resonances: types>>
interface
<<Resonances: sub interfaces>>
end interface
end module resonances
@ %def resonances
@
<<[[resonances_sub.f90]]>>=
<<File header>>
submodule (resonances) resonances_s
<<Use debug>>
use string_utils, only: str
use format_utils, only: write_indent
use constants, only: one
use io_units
use diagnostics
implicit none
contains
<<Resonances: procedures>>
end submodule resonances_s
@ %def resonances_s
@
\subsection{Decay products (contributors)}
This stores the indices of the particles that contribute to a resonance, i.e.,
the decay products.
<<Resonances: public>>=
public :: resonance_contributors_t
<<Resonances: types>>=
type :: resonance_contributors_t
integer, dimension(:), allocatable :: c
contains
<<Resonances: resonance contributors: TBP>>
end type resonance_contributors_t
@ %def resonance_contributors_t
@ Equality (comparison)
<<Resonances: resonance contributors: TBP>>=
procedure, private :: resonance_contributors_equal
generic :: operator(==) => resonance_contributors_equal
<<Resonances: sub interfaces>>=
elemental module function resonance_contributors_equal &
(c1, c2) result (equal)
logical :: equal
class(resonance_contributors_t), intent(in) :: c1, c2
end function resonance_contributors_equal
<<Resonances: procedures>>=
elemental module function resonance_contributors_equal &
(c1, c2) result (equal)
logical :: equal
class(resonance_contributors_t), intent(in) :: c1, c2
equal = allocated (c1%c) .and. allocated (c2%c)
if (equal) equal = size (c1%c) == size (c2%c)
if (equal) equal = all (c1%c == c2%c)
end function resonance_contributors_equal
@ %def resonance_contributors_equal
@ Assignment
<<Resonances: resonance contributors: TBP>>=
procedure, private :: resonance_contributors_assign
generic :: assignment(=) => resonance_contributors_assign
<<Resonances: sub interfaces>>=
pure module subroutine resonance_contributors_assign &
(contributors_out, contributors_in)
class(resonance_contributors_t), intent(inout) :: contributors_out
class(resonance_contributors_t), intent(in) :: contributors_in
end subroutine resonance_contributors_assign
<<Resonances: procedures>>=
pure module subroutine resonance_contributors_assign &
(contributors_out, contributors_in)
class(resonance_contributors_t), intent(inout) :: contributors_out
class(resonance_contributors_t), intent(in) :: contributors_in
if (allocated (contributors_out%c)) deallocate (contributors_out%c)
if (allocated (contributors_in%c)) then
allocate (contributors_out%c (size (contributors_in%c)))
contributors_out%c = contributors_in%c
end if
end subroutine resonance_contributors_assign
@ %def resonance_contributors_assign
@
\subsection{Resonance info object}
This data structure augments the set of resonance contributors by a flavor
object, such that we can perform calculations that take into
account the particle properties, including mass and width.
Avoiding nameclash with similar but different [[resonance_t]] of
[[phs_base]]:
<<Resonances: public>>=
public :: resonance_info_t
<<Resonances: types>>=
type :: resonance_info_t
type(flavor_t) :: flavor
type(resonance_contributors_t) :: contributors
contains
<<Resonances: resonance info: TBP>>
end type resonance_info_t
@ %def resonance_info_t
@
<<Resonances: resonance info: TBP>>=
procedure :: copy => resonance_info_copy
<<Resonances: sub interfaces>>=
module subroutine resonance_info_copy (resonance_in, resonance_out)
class(resonance_info_t), intent(in) :: resonance_in
type(resonance_info_t), intent(out) :: resonance_out
end subroutine resonance_info_copy
<<Resonances: procedures>>=
module subroutine resonance_info_copy (resonance_in, resonance_out)
class(resonance_info_t), intent(in) :: resonance_in
type(resonance_info_t), intent(out) :: resonance_out
resonance_out%flavor = resonance_in%flavor
if (allocated (resonance_in%contributors%c)) then
associate (c => resonance_in%contributors%c)
allocate (resonance_out%contributors%c (size (c)))
resonance_out%contributors%c = c
end associate
end if
end subroutine resonance_info_copy
@ %def resonance_info_copy
@
<<Resonances: resonance info: TBP>>=
procedure :: write => resonance_info_write
<<Resonances: sub interfaces>>=
module subroutine resonance_info_write (resonance, unit, verbose)
class(resonance_info_t), intent(in) :: resonance
integer, optional, intent(in) :: unit
logical, optional, intent(in) :: verbose
end subroutine resonance_info_write
<<Resonances: procedures>>=
module subroutine resonance_info_write (resonance, unit, verbose)
class(resonance_info_t), intent(in) :: resonance
integer, optional, intent(in) :: unit
logical, optional, intent(in) :: verbose
integer :: u, i
logical :: verb
u = given_output_unit (unit); if (u < 0) return
verb = .true.; if (present (verbose)) verb = verbose
if (verb) then
write (u, '(A)', advance='no') "Resonance contributors: "
else
write (u, '(1x)', advance="no")
end if
if (allocated (resonance%contributors%c)) then
do i = 1, size(resonance%contributors%c)
write (u, '(I0,1X)', advance='no') resonance%contributors%c(i)
end do
else if (verb) then
write (u, "(A)", advance="no") "[not allocated]"
end if
if (resonance%flavor%is_defined ()) call resonance%flavor%write (u)
write (u, '(A)')
end subroutine resonance_info_write
@ %def resonance_info_write
@ Create a resonance-info object. The particle info may be available
in term of a flavor object or as a PDG code; in the latter case we
have to require a model data object that provides mass and width information.
<<Resonances: resonance info: TBP>>=
procedure, private :: resonance_info_init_pdg
procedure, private :: resonance_info_init_flv
generic :: init => resonance_info_init_pdg, resonance_info_init_flv
<<Resonances: sub interfaces>>=
module subroutine resonance_info_init_pdg &
(resonance, mom_id, pdg, model, n_out)
class(resonance_info_t), intent(out) :: resonance
integer, intent(in) :: mom_id
integer, intent(in) :: pdg, n_out
class(model_data_t), intent(in), target :: model
end subroutine resonance_info_init_pdg
module subroutine resonance_info_init_flv (resonance, mom_id, flv, n_out)
class(resonance_info_t), intent(out) :: resonance
integer, intent(in) :: mom_id
type(flavor_t), intent(in) :: flv
integer, intent(in) :: n_out
end subroutine resonance_info_init_flv
<<Resonances: procedures>>=
module subroutine resonance_info_init_pdg &
(resonance, mom_id, pdg, model, n_out)
class(resonance_info_t), intent(out) :: resonance
integer, intent(in) :: mom_id
integer, intent(in) :: pdg, n_out
class(model_data_t), intent(in), target :: model
type(flavor_t) :: flv
if (debug_on) call msg_debug (D_PHASESPACE, "resonance_info_init_pdg")
call flv%init (pdg, model)
call resonance%init (mom_id, flv, n_out)
end subroutine resonance_info_init_pdg
module subroutine resonance_info_init_flv (resonance, mom_id, flv, n_out)
class(resonance_info_t), intent(out) :: resonance
integer, intent(in) :: mom_id
type(flavor_t), intent(in) :: flv
integer, intent(in) :: n_out
integer :: i
logical, dimension(n_out) :: contrib
integer, dimension(n_out) :: tmp
if (debug_on) call msg_debug (D_PHASESPACE, "resonance_info_init_flv")
resonance%flavor = flv
do i = 1, n_out
tmp(i) = i
end do
contrib = btest (mom_id, tmp - 1)
allocate (resonance%contributors%c (count (contrib)))
resonance%contributors%c = pack (tmp, contrib)
end subroutine resonance_info_init_flv
@ %def resonance_info_init
@
<<Resonances: resonance info: TBP>>=
procedure, private :: resonance_info_equal
generic :: operator(==) => resonance_info_equal
<<Resonances: sub interfaces>>=
elemental module function resonance_info_equal (r1, r2) result (equal)
logical :: equal
class(resonance_info_t), intent(in) :: r1, r2
end function resonance_info_equal
<<Resonances: procedures>>=
elemental module function resonance_info_equal (r1, r2) result (equal)
logical :: equal
class(resonance_info_t), intent(in) :: r1, r2
equal = r1%flavor == r2%flavor .and. r1%contributors == r2%contributors
end function resonance_info_equal
@ %def resonance_info_equal
@ With each resonance region we associate a Breit-Wigner function
\begin{equation*}
P = \frac{M_{res}^4}{(s - M_{res}^2)^2 + \Gamma_{res}^2 M_{res}^2},
\end{equation*}
where $s$ denotes the invariant mass of the outgoing momenta originating
from this resonance. Note that the $M_{res}^4$ in the nominator makes
the mapping a dimensionless quantity.
<<Resonances: resonance info: TBP>>=
procedure :: mapping => resonance_info_mapping
<<Resonances: sub interfaces>>=
module function resonance_info_mapping (resonance, s) result (bw)
real(default) :: bw
class(resonance_info_t), intent(in) :: resonance
real(default), intent(in) :: s
end function resonance_info_mapping
<<Resonances: procedures>>=
module function resonance_info_mapping (resonance, s) result (bw)
real(default) :: bw
class(resonance_info_t), intent(in) :: resonance
real(default), intent(in) :: s
real(default) :: m, gamma
if (resonance%flavor%is_defined ()) then
m = resonance%flavor%get_mass ()
gamma = resonance%flavor%get_width ()
bw = m**4 / ((s - m**2)**2 + gamma**2 * m**2)
else
bw = one
end if
end function resonance_info_mapping
@ %def resonance_info_mapping
@ Used for building a resonance tree below.
<<Resonances: resonance info: TBP>>=
procedure, private :: get_n_contributors => resonance_info_get_n_contributors
procedure, private :: contains => resonance_info_contains
<<Resonances: sub interfaces>>=
elemental module function resonance_info_get_n_contributors &
(resonance) result (n)
class(resonance_info_t), intent(in) :: resonance
integer :: n
end function resonance_info_get_n_contributors
elemental module function resonance_info_contains &
(resonance, c) result (flag)
class(resonance_info_t), intent(in) :: resonance
integer, intent(in) :: c
logical :: flag
end function resonance_info_contains
<<Resonances: procedures>>=
elemental module function resonance_info_get_n_contributors &
(resonance) result (n)
class(resonance_info_t), intent(in) :: resonance
integer :: n
if (allocated (resonance%contributors%c)) then
n = size (resonance%contributors%c)
else
n = 0
end if
end function resonance_info_get_n_contributors
elemental module function resonance_info_contains &
(resonance, c) result (flag)
class(resonance_info_t), intent(in) :: resonance
integer, intent(in) :: c
logical :: flag
if (allocated (resonance%contributors%c)) then
flag = any (resonance%contributors%c == c)
else
flag = .false.
end if
end function resonance_info_contains
@ %def resonance_info_get_n_contributors
@ %def resonance_info_contains
@
\subsection{Resonance history object}
This data structure stores a set of resonances, i.e., the resonances that
appear in a particular Feynman graph or, in the context of phase space, phase
space diagram.
<<Resonances: public>>=
public :: resonance_history_t
<<Resonances: types>>=
type :: resonance_history_t
type(resonance_info_t), dimension(:), allocatable :: resonances
integer :: n_resonances = 0
contains
<<Resonances: resonance history: TBP>>
end type resonance_history_t
@ %def resonance_history_t
@ Clear the resonance history. Assuming that there are no
pointer-allocated parts, a straightforward [[intent(out)]] will do.
<<Resonances: resonance history: TBP>>=
procedure :: clear => resonance_history_clear
<<Resonances: sub interfaces>>=
module subroutine resonance_history_clear (res_hist)
class(resonance_history_t), intent(out) :: res_hist
end subroutine resonance_history_clear
<<Resonances: procedures>>=
module subroutine resonance_history_clear (res_hist)
class(resonance_history_t), intent(out) :: res_hist
end subroutine resonance_history_clear
@ %def resonance_history_clear
@
<<Resonances: resonance history: TBP>>=
procedure :: copy => resonance_history_copy
<<Resonances: sub interfaces>>=
module subroutine resonance_history_copy (res_hist_in, res_hist_out)
class(resonance_history_t), intent(in) :: res_hist_in
type(resonance_history_t), intent(out) :: res_hist_out
end subroutine resonance_history_copy
<<Resonances: procedures>>=
module subroutine resonance_history_copy (res_hist_in, res_hist_out)
class(resonance_history_t), intent(in) :: res_hist_in
type(resonance_history_t), intent(out) :: res_hist_out
integer :: i
res_hist_out%n_resonances = res_hist_in%n_resonances
allocate (res_hist_out%resonances (size (res_hist_in%resonances)))
do i = 1, size (res_hist_in%resonances)
call res_hist_in%resonances(i)%copy (res_hist_out%resonances(i))
end do
end subroutine resonance_history_copy
@ %def resonance_history_copy
@
<<Resonances: resonance history: TBP>>=
procedure :: write => resonance_history_write
<<Resonances: sub interfaces>>=
module subroutine resonance_history_write (res_hist, unit, verbose, indent)
class(resonance_history_t), intent(in) :: res_hist
integer, optional, intent(in) :: unit
logical, optional, intent(in) :: verbose
integer, optional, intent(in) :: indent
end subroutine resonance_history_write
<<Resonances: procedures>>=
module subroutine resonance_history_write (res_hist, unit, verbose, indent)
class(resonance_history_t), intent(in) :: res_hist
integer, optional, intent(in) :: unit
logical, optional, intent(in) :: verbose
integer, optional, intent(in) :: indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write(u, '(A,I0,A)') "Resonance history with ", &
res_hist%n_resonances, " resonances:"
do i = 1, res_hist%n_resonances
call write_indent (u, indent)
write (u, "(2x)", advance="no")
call res_hist%resonances(i)%write (u, verbose)
end do
end subroutine resonance_history_write
@ %def resonance_history_write
@ Assignment. Indirectly calls type-bound assignment for the contributors.
Strictly speaking, this is redundant. But NAGfor 6.208 intrinsic assignment
crashes under certain conditions.
<<Resonances: resonance history: TBP>>=
procedure, private :: resonance_history_assign
generic :: assignment(=) => resonance_history_assign
<<Resonances: sub interfaces>>=
module subroutine resonance_history_assign (res_hist_out, res_hist_in)
class(resonance_history_t), intent(out) :: res_hist_out
class(resonance_history_t), intent(in) :: res_hist_in
end subroutine resonance_history_assign
<<Resonances: procedures>>=
module subroutine resonance_history_assign (res_hist_out, res_hist_in)
class(resonance_history_t), intent(out) :: res_hist_out
class(resonance_history_t), intent(in) :: res_hist_in
if (allocated (res_hist_in%resonances)) then
res_hist_out%resonances = res_hist_in%resonances
res_hist_out%n_resonances = res_hist_in%n_resonances
end if
end subroutine resonance_history_assign
@ %def resonance_history_assign
@ Equality. If this turns out to slow down the program, we should
change the implementation or use hash codes.
<<Resonances: resonance history: TBP>>=
procedure, private :: resonance_history_equal
generic :: operator(==) => resonance_history_equal
<<Resonances: sub interfaces>>=
elemental module function resonance_history_equal (rh1, rh2) result (equal)
logical :: equal
class(resonance_history_t), intent(in) :: rh1, rh2
end function resonance_history_equal
<<Resonances: procedures>>=
elemental module function resonance_history_equal (rh1, rh2) result (equal)
logical :: equal
class(resonance_history_t), intent(in) :: rh1, rh2
integer :: i
equal = .false.
if (rh1%n_resonances == rh2%n_resonances) then
do i = 1, rh1%n_resonances
if (.not. rh1%resonances(i) == rh2%resonances(i)) then
return
end if
end do
equal = .true.
end if
end function resonance_history_equal
@ %def resonance_history_equal
@ Check if a resonance history is a strict superset of another one. This is
true if the first one is nonempty and the second one is empty.
Otherwise, we check if each entry of the second argument appears in
the first one.
<<Resonances: resonance history: TBP>>=
procedure, private :: resonance_history_contains
generic :: operator(.contains.) => resonance_history_contains
<<Resonances: sub interfaces>>=
elemental module function resonance_history_contains &
(rh1, rh2) result (flag)
logical :: flag
class(resonance_history_t), intent(in) :: rh1, rh2
end function resonance_history_contains
<<Resonances: procedures>>=
elemental module function resonance_history_contains &
(rh1, rh2) result (flag)
logical :: flag
class(resonance_history_t), intent(in) :: rh1, rh2
integer :: i
if (rh1%n_resonances > rh2%n_resonances) then
flag = .true.
do i = 1, rh2%n_resonances
flag = flag .and. any (rh1%resonances == rh2%resonances(i))
end do
else
flag = .false.
end if
end function resonance_history_contains
@ %def resonance_history_contains
@ Number of entries for dynamically extending the resonance-info array.
<<Resonances: parameters>>=
integer, parameter :: n_max_resonances = 10
@
<<Resonances: resonance history: TBP>>=
procedure :: add_resonance => resonance_history_add_resonance
<<Resonances: sub interfaces>>=
module subroutine resonance_history_add_resonance (res_hist, resonance)
class(resonance_history_t), intent(inout) :: res_hist
type(resonance_info_t), intent(in) :: resonance
end subroutine resonance_history_add_resonance
<<Resonances: procedures>>=
module subroutine resonance_history_add_resonance (res_hist, resonance)
class(resonance_history_t), intent(inout) :: res_hist
type(resonance_info_t), intent(in) :: resonance
type(resonance_info_t), dimension(:), allocatable :: tmp
integer :: n, i
if (debug_on) call msg_debug &
(D_PHASESPACE, "resonance_history_add_resonance")
if (.not. allocated (res_hist%resonances)) then
n = 0
allocate (res_hist%resonances (1))
else
n = res_hist%n_resonances
allocate (tmp (n))
do i = 1, n
call res_hist%resonances(i)%copy (tmp(i))
end do
deallocate (res_hist%resonances)
allocate (res_hist%resonances (n+1))
do i = 1, n
call tmp(i)%copy (res_hist%resonances(i))
end do
deallocate (tmp)
end if
call resonance%copy (res_hist%resonances(n+1))
res_hist%n_resonances = n + 1
if (debug_on) call msg_debug &
(D_PHASESPACE, "res_hist%n_resonances", res_hist%n_resonances)
end subroutine resonance_history_add_resonance
@ %def resonance_history_add_resonance
@
<<Resonances: resonance history: TBP>>=
procedure :: remove_resonance => resonance_history_remove_resonance
<<Resonances: sub interfaces>>=
module subroutine resonance_history_remove_resonance (res_hist, i_res)
class(resonance_history_t), intent(inout) :: res_hist
integer, intent(in) :: i_res
end subroutine resonance_history_remove_resonance
<<Resonances: procedures>>=
module subroutine resonance_history_remove_resonance (res_hist, i_res)
class(resonance_history_t), intent(inout) :: res_hist
integer, intent(in) :: i_res
type(resonance_info_t), dimension(:), allocatable :: tmp_1, tmp_2
integer :: i, j, n
n = res_hist%n_resonances
res_hist%n_resonances = n - 1
if (res_hist%n_resonances == 0) then
deallocate (res_hist%resonances)
else
if (i_res > 1) allocate (tmp_1(1:i_res-1))
if (i_res < n) allocate (tmp_2(i_res+1:n))
if (allocated (tmp_1)) then
do i = 1, i_res - 1
call res_hist%resonances(i)%copy (tmp_1(i))
end do
end if
if (allocated (tmp_2)) then
do i = i_res + 1, n
call res_hist%resonances(i)%copy (tmp_2(i))
end do
end if
deallocate (res_hist%resonances)
allocate (res_hist%resonances (res_hist%n_resonances))
j = 1
if (allocated (tmp_1)) then
do i = 1, i_res - 1
call tmp_1(i)%copy (res_hist%resonances(j))
j = j + 1
end do
deallocate (tmp_1)
end if
if (allocated (tmp_2)) then
do i = i_res + 1, n
call tmp_2(i)%copy (res_hist%resonances(j))
j = j + 1
end do
deallocate (tmp_2)
end if
end if
end subroutine resonance_history_remove_resonance
@ %def resonance_history_remove_resonance
@
<<Resonances: resonance history: TBP>>=
procedure :: add_offset => resonance_history_add_offset
<<Resonances: sub interfaces>>=
module subroutine resonance_history_add_offset (res_hist, n)
class(resonance_history_t), intent(inout) :: res_hist
integer, intent(in) :: n
end subroutine resonance_history_add_offset
<<Resonances: procedures>>=
module subroutine resonance_history_add_offset (res_hist, n)
class(resonance_history_t), intent(inout) :: res_hist
integer, intent(in) :: n
integer :: i_res
do i_res = 1, res_hist%n_resonances
associate (contributors => res_hist%resonances(i_res)%contributors%c)
contributors = contributors + n
end associate
end do
end subroutine resonance_history_add_offset
@ %def resonance_history_add_offset
@
<<Resonances: resonance history: TBP>>=
procedure :: contains_leg => resonance_history_contains_leg
<<Resonances: sub interfaces>>=
module function resonance_history_contains_leg &
(res_hist, i_leg) result (val)
logical :: val
class(resonance_history_t), intent(in) :: res_hist
integer, intent(in) :: i_leg
end function resonance_history_contains_leg
<<Resonances: procedures>>=
module function resonance_history_contains_leg &
(res_hist, i_leg) result (val)
logical :: val
class(resonance_history_t), intent(in) :: res_hist
integer, intent(in) :: i_leg
integer :: i_res
val = .false.
do i_res = 1, res_hist%n_resonances
if (any (res_hist%resonances(i_res)%contributors%c == i_leg)) then
val = .true.
exit
end if
end do
end function resonance_history_contains_leg
@ %def resonance_history_contains_leg
@
<<Resonances: resonance history: TBP>>=
procedure :: mapping => resonance_history_mapping
<<Resonances: sub interfaces>>=
module function resonance_history_mapping &
(res_hist, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
end function resonance_history_mapping
<<Resonances: procedures>>=
module function resonance_history_mapping &
(res_hist, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
integer :: i_res
real(default) :: s
p_map = one
do i_res = 1, res_hist%n_resonances
associate (res => res_hist%resonances(i_res))
s = compute_resonance_mass (p, res%contributors%c, i_gluon)**2
p_map = p_map * res%mapping (s)
end associate
end do
end function resonance_history_mapping
@ %def resonance_history_mapping
@ This predicate is true if all resonances in the history have exactly
[[n]] contributors. For instance, if $n=2$, all resonances have a
two-particle decay.
<<Resonances: resonance history: TBP>>=
procedure :: only_has_n_contributors => &
resonance_history_only_has_n_contributors
<<Resonances: sub interfaces>>=
module function resonance_history_only_has_n_contributors &
(res_hist, n) result (value)
logical :: value
class(resonance_history_t), intent(in) :: res_hist
integer, intent(in) :: n
end function resonance_history_only_has_n_contributors
<<Resonances: procedures>>=
module function resonance_history_only_has_n_contributors &
(res_hist, n) result (value)
logical :: value
class(resonance_history_t), intent(in) :: res_hist
integer, intent(in) :: n
integer :: i_res
value = .true.
do i_res = 1, res_hist%n_resonances
associate (res => res_hist%resonances(i_res))
value = value .and. size (res%contributors%c) == n
end associate
end do
end function resonance_history_only_has_n_contributors
@ %def resonance_history_only_has_n_contributors
@
<<Resonances: resonance history: TBP>>=
procedure :: has_flavor => resonance_history_has_flavor
<<Resonances: sub interfaces>>=
module function resonance_history_has_flavor &
(res_hist, flv) result (has_flv)
logical :: has_flv
class(resonance_history_t), intent(in) :: res_hist
type(flavor_t), intent(in) :: flv
end function resonance_history_has_flavor
<<Resonances: procedures>>=
module function resonance_history_has_flavor &
(res_hist, flv) result (has_flv)
logical :: has_flv
class(resonance_history_t), intent(in) :: res_hist
type(flavor_t), intent(in) :: flv
integer :: i
has_flv = .false.
do i = 1, res_hist%n_resonances
has_flv = has_flv .or. res_hist%resonances(i)%flavor == flv
end do
end function resonance_history_has_flavor
@ %def resonance_history_has_flavor
@
\subsection{Kinematics}
Evaluate the distance from a resonance. The distance is given by
$|p^2-m^2|/(m\Gamma)$. For $\Gamma\ll m$, this is the relative
distance from the resonance peak in units of the half-width.
<<Resonances: resonance info: TBP>>=
procedure :: evaluate_distance => resonance_info_evaluate_distance
<<Resonances: sub interfaces>>=
module subroutine resonance_info_evaluate_distance (res_info, p, dist)
class(resonance_info_t), intent(in) :: res_info
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(out) :: dist
end subroutine resonance_info_evaluate_distance
<<Resonances: procedures>>=
module subroutine resonance_info_evaluate_distance (res_info, p, dist)
class(resonance_info_t), intent(in) :: res_info
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(out) :: dist
real(default) :: m, w
type(vector4_t) :: q
m = res_info%flavor%get_mass ()
w = res_info%flavor%get_width ()
q = sum (p(res_info%contributors%c))
dist = abs (q**2 - m**2) / (m * w)
end subroutine resonance_info_evaluate_distance
@ %def resonance_info_evaluate_distance
@
Evaluate the array of distances from a resonance history. We assume that the
array has been allocated with correct size, namely the number of resonances in
this history.
<<Resonances: resonance history: TBP>>=
procedure :: evaluate_distances => resonance_history_evaluate_distances
<<Resonances: sub interfaces>>=
module subroutine resonance_history_evaluate_distances (res_hist, p, dist)
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), dimension(:), intent(in) :: p
real(default), dimension(:), intent(out) :: dist
end subroutine resonance_history_evaluate_distances
<<Resonances: procedures>>=
module subroutine resonance_history_evaluate_distances (res_hist, p, dist)
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), dimension(:), intent(in) :: p
real(default), dimension(:), intent(out) :: dist
integer :: i
do i = 1, res_hist%n_resonances
call res_hist%resonances(i)%evaluate_distance (p, dist(i))
end do
end subroutine resonance_history_evaluate_distances
@ %def resonance_history_evaluate_distances
@ Use the distance to determine a Gaussian turnoff factor for a
resonance. The factor is given by a Gaussian function
$e^{-d^2/\sigma^2}$, where $\sigma$ is the [[gw]] parameter multiplied
by the resonance width, and $d$ is the distance (see above). So, for
$d=\sigma$, the factor is $0.37$, and for $d=2\sigma$ we get $0.018$.
If the [[gw]] factor is less or equal to zero, return $1$.
<<Resonances: resonance info: TBP>>=
procedure :: evaluate_gaussian => resonance_info_evaluate_gaussian
<<Resonances: sub interfaces>>=
module function resonance_info_evaluate_gaussian &
(res_info, p, gw) result (factor)
class(resonance_info_t), intent(in) :: res_info
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: gw
real(default) :: factor
end function resonance_info_evaluate_gaussian
<<Resonances: procedures>>=
module function resonance_info_evaluate_gaussian &
(res_info, p, gw) result (factor)
class(resonance_info_t), intent(in) :: res_info
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: gw
real(default) :: factor
real(default) :: dist, w
if (gw > 0) then
w = res_info%flavor%get_width ()
call res_info%evaluate_distance (p, dist)
factor = exp (- (dist / (gw * w)) **2)
else
factor = 1
end if
end function resonance_info_evaluate_gaussian
@ %def resonance_info_evaluate_gaussian
@ The Gaussian factor of the history is the product of all factors.
<<Resonances: resonance history: TBP>>=
procedure :: evaluate_gaussian => resonance_history_evaluate_gaussian
<<Resonances: sub interfaces>>=
module function resonance_history_evaluate_gaussian &
(res_hist, p, gw) result (factor)
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: gw
real(default) :: factor
end function resonance_history_evaluate_gaussian
<<Resonances: procedures>>=
module function resonance_history_evaluate_gaussian &
(res_hist, p, gw) result (factor)
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: gw
real(default), dimension(:), allocatable :: dist
real(default) :: factor
integer :: i
factor = 1
do i = 1, res_hist%n_resonances
factor = factor * res_hist%resonances(i)%evaluate_gaussian (p, gw)
end do
end function resonance_history_evaluate_gaussian
@ %def resonance_history_evaluate_gaussian
@
Use the distances to determine whether the resonance history can qualify as
on-shell. The criterion is whether the distance is greater than the number of
width values as given by [[on_shell_limit]].
<<Resonances: resonance info: TBP>>=
procedure :: is_on_shell => resonance_info_is_on_shell
<<Resonances: sub interfaces>>=
module function resonance_info_is_on_shell (res_info, p, on_shell_limit) &
result (flag)
class(resonance_info_t), intent(in) :: res_info
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: on_shell_limit
logical :: flag
end function resonance_info_is_on_shell
<<Resonances: procedures>>=
module function resonance_info_is_on_shell (res_info, p, on_shell_limit) &
result (flag)
class(resonance_info_t), intent(in) :: res_info
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: on_shell_limit
logical :: flag
real(default) :: dist
call res_info%evaluate_distance (p, dist)
flag = dist < on_shell_limit
end function resonance_info_is_on_shell
@ %def resonance_info_is_on_shell
@
<<Resonances: resonance history: TBP>>=
procedure :: is_on_shell => resonance_history_is_on_shell
<<Resonances: sub interfaces>>=
module function resonance_history_is_on_shell &
(res_hist, p, on_shell_limit) result (flag)
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: on_shell_limit
logical :: flag
end function resonance_history_is_on_shell
<<Resonances: procedures>>=
module function resonance_history_is_on_shell &
(res_hist, p, on_shell_limit) result (flag)
class(resonance_history_t), intent(in) :: res_hist
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: on_shell_limit
logical :: flag
integer :: i
flag = .true.
do i = 1, res_hist%n_resonances
flag = flag .and. res_hist%resonances(i)%is_on_shell (p, on_shell_limit)
end do
end function resonance_history_is_on_shell
@ %def resonance_history_is_on_shell
@
\subsection{OMega restriction strings}
One application of the resonance module is creating restriction
strings that can be fed into process definitions with the OMega
generator. Since OMega counts the incoming particles first, we have
to supply [[n_in]] as an offset.
<<Resonances: resonance info: TBP>>=
procedure :: as_omega_string => resonance_info_as_omega_string
<<Resonances: resonance history: TBP>>=
procedure :: as_omega_string => resonance_history_as_omega_string
<<Resonances: sub interfaces>>=
module function resonance_info_as_omega_string &
(res_info, n_in) result (string)
class(resonance_info_t), intent(in) :: res_info
integer, intent(in) :: n_in
type(string_t) :: string
end function resonance_info_as_omega_string
module function resonance_history_as_omega_string &
(res_hist, n_in) result (string)
class(resonance_history_t), intent(in) :: res_hist
integer, intent(in) :: n_in
type(string_t) :: string
end function resonance_history_as_omega_string
<<Resonances: procedures>>=
module function resonance_info_as_omega_string &
(res_info, n_in) result (string)
class(resonance_info_t), intent(in) :: res_info
integer, intent(in) :: n_in
type(string_t) :: string
integer :: i
string = ""
if (allocated (res_info%contributors%c)) then
do i = 1, size (res_info%contributors%c)
if (i > 1) string = string // "+"
string = string // str (res_info%contributors%c(i) + n_in)
end do
string = string // "~" // res_info%flavor%get_name ()
end if
end function resonance_info_as_omega_string
module function resonance_history_as_omega_string &
(res_hist, n_in) result (string)
class(resonance_history_t), intent(in) :: res_hist
integer, intent(in) :: n_in
type(string_t) :: string
integer :: i
string = ""
do i = 1, res_hist%n_resonances
if (i > 1) string = string // " && "
string = string // res_hist%resonances(i)%as_omega_string (n_in)
end do
end function resonance_history_as_omega_string
@ %def resonance_info_as_omega_string
@ %def resonance_history_as_omega_string
@
\subsection{Resonance history as tree}
If we want to organize the resonances and their decay products, it can be
useful to have them explicitly as a tree structure. We implement this in the
traditional event-record form with the resonances sorted by decreasing number
of contributors, and their decay products added as an extra array.
<<Resonances: public>>=
public :: resonance_tree_t
<<Resonances: types>>=
type :: resonance_branch_t
integer :: i = 0
type(flavor_t) :: flv
integer, dimension(:), allocatable :: r_child
integer, dimension(:), allocatable :: o_child
end type resonance_branch_t
type :: resonance_tree_t
private
integer :: n = 0
type(resonance_branch_t), dimension(:), allocatable :: branch
contains
<<Resonances: resonance tree: TBP>>
end type resonance_tree_t
@ %def resonance_branch_t resonance_tree_t
@
<<Resonances: resonance tree: TBP>>=
procedure :: write => resonance_tree_write
<<Resonances: sub interfaces>>=
module subroutine resonance_tree_write (tree, unit, indent)
class(resonance_tree_t), intent(in) :: tree
integer, intent(in), optional :: unit, indent
end subroutine resonance_tree_write
<<Resonances: procedures>>=
module subroutine resonance_tree_write (tree, unit, indent)
class(resonance_tree_t), intent(in) :: tree
integer, intent(in), optional :: unit, indent
integer :: u, b, c
u = given_output_unit (unit)
call write_indent (u, indent)
write (u, "(A)", advance="no") "Resonance tree:"
if (tree%n > 0) then
write (u, *)
do b = 1, tree%n
call write_indent (u, indent)
write (u, "(2x,'r',I0,':',1x)", advance="no") b
associate (branch => tree%branch(b))
call branch%flv%write (u)
write (u, "(1x,'=>')", advance="no")
if (allocated (branch%r_child)) then
do c = 1, size (branch%r_child)
write (u, "(1x,'r',I0)", advance="no") branch%r_child(c)
end do
end if
if (allocated (branch%o_child)) then
do c = 1, size (branch%o_child)
write (u, "(1x,I0)", advance="no") branch%o_child(c)
end do
end if
write (u, *)
end associate
end do
else
write (u, "(1x,A)") "[empty]"
end if
end subroutine resonance_tree_write
@ %def resonance_tree_write
@ Contents.
<<Resonances: resonance tree: TBP>>=
procedure :: get_n_resonances => resonance_tree_get_n_resonances
procedure :: get_flv => resonance_tree_get_flv
<<Resonances: sub interfaces>>=
module function resonance_tree_get_n_resonances (tree) result (n)
class(resonance_tree_t), intent(in) :: tree
integer :: n
end function resonance_tree_get_n_resonances
module function resonance_tree_get_flv (tree, i) result (flv)
class(resonance_tree_t), intent(in) :: tree
integer, intent(in) :: i
type(flavor_t) :: flv
end function resonance_tree_get_flv
<<Resonances: procedures>>=
module function resonance_tree_get_n_resonances (tree) result (n)
class(resonance_tree_t), intent(in) :: tree
integer :: n
n = tree%n
end function resonance_tree_get_n_resonances
module function resonance_tree_get_flv (tree, i) result (flv)
class(resonance_tree_t), intent(in) :: tree
integer, intent(in) :: i
type(flavor_t) :: flv
flv = tree%branch(i)%flv
end function resonance_tree_get_flv
@ %def resonance_tree_get_n_resonances
@ %def resonance_tree_get_flv
@ Return the shifted indices of the resonance children for branch [[i]]. For
a child which is itself a resonance, add [[offset_r]] to the index value. For
the others, add [[offset_o]]. Combine both in a single array.
<<Resonances: resonance tree: TBP>>=
procedure :: get_children => resonance_tree_get_children
<<Resonances: sub interfaces>>=
module function resonance_tree_get_children (tree, i, offset_r, offset_o) &
result (child)
class(resonance_tree_t), intent(in) :: tree
integer, intent(in) :: i, offset_r, offset_o
integer, dimension(:), allocatable :: child
end function resonance_tree_get_children
<<Resonances: procedures>>=
module function resonance_tree_get_children (tree, i, offset_r, offset_o) &
result (child)
class(resonance_tree_t), intent(in) :: tree
integer, intent(in) :: i, offset_r, offset_o
integer, dimension(:), allocatable :: child
integer :: nr, no
associate (branch => tree%branch(i))
nr = size (branch%r_child)
no = size (branch%o_child)
allocate (child (nr + no))
child(1:nr) = branch%r_child + offset_r
child(nr+1:nr+no) = branch%o_child + offset_o
end associate
end function resonance_tree_get_children
@ %def resonance_tree_get_children
@ Transform a resonance history into a resonance tree.
Algorithm:
\begin{enumerate}
\item
Determine a mapping of the resonance array, such that in the new array the
resonances are ordered by decreasing number of contributors.
\item
Copy the flavor entries to the mapped array.
\item
Scan all resonances and, for each one, find a resonance that is its parent.
Since the resonances are ordered, later matches overwrite earlier ones. The
last match is the correct one. Then scan again and, for each resonance,
collect the resonances that have it as parent. This is the set of child
resonances.
\item
Analogously, scan all outgoing particles that appear in any of the
contributors list. Determine their immediate parent as above, and set the
child outgoing parents for the resonances, as above.
\end{enumerate}
<<Resonances: resonance history: TBP>>=
procedure :: to_tree => resonance_history_to_tree
<<Resonances: sub interfaces>>=
module subroutine resonance_history_to_tree (res_hist, tree)
class(resonance_history_t), intent(in) :: res_hist
type(resonance_tree_t), intent(out) :: tree
end subroutine resonance_history_to_tree
<<Resonances: procedures>>=
module subroutine resonance_history_to_tree (res_hist, tree)
class(resonance_history_t), intent(in) :: res_hist
type(resonance_tree_t), intent(out) :: tree
integer :: nr
integer, dimension(:), allocatable :: r_branch, r_source
nr = res_hist%n_resonances
tree%n = nr
allocate (tree%branch (tree%n), r_branch (tree%n), r_source (tree%n))
if (tree%n > 0) then
call find_branch_ordering ()
call set_flavors ()
call set_child_resonances ()
call set_child_outgoing ()
end if
contains
subroutine find_branch_ordering ()
integer, dimension(:), allocatable :: nc_array
integer :: r, ir, nc
allocate (nc_array (tree%n))
nc_array(:) = res_hist%resonances%get_n_contributors ()
ir = 0
do nc = maxval (nc_array), minval (nc_array), -1
do r = 1, nr
if (nc_array(r) == nc) then
ir = ir + 1
r_branch(r) = ir
r_source(ir) = r
end if
end do
end do
end subroutine find_branch_ordering
subroutine set_flavors ()
integer :: r
do r = 1, nr
tree%branch(r_branch(r))%flv = res_hist%resonances(r)%flavor
end do
end subroutine set_flavors
subroutine set_child_resonances ()
integer, dimension(:), allocatable :: r_child, r_parent
integer :: r, ir, pr
allocate (r_parent (nr), source = 0)
SCAN_RES: do r = 1, nr
associate (this_res => res_hist%resonances(r))
SCAN_PARENT: do ir = 1, nr
pr = r_source(ir)
if (pr == r) cycle SCAN_PARENT
if (all (res_hist%resonances(pr)%contains &
(this_res%contributors%c))) then
r_parent (r) = pr
end if
end do SCAN_PARENT
end associate
end do SCAN_RES
allocate (r_child (nr), source = [(r, r = 1, nr)])
do r = 1, nr
ir = r_branch(r)
tree%branch(ir)%r_child = r_branch (pack (r_child, r_parent == r))
end do
end subroutine set_child_resonances
subroutine set_child_outgoing ()
integer, dimension(:), allocatable :: o_child, o_parent
integer :: o_max, r, o, ir
o_max = 0
do r = 1, nr
associate (this_res => res_hist%resonances(r))
o_max = max (o_max, maxval (this_res%contributors%c))
end associate
end do
allocate (o_parent (o_max), source=0)
SCAN_OUT: do o = 1, o_max
SCAN_PARENT: do ir = 1, nr
r = r_source(ir)
associate (this_res => res_hist%resonances(r))
if (this_res%contains (o)) o_parent(o) = r
end associate
end do SCAN_PARENT
end do SCAN_OUT
allocate (o_child (o_max), source = [(o, o = 1, o_max)])
do r = 1, nr
ir = r_branch(r)
tree%branch(ir)%o_child = pack (o_child, o_parent == r)
end do
end subroutine set_child_outgoing
end subroutine resonance_history_to_tree
@ %def resonance_history_to_tree
@
\subsection{Resonance history set}
This is an array of resonance histories. The elements are supposed to
be unique. That is, entering a new element is successful only if the
element does not already exist.
The current implementation uses a straightforward linear search for
comparison. If this should become an issue, we may change the
implementation to a hash table. To keep this freedom, the set should
be an opaque object. In fact, we expect to use it as a transient data
structure. Once the set is complete, we transform it into a
contiguous array.
<<Resonances: public>>=
public :: resonance_history_set_t
<<Resonances: types>>=
type :: index_array_t
integer, dimension(:), allocatable :: i
end type index_array_t
type :: resonance_history_set_t
private
logical :: complete = .false.
integer :: n_filter = 0
type(resonance_history_t), dimension(:), allocatable :: history
type(index_array_t), dimension(:), allocatable :: contains_this
type(resonance_tree_t), dimension(:), allocatable :: tree
integer :: last = 0
contains
<<Resonances: resonance history set: TBP>>
end type resonance_history_set_t
@ %def resonance_history_set_t
@ Display.
The tree-format version of the histories is displayed only upon request.
<<Resonances: resonance history set: TBP>>=
procedure :: write => resonance_history_set_write
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_write &
(res_set, unit, indent, show_trees)
class(resonance_history_set_t), intent(in) :: res_set
integer, intent(in), optional :: unit
integer, intent(in), optional :: indent
logical, intent(in), optional :: show_trees
end subroutine resonance_history_set_write
<<Resonances: procedures>>=
module subroutine resonance_history_set_write &
(res_set, unit, indent, show_trees)
class(resonance_history_set_t), intent(in) :: res_set
integer, intent(in), optional :: unit
integer, intent(in), optional :: indent
logical, intent(in), optional :: show_trees
logical :: s_trees
integer :: u, i, j, ind
u = given_output_unit (unit)
s_trees = .false.; if (present (show_trees)) s_trees = show_trees
ind = 0; if (present (indent)) ind = indent
call write_indent (u, indent)
write (u, "(A)", advance="no") "Resonance history set:"
if (res_set%complete) then
write (u, *)
else
write (u, "(1x,A)") "[incomplete]"
end if
do i = 1, res_set%last
write (u, "(1x,I0,1x)", advance="no") i
call res_set%history(i)%write (u, verbose=.false., indent=indent)
if (allocated (res_set%contains_this)) then
call write_indent (u, indent)
write (u, "(3x,A)", advance="no") "contained in ("
do j = 1, size (res_set%contains_this(i)%i)
if (j>1) write (u, "(',')", advance="no")
write (u, "(I0)", advance="no") res_set%contains_this(i)%i(j)
end do
write (u, "(A)") ")"
end if
if (s_trees .and. allocated (res_set%tree)) then
call res_set%tree(i)%write (u, ind + 1)
end if
end do
end subroutine resonance_history_set_write
@ %def resonance_history_set_write
@ Initialization. The default initial size is 16 elements, to be doubled in
size repeatedly as needed.
<<Resonances: parameters>>=
integer, parameter :: resonance_history_set_initial_size = 16
@ %def resonance_history_set_initial_size = 16
<<Resonances: resonance history set: TBP>>=
procedure :: init => resonance_history_set_init
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_init &
(res_set, n_filter, initial_size)
class(resonance_history_set_t), intent(out) :: res_set
integer, intent(in), optional :: n_filter
integer, intent(in), optional :: initial_size
end subroutine resonance_history_set_init
<<Resonances: procedures>>=
module subroutine resonance_history_set_init &
(res_set, n_filter, initial_size)
class(resonance_history_set_t), intent(out) :: res_set
integer, intent(in), optional :: n_filter
integer, intent(in), optional :: initial_size
if (present (n_filter)) res_set%n_filter = n_filter
if (present (initial_size)) then
allocate (res_set%history (initial_size))
else
allocate (res_set%history (resonance_history_set_initial_size))
end if
end subroutine resonance_history_set_init
@ %def resonance_history_set_init
@ Enter an entry: append to the array if it does not yet exist, expand
as needed. If a [[n_filter]] value has been provided, enter the
resonance only if it fulfils the requirement.
An empty resonance history is entered only if the [[trivial]] flag is set.
<<Resonances: resonance history set: TBP>>=
procedure :: enter => resonance_history_set_enter
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_enter &
(res_set, res_history, trivial)
class(resonance_history_set_t), intent(inout) :: res_set
type(resonance_history_t), intent(in) :: res_history
logical, intent(in), optional :: trivial
end subroutine resonance_history_set_enter
<<Resonances: procedures>>=
module subroutine resonance_history_set_enter &
(res_set, res_history, trivial)
class(resonance_history_set_t), intent(inout) :: res_set
type(resonance_history_t), intent(in) :: res_history
logical, intent(in), optional :: trivial
integer :: i, new
if (res_history%n_resonances == 0) then
if (present (trivial)) then
if (.not. trivial) return
else
return
end if
end if
if (res_set%n_filter > 0) then
if (.not. res_history%only_has_n_contributors (res_set%n_filter)) return
end if
do i = 1, res_set%last
if (res_set%history(i) == res_history) return
end do
new = res_set%last + 1
if (new > size (res_set%history)) call res_set%expand ()
res_set%history(new) = res_history
res_set%last = new
end subroutine resonance_history_set_enter
@ %def resonance_history_set_enter
@ Freeze the resonance history set: determine the array that determines
in which other resonance histories a particular history is contained.
This can only be done once, and once this is done, no further histories can be
entered.
<<Resonances: resonance history set: TBP>>=
procedure :: freeze => resonance_history_set_freeze
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_freeze (res_set)
class(resonance_history_set_t), intent(inout) :: res_set
end subroutine resonance_history_set_freeze
<<Resonances: procedures>>=
module subroutine resonance_history_set_freeze (res_set)
class(resonance_history_set_t), intent(inout) :: res_set
integer :: i, n, c
logical, dimension(:), allocatable :: contains_this
integer, dimension(:), allocatable :: index_array
n = res_set%last
allocate (contains_this (n))
allocate (index_array (n), source = [(i, i=1, n)])
allocate (res_set%contains_this (n))
do i = 1, n
contains_this = resonance_history_contains &
(res_set%history(1:n), res_set%history(i))
c = count (contains_this)
allocate (res_set%contains_this(i)%i (c))
res_set%contains_this(i)%i = pack (index_array, contains_this)
end do
allocate (res_set%tree (n))
do i = 1, n
call res_set%history(i)%to_tree (res_set%tree(i))
end do
res_set%complete = .true.
end subroutine resonance_history_set_freeze
@ %def resonance_history_set_freeze
@ Determine the histories (in form of their indices in the array) that can be
considered on-shell, given a set of momenta and a maximum distance. The
distance from the resonance is measured in multiples of the resonance width.
Note that the momentum array must only contain the outgoing particles.
If a particular history is on-shell, but there is another history which
contains this and also is on-shell, only the latter is retained.
<<Resonances: resonance history set: TBP>>=
procedure :: determine_on_shell_histories &
=> resonance_history_set_determine_on_shell_histories
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_determine_on_shell_histories &
(res_set, p, on_shell_limit, index_array)
class(resonance_history_set_t), intent(in) :: res_set
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: on_shell_limit
integer, dimension(:), allocatable, intent(out) :: index_array
end subroutine resonance_history_set_determine_on_shell_histories
<<Resonances: procedures>>=
module subroutine resonance_history_set_determine_on_shell_histories &
(res_set, p, on_shell_limit, index_array)
class(resonance_history_set_t), intent(in) :: res_set
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: on_shell_limit
integer, dimension(:), allocatable, intent(out) :: index_array
integer :: n, i
integer, dimension(:), allocatable :: i_array
if (res_set%complete) then
n = res_set%last
allocate (i_array (n), source=0)
do i = 1, n
if (res_set%history(i)%is_on_shell (p, on_shell_limit)) i_array(i) = i
end do
do i = 1, n
if (any (i_array(res_set%contains_this(i)%i) /= 0)) then
i_array(i) = 0
end if
end do
allocate (index_array (count (i_array /= 0)))
index_array(:) = pack (i_array, i_array /= 0)
end if
end subroutine resonance_history_set_determine_on_shell_histories
@ %def resonance_history_set_determine_on_shell_histories
@ For the selected history, compute the Gaussian turnoff factor.
The turnoff parameter is [[gw]].
<<Resonances: resonance history set: TBP>>=
procedure :: evaluate_gaussian => resonance_history_set_evaluate_gaussian
<<Resonances: sub interfaces>>=
module function resonance_history_set_evaluate_gaussian &
(res_set, p, gw, i) result (factor)
class(resonance_history_set_t), intent(in) :: res_set
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: gw
integer, intent(in) :: i
real(default) :: factor
end function resonance_history_set_evaluate_gaussian
<<Resonances: procedures>>=
module function resonance_history_set_evaluate_gaussian &
(res_set, p, gw, i) result (factor)
class(resonance_history_set_t), intent(in) :: res_set
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in) :: gw
integer, intent(in) :: i
real(default) :: factor
factor = res_set%history(i)%evaluate_gaussian (p, gw)
end function resonance_history_set_evaluate_gaussian
@ %def resonance_history_set_evaluate_gaussian
@ Return the number of histories. This is zero if there are none, or
if [[freeze]] has not been called yet.
<<Resonances: resonance history set: TBP>>=
procedure :: get_n_history => resonance_history_set_get_n_history
<<Resonances: sub interfaces>>=
module function resonance_history_set_get_n_history (res_set) result (n)
class(resonance_history_set_t), intent(in) :: res_set
integer :: n
end function resonance_history_set_get_n_history
<<Resonances: procedures>>=
module function resonance_history_set_get_n_history (res_set) result (n)
class(resonance_history_set_t), intent(in) :: res_set
integer :: n
if (res_set%complete) then
n = res_set%last
else
n = 0
end if
end function resonance_history_set_get_n_history
@ %def resonance_history_set_get_n_history
@ Return a single history.
<<Resonances: resonance history set: TBP>>=
procedure :: get_history => resonance_history_set_get_history
<<Resonances: sub interfaces>>=
module function resonance_history_set_get_history &
(res_set, i) result (res_history)
class(resonance_history_set_t), intent(in) :: res_set
integer, intent(in) :: i
type(resonance_history_t) :: res_history
end function resonance_history_set_get_history
<<Resonances: procedures>>=
module function resonance_history_set_get_history &
(res_set, i) result (res_history)
class(resonance_history_set_t), intent(in) :: res_set
integer, intent(in) :: i
type(resonance_history_t) :: res_history
if (res_set%complete .and. i <= res_set%last) then
res_history = res_set%history(i)
end if
end function resonance_history_set_get_history
@ %def resonance_history_set_get_history
@ Conversion to a plain array, sized correctly.
<<Resonances: resonance history set: TBP>>=
procedure :: to_array => resonance_history_set_to_array
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_to_array (res_set, res_history)
class(resonance_history_set_t), intent(in) :: res_set
type(resonance_history_t), dimension(:), allocatable, intent(out) :: &
res_history
end subroutine resonance_history_set_to_array
<<Resonances: procedures>>=
module subroutine resonance_history_set_to_array (res_set, res_history)
class(resonance_history_set_t), intent(in) :: res_set
type(resonance_history_t), dimension(:), allocatable, intent(out) :: &
res_history
if (res_set%complete) then
allocate (res_history (res_set%last))
res_history(:) = res_set%history(1:res_set%last)
end if
end subroutine resonance_history_set_to_array
@ %def resonance_history_set_to_array
@ Return a selected history in tree form.
<<Resonances: resonance history set: TBP>>=
procedure :: get_tree => resonance_history_set_get_tree
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_get_tree (res_set, i, res_tree)
class(resonance_history_set_t), intent(in) :: res_set
integer, intent(in) :: i
type(resonance_tree_t), intent(out) :: res_tree
end subroutine resonance_history_set_get_tree
<<Resonances: procedures>>=
module subroutine resonance_history_set_get_tree (res_set, i, res_tree)
class(resonance_history_set_t), intent(in) :: res_set
integer, intent(in) :: i
type(resonance_tree_t), intent(out) :: res_tree
if (res_set%complete) then
res_tree = res_set%tree(i)
end if
end subroutine resonance_history_set_get_tree
@ %def resonance_history_set_to_array
@ Expand: double the size of the array. We do not need this in the API.
<<Resonances: resonance history set: TBP>>=
procedure, private :: expand => resonance_history_set_expand
<<Resonances: sub interfaces>>=
module subroutine resonance_history_set_expand (res_set)
class(resonance_history_set_t), intent(inout) :: res_set
end subroutine resonance_history_set_expand
<<Resonances: procedures>>=
module subroutine resonance_history_set_expand (res_set)
class(resonance_history_set_t), intent(inout) :: res_set
type(resonance_history_t), dimension(:), allocatable :: history_new
integer :: s
s = size (res_set%history)
allocate (history_new (2 * s))
history_new(1:s) = res_set%history(1:s)
call move_alloc (history_new, res_set%history)
end subroutine resonance_history_set_expand
@ %def resonance_history_set_expand
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[resonances_ut.f90]]>>=
<<File header>>
module resonances_ut
use unit_tests
use resonances_uti
<<Standard module head>>
<<Resonances: public test>>
contains
<<Resonances: test driver>>
end module resonances_ut
@ %def resonances_ut
@
<<[[resonances_uti.f90]]>>=
<<File header>>
module resonances_uti
<<Use kinds>>
<<Use strings>>
use format_defs, only: FMF_12
use lorentz, only: vector4_t, vector4_at_rest
use model_data, only: model_data_t
use flavors, only: flavor_t
use resonances, only: resonance_history_t
use resonances
<<Standard module head>>
<<Resonances: test declarations>>
contains
<<Resonances: tests>>
end module resonances_uti
@ %def resonances_ut
@ API: driver for the unit tests below.
<<Resonances: public test>>=
public :: resonances_test
<<Resonances: test driver>>=
subroutine resonances_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Resonances: execute tests>>
end subroutine resonances_test
@ %def resonances_test
@ Basic operations on a resonance history object.
<<Resonances: execute tests>>=
call test (resonances_1, "resonances_1", &
"check resonance history setup", &
u, results)
<<Resonances: test declarations>>=
public :: resonances_1
<<Resonances: tests>>=
subroutine resonances_1 (u)
integer, intent(in) :: u
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(model_data_t), target :: model
write (u, "(A)") "* Test output: resonances_1"
write (u, "(A)") "* Purpose: test resonance history setup"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Empty resonance history"
write (u, "(A)")
call res_history%write (u)
write (u, "(A)")
write (u, "(A)") "* Add resonance"
write (u, "(A)")
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
write (u, "(A)")
write (u, "(A)") "* Add another resonance"
write (u, "(A)")
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
write (u, "(A)")
write (u, "(A)") "* Remove resonance"
write (u, "(A)")
call res_history%remove_resonance (1)
call res_history%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: resonances_1"
end subroutine resonances_1
@ %def resonances_1
@ Basic operations on a resonance history object.
<<Resonances: execute tests>>=
call test (resonances_2, "resonances_2", &
"check O'Mega restriction strings", &
u, results)
<<Resonances: test declarations>>=
public :: resonances_2
<<Resonances: tests>>=
subroutine resonances_2 (u)
integer, intent(in) :: u
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(model_data_t), target :: model
type(string_t) :: restrictions
write (u, "(A)") "* Test output: resonances_2"
write (u, "(A)") "* Purpose: test OMega restrictions strings &
&for resonance history"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Empty resonance history"
write (u, "(A)")
restrictions = res_history%as_omega_string (2)
write (u, "(A,A,A)") "restrictions = '", char (restrictions), "'"
write (u, "(A)")
write (u, "(A)") "* Add resonance"
write (u, "(A)")
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
restrictions = res_history%as_omega_string (2)
write (u, "(A,A,A)") "restrictions = '", char (restrictions), "'"
write (u, "(A)")
write (u, "(A)") "* Add another resonance"
write (u, "(A)")
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
restrictions = res_history%as_omega_string (2)
write (u, "(A,A,A)") "restrictions = '", char (restrictions), "'"
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: resonances_2"
end subroutine resonances_2
@ %def resonances_2
@ Basic operations on a resonance history set.
<<Resonances: execute tests>>=
call test (resonances_3, "resonances_3", &
"check resonance history set", &
u, results)
<<Resonances: test declarations>>=
public :: resonances_3
<<Resonances: tests>>=
subroutine resonances_3 (u)
integer, intent(in) :: u
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(resonance_history_t), dimension(:), allocatable :: res_histories
type(resonance_history_set_t) :: res_set
type(model_data_t), target :: model
integer :: i
write (u, "(A)") "* Test output: resonances_3"
write (u, "(A)") "* Purpose: test resonance history set"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Initialize resonance history set"
write (u, "(A)")
call res_set%init (initial_size = 2)
write (u, "(A)") "* Add resonance histories, one at a time"
write (u, "(A)")
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_info%init (7, 25, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
call res_set%freeze ()
write (u, "(A)")
write (u, "(A)") "* Result"
write (u, "(A)")
call res_set%write (u)
write (u, "(A)")
write (u, "(A)") "* Queries"
write (u, "(A)")
write (u, "(A,1x,I0)") "n_history =", res_set%get_n_history ()
write (u, "(A)")
write (u, "(A)") "History #2:"
res_history = res_set%get_history (2)
call res_history%write (u, indent=1)
call res_history%clear ()
write (u, "(A)")
write (u, "(A)") "* Result in array form"
call res_set%to_array (res_histories)
do i = 1, size (res_histories)
write (u, *)
call res_histories(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Re-initialize resonance history set with filter n=2"
write (u, "(A)")
call res_set%init (n_filter = 2)
write (u, "(A)") "* Add resonance histories, one at a time"
write (u, "(A)")
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
write (u, *)
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
call res_set%enter (res_history)
call res_history%clear ()
call res_set%freeze ()
write (u, "(A)")
write (u, "(A)") "* Result"
write (u, "(A)")
call res_set%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: resonances_3"
end subroutine resonances_3
@ %def resonances_3
@ Probe momenta for resonance histories
<<Resonances: execute tests>>=
call test (resonances_4, "resonances_4", &
"resonance history: distance evaluation", &
u, results)
<<Resonances: test declarations>>=
public :: resonances_4
<<Resonances: tests>>=
subroutine resonances_4 (u)
integer, intent(in) :: u
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(model_data_t), target :: model
type(flavor_t) :: fw, fz
real(default) :: mw, mz, ww, wz
type(vector4_t), dimension(3) :: p
real(default), dimension(2) :: dist
real(default) :: gw, factor
integer :: i
write (u, "(A)") "* Test output: resonances_4"
write (u, "(A)") "* Purpose: test resonance history evaluation"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* W and Z parameters"
write (u, "(A)")
call fw%init (24, model)
call fz%init (23, model)
mw = fw%get_mass ()
ww = fw%get_width ()
mz = fz%get_mass ()
wz = fz%get_width ()
write (u, "(A,1x," // FMF_12 // ")") "mW =", mw
write (u, "(A,1x," // FMF_12 // ")") "wW =", ww
write (u, "(A,1x," // FMF_12 // ")") "mZ =", mz
write (u, "(A,1x," // FMF_12 // ")") "wZ =", wz
write (u, "(A)")
write (u, "(A)") "* Gaussian width parameter"
write (u, "(A)")
gw = 2
write (u, "(A,1x," // FMF_12 // ")") "gw =", gw
write (u, "(A)")
write (u, "(A)") "* Setup resonance histories"
write (u, "(A)")
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
write (u, "(A)")
write (u, "(A)") "* Setup zero momenta"
write (u, "(A)")
do i = 1, 3
call p(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Evaluate distances from resonances"
write (u, "(A)")
call res_history%evaluate_distances (p, dist)
write (u, "(A,1x," // FMF_12 // ")") "distance (W) =", dist(1)
write (u, "(A,1x," // FMF_12 // ")") "m/w (W) =", mw / ww
write (u, "(A,1x," // FMF_12 // ")") "distance (Z) =", dist(2)
write (u, "(A,1x," // FMF_12 // ")") "m/w (Z) =", mz / wz
write (u, "(A)")
write (u, "(A)") "* Evaluate Gaussian turnoff factor"
write (u, "(A)")
factor = res_history%evaluate_gaussian (p, gw)
write (u, "(A,1x," // FMF_12 // ")") "gaussian fac =", factor
write (u, "(A)")
write (u, "(A)") "* Set momenta on W peak"
write (u, "(A)")
p(1) = vector4_at_rest (mw/2)
p(2) = vector4_at_rest (mw/2)
do i = 1, 3
call p(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Evaluate distances from resonances"
write (u, "(A)")
call res_history%evaluate_distances (p, dist)
write (u, "(A,1x," // FMF_12 // ")") "distance (W) =", dist(1)
write (u, "(A,1x," // FMF_12 // ")") "distance (Z) =", dist(2)
write (u, "(A,1x," // FMF_12 // ")") "expected =", &
abs (mz**2 - mw**2) / (mz*wz)
write (u, "(A)")
write (u, "(A)") "* Evaluate Gaussian turnoff factor"
write (u, "(A)")
factor = res_history%evaluate_gaussian (p, gw)
write (u, "(A,1x," // FMF_12 // ")") "gaussian fac =", factor
write (u, "(A,1x," // FMF_12 // ")") "expected =", &
exp (- (abs (mz**2 - mw**2) / (mz*wz))**2 / (gw * wz)**2)
write (u, "(A)")
write (u, "(A)") "* Set momenta on both peaks"
write (u, "(A)")
p(3) = vector4_at_rest (mz - mw)
do i = 1, 3
call p(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Evaluate distances from resonances"
write (u, "(A)")
call res_history%evaluate_distances (p, dist)
write (u, "(A,1x," // FMF_12 // ")") "distance (W) =", dist(1)
write (u, "(A,1x," // FMF_12 // ")") "distance (Z) =", dist(2)
write (u, "(A)")
write (u, "(A)") "* Evaluate Gaussian turnoff factor"
write (u, "(A)")
factor = res_history%evaluate_gaussian (p, gw)
write (u, "(A,1x," // FMF_12 // ")") "gaussian fac =", factor
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: resonances_4"
end subroutine resonances_4
@ %def resonances_4
@ Probe on-shell test for resonance histories
<<Resonances: execute tests>>=
call test (resonances_5, "resonances_5", &
"resonance history: on-shell test", &
u, results)
<<Resonances: test declarations>>=
public :: resonances_5
<<Resonances: tests>>=
subroutine resonances_5 (u)
integer, intent(in) :: u
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(resonance_history_set_t) :: res_set
type(model_data_t), target :: model
type(flavor_t) :: fw, fz
real(default) :: mw, mz, ww, wz
real(default) :: on_shell_limit
integer, dimension(:), allocatable :: on_shell
type(vector4_t), dimension(4) :: p
write (u, "(A)") "* Test output: resonances_5"
write (u, "(A)") "* Purpose: resonance history on-shell test"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* W and Z parameters"
write (u, "(A)")
call fw%init (24, model)
call fz%init (23, model)
mw = fw%get_mass ()
ww = fw%get_width ()
mz = fz%get_mass ()
wz = fz%get_width ()
write (u, "(A,1x," // FMF_12 // ")") "mW =", mw
write (u, "(A,1x," // FMF_12 // ")") "wW =", ww
write (u, "(A,1x," // FMF_12 // ")") "mZ =", mz
write (u, "(A,1x," // FMF_12 // ")") "wZ =", wz
write (u, "(A)")
write (u, "(A)") "* On-shell parameter: distance as multiple of width"
write (u, "(A)")
on_shell_limit = 3
write (u, "(A,1x," // FMF_12 // ")") "on-shell limit =", on_shell_limit
write (u, "(A)")
write (u, "(A)") "* Setup resonance history set"
write (u, "(A)")
call res_set%init ()
call res_info%init (3, -24, model, 6)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_info%init (12, 24, model, 6)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_info%init (15, 23, model, 6)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_info%init (3, -24, model, 6)
call res_history%add_resonance (res_info)
call res_info%init (15, 23, model, 6)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_info%init (12, 24, model, 6)
call res_history%add_resonance (res_info)
call res_info%init (15, 23, model, 6)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_set%freeze ()
call res_set%write (u)
write (u, "(A)")
write (u, "(A)") "* Setup zero momenta"
write (u, "(A)")
call write_momenta (p)
call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
call write_on_shell_histories (on_shell)
write (u, "(A)")
write (u, "(A)") "* Setup momenta near W- resonance (2 widths off)"
write (u, "(A)")
p(1) = vector4_at_rest (82.5_default)
call write_momenta (p)
call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
call write_on_shell_histories (on_shell)
write (u, "(A)")
write (u, "(A)") "* Setup momenta near W- resonance (4 widths off)"
write (u, "(A)")
p(1) = vector4_at_rest (84.5_default)
call write_momenta (p)
call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
call write_on_shell_histories (on_shell)
write (u, "(A)")
write (u, "(A)") "* Setup momenta near Z resonance"
write (u, "(A)")
p(1) = vector4_at_rest (45._default)
p(3) = vector4_at_rest (45._default)
call write_momenta (p)
call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
call write_on_shell_histories (on_shell)
write (u, "(A)")
write (u, "(A)") "* Setup momenta near W- and W+ resonances"
write (u, "(A)")
p(1) = vector4_at_rest (40._default)
p(2) = vector4_at_rest (40._default)
p(3) = vector4_at_rest (40._default)
p(4) = vector4_at_rest (40._default)
call write_momenta (p)
call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
call write_on_shell_histories (on_shell)
write (u, "(A)")
write (u, "(A)") "* Setup momenta near W- and Z resonances, &
&shadowing single resonances"
write (u, "(A)")
p(1) = vector4_at_rest (40._default)
p(2) = vector4_at_rest (40._default)
p(3) = vector4_at_rest (10._default)
p(4) = vector4_at_rest ( 0._default)
call write_momenta (p)
call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
call write_on_shell_histories (on_shell)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: resonances_5"
contains
subroutine write_momenta (p)
type(vector4_t), dimension(:), intent(in) :: p
integer :: i
do i = 1, size (p)
call p(i)%write (u)
end do
end subroutine write_momenta
subroutine write_on_shell_histories (on_shell)
integer, dimension(:), intent(in) :: on_shell
integer :: i
write (u, *)
write (u, "(A)", advance="no") "on-shell = ("
do i = 1, size (on_shell)
if (i > 1) write (u, "(',')", advance="no")
write (u, "(I0)", advance="no") on_shell(i)
end do
write (u, "(')')")
end subroutine write_on_shell_histories
end subroutine resonances_5
@ %def resonances_5
@ Organize the resonance history as a tree structure.
<<Resonances: execute tests>>=
call test (resonances_6, "resonances_6", &
"check resonance history setup", &
u, results)
<<Resonances: test declarations>>=
public :: resonances_6
<<Resonances: tests>>=
subroutine resonances_6 (u)
integer, intent(in) :: u
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(resonance_tree_t) :: res_tree
type(model_data_t), target :: model
write (u, "(A)") "* Test output: resonances_6"
write (u, "(A)") "* Purpose: retrieve resonance histories as trees"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Empty resonance history"
write (u, "(A)")
call res_history%write (u)
write (u, "(A)")
call res_history%to_tree (res_tree)
call res_tree%write (u)
write (u, "(A)")
write (u, "(A)") "* Single resonance"
write (u, "(A)")
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
write (u, "(A)")
call res_history%to_tree (res_tree)
call res_tree%write (u)
write (u, "(A)")
write (u, "(A)") "* Nested resonances"
write (u, "(A)")
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
write (u, "(A)")
call res_history%to_tree (res_tree)
call res_tree%write (u)
write (u, "(A)")
write (u, "(A)") "* Disjunct resonances"
write (u, "(A)")
call res_history%clear ()
call res_info%init (5, 24, model, 7)
call res_history%add_resonance (res_info)
call res_info%init (7, 6, model, 7)
call res_history%add_resonance (res_info)
call res_info%init (80, -24, model, 7)
call res_history%add_resonance (res_info)
call res_info%init (112, -6, model, 7)
call res_history%add_resonance (res_info)
call res_history%write (u)
write (u, "(A)")
call res_history%to_tree (res_tree)
call res_tree%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: resonances_6"
end subroutine resonances_6
@ %def resonances_6
@ Basic operations on a resonance history set.
<<Resonances: execute tests>>=
call test (resonances_7, "resonances_7", &
"display tree format of history set elements", &
u, results)
<<Resonances: test declarations>>=
public :: resonances_7
<<Resonances: tests>>=
subroutine resonances_7 (u)
integer, intent(in) :: u
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(resonance_tree_t) :: res_tree
type(resonance_history_set_t) :: res_set
type(model_data_t), target :: model
type(flavor_t) :: flv
write (u, "(A)") "* Test output: resonances_7"
write (u, "(A)") "* Purpose: test tree format"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Initialize, fill and freeze resonance history set"
write (u, "(A)")
call res_set%init (initial_size = 2)
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_history%clear ()
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_info%init (7, 23, model, 5)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_info%init (3, -24, model, 5)
call res_history%add_resonance (res_info)
call res_info%init (7, 25, model, 5)
call res_history%add_resonance (res_info)
call res_set%enter (res_history)
call res_history%clear ()
call res_set%freeze ()
call res_set%write (u, show_trees = .true.)
write (u, "(A)")
write (u, "(A)") "* Extract tree #1"
write (u, "(A)")
call res_set%get_tree (1, res_tree)
call res_tree%write (u)
write (u, *)
write (u, "(1x,A,1x,I0)") "n_resonances =", res_tree%get_n_resonances ()
write (u, *)
write (u, "(1x,A,1x)", advance="no") "flv(r1) ="
flv = res_tree%get_flv (1)
call flv%write (u)
write (u, *)
write (u, "(1x,A,1x)", advance="no") "flv(r2) ="
flv = res_tree%get_flv (2)
call flv%write (u)
write (u, *)
write (u, *)
write (u, "(1x,A)") "[offset = 2, 4]"
write (u, "(1x,A,9(1x,I0))") "children(r1) =", &
res_tree%get_children(1, 2, 4)
write (u, "(1x,A,9(1x,I0))") "children(r2) =", &
res_tree%get_children(2, 2, 4)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: resonances_7"
end subroutine resonances_7
@ %def resonances_7
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\clearpage
\section{Mappings}
Mappings are objects that encode the transformation of the interval
$(0,1)$ to a physical variable $m^2$ or $\cos\theta$ (and back), as it
is used in the phase space parameterization. The mapping objects
contain fixed parameters, the associated methods implement the mapping
and inverse mapping operations, including the computation of the
Jacobian (phase space factor).
<<[[mappings.f90]]>>=
<<File header>>
module mappings
<<Use kinds>>
use kinds, only: TC
<<Use strings>>
use model_data
use flavors
<<Standard module head>>
<<Mappings: public>>
<<Mappings: parameters>>
<<Mappings: types>>
<<Mappings: interfaces>>
interface
<<Mappings: sub interfaces>>
end interface
end module mappings
@ %def mappings
@
<<[[mappings_sub.f90]]>>=
<<File header>>
submodule (mappings) mappings_s
use io_units
use constants, only: pi
use format_defs, only: FMT_19
use diagnostics
use md5
implicit none
contains
<<Mappings: procedures>>
end submodule mappings_s
@ %def mappings_s
@
\subsection{Default parameters}
This type holds the default parameters, needed for setting the scale
in cases where no mass parameter is available. The contents are public.
<<Mappings: public>>=
public :: mapping_defaults_t
<<Mappings: types>>=
type :: mapping_defaults_t
real(default) :: energy_scale = 10
real(default) :: invariant_mass_scale = 10
real(default) :: momentum_transfer_scale = 10
logical :: step_mapping = .true.
logical :: step_mapping_exp = .true.
logical :: enable_s_mapping = .false.
contains
<<Mappings: mapping defaults: TBP>>
end type mapping_defaults_t
@ %def mapping_defaults_t
@ Output.
<<Mappings: mapping defaults: TBP>>=
procedure :: write => mapping_defaults_write
<<Mappings: sub interfaces>>=
module subroutine mapping_defaults_write (object, unit)
class(mapping_defaults_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine mapping_defaults_write
<<Mappings: procedures>>=
module subroutine mapping_defaults_write (object, unit)
class(mapping_defaults_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A," // FMT_19 // ")") "energy scale = ", &
object%energy_scale
write (u, "(3x,A," // FMT_19 // ")") "mass scale = ", &
object%invariant_mass_scale
write (u, "(3x,A," // FMT_19 // ")") "q scale = ", &
object%momentum_transfer_scale
write (u, "(3x,A,L1)") "step mapping = ", &
object%step_mapping
write (u, "(3x,A,L1)") "step exp. mode = ", &
object%step_mapping_exp
write (u, "(3x,A,L1)") "allow s mapping = ", &
object%enable_s_mapping
end subroutine mapping_defaults_write
@ %def mapping_defaults_write
@
<<Mappings: public>>=
public :: mapping_defaults_md5sum
<<Mappings: sub interfaces>>=
module function mapping_defaults_md5sum &
(mapping_defaults) result (md5sum_map)
character(32) :: md5sum_map
type(mapping_defaults_t), intent(in) :: mapping_defaults
end function mapping_defaults_md5sum
<<Mappings: procedures>>=
module function mapping_defaults_md5sum &
(mapping_defaults) result (md5sum_map)
character(32) :: md5sum_map
type(mapping_defaults_t), intent(in) :: mapping_defaults
integer :: u
u = free_unit ()
open (u, status = "scratch")
write (u, *) mapping_defaults%energy_scale
write (u, *) mapping_defaults%invariant_mass_scale
write (u, *) mapping_defaults%momentum_transfer_scale
write (u, *) mapping_defaults%step_mapping
write (u, *) mapping_defaults%step_mapping_exp
write (u, *) mapping_defaults%enable_s_mapping
rewind (u)
md5sum_map = md5sum (u)
close (u)
end function mapping_defaults_md5sum
@ %def mapping_defaults_md5sum
@
\subsection{The Mapping type}
Each mapping has a type (e.g., s-channel, infrared), a binary code
(redundant, but useful for debugging), and a reference particle. The
flavor code of this particle is stored for bookkeeping reasons, what
matters are the mass and width of this particle. Furthermore,
depending on the type, various mapping parameters can be set and used.
The parameters [[a1]] to [[a3]] (for $m^2$ mappings) and [[b1]] to
[[b3]] (for $\cos\theta$ mappings) are values that are stored once to
speed up the calculation, if [[variable_limits]] is false. The exact
meaning of these parameters depends on the mapping type. The limits
are fixed if there is a fixed c.m. energy.
<<Mappings: public>>=
public :: mapping_t
<<Mappings: types>>=
type :: mapping_t
private
integer :: type = NO_MAPPING
integer(TC) :: bincode
type(flavor_t) :: flv
real(default) :: mass = 0
real(default) :: width = 0
logical :: a_unknown = .true.
real(default) :: a1 = 0
real(default) :: a2 = 0
real(default) :: a3 = 0
logical :: b_unknown = .true.
real(default) :: b1 = 0
real(default) :: b2 = 0
real(default) :: b3 = 0
logical :: variable_limits = .true.
contains
<<Mappings: mapping: TBP>>
end type mapping_t
@ %def mapping_t
@ The valid mapping types. The extra type [[STEP_MAPPING]] is used
only internally.
<<Mappings: parameters>>=
<<Mapping modes>>
@
\subsection{Screen output}
Do not write empty mappings.
<<Mappings: mapping: TBP>>=
procedure :: write => mapping_write
<<Mappings: sub interfaces>>=
module subroutine mapping_write (map, unit, verbose)
class(mapping_t), intent(in) :: map
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine mapping_write
<<Mappings: procedures>>=
module subroutine mapping_write (map, unit, verbose)
class(mapping_t), intent(in) :: map
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
character(len=9) :: str
u = given_output_unit (unit); if (u < 0) return
select case(map%type)
case(S_CHANNEL); str = "s_channel"
case(COLLINEAR); str = "collinear"
case(INFRARED); str = "infrared "
case(RADIATION); str = "radiation"
case(T_CHANNEL); str = "t_channel"
case(U_CHANNEL); str = "u_channel"
case(STEP_MAPPING_E); str = "step_exp"
case(STEP_MAPPING_H); str = "step_hyp"
case(ON_SHELL); str = "on_shell"
case default; str = "????????"
end select
if (map%type /= NO_MAPPING) then
write (u, '(1x,A,I4,A)') &
"Branch #", map%bincode, ": " // &
"Mapping (" // str // ") for particle " // &
'"' // char (map%flv%get_name ()) // '"'
if (present (verbose)) then
if (verbose) then
select case (map%type)
case (S_CHANNEL, RADIATION, STEP_MAPPING_E, STEP_MAPPING_H)
write (u, "(1x,A,3(" // FMT_19 // "))") &
" m/w = ", map%mass, map%width
case default
write (u, "(1x,A,3(" // FMT_19 // "))") &
" m = ", map%mass
end select
select case (map%type)
case (S_CHANNEL, T_CHANNEL, U_CHANNEL, &
STEP_MAPPING_E, STEP_MAPPING_H, &
COLLINEAR, INFRARED, RADIATION)
write (u, "(1x,A,3(" // FMT_19 // "))") &
" a1/2/3 = ", map%a1, map%a2, map%a3
end select
select case (map%type)
case (T_CHANNEL, U_CHANNEL, COLLINEAR)
write (u, "(1x,A,3(" // FMT_19 // "))") &
" b1/2/3 = ", map%b1, map%b2, map%b3
end select
end if
end if
end if
end subroutine mapping_write
@ %def mapping_write
@
\subsection{Define a mapping}
The initialization routine sets the mapping type and the particle
(binary code and flavor code) for which the mapping applies (e.g., a
$Z$ resonance in branch \#3).
<<Mappings: mapping: TBP>>=
procedure :: init => mapping_init
<<Mappings: sub interfaces>>=
module subroutine mapping_init (mapping, bincode, type, f, model)
class(mapping_t), intent(inout) :: mapping
integer(TC), intent(in) :: bincode
type(string_t), intent(in) :: type
integer, intent(in), optional :: f
class(model_data_t), intent(in), optional, target :: model
end subroutine mapping_init
<<Mappings: procedures>>=
module subroutine mapping_init (mapping, bincode, type, f, model)
class(mapping_t), intent(inout) :: mapping
integer(TC), intent(in) :: bincode
type(string_t), intent(in) :: type
integer, intent(in), optional :: f
class(model_data_t), intent(in), optional, target :: model
mapping%bincode = bincode
select case (char (type))
case ("s_channel"); mapping%type = S_CHANNEL
case ("collinear"); mapping%type = COLLINEAR
case ("infrared"); mapping%type = INFRARED
case ("radiation"); mapping%type = RADIATION
case ("t_channel"); mapping%type = T_CHANNEL
case ("u_channel"); mapping%type = U_CHANNEL
case ("step_exp"); mapping%type = STEP_MAPPING_E
case ("step_hyp"); mapping%type = STEP_MAPPING_H
case ("on_shell"); mapping%type = ON_SHELL
case default
call msg_bug ("Mappings: encountered undefined mapping key '" &
// char (type) // "'")
end select
if (present (f) .and. present (model)) call mapping%flv%init (f, model)
end subroutine mapping_init
@ %def mapping_init
@ This sets the actual mass and width, using a parameter set. Since
the auxiliary parameters will only be determined when the mapping is
first called, they are marked as unknown.
<<Mappings: mapping: TBP>>=
procedure :: set_parameters => mapping_set_parameters
<<Mappings: sub interfaces>>=
module subroutine mapping_set_parameters &
(map, mapping_defaults, variable_limits)
class(mapping_t), intent(inout) :: map
type(mapping_defaults_t), intent(in) :: mapping_defaults
logical, intent(in) :: variable_limits
end subroutine mapping_set_parameters
<<Mappings: procedures>>=
module subroutine mapping_set_parameters &
(map, mapping_defaults, variable_limits)
class(mapping_t), intent(inout) :: map
type(mapping_defaults_t), intent(in) :: mapping_defaults
logical, intent(in) :: variable_limits
if (map%type /= NO_MAPPING) then
map%mass = map%flv%get_mass ()
map%width = map%flv%get_width ()
map%variable_limits = variable_limits
map%a_unknown = .true.
map%b_unknown = .true.
select case (map%type)
case (S_CHANNEL)
if (map%mass <= 0) then
call map%write ()
call msg_fatal &
& (" S-channel resonance must have positive mass")
else if (map%width <= 0) then
call map%write ()
call msg_fatal &
& (" S-channel resonance must have positive width")
end if
case (RADIATION)
map%width = max (map%width, mapping_defaults%energy_scale)
case (INFRARED, COLLINEAR)
map%mass = max (map%mass, mapping_defaults%invariant_mass_scale)
case (T_CHANNEL, U_CHANNEL)
map%mass = max (map%mass, mapping_defaults%momentum_transfer_scale)
end select
end if
end subroutine mapping_set_parameters
@ %def mapping_set_code mapping_set_parameters
@ For a step mapping the mass and width are set directly, instead of
being determined from the flavor parameter (which is meaningless
here). They correspond to the effective upper bound of phase space
due to a resonance, as opposed to the absolute upper bound.
<<Mappings: mapping: TBP>>=
procedure :: set_step_mapping_parameters => &
mapping_set_step_mapping_parameters
<<Mappings: sub interfaces>>=
module subroutine mapping_set_step_mapping_parameters (map, &
mass, width, variable_limits)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: mass, width
logical, intent(in) :: variable_limits
end subroutine mapping_set_step_mapping_parameters
<<Mappings: procedures>>=
module subroutine mapping_set_step_mapping_parameters (map, &
mass, width, variable_limits)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: mass, width
logical, intent(in) :: variable_limits
select case (map%type)
case (STEP_MAPPING_E, STEP_MAPPING_H)
map%variable_limits = variable_limits
map%a_unknown = .true.
map%b_unknown = .true.
map%mass = mass
map%width = width
end select
end subroutine mapping_set_step_mapping_parameters
@ %def mapping_set_step_mapping_parameters
@
\subsection{Retrieve contents}
Return true if there is any / an s-channel mapping.
<<Mappings: mapping: TBP>>=
procedure :: is_set => mapping_is_set
procedure :: is_s_channel => mapping_is_s_channel
procedure :: is_on_shell => mapping_is_on_shell
<<Mappings: sub interfaces>>=
module function mapping_is_set (mapping) result (flag)
class(mapping_t), intent(in) :: mapping
logical :: flag
end function mapping_is_set
module function mapping_is_s_channel (mapping) result (flag)
class(mapping_t), intent(in) :: mapping
logical :: flag
end function mapping_is_s_channel
module function mapping_is_on_shell (mapping) result (flag)
class(mapping_t), intent(in) :: mapping
logical :: flag
end function mapping_is_on_shell
<<Mappings: procedures>>=
module function mapping_is_set (mapping) result (flag)
class(mapping_t), intent(in) :: mapping
logical :: flag
flag = mapping%type /= NO_MAPPING
end function mapping_is_set
module function mapping_is_s_channel (mapping) result (flag)
class(mapping_t), intent(in) :: mapping
logical :: flag
flag = mapping%type == S_CHANNEL
end function mapping_is_s_channel
module function mapping_is_on_shell (mapping) result (flag)
class(mapping_t), intent(in) :: mapping
logical :: flag
flag = mapping%type == ON_SHELL
end function mapping_is_on_shell
@ %def mapping_is_set
@ %def mapping_is_s_channel
@ %def mapping_is_on_shell
@ Return the binary code for the mapped particle.
<<Mappings: mapping: TBP>>=
procedure :: get_bincode => mapping_get_bincode
<<Mappings: sub interfaces>>=
module function mapping_get_bincode (mapping) result (bincode)
class(mapping_t), intent(in) :: mapping
integer(TC) :: bincode
end function mapping_get_bincode
<<Mappings: procedures>>=
module function mapping_get_bincode (mapping) result (bincode)
class(mapping_t), intent(in) :: mapping
integer(TC) :: bincode
bincode = mapping%bincode
end function mapping_get_bincode
@ %def mapping_get_bincode
@ Return the flavor object for the mapped particle.
<<Mappings: mapping: TBP>>=
procedure :: get_flv => mapping_get_flv
<<Mappings: sub interfaces>>=
module function mapping_get_flv (mapping) result (flv)
class(mapping_t), intent(in) :: mapping
type(flavor_t) :: flv
end function mapping_get_flv
<<Mappings: procedures>>=
module function mapping_get_flv (mapping) result (flv)
class(mapping_t), intent(in) :: mapping
type(flavor_t) :: flv
flv = mapping%flv
end function mapping_get_flv
@ %def mapping_get_flv
@ Return stored mass and width, respectively.
<<Mappings: mapping: TBP>>=
procedure :: get_mass => mapping_get_mass
procedure :: get_width => mapping_get_width
<<Mappings: sub interfaces>>=
module function mapping_get_mass (mapping) result (mass)
class(mapping_t), intent(in) :: mapping
real(default) :: mass
end function mapping_get_mass
module function mapping_get_width (mapping) result (width)
class(mapping_t), intent(in) :: mapping
real(default) :: width
end function mapping_get_width
<<Mappings: procedures>>=
module function mapping_get_mass (mapping) result (mass)
class(mapping_t), intent(in) :: mapping
real(default) :: mass
mass = mapping%mass
end function mapping_get_mass
module function mapping_get_width (mapping) result (width)
class(mapping_t), intent(in) :: mapping
real(default) :: width
width = mapping%width
end function mapping_get_width
@ %def mapping_get_mass
@ %def mapping_get_width
@
\subsection{Compare mappings}
Equality for single mappings and arrays
<<Mappings: public>>=
public :: operator(==)
<<Mappings: interfaces>>=
interface operator(==)
module procedure mapping_equal
end interface
<<Mappings: sub interfaces>>=
module function mapping_equal (m1, m2) result (equal)
type(mapping_t), intent(in) :: m1, m2
logical :: equal
end function mapping_equal
<<Mappings: procedures>>=
module function mapping_equal (m1, m2) result (equal)
type(mapping_t), intent(in) :: m1, m2
logical :: equal
if (m1%type == m2%type) then
select case (m1%type)
case (NO_MAPPING)
equal = .true.
case (S_CHANNEL, RADIATION, STEP_MAPPING_E, STEP_MAPPING_H)
equal = (m1%mass == m2%mass) .and. (m1%width == m2%width)
case default
equal = (m1%mass == m2%mass)
end select
else
equal = .false.
end if
end function mapping_equal
@ %def mapping_equal
@
\subsection{Mappings of the invariant mass}
Inserting an $x$ value between 0 and 1, we want to compute the
corresponding invariant mass $m^2(x)$ and the jacobian, aka phase
space factor $f(x)$. We also need the reverse operation.
In general, the phase space factor $f$ is defined by
\begin{equation}
\frac{1}{s}\int_{m^2_{\textrm{min}}}^{m^2_{\textrm{max}}} dm^2\,g(m^2)
= \int_0^1 dx\,\frac{1}{s}\,\frac{dm^2}{dx}\,g(m^2(x))
= \int_0^1 dx\,f(x)\,g(x),
\end{equation}
where thus
\begin{equation}
f(x) = \frac{1}{s}\,\frac{dm^2}{dx}.
\end{equation}
With this mapping, a function of the form
\begin{equation}
g(m^2) = c\frac{dx(m^2)}{dm^2}
\end{equation}
is mapped to a constant:
\begin{equation}
\frac{1}{s}\int_{m^2_{\textrm{min}}}^{m^2_{\textrm{max}}} dm^2\,g(m^2)
= \int_0^1 dx\,f(x)\,g(m^2(x)) = \int_0^1 dx\,\frac{c}{s}.
\end{equation}
Here is the mapping routine. Input are the available energy
squared [[s]], the limits for $m^2$, and the $x$ value. Output are
the $m^2$ value and the phase space factor $f$.
<<Mappings: mapping: TBP>>=
procedure :: compute_msq_from_x => mapping_compute_msq_from_x
<<Mappings: sub interfaces>>=
module subroutine mapping_compute_msq_from_x &
(map, s, msq_min, msq_max, msq, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s, msq_min, msq_max
real(default), intent(out) :: msq, f
real(default), intent(in) :: x
end subroutine mapping_compute_msq_from_x
<<Mappings: procedures>>=
module subroutine mapping_compute_msq_from_x &
(map, s, msq_min, msq_max, msq, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s, msq_min, msq_max
real(default), intent(out) :: msq, f
real(default), intent(in) :: x
real(default) :: z, msq0, msq1, tmp
integer :: type
type = map%type
if (s == 0) &
call msg_fatal (" Applying msq mapping for zero energy")
<<Modify mapping type if necessary>>
select case(type)
case (NO_MAPPING)
<<Constants for trivial msq mapping>>
<<Apply trivial msq mapping>>
case (S_CHANNEL)
<<Constants for s-channel resonance mapping>>
<<Apply s-channel resonance mapping>>
case (COLLINEAR, INFRARED, RADIATION)
<<Constants for s-channel pole mapping>>
<<Apply s-channel pole mapping>>
case (T_CHANNEL, U_CHANNEL)
<<Constants for t-channel pole mapping>>
<<Apply t-channel pole mapping>>
case (STEP_MAPPING_E)
<<Constants for exponential step mapping>>
<<Apply exponential step mapping>>
case (STEP_MAPPING_H)
<<Constants for hyperbolic step mapping>>
<<Apply hyperbolic step mapping>>
case default
call msg_fatal ( " Attempt to apply undefined msq mapping")
end select
end subroutine mapping_compute_msq_from_x
@ %def mapping_compute_msq_from_x
@ The inverse mapping
<<Mappings: mapping: TBP>>=
procedure :: compute_x_from_msq => mapping_compute_x_from_msq
<<Mappings: sub interfaces>>=
module subroutine mapping_compute_x_from_msq &
(map, s, msq_min, msq_max, msq, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s, msq_min, msq_max
real(default), intent(in) :: msq
real(default), intent(out) :: f, x
end subroutine mapping_compute_x_from_msq
<<Mappings: procedures>>=
module subroutine mapping_compute_x_from_msq &
(map, s, msq_min, msq_max, msq, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s, msq_min, msq_max
real(default), intent(in) :: msq
real(default), intent(out) :: f, x
real(default) :: msq0, msq1, tmp, z
integer :: type
type = map%type
if (s == 0) &
call msg_fatal (" Applying inverse msq mapping for zero energy")
<<Modify mapping type if necessary>>
select case (type)
case (NO_MAPPING)
<<Constants for trivial msq mapping>>
<<Apply inverse trivial msq mapping>>
case (S_CHANNEL)
<<Constants for s-channel resonance mapping>>
<<Apply inverse s-channel resonance mapping>>
case (COLLINEAR, INFRARED, RADIATION)
<<Constants for s-channel pole mapping>>
<<Apply inverse s-channel pole mapping>>
case (T_CHANNEL, U_CHANNEL)
<<Constants for t-channel pole mapping>>
<<Apply inverse t-channel pole mapping>>
case (STEP_MAPPING_E)
<<Constants for exponential step mapping>>
<<Apply inverse exponential step mapping>>
case (STEP_MAPPING_H)
<<Constants for hyperbolic step mapping>>
<<Apply inverse hyperbolic step mapping>>
case default
call msg_fatal ( " Attempt to apply undefined msq mapping")
end select
end subroutine mapping_compute_x_from_msq
@ %def mapping_compute_x_from_msq
@
\subsubsection{Trivial mapping}
We simply map the boundaries of the interval $(m_{\textrm{min}},
m_{\textrm{max}})$ to $(0,1)$:
\begin{equation}
m^2 = (1-x) m_{\textrm{min}}^2 + x m_{\textrm{max}}^2;
\end{equation}
the inverse is
\begin{equation}
x = \frac{m^2 - m_{\textrm{min}}^2}{m_{\textrm{max}}^2- m_{\textrm{min}}^2}.
\end{equation}
Hence
\begin{equation}
f(x) = \frac{m_{\textrm{max}}^2 - m_{\textrm{min}}^2}{s},
\end{equation}
and we have, as required,
\begin{equation}
f(x)\,\frac{dx}{dm^2} = \frac{1}{s}.
\end{equation}
We store the constant parameters the first time the mapping is called
-- or, if limits vary, recompute them each time.
<<Constants for trivial msq mapping>>=
if (map%variable_limits .or. map%a_unknown) then
map%a1 = 0
map%a2 = msq_max - msq_min
map%a3 = map%a2 / s
map%a_unknown = .false.
end if
<<Apply trivial msq mapping>>=
msq = (1-x) * msq_min + x * msq_max
f = map%a3
<<Apply inverse trivial msq mapping>>=
if (map%a2 /= 0) then
x = (msq - msq_min) / map%a2
else
x = 0
end if
f = map%a3
@ Resonance or step mapping does not make much sense if the resonance mass is
outside the kinematical bounds. If this is the case, revert to
[[NO_MAPPING]]. This is possible even if the kinematical bounds vary
from event to event.
<<Modify mapping type if necessary>>=
select case (type)
case (S_CHANNEL, STEP_MAPPING_E, STEP_MAPPING_H)
msq0 = map%mass**2
if (msq0 < msq_min .or. msq0 > msq_max) type = NO_MAPPING
end select
@
\subsubsection{Breit-Wigner mapping}
A Breit-Wigner resonance with mass $M$ and width $\Gamma$ is flattened
by the following mapping:
This mapping does not make much sense if the resonance mass is too low.
If this is the case, revert to [[NO_MAPPING]]. There is a tricky
point with this if the mass is too high: [[msq_max]] is not a
constant if structure functions are around. However, switching the
type depending on the overall energy does not change the integral, it
is just another branching point.
\begin{equation}
m^2 = M(M+t\Gamma),
\end{equation}
where
\begin{equation}
t = \tan\left[(1-x)\arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}
+ x \arctan\frac{m^2_{\textrm{max}} - M^2}{M\Gamma}\right].
\end{equation}
The inverse:
\begin{equation}
x = \frac{ \arctan\frac{m^2 - M^2}{M\Gamma}
- \arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}}
{ \arctan\frac{m^2_{\textrm{max}} - M^2}{M\Gamma}
- \arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}}
\end{equation}
The phase-space factor of this transformation is
\begin{equation}
f(x) = \frac{M\Gamma}{s}\left(
\arctan\frac{m^2_{\textrm{max}} - M^2}{M\Gamma}
- \arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}\right)
(1 + t^2).
\end{equation}
This maps any function proportional to
\begin{equation}
g(m^2) = \frac{M\Gamma}{(m^2-M^2)^2 + M^2\Gamma^2}
\end{equation}
to a constant times $1/s$.
<<Constants for s-channel resonance mapping>>=
if (map%variable_limits .or. map%a_unknown) then
msq0 = map%mass ** 2
map%a1 = atan ((msq_min - msq0) / (map%mass * map%width))
map%a2 = atan ((msq_max - msq0) / (map%mass * map%width))
map%a3 = (map%a2 - map%a1) * (map%mass * map%width) / s
map%a_unknown = .false.
end if
<<Apply s-channel resonance mapping>>=
z = (1-x) * map%a1 + x * map%a2
if (-pi/2 < z .and. z < pi/2) then
tmp = tan (z)
msq = map%mass * (map%mass + map%width * tmp)
f = map%a3 * (1 + tmp**2)
else
msq = 0
f = 0
end if
<<Apply inverse s-channel resonance mapping>>=
tmp = (msq - msq0) / (map%mass * map%width)
x = (atan (tmp) - map%a1) / (map%a2 - map%a1)
f = map%a3 * (1 + tmp**2)
@
\subsubsection{Mapping for massless splittings}
This mapping accounts for approximately scale-invariant behavior where
$\ln M^2$ is evenly distributed.
\begin{equation}
m^2 = m_{\textrm{min}}^2 + M^2\left(\exp(xL)-1\right)
\end{equation}
where
\begin{equation}
L = \ln\left(\frac{m_{\textrm{max}}^2 - m_{\textrm{min}}^2}{M^2} + 1\right).
\end{equation}
The inverse:
\begin{equation}
x = \frac1L\ln\left(\frac{m^2-m_{\textrm{min}}^2}{M^2} + 1\right)
\end{equation}
The constant $M$ is a characteristic scale. Above this scale
($m^2-m_{\textrm{min}}^2 \gg M^2$), this mapping behaves like
$x\propto\ln m^2$, while below the scale it reverts to a linear
mapping.
The phase-space factor is
\begin{equation}
f(x) = \frac{M^2}{s}\,\exp(xL)\,L.
\end{equation}
A function proportional to
\begin{equation}
g(m^2) = \frac{1}{(m^2-m_{\textrm{min}}^2) + M^2}
\end{equation}
is mapped to a constant, i.e., a simple pole near $m_{\textrm{min}}$
with a regulator mass $M$.
This type of mapping is useful for massless collinear and infrared
singularities, where the scale is stored as the mass parameter. In
the radiation case (IR radiation off massive particle), the heavy
particle width is the characteristic scale.
<<Constants for s-channel pole mapping>>=
if (map%variable_limits .or. map%a_unknown) then
if (type == RADIATION) then
msq0 = map%width**2
else
msq0 = map%mass**2
end if
map%a1 = msq0
map%a2 = log ((msq_max - msq_min) / msq0 + 1)
map%a3 = map%a2 / s
map%a_unknown = .false.
end if
<<Apply s-channel pole mapping>>=
msq1 = map%a1 * exp (x * map%a2)
msq = msq1 - map%a1 + msq_min
f = map%a3 * msq1
<<Apply inverse s-channel pole mapping>>=
msq1 = msq - msq_min + map%a1
x = log (msq1 / map%a1) / map%a2
f = map%a3 * msq1
@
\subsubsection{Mapping for t-channel poles}
This is also approximately scale-invariant, and we use the same type
of mapping as before. However, we map $1/x$ singularities at both
ends of the interval; again, the mapping becomes linear when the
distance is less than $M^2$:
\begin{equation}
m^2 =
\begin{cases}
m_{\textrm{min}}^2 + M^2\left(\exp(xL)-1\right)
&
\text{for $0 < x < \frac12$}
\\
m_{\textrm{max}}^2 - M^2\left(\exp((1-x)L)-1\right)
&
\text{for $\frac12 \leq x < 1$}
\end{cases}
\end{equation}
where
\begin{equation}
L = 2\ln\left(\frac{m_{\textrm{max}}^2 - m_{\textrm{min}}^2}{2M^2}
+ 1\right).
\end{equation}
The inverse:
\begin{equation}
x =
\begin{cases}
\frac1L\ln\left(\frac{m^2-m_{\textrm{min}}^2}{M^2} + 1\right)
&
\text{for $m^2 < (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
\\
1 - \frac1L\ln\left(\frac{m_{\textrm{max}}-m^2}{M^2} + 1\right)
&
\text{for $m^2 \geq (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
\end{cases}
\end{equation}
The phase-space factor is
\begin{equation}
f(x) =
\begin{cases}
\frac{M^2}{s}\,\exp(xL)\,L.
&
\text{for $0 < x < \frac12$}
\\
\frac{M^2}{s}\,\exp((1-x)L)\,L.
&
\text{for $\frac12 \leq x < 1$}
\end{cases}
\end{equation}
A (continuous) function proportional to
\begin{equation}
g(m^2) =
\begin{cases}
1/(m^2-m_{\textrm{min}}^2) + M^2)
&
\text{for $m^2 < (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
\\
1/((m_{\textrm{max}}^2 - m^2) + M^2)
&
\text{for $m^2 \leq (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
\end{cases}
\end{equation}
is mapped to a constant by this mapping, i.e., poles near both ends of
the interval.
<<Constants for t-channel pole mapping>>=
if (map%variable_limits .or. map%a_unknown) then
msq0 = map%mass**2
map%a1 = msq0
map%a2 = 2 * log ((msq_max - msq_min)/(2*msq0) + 1)
map%a3 = map%a2 / s
map%a_unknown = .false.
end if
<<Apply t-channel pole mapping>>=
if (x < .5_default) then
msq1 = map%a1 * exp (x * map%a2)
msq = msq1 - map%a1 + msq_min
else
msq1 = map%a1 * exp ((1-x) * map%a2)
msq = -(msq1 - map%a1) + msq_max
end if
f = map%a3 * msq1
<<Apply inverse t-channel pole mapping>>=
if (msq < (msq_max + msq_min)/2) then
msq1 = msq - msq_min + map%a1
x = log (msq1/map%a1) / map%a2
else
msq1 = msq_max - msq + map%a1
x = 1 - log (msq1/map%a1) / map%a2
end if
f = map%a3 * msq1
@
\subsection{Step mapping}
Step mapping is useful when the allowed range for a squared-mass
variable is large, but only a fraction at the lower end is populated
because the particle in question is an (off-shell) decay product of a
narrow resonance. I.e., if the resonance was forced to be on-shell,
the upper end of the range would be the resonance mass, minus the
effective (real or resonance) mass of the particle(s) in the sibling
branch of the decay.
The edge of this phase space section has a width which is determined
by the width of the parent, plus the width of the sibling branch. (The
widths might be added in quadrature, but this precision is probably
not important.)
\subsubsection{Fermi function}
A possible mapping is derived from the Fermi function which has
precisely this behavior. The Fermi function is given by
\begin{equation}
f(x) = \frac{1}{1 + \exp\frac{x-\mu}{\gamma}}
\end{equation}
where $x$ is taken as the invariant mass squared, $\mu$ is the
invariant mass squared of the edge, and $\gamma$ is the effective
width which is given by the widths of the parent and the sibling
branch. (Widths might be added in quadrature, but we do not require
this level of precision.)
\begin{align}
x &= \frac{m^2 - m_{\text{min}}^2}{\Delta m^2}
\\
\mu &=
\frac{m_{\text{max,eff}}^2 - m_{\text{min}}^2}
{\Delta m^2}
\\
\gamma &= \frac{2m_{\text{max,eff}}\Gamma}{\Delta m^2}
\end{align}
with
\begin{equation}
\Delta m^2 = m_{\text{max}}^2 - m_{\text{min}}^2
\end{equation}
$m^2$ is thus given by
\begin{equation}
m^2(x) = xm_{\text{max}}^2 + (1-x)m_{\text{min}}^2
\end{equation}
For the mapping, we compute the integral $g(x)$ of the Fermi function,
normalized such that $g(0)=0$ and $g(1)=1$. We introduce the abbreviations
\begin{align}
\alpha &= 1 - \gamma\ln\frac{1 + \beta e^{1/\gamma}}{1 + \beta}
\\
\beta &= e^{- \mu/\gamma}
\end{align}
and obtain
\begin{equation}
g(x) = \frac{1}{\alpha}
\left(x - \gamma\ln\frac{1 + \beta e^{x/\gamma}}
{1 + \beta}\right)
\end{equation}
The actual mapping is the inverse function $h(y) = g^{-1}(y)$,
\begin{equation}
h(y) = -\gamma\ln\left(e^{-\alpha y/\gamma}(1 + \beta) - \beta\right)
\end{equation}
The Jacobian is
\begin{equation}
\frac{dh}{dy} = \alpha\left(1 - e^{\alpha y/\gamma}
\frac{\beta}{1 + \beta}\right)^{-1}
\end{equation}
which is equal to $1/(dg/dx)$, namely
\begin{equation}
\frac{dg}{dx} = \frac{1}{\alpha}\,\frac{1}{1 + \beta e^{x/\gamma}}
\end{equation}
The final result is
\begin{align}
\int_{m_{\text{min}}^2}^{m_{\text{max}}^2} dm^2\,F(m^2)
&= \Delta m^2\int_0^1\,dx\,F(m^2(x))
\\
&= \Delta m^2\int_0^1\,dy\,F(m^2(h(y)))\,\frac{dh}{dy}
\end{align}
Here is the implementation. We fill [[a1]], [[a2]], [[a3]] with
$\alpha,\beta,\gamma$, respectively.
<<Constants for exponential step mapping>>=
if (map%variable_limits .or. map%a_unknown) then
map%a3 = max (2 * map%mass * map%width / (msq_max - msq_min), 0.01_default)
map%a2 = exp (- (map%mass**2 - msq_min) / (msq_max - msq_min) &
/ map%a3)
map%a1 = 1 - map%a3 * log ((1 + map%a2 * exp (1 / map%a3)) / (1 + map%a2))
end if
<<Apply exponential step mapping>>=
tmp = exp (- x * map%a1 / map%a3) * (1 + map%a2)
z = - map%a3 * log (tmp - map%a2)
msq = z * msq_max + (1 - z) * msq_min
f = map%a1 / (1 - map%a2 / tmp) * (msq_max - msq_min) / s
<<Apply inverse exponential step mapping>>=
z = (msq - msq_min) / (msq_max - msq_min)
tmp = 1 + map%a2 * exp (z / map%a3)
x = (z - map%a3 * log (tmp / (1 + map%a2))) &
/ map%a1
f = map%a1 * tmp * (msq_max - msq_min) / s
@
\subsubsection{Hyperbolic mapping}
The Fermi function has the drawback that it decreases exponentially.
It might be preferable to take a function with a power-law decrease,
such that the high-mass region is not completely depopulated.
Here, we start with the actual mapping which we take as
\begin{equation}
h(y) = \frac{b}{a-y} - \frac{b}{a} + \mu y
\end{equation}
with the abbreviation
\begin{equation}
a = \frac12\left(1 + \sqrt{1 + \frac{4b}{1-\mu}}\right)
\end{equation}
This is a hyperbola in the $xy$ plane. The derivative is
\begin{equation}
\frac{dh}{dy} = \frac{b}{(a-y)^2} + \mu
\end{equation}
The constants correspond to
\begin{align}
\mu &=
\frac{m_{\text{max,eff}}^2 - m_{\text{min}}^2}
{\Delta m^2}
\\
b &= \frac{1}{\mu}\left(\frac{2m_{\text{max,eff}}\Gamma}{\Delta m^2}\right)^2
\end{align}
The inverse function is the solution of a quadratic equation,
\begin{equation}
g(x) = \frac{1}{2}
\left[\left(a + \frac{x}{\mu} + \frac{b}{a\mu}\right)
- \sqrt{\left(a-\frac{x}{\mu}\right)^2
+ 2\frac{b}{a\mu}\left(a + \frac{x}{\mu}\right)
+ \left(\frac{b}{a\mu}\right)^2}\right]
\end{equation}
The constants $a_{1,2,3}$ are identified with $a,b,\mu$.
<<Constants for hyperbolic step mapping>>=
if (map%variable_limits .or. map%a_unknown) then
map%a3 = (map%mass**2 - msq_min) / (msq_max - msq_min)
map%a2 = max ((2 * map%mass * map%width / (msq_max - msq_min))**2 &
/ map%a3, 1e-6_default)
map%a1 = (1 + sqrt (1 + 4 * map%a2 / (1 - map%a3))) / 2
end if
<<Apply hyperbolic step mapping>>=
z = map%a2 / (map%a1 - x) - map%a2 / map%a1 + map%a3 * x
msq = z * msq_max + (1 - z) * msq_min
f = (map%a2 / (map%a1 - x)**2 + map%a3) * (msq_max - msq_min) / s
<<Apply inverse hyperbolic step mapping>>=
z = (msq - msq_min) / (msq_max - msq_min)
tmp = map%a2 / (map%a1 * map%a3)
x = ((map%a1 + z / map%a3 + tmp) &
- sqrt ((map%a1 - z / map%a3)**2 + 2 * tmp * (map%a1 + z / map%a3) &
+ tmp**2)) / 2
f = (map%a2 / (map%a1 - x)**2 + map%a3) * (msq_max - msq_min) / s
@
\subsection{Mappings of the polar angle}
The other type of singularity, a simple pole just outside the
integration region, can occur in the integration over $\cos\theta$.
This applies to exchange of massless (or light) particles.
Double poles (Coulomb scattering) are also possible, but only in
certain cases. These are also handled by the single-pole mapping.
The mapping is analogous to the previous $m^2$ pole mapping, but with
a different normalization and notation of variables:
\begin{equation}
\frac12\int_{-1}^1 d\cos\theta\,g(\theta)
= \int_0^1 dx\,\frac{d\cos\theta}{dx}\,g(\theta(x))
= \int_0^1 dx\,f(x)\,g(x),
\end{equation}
where thus
\begin{equation}
f(x) = \frac12\,\frac{d\cos\theta}{dx}.
\end{equation}
With this mapping, a function of the form
\begin{equation}
g(\theta) = c\frac{dx(\cos\theta)}{d\cos\theta}
\end{equation}
is mapped to a constant:
\begin{equation}
\int_{-1}^1 d\cos\theta\,g(\theta)
= \int_0^1 dx\,f(x)\,g(\theta(x)) = \int_0^1 dx\,c.
\end{equation}
<<Mappings: mapping: TBP>>=
procedure :: compute_ct_from_x => mapping_compute_ct_from_x
<<Mappings: sub interfaces>>=
module subroutine mapping_compute_ct_from_x (map, s, ct, st, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s
real(default), intent(out) :: ct, st, f
real(default), intent(in) :: x
end subroutine mapping_compute_ct_from_x
<<Mappings: procedures>>=
module subroutine mapping_compute_ct_from_x (map, s, ct, st, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s
real(default), intent(out) :: ct, st, f
real(default), intent(in) :: x
real(default) :: tmp, ct1
select case (map%type)
case (NO_MAPPING, S_CHANNEL, INFRARED, RADIATION, &
STEP_MAPPING_E, STEP_MAPPING_H)
<<Apply trivial ct mapping>>
case (T_CHANNEL, U_CHANNEL, COLLINEAR)
<<Constants for ct pole mapping>>
<<Apply ct pole mapping>>
case default
call msg_fatal (" Attempt to apply undefined ct mapping")
end select
end subroutine mapping_compute_ct_from_x
@ %def mapping_compute_ct_from_x
<<Mappings: mapping: TBP>>=
procedure :: compute_x_from_ct => mapping_compute_x_from_ct
<<Mappings: sub interfaces>>=
module subroutine mapping_compute_x_from_ct (map, s, ct, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s
real(default), intent(in) :: ct
real(default), intent(out) :: f, x
end subroutine mapping_compute_x_from_ct
<<Mappings: procedures>>=
module subroutine mapping_compute_x_from_ct (map, s, ct, f, x)
class(mapping_t), intent(inout) :: map
real(default), intent(in) :: s
real(default), intent(in) :: ct
real(default), intent(out) :: f, x
real(default) :: ct1
select case (map%type)
case (NO_MAPPING, S_CHANNEL, INFRARED, RADIATION, &
STEP_MAPPING_E, STEP_MAPPING_H)
<<Apply inverse trivial ct mapping>>
case (T_CHANNEL, U_CHANNEL, COLLINEAR)
<<Constants for ct pole mapping>>
<<Apply inverse ct pole mapping>>
case default
call msg_fatal (" Attempt to apply undefined inverse ct mapping")
end select
end subroutine mapping_compute_x_from_ct
@ %def mapping_compute_x_from_ct
@
\subsubsection{Trivial mapping}
This is just the mapping of the interval $(-1,1)$ to $(0,1)$:
\begin{equation}
\cos\theta = -1 + 2x
\end{equation}
and
\begin{equation}
f(x) = 1
\end{equation}
with the inverse
\begin{equation}
x = \frac{1+\cos\theta}{2}
\end{equation}
<<Apply trivial ct mapping>>=
tmp = 2 * (1-x)
ct = 1 - tmp
st = sqrt (tmp * (2-tmp))
f = 1
<<Apply inverse trivial ct mapping>>=
x = (ct + 1) / 2
f = 1
@
\subsubsection{Pole mapping}
As above for $m^2$, we simultaneously map poles at both ends of the
$\cos\theta$ interval. The formulae are completely analogous:
\begin{equation}
\cos\theta =
\begin{cases}
\frac{M^2}{s}\left[\exp(xL)-1\right] - 1
&
\text{for $x<\frac12$}
\\
-\frac{M^2}{s}\left[\exp((1-x)L)-1\right] + 1
&
\text{for $x\geq\frac12$}
\end{cases}
\end{equation}
where
\begin{equation}
L = 2\ln\frac{M^2+s}{M^2}.
\end{equation}
Inverse:
\begin{equation}
x =
\begin{cases}
\frac{1}{2L}\ln\frac{1 + \cos\theta + M^2/s}{M^2/s}
&
\text{for $\cos\theta < 0$}
\\
1 - \frac{1}{2L}\ln\frac{1 - \cos\theta + M^2/s}{M^2/s}
&
\text{for $\cos\theta \geq 0$}
\end{cases}
\end{equation}
The phase-space factor:
\begin{equation}
f(x) =
\begin{cases}
\frac{M^2}{s}\exp(xL)\,L
&
\text{for $x<\frac12$}
\\
\frac{M^2}{s}\exp((1-x)L)\,L
&
\text{for $x\geq\frac12$}
\end{cases}
\end{equation}
<<Constants for ct pole mapping>>=
if (map%variable_limits .or. map%b_unknown) then
map%b1 = map%mass**2 / s
map%b2 = log ((map%b1 + 1) / map%b1)
map%b3 = 0
map%b_unknown = .false.
end if
<<Apply ct pole mapping>>=
if (x < .5_default) then
ct1 = map%b1 * exp (2 * x * map%b2)
ct = ct1 - map%b1 - 1
else
ct1 = map%b1 * exp (2 * (1-x) * map%b2)
ct = -(ct1 - map%b1) + 1
end if
if (ct >= -1 .and. ct <= 1) then
st = sqrt (1 - ct**2)
f = ct1 * map%b2
else
ct = 1; st = 0; f = 0
end if
<<Apply inverse ct pole mapping>>=
if (ct < 0) then
ct1 = ct + map%b1 + 1
x = log (ct1 / map%b1) / (2 * map%b2)
else
ct1 = -ct + map%b1 + 1
x = 1 - log (ct1 / map%b1) / (2 * map%b2)
end if
f = ct1 * map%b2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\clearpage
\section{Phase-space trees}
The phase space evaluation is organized in terms of trees, where each
branch corresponds to three integrations: $m^2$, $\cos\theta$, and
$\phi$. The complete tree thus makes up a specific parameterization
of the multidimensional phase-space integral. For the multi-channel
integration, the phase-space tree is a single channel.
The trees imply mappings of formal Feynman tree graphs into arrays of
integer numbers: Each branch, corresponding to a particular line in
the graph, is assigned an integer code $c$ (with kind value [[TC]] =
tree code).
In this integer, each bit determines whether a particular external
momentum flows through the line. The external branches therefore have
codes $1,2,4,8,\ldots$. An internal branch has those bits ORed
corresponding to the momenta flowing through it. For example, a
branch with momentum $p_1+p_4$ has code $2^0+2^3=1+8=9$.
There is a two-fold ambiguity: Momentum conservation implies that the
branch with code
\begin{equation}
c_0 = \sum_{i=1}^{n(\rm{ext})} 2^{i-1}
\end{equation}
i.e. the branch with momentum $p_1+p_2+\ldots p_n$ has momentum zero,
which is equivalent to tree code $0$ by definition. Correspondingly,
\begin{equation}
c \quad\textrm{and}\quad c_0 - c = c\;\textrm{XOR}\;c_0
\end{equation}
are equivalent. E.g., if there are five externals with codes
$c=1,2,4,8,16$, then $c=9$ and $\bar c=31-9=22$ are equivalent.
This ambiguity may be used to assign a direction to the line: If all
momenta are understood as outgoing, $c=9$ in the example above means
$p_1+p_4$, but $c=22$ means $p_2+p_3+p_5 = -(p_1+p_4)$.
Here we make use of the ambiguity in a slightly different way. First,
the initial particles are singled out as those externals with the
highest bits, the IN-bits. (Here: $8$ and $16$ for a $2\to 3$
scattering process, $16$ only for a $1\to 4$ decay.) Then we invert
those codes where all IN-bits are set. For a decay process this maps
each tree of an equivalence class onto a unique representative (that one
with the smallest integer codes). For a scattering process we proceed
further:
The ambiguity remains in all branches where only one IN-bit is set,
including the initial particles. If there are only externals with
this property, we have an $s$-channel graph which we leave as it is.
In all other cases, an internal with only one IN-bit is a $t$-channel
line, which for phase space integration should be associated with one
of the initial momenta as a reference axis. We take that one whose
bit is set in the current tree code. (E.g., for branch $c=9$ we use
the initial particle $c=8$ as reference axis, whereas for the same
branch we would take $c=16$ if it had been assigned $\bar c=31-9=22$
as tree code.) Thus, different ways of coding the same $t$-channel
graph imply different phase space parameterizations.
$s$-channel graphs have a unique parameterization. The same sets of
parameterizations are used for $t$-channel graphs, except for the
reference frames of their angular parts. We map each
$t$-channel graph onto an $s$-channel graph as follows:
Working in ascending order, for each $t$-channel line (whose code has
exactly one IN-bit set) the attached initial line is flipped upstream,
while the outgoing line is flipped downstream. (This works only if
$t$-channel graphs are always parameterized beginning at their outer
vertices, which we require as a restriction.) After all possible
flips have been applied, we have an $s$-channel graph. We only have
to remember the initial particle a vertex was originally attached to.
<<[[phs_trees.f90]]>>=
<<File header>>
module phs_trees
<<Use kinds>>
use kinds, only: TC
<<Use strings>>
use lorentz
use permutations, only: permutation_t, permutation_size
use permutations, only: permutation_init, permutation_find
use permutations, only: tc_decay_level, tc_permute
use model_data
use flavors
use resonances, only: resonance_history_t, resonance_info_t
use mappings
<<Standard module head>>
<<PHS trees: public>>
<<PHS trees: types>>
interface
<<PHS trees: sub interfaces>>
end interface
end module phs_trees
@ %def phs_trees
@
<<[[phs_trees_sub.f90]]>>=
<<File header>>
submodule (phs_trees) phs_trees_s
use io_units
use constants, only: twopi, twopi2, twopi5
use format_defs, only: FMT_19
use numeric_utils, only: vanishes
use diagnostics
implicit none
contains
<<PHS trees: procedures>>
end submodule phs_trees_s
@ %def phs_trees_s
@
\subsection{Particles}
We define a particle type which contains only four-momentum and
invariant mass squared, and a flag that tells whether the momentum is
filled or not.
<<PHS trees: public>>=
public :: phs_prt_t
<<PHS trees: types>>=
type :: phs_prt_t
private
logical :: defined = .false.
type(vector4_t) :: p
real(default) :: p2
contains
<<PHS trees: prt: TBP>>
end type phs_prt_t
@ %def phs_prt_t
@ Set contents:
<<PHS trees: prt: TBP>>=
procedure :: set_defined => phs_prt_set_defined
procedure :: set_undefined => phs_prt_set_undefined
procedure :: set_momentum => phs_prt_set_momentum
procedure :: set_msq => phs_prt_set_msq
<<PHS trees: sub interfaces>>=
elemental module subroutine phs_prt_set_defined (prt)
class(phs_prt_t), intent(inout) :: prt
end subroutine phs_prt_set_defined
elemental module subroutine phs_prt_set_undefined (prt)
class(phs_prt_t), intent(inout) :: prt
end subroutine phs_prt_set_undefined
elemental module subroutine phs_prt_set_momentum (prt, p)
class(phs_prt_t), intent(inout) :: prt
type(vector4_t), intent(in) :: p
end subroutine phs_prt_set_momentum
elemental module subroutine phs_prt_set_msq (prt, p2)
class(phs_prt_t), intent(inout) :: prt
real(default), intent(in) :: p2
end subroutine phs_prt_set_msq
<<PHS trees: procedures>>=
elemental module subroutine phs_prt_set_defined (prt)
class(phs_prt_t), intent(inout) :: prt
prt%defined = .true.
end subroutine phs_prt_set_defined
elemental module subroutine phs_prt_set_undefined (prt)
class(phs_prt_t), intent(inout) :: prt
prt%defined = .false.
end subroutine phs_prt_set_undefined
elemental module subroutine phs_prt_set_momentum (prt, p)
class(phs_prt_t), intent(inout) :: prt
type(vector4_t), intent(in) :: p
prt%p = p
end subroutine phs_prt_set_momentum
elemental module subroutine phs_prt_set_msq (prt, p2)
class(phs_prt_t), intent(inout) :: prt
real(default), intent(in) :: p2
prt%p2 = p2
end subroutine phs_prt_set_msq
@ %def phs_prt_set_defined phs_prt_set_momentum phs_prt_set_msq
@ Access methods:
<<PHS trees: prt: TBP>>=
procedure :: is_defined => phs_prt_is_defined
procedure :: get_momentum => phs_prt_get_momentum
procedure :: get_msq => phs_prt_get_msq
<<PHS trees: sub interfaces>>=
elemental module function phs_prt_is_defined (prt) result (defined)
logical :: defined
class(phs_prt_t), intent(in) :: prt
end function phs_prt_is_defined
elemental module function phs_prt_get_momentum (prt) result (p)
type(vector4_t) :: p
class(phs_prt_t), intent(in) :: prt
end function phs_prt_get_momentum
elemental module function phs_prt_get_msq (prt) result (p2)
real(default) :: p2
class(phs_prt_t), intent(in) :: prt
end function phs_prt_get_msq
<<PHS trees: procedures>>=
elemental module function phs_prt_is_defined (prt) result (defined)
logical :: defined
class(phs_prt_t), intent(in) :: prt
defined = prt%defined
end function phs_prt_is_defined
elemental module function phs_prt_get_momentum (prt) result (p)
type(vector4_t) :: p
class(phs_prt_t), intent(in) :: prt
p = prt%p
end function phs_prt_get_momentum
elemental module function phs_prt_get_msq (prt) result (p2)
real(default) :: p2
class(phs_prt_t), intent(in) :: prt
p2 = prt%p2
end function phs_prt_get_msq
@ %def phs_prt_is_defined phs_prt_get_momentum phs_prt_get_msq
@ Addition of momenta (invariant mass square is computed).
<<PHS trees: prt: TBP>>=
procedure :: combine => phs_prt_combine
<<PHS trees: sub interfaces>>=
elemental module subroutine phs_prt_combine (prt, prt1, prt2)
class(phs_prt_t), intent(inout) :: prt
type(phs_prt_t), intent(in) :: prt1, prt2
end subroutine phs_prt_combine
<<PHS trees: procedures>>=
elemental module subroutine phs_prt_combine (prt, prt1, prt2)
class(phs_prt_t), intent(inout) :: prt
type(phs_prt_t), intent(in) :: prt1, prt2
prt%defined = .true.
prt%p = prt1%p + prt2%p
prt%p2 = prt%p ** 2
call phs_prt_check (prt)
end subroutine phs_prt_combine
@ %def phs_prt_combine
@ Output
<<PHS trees: prt: TBP>>=
procedure :: write => phs_prt_write
<<PHS trees: sub interfaces>>=
module subroutine phs_prt_write (prt, unit)
class(phs_prt_t), intent(in) :: prt
integer, intent(in), optional :: unit
end subroutine phs_prt_write
<<PHS trees: procedures>>=
module subroutine phs_prt_write (prt, unit)
class(phs_prt_t), intent(in) :: prt
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
if (prt%defined) then
call vector4_write (prt%p, u)
write (u, "(1x,A,1x," // FMT_19 // ")") "T = ", prt%p2
else
write (u, "(3x,A)") "[undefined]"
end if
end subroutine phs_prt_write
@ %def phs_prt_write
<<PHS trees: prt: TBP>>=
procedure :: check => phs_prt_check
<<PHS trees: sub interfaces>>=
elemental module subroutine phs_prt_check (prt)
class(phs_prt_t), intent(inout) :: prt
end subroutine phs_prt_check
<<PHS trees: procedures>>=
elemental module subroutine phs_prt_check (prt)
class(phs_prt_t), intent(inout) :: prt
if (prt%p2 < 0._default) then
prt%p2 = 0._default
end if
end subroutine phs_prt_check
@ %def phs_prt_check
@
\subsection{The phase-space tree type}
\subsubsection{Definition}
In the concrete implementation, each branch $c$ may have two
\emph{daughters} $c_1$ and $c_2$ such that $c_1+c_2=c$, a
\emph{sibling} $c_s$ and a \emph{mother} $c_m$ such that $c+c_s =
c_m$, and a \emph{friend} which is kept during flips, such that it can
indicate a fixed reference frame. Absent entries are set $c=0$.
First, declare the branch type. There is some need to have this
public. Give initializations for all components, so no [[init]]
routine is necessary. The branch has some information about the
associated coordinates and about connections.
<<PHS trees: types>>=
type :: phs_branch_t
private
logical :: set = .false.
logical :: inverted_decay = .false.
logical :: inverted_axis = .false.
integer(TC) :: mother = 0
integer(TC) :: sibling = 0
integer(TC) :: friend = 0
integer(TC) :: origin = 0
integer(TC), dimension(2) :: daughter = 0
integer :: firstborn = 0
logical :: has_children = .false.
logical :: has_friend = .false.
logical :: is_real = .false.
end type phs_branch_t
@ %def phs_branch_t
@ The tree type: No initialization, this is done by
[[phs_tree_init]]. In addition to the branch array which
The branches are collected in an array which holds all possible
branches, of which only a few are set. After flips have been applied,
the branch $c_M=\sum_{i=1}^{n({\rm fin})}2^{i-1}$ must be there,
indicating the mother of all decay products. In addition, we should
check for consistency at the beginning.
[[n_branches]] is the number of those actually set. [[n_externals]]
defines the number of significant bit, and [[mask]] is a code where all
bits are set. Analogous: [[n_in]] and [[mask_in]] for the incoming
particles.
The [[mapping]] array contains the mappings associated to the branches
(corresponding indices). The array [[mass_sum]] contains the sum of
the real masses of the external final-state particles associated to
the branch. During phase-space evaluation, this determines the
boundaries.
<<PHS trees: public>>=
public :: phs_tree_t
<<PHS trees: types>>=
type :: phs_tree_t
private
integer :: n_branches, n_externals, n_in, n_msq, n_angles
integer(TC) :: n_branches_tot, n_branches_out
integer(TC) :: mask, mask_in, mask_out
type(phs_branch_t), dimension(:), allocatable :: branch
type(mapping_t), dimension(:), allocatable :: mapping
real(default), dimension(:), allocatable :: mass_sum
real(default), dimension(:), allocatable :: effective_mass
real(default), dimension(:), allocatable :: effective_width
logical :: real_phsp = .false.
integer, dimension(:), allocatable :: momentum_link
contains
<<PHS trees: phs tree: TBP>>
end type phs_tree_t
@ %def phs_tree_t
@ The maximum number of external particles that can be represented is
related to the bit size of the integer that stores binary codes. With
the default integer of 32 bit on common machines, this is more than
enough space. If [[TC]] is actually the default integer kind, there
is no need to keep it separate, but doing so marks this as a
special type of integer. So, just state that the maximum number is 32:
<<Limits: public parameters>>=
integer, parameter, public :: MAX_EXTERNAL = 32
@ %def MAX_EXTERNAL
@
\subsubsection{Constructor and destructor}
Allocate memory for a phase-space tree with given number of externals and
incoming. The number of allocated branches can easily become large,
but appears manageable for realistic cases, e.g., for [[n_in=2]] and
[[n_out=8]] we get $2^{10}-1=1023$.
Here we set the masks for incoming and for all externals.
<<PHS trees: phs tree: TBP>>=
procedure :: init => phs_tree_init
procedure :: final => phs_tree_final
<<PHS trees: sub interfaces>>=
elemental module subroutine phs_tree_init &
(tree, n_in, n_out, n_masses, n_angles)
class(phs_tree_t), intent(inout) :: tree
integer, intent(in) :: n_in, n_out, n_masses, n_angles
end subroutine phs_tree_init
elemental module subroutine phs_tree_final (tree)
class(phs_tree_t), intent(inout) :: tree
end subroutine phs_tree_final
<<PHS trees: procedures>>=
elemental module subroutine phs_tree_init &
(tree, n_in, n_out, n_masses, n_angles)
class(phs_tree_t), intent(inout) :: tree
integer, intent(in) :: n_in, n_out, n_masses, n_angles
integer(TC) :: i
tree%n_externals = n_in + n_out
tree%n_branches_tot = 2**(n_in+n_out) - 1
tree%n_branches_out = 2**n_out - 1
tree%mask = 0
do i = 0, n_in + n_out - 1
tree%mask = ibset (tree%mask, i)
end do
tree%n_in = n_in
tree%mask_in = 0
do i = n_out, n_in + n_out - 1
tree%mask_in = ibset (tree%mask_in, i)
end do
tree%mask_out = ieor (tree%mask, tree%mask_in)
tree%n_msq = n_masses
tree%n_angles = n_angles
allocate (tree%branch (tree%n_branches_tot))
tree%n_branches = 0
allocate (tree%mapping (tree%n_branches_out))
allocate (tree%mass_sum (tree%n_branches_out))
allocate (tree%effective_mass (tree%n_branches_out))
allocate (tree%effective_width (tree%n_branches_out))
end subroutine phs_tree_init
elemental module subroutine phs_tree_final (tree)
class(phs_tree_t), intent(inout) :: tree
deallocate (tree%branch)
deallocate (tree%mapping)
deallocate (tree%mass_sum)
deallocate (tree%effective_mass)
deallocate (tree%effective_width)
end subroutine phs_tree_final
@ %def phs_tree_init phs_tree_final
@
\subsubsection{Screen output}
Write only the branches that are set:
<<PHS trees: phs tree: TBP>>=
procedure :: write => phs_tree_write
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_write (tree, unit)
class(phs_tree_t), intent(in) :: tree
integer, intent(in), optional :: unit
end subroutine phs_tree_write
<<PHS trees: procedures>>=
module subroutine phs_tree_write (tree, unit)
class(phs_tree_t), intent(in) :: tree
integer, intent(in), optional :: unit
integer :: u
integer(TC) :: k
u = given_output_unit (unit); if (u < 0) return
write (u, '(3X,A,1x,I0,5X,A,I3)') &
'External:', tree%n_externals, 'Mask:', tree%mask
write (u, '(3X,A,1x,I0,5X,A,I3)') &
'Incoming:', tree%n_in, 'Mask:', tree%mask_in
write (u, '(3X,A,1x,I0,5X,A,I3)') &
'Branches:', tree%n_branches
do k = size (tree%branch), 1, -1
if (tree%branch(k)%set) &
call phs_branch_write (tree%branch(k), unit=unit, kval=k)
end do
do k = 1, size (tree%mapping)
call tree%mapping (k)%write (unit, verbose=.true.)
end do
write (u, "(3x,A)") "Arrays: mass_sum, effective_mass, effective_width"
do k = 1, size (tree%mass_sum)
if (tree%branch(k)%set) then
write (u, "(5x,I0,3(2x," // FMT_19 // "))") k, tree%mass_sum(k), &
tree%effective_mass(k), tree%effective_width(k)
end if
end do
end subroutine phs_tree_write
subroutine phs_branch_write (b, unit, kval)
type(phs_branch_t), intent(in) :: b
integer, intent(in), optional :: unit
integer(TC), intent(in), optional :: kval
integer :: u
integer(TC) :: k
character(len=6) :: tmp
character(len=1) :: firstborn(2), sign_decay, sign_axis
integer :: i
u = given_output_unit (unit); if (u < 0) return
k = 0; if (present (kval)) k = kval
if (b%origin /= 0) then
write(tmp, '(A,I4,A)') '(', b%origin, ')'
else
tmp = ' '
end if
do i=1, 2
if (b%firstborn == i) then
firstborn(i) = "*"
else
firstborn(i) = " "
end if
end do
if (b%inverted_decay) then
sign_decay = "-"
else
sign_decay = "+"
end if
if (b%inverted_axis) then
sign_axis = "-"
else
sign_axis = "+"
end if
if (b%has_children) then
if (b%has_friend) then
write(u,'(4X,A1,I0,3x,A,1X,A,I0,A1,1x,I0,A1,1X,A1,1X,A,1x,I0)') &
& '*', k, tmp, &
& 'Daughters: ', &
& b%daughter(1), firstborn(1), &
& b%daughter(2), firstborn(2), sign_decay, &
& 'Friend: ', b%friend
else
write(u,'(4X,A1,I0,3x,A,1X,A,I0,A1,1x,I0,A1,1X,A1,1X,A)') &
& '*', k, tmp, &
& 'Daughters: ', &
& b%daughter(1), firstborn(1), &
& b%daughter(2), firstborn(2), sign_decay, &
& '(axis '//sign_axis//')'
end if
else
write(u,'(5X,I0)') k
end if
end subroutine phs_branch_write
@ %def phs_tree_write phs_branch_write
@
\subsection{PHS tree setup}
\subsubsection{Transformation into an array of branch codes and back}
Assume that the tree/array has been created before with the
appropriate length and is empty.
<<PHS trees: public>>=
public :: phs_tree_from_array
<<PHS trees: phs tree: TBP>>=
procedure :: from_array => phs_tree_from_array
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_from_array (tree, a)
class(phs_tree_t), intent(inout) :: tree
integer(TC), dimension(:), intent(in) :: a
end subroutine phs_tree_from_array
<<PHS trees: procedures>>=
module subroutine phs_tree_from_array (tree, a)
class(phs_tree_t), intent(inout) :: tree
integer(TC), dimension(:), intent(in) :: a
integer :: i
integer(TC) :: k
<<Set branches from array [[a]]>>
<<Set external branches if necessary>>
<<Check number of branches>>
<<Determine the connections>>
contains
<<Subroutine: set relatives>>
end subroutine phs_tree_from_array
@ %def phs_tree_from_array
@ First, set all branches specified by the user. If all IN-bits
are set, we invert the branch code.
<<Set branches from array [[a]]>>=
do i=1, size(a)
k = a(i)
if (iand(k, tree%mask_in) == tree%mask_in) k = ieor(tree%mask, k)
tree%branch(k)%set = .true.
tree%n_branches = tree%n_branches+1
end do
@ The external branches are understood, so set them now if not yet
done. In all cases ensure that the representative with one bit set is
used, except for decays where the in-particle is represented by all
OUT-bits set instead.
<<Set external branches if necessary>>=
do i=0, tree%n_externals-1
k = ibset(0,i)
if (iand(k, tree%mask_in) == tree%mask_in) k = ieor(tree%mask, k)
if (tree%branch(ieor(tree%mask, k))%set) then
tree%branch(ieor(tree%mask, k))%set = .false.
tree%branch(k)%set = .true.
else if (.not.tree%branch(k)%set) then
tree%branch(k)%set = .true.
tree%n_branches = tree%n_branches+1
end if
end do
@ Now the number of branches set can be checked. Here we assume that
the tree is binary. For three externals there are three branches in
total, and for each additional external branch we get another internal
one.
<<Check number of branches>>=
if (tree%n_branches /= tree%n_externals*2-3) then
call phs_tree_write (tree)
call msg_bug &
& (" Wrong number of branches set in phase space tree")
end if
@ For all branches that are set, except for the externals, we try to
find the daughter branches:
<<Determine the connections>>=
do k=1, size (tree%branch)
if (tree%branch(k)%set .and. tc_decay_level (k) /= 1) then
call branch_set_relatives(k)
end if
end do
@ To this end, we scan all codes less than the current code, whether
we can find two branches which are set and which together give the
current code. After that, the tree may still not be connected, but at
least we know if a branch does not have daughters: This indicates some
inconsistency.
The algorithm ensures that, at this stage, the first daughter has a
smaller code value than the second one.
<<Subroutine: set relatives>>=
subroutine branch_set_relatives (k)
integer(TC), intent(in) :: k
integer(TC) :: m,n
do m=1, k-1
if (iand(k,m)==m) then
n = ieor(k,m)
if ( tree%branch(m)%set .and. tree%branch(n)%set ) then
tree%branch(k)%daughter(1) = m; tree%branch(k)%daughter(2) = n
tree%branch(m)%mother = k; tree%branch(n)%mother = k
tree%branch(m)%sibling = n; tree%branch(n)%sibling = m
tree%branch(k)%has_children = .true.
return
end if
end if
end do
call phs_tree_write (tree)
call msg_bug &
& (" Missing daughter branch(es) in phase space tree")
end subroutine branch_set_relatives
@ The inverse: this is trivial, fortunately.
@
\subsubsection{Flip $t$-channel into $s$-channel}
Flipping the tree is done upwards, beginning from the decay products.
First we select a $t$-channel branch [[k]]: one which is set, which
does have an IN-bit, and which is not an external particle.
Next, we determine the adjacent in-particle (called the 'friend' [[f]]
here, since it will provide the reference axis for the angular
integration). In addition, we look for the 'mother' and 'sibling' of
this particle. If the latter field is empty, we select the (unique)
other out-particle which has no mother, calling the internal
subroutine [[find_orphan]].
The flip is done as follows: We assume that the first daughter [[d]]
is an $s$-channel line, which is true if the daughters are sorted.
This will stay the first daughter. The second one is a $t$-channel
line; it is exchanged with the 'sibling' [[s]]. The new line which
replaces the branch [[k]] is just the sum of [[s]] and [[d]]. In
addition, we have to rearrange the relatives of [[s]] and [[d]], as
well of [[f]].
Finally, we flip 'sibling' and 'friend' and set the new $s$-channel
branch [[n]] which replaces the $t$-channel branch [[k]]. After this
is complete, we are ready to execute another flip.
[Although the friend is not needed for the final flip, since it would
be an initial particle anyway, we need to know whether we have $t$- or
$u$-channel.]
<<PHS trees: phs tree: TBP>>=
procedure :: flip_t_to_s_channel => phs_tree_flip_t_to_s_channel
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_flip_t_to_s_channel (tree)
class(phs_tree_t), intent(inout) :: tree
end subroutine phs_tree_flip_t_to_s_channel
<<PHS trees: procedures>>=
module subroutine phs_tree_flip_t_to_s_channel (tree)
class(phs_tree_t), intent(inout) :: tree
integer(TC) :: k, f, m, n, d, s
if (tree%n_in == 2) then
FLIP: do k=3, tree%mask-1
if (.not. tree%branch(k)%set) cycle FLIP
f = iand(k,tree%mask_in)
if (f==0 .or. f==k) cycle FLIP
m = tree%branch(k)%mother
s = tree%branch(k)%sibling
if (s==0) call find_orphan(s)
d = tree%branch(k)%daughter(1)
n = ior(d,s)
tree%branch(k)%set = .false.
tree%branch(n)%set = .true.
tree%branch(n)%origin = k
tree%branch(n)%daughter(1) = d; tree%branch(d)%mother = n
tree%branch(n)%daughter(2) = s; tree%branch(s)%mother = n
tree%branch(n)%has_children = .true.
tree%branch(d)%sibling = s; tree%branch(s)%sibling = d
tree%branch(n)%sibling = f; tree%branch(f)%sibling = n
tree%branch(n)%mother = m
tree%branch(f)%mother = m
if (m/=0) then
tree%branch(m)%daughter(1) = n
tree%branch(m)%daughter(2) = f
end if
tree%branch(n)%friend = f
tree%branch(n)%has_friend = .true.
tree%branch(n)%firstborn = 2
end do FLIP
end if
contains
subroutine find_orphan(s)
integer(TC) :: s
do s=1, tree%mask_out
if (tree%branch(s)%set .and. tree%branch(s)%mother==0) return
end do
call phs_tree_write (tree)
call msg_bug (" Can't flip phase space tree to channel")
end subroutine find_orphan
end subroutine phs_tree_flip_t_to_s_channel
@ %def phs_tree_flip_t_to_s_channel
@ After the tree has been flipped, one may need to determine what has
become of a particular $t$-channel branch. This function gives the
bincode of the flipped tree. If the original bincode does not contain
IN-bits, we leave it as it is.
<<PHS trees: procedures>>=
function tc_flipped (tree, kt) result (ks)
type(phs_tree_t), intent(in) :: tree
integer(TC), intent(in) :: kt
integer(TC) :: ks
if (iand (kt, tree%mask_in) == 0) then
ks = kt
else
ks = tree%branch(iand (kt, tree%mask_out))%mother
end if
end function tc_flipped
@ %def tc_flipped
@ Scan a tree and make sure that the first daughter has always a
smaller code than the second one. Furthermore, delete any [[friend]]
entry in the root branch -- this branching has the incoming particle
direction as axis anyway. Keep track of reordering by updating
[[inverted_axis]], [[inverted_decay]] and [[firstborn]].
<<PHS trees: phs tree: TBP>>=
procedure :: canonicalize => phs_tree_canonicalize
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_canonicalize (tree)
class(phs_tree_t), intent(inout) :: tree
end subroutine phs_tree_canonicalize
<<PHS trees: procedures>>=
module subroutine phs_tree_canonicalize (tree)
class(phs_tree_t), intent(inout) :: tree
integer :: n_out
integer(TC) :: k_out
call branch_canonicalize (tree%branch(tree%mask_out))
n_out = tree%n_externals - tree%n_in
k_out = tree%mask_out
if (tree%branch(k_out)%has_friend &
& .and. tree%branch(k_out)%friend == ibset (0, n_out)) then
tree%branch(k_out)%inverted_axis = .not.tree%branch(k_out)%inverted_axis
end if
tree%branch(k_out)%has_friend = .false.
tree%branch(k_out)%friend = 0
contains
recursive subroutine branch_canonicalize (b)
type(phs_branch_t), intent(inout) :: b
integer(TC) :: d1, d2
if (b%has_children) then
d1 = b%daughter(1)
d2 = b%daughter(2)
if (d1 > d2) then
b%daughter(1) = d2
b%daughter(2) = d1
b%inverted_decay = .not.b%inverted_decay
if (b%firstborn /= 0) b%firstborn = 3 - b%firstborn
end if
call branch_canonicalize (tree%branch(b%daughter(1)))
call branch_canonicalize (tree%branch(b%daughter(2)))
end if
end subroutine branch_canonicalize
end subroutine phs_tree_canonicalize
@ %def phs_tree_canonicalize
@
\subsubsection{Mappings}
Initialize a mapping for the current tree. This is done while reading
from file, so the mapping parameters are read, but applied to the
flipped tree. Thus, the size of the array of mappings is given by the
number of outgoing particles only.
<<PHS trees: phs tree: TBP>>=
procedure :: init_mapping => phs_tree_init_mapping
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_init_mapping (tree, k, type, pdg, model)
class(phs_tree_t), intent(inout) :: tree
integer(TC), intent(in) :: k
type(string_t), intent(in) :: type
integer, intent(in) :: pdg
class(model_data_t), intent(in), target :: model
end subroutine phs_tree_init_mapping
<<PHS trees: procedures>>=
module subroutine phs_tree_init_mapping (tree, k, type, pdg, model)
class(phs_tree_t), intent(inout) :: tree
integer(TC), intent(in) :: k
type(string_t), intent(in) :: type
integer, intent(in) :: pdg
class(model_data_t), intent(in), target :: model
integer(TC) :: kk
kk = tc_flipped (tree, k)
call tree%mapping(kk)%init (kk, type, pdg, model)
end subroutine phs_tree_init_mapping
@ %def phs_tree_init_mapping
@ Set the physical parameters for the mapping, using a specific
parameter set. Also set the mass sum array.
<<PHS trees: phs tree: TBP>>=
procedure :: set_mapping_parameters => phs_tree_set_mapping_parameters
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_set_mapping_parameters &
(tree, mapping_defaults, variable_limits)
class(phs_tree_t), intent(inout) :: tree
type(mapping_defaults_t), intent(in) :: mapping_defaults
logical, intent(in) :: variable_limits
end subroutine phs_tree_set_mapping_parameters
<<PHS trees: procedures>>=
module subroutine phs_tree_set_mapping_parameters &
(tree, mapping_defaults, variable_limits)
class(phs_tree_t), intent(inout) :: tree
type(mapping_defaults_t), intent(in) :: mapping_defaults
logical, intent(in) :: variable_limits
integer(TC) :: k
do k = 1, tree%n_branches_out
call tree%mapping(k)%set_parameters (mapping_defaults, variable_limits)
end do
end subroutine phs_tree_set_mapping_parameters
@ %def phs_tree_set_mapping_parameters
@ Return the mapping for the sum of all outgoing particles. This
should either be no mapping or a global s-channel mapping.
<<PHS trees: phs tree: TBP>>=
procedure :: assign_s_mapping => phs_tree_assign_s_mapping
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_assign_s_mapping (tree, mapping)
class(phs_tree_t), intent(in) :: tree
type(mapping_t), intent(out) :: mapping
end subroutine phs_tree_assign_s_mapping
<<PHS trees: procedures>>=
module subroutine phs_tree_assign_s_mapping (tree, mapping)
class(phs_tree_t), intent(in) :: tree
type(mapping_t), intent(out) :: mapping
mapping = tree%mapping(tree%mask_out)
end subroutine phs_tree_assign_s_mapping
@ %def phs_tree_assign_s_mapping
@
\subsubsection{Kinematics}
Fill the mass sum array, starting from the external particles and
working down to the tree root. For each bincode [[k]] we scan the
bits in [[k]]; if only one is set, we take the physical mass of the
corresponding external particle; if more then one is set, we sum up
the two masses (which we know have already been set).
<<PHS trees: phs tree: TBP>>=
procedure :: set_mass_sum => phs_tree_set_mass_sum
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_set_mass_sum (tree, flv)
class(phs_tree_t), intent(inout) :: tree
type(flavor_t), dimension(:), intent(in) :: flv
end subroutine phs_tree_set_mass_sum
<<PHS trees: procedures>>=
module subroutine phs_tree_set_mass_sum (tree, flv)
class(phs_tree_t), intent(inout) :: tree
type(flavor_t), dimension(:), intent(in) :: flv
integer(TC) :: k
integer :: i
tree%mass_sum = 0
do k = 1, tree%n_branches_out
do i = 0, size (flv) - 1
if (btest(k,i)) then
if (ibclr(k,i) == 0) then
tree%mass_sum(k) = flv(i+1)%get_mass ()
else
tree%mass_sum(k) = &
tree%mass_sum(ibclr(k,i)) + tree%mass_sum(ibset(0,i))
end if
exit
end if
end do
end do
end subroutine phs_tree_set_mass_sum
@ %def phs_tree_set_mass_sum
@ Set the effective masses and widths. For each non-resonant branch
in a tree, the effective mass is equal to the sum of the effective
masses of the children (and analogous for the width). External
particles have their real mass and width zero. For resonant branches,
we insert mass and width from the corresponding mapping.
This routine has [[phs_tree_set_mass_sum]] and
[[phs_tree_set_mapping_parameters]] as prerequisites.
<<PHS trees: phs tree: TBP>>=
procedure :: set_effective_masses => phs_tree_set_effective_masses
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_set_effective_masses (tree)
class(phs_tree_t), intent(inout) :: tree
end subroutine phs_tree_set_effective_masses
<<PHS trees: procedures>>=
module subroutine phs_tree_set_effective_masses (tree)
class(phs_tree_t), intent(inout) :: tree
tree%effective_mass = 0
tree%effective_width = 0
call set_masses_x (tree%mask_out)
contains
recursive subroutine set_masses_x (k)
integer(TC), intent(in) :: k
integer(TC) :: k1, k2
if (tree%branch(k)%has_children) then
k1 = tree%branch(k)%daughter(1)
k2 = tree%branch(k)%daughter(2)
call set_masses_x (k1)
call set_masses_x (k2)
if (tree%mapping(k)%is_s_channel ()) then
tree%effective_mass(k) = tree%mapping(k)%get_mass ()
tree%effective_width(k) = tree%mapping(k)%get_width ()
else
tree%effective_mass(k) = &
tree%effective_mass(k1) + tree%effective_mass(k2)
tree%effective_width(k) = &
tree%effective_width(k1) + tree%effective_width(k2)
end if
else
tree%effective_mass(k) = tree%mass_sum(k)
end if
end subroutine set_masses_x
end subroutine phs_tree_set_effective_masses
@ %def phs_tree_set_effective_masses
@ Define step mappings, recursively, for the decay products of all
intermediate resonances. Step mappings account for the fact that a
branch may originate from a resonance, which almost replaces the
upper limit on the possible invariant mass. The step
mapping implements a smooth cutoff that interpolates between the
resonance and the real kinematic limit. The mapping width determines
the sharpness of the cutoff.
Step mappings are inserted only for branches that are not mapped
otherwise.
At each branch, we record the mass that is effectively available for
phase space, by taking the previous limit and subtracting the
effective mass of the sibling branch. Widths are added, not subtracted.
If we encounter a resonance decay, we discard the previous limit and
replace it by the mass and width of the resonance, also subtracting
the sibling branch.
Initially, the limit is zero, so it becomes negative at any branch. Only
if there is a resonance, the limit becomes positive. Whenever the
limit is positive, and the current branch decays, we activate a step
mapping for the current branch.
As a result, step mappings are implemented for all internal lines that
originate from an intermediate resonance decay.
The flag [[variable_limits]] applies to the ultimate limit from the
available energy, not to the intermediate resonances whose masses are
always fixed.
This routine requires [[phs_tree_set_effective_masses]]
<<PHS trees: phs tree: TBP>>=
procedure :: set_step_mappings => phs_tree_set_step_mappings
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_set_step_mappings &
(tree, exp_type, variable_limits)
class(phs_tree_t), intent(inout) :: tree
logical, intent(in) :: exp_type
logical, intent(in) :: variable_limits
end subroutine phs_tree_set_step_mappings
<<PHS trees: procedures>>=
module subroutine phs_tree_set_step_mappings &
(tree, exp_type, variable_limits)
class(phs_tree_t), intent(inout) :: tree
logical, intent(in) :: exp_type
logical, intent(in) :: variable_limits
type(string_t) :: map_str
integer(TC) :: k
if (exp_type) then
map_str = "step_exp"
else
map_str = "step_hyp"
end if
k = tree%mask_out
call set_step_mappings_x (k, 0._default, 0._default)
contains
recursive subroutine set_step_mappings_x (k, m_limit, w_limit)
integer(TC), intent(in) :: k
real(default), intent(in) :: m_limit, w_limit
integer(TC), dimension(2) :: kk
real(default), dimension(2) :: m, w
if (tree%branch(k)%has_children) then
if (m_limit > 0) then
if (.not. tree%mapping(k)%is_set ()) then
call tree%mapping(k)%init (k, map_str)
call tree%mapping(k)%set_step_mapping_parameters (m_limit, &
w_limit, variable_limits)
end if
end if
kk = tree%branch(k)%daughter
m = tree%effective_mass(kk)
w = tree%effective_width(kk)
if (tree%mapping(k)%is_s_channel ()) then
call set_step_mappings_x (kk(1), &
tree%mapping(k)%get_mass () - m(2), &
tree%mapping(k)%get_width () + w(2))
call set_step_mappings_x (kk(2), &
tree%mapping(k)%get_mass () - m(1), &
tree%mapping(k)%get_width () + w(1))
else if (m_limit > 0) then
call set_step_mappings_x (kk(1), &
m_limit - m(2), &
w_limit + w(2))
call set_step_mappings_x (kk(2), &
m_limit - m(1), &
w_limit + w(1))
else
call set_step_mappings_x (kk(1), &
- m(2), &
+ w(2))
call set_step_mappings_x (kk(2), &
- m(1), &
+ w(1))
end if
end if
end subroutine set_step_mappings_x
end subroutine phs_tree_set_step_mappings
@ %def phs_tree_set_step_mappings
@
\subsubsection{Resonance structure}
We identify the resonances within a tree as the set of s-channel
mappings. The [[resonance_history_t]] type serves as the result
container.
<<PHS trees: phs tree: TBP>>=
procedure :: extract_resonance_history => phs_tree_extract_resonance_history
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_extract_resonance_history (tree, res_history)
class(phs_tree_t), intent(in) :: tree
type(resonance_history_t), intent(out) :: res_history
end subroutine phs_tree_extract_resonance_history
<<PHS trees: procedures>>=
module subroutine phs_tree_extract_resonance_history (tree, res_history)
class(phs_tree_t), intent(in) :: tree
type(resonance_history_t), intent(out) :: res_history
type(resonance_info_t) :: res_info
integer :: i
if (allocated (tree%mapping)) then
do i = 1, size (tree%mapping)
associate (mapping => tree%mapping(i))
if (mapping%is_s_channel ()) then
call res_info%init (mapping%get_bincode (), mapping%get_flv (), &
n_out = tree%n_externals - tree%n_in)
call res_history%add_resonance (res_info)
end if
end associate
end do
end if
end subroutine phs_tree_extract_resonance_history
@ %def phs_tree_extract_resonance_history
@
\subsubsection{Structural comparison}
This function allows to check whether one tree is the permutation of
another one. The permutation is applied to the second tree in the
argument list. We do not make up a temporary permuted tree, but
compare the two trees directly. The branches are scanned recursively,
where for each daughter we check the friend and the mapping as well.
Once a discrepancy is found, the recursion is exited immediately.
<<PHS trees: public>>=
public :: phs_tree_equivalent
<<PHS trees: sub interfaces>>=
module function phs_tree_equivalent (t1, t2, perm) result (is_equal)
type(phs_tree_t), intent(in) :: t1, t2
type(permutation_t), intent(in) :: perm
logical :: equal, is_equal
end function phs_tree_equivalent
<<PHS trees: procedures>>=
module function phs_tree_equivalent (t1, t2, perm) result (is_equal)
type(phs_tree_t), intent(in) :: t1, t2
type(permutation_t), intent(in) :: perm
logical :: equal, is_equal
integer(TC) :: k1, k2, mask_in
k1 = t1%mask_out
k2 = t2%mask_out
mask_in = t1%mask_in
equal = .true.
call check (t1%branch(k1), t2%branch(k2), k1, k2)
is_equal = equal
contains
recursive subroutine check (b1, b2, k1, k2)
type(phs_branch_t), intent(in) :: b1, b2
integer(TC), intent(in) :: k1, k2
integer(TC), dimension(2) :: d1, d2, pd2
integer :: i
if (.not.b1%has_friend .and. .not.b2%has_friend) then
equal = .true.
else if (b1%has_friend .and. b2%has_friend) then
equal = (b1%friend == tc_permute (b2%friend, perm, mask_in))
end if
if (equal) then
if (b1%has_children .and. b2%has_children) then
d1 = b1%daughter
d2 = b2%daughter
do i=1, 2
pd2(i) = tc_permute (d2(i), perm, mask_in)
end do
if (d1(1)==pd2(1) .and. d1(2)==pd2(2)) then
equal = (b1%firstborn == b2%firstborn)
if (equal) call check &
& (t1%branch(d1(1)), t2%branch(d2(1)), d1(1), d2(1))
if (equal) call check &
& (t1%branch(d1(2)), t2%branch(d2(2)), d1(2), d2(2))
else if (d1(1)==pd2(2) .and. d1(2)==pd2(1)) then
equal = ( (b1%firstborn == 0 .and. b2%firstborn == 0) &
& .or. (b1%firstborn == 3 - b2%firstborn) )
if (equal) call check &
& (t1%branch(d1(1)), t2%branch(d2(2)), d1(1), d2(2))
if (equal) call check &
& (t1%branch(d1(2)), t2%branch(d2(1)), d1(2), d2(1))
else
equal = .false.
end if
end if
end if
if (equal) then
equal = (t1%mapping(k1) == t2%mapping(k2))
end if
end subroutine check
end function phs_tree_equivalent
@ %def phs_tree_equivalent
@ Scan two decay trees and determine the correspondence of mass
variables, i.e., the permutation that transfers the ordered list of
mass variables belonging to the second tree into the first one. Mass
variables are assigned beginning from branches and ending at the root.
<<PHS trees: public>>=
public :: phs_tree_find_msq_permutation
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_find_msq_permutation &
(tree1, tree2, perm2, msq_perm)
type(phs_tree_t), intent(in) :: tree1, tree2
type(permutation_t), intent(in) :: perm2
type(permutation_t), intent(out) :: msq_perm
end subroutine phs_tree_find_msq_permutation
<<PHS trees: procedures>>=
module subroutine phs_tree_find_msq_permutation &
(tree1, tree2, perm2, msq_perm)
type(phs_tree_t), intent(in) :: tree1, tree2
type(permutation_t), intent(in) :: perm2
type(permutation_t), intent(out) :: msq_perm
type(permutation_t) :: perm1
integer(TC) :: mask_in, root
integer(TC), dimension(:), allocatable :: index1, index2
integer :: i
allocate (index1 (tree1%n_msq), index2 (tree2%n_msq))
call permutation_init (perm1, permutation_size (perm2))
mask_in = tree1%mask_in
root = tree1%mask_out
i = 0
call tree_scan (tree1, root, perm1, index1)
i = 0
call tree_scan (tree2, root, perm2, index2)
call permutation_find (msq_perm, index1, index2)
contains
recursive subroutine tree_scan (tree, k, perm, index)
type(phs_tree_t), intent(in) :: tree
integer(TC), intent(in) :: k
type(permutation_t), intent(in) :: perm
integer, dimension(:), intent(inout) :: index
if (tree%branch(k)%has_children) then
call tree_scan (tree, tree%branch(k)%daughter(1), perm, index)
call tree_scan (tree, tree%branch(k)%daughter(2), perm, index)
i = i + 1
if (i <= size (index)) index(i) = tc_permute (k, perm, mask_in)
end if
end subroutine tree_scan
end subroutine phs_tree_find_msq_permutation
@ %def phs_tree_find_msq_permutation
<<PHS trees: public>>=
public :: phs_tree_find_angle_permutation
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_find_angle_permutation &
(tree1, tree2, perm2, angle_perm, sig2)
type(phs_tree_t), intent(in) :: tree1, tree2
type(permutation_t), intent(in) :: perm2
type(permutation_t), intent(out) :: angle_perm
logical, dimension(:), allocatable, intent(out) :: sig2
end subroutine phs_tree_find_angle_permutation
<<PHS trees: procedures>>=
module subroutine phs_tree_find_angle_permutation &
(tree1, tree2, perm2, angle_perm, sig2)
type(phs_tree_t), intent(in) :: tree1, tree2
type(permutation_t), intent(in) :: perm2
type(permutation_t), intent(out) :: angle_perm
logical, dimension(:), allocatable, intent(out) :: sig2
type(permutation_t) :: perm1
integer(TC) :: mask_in, root
integer(TC), dimension(:), allocatable :: index1, index2
logical, dimension(:), allocatable :: sig1
integer :: i
allocate (index1 (tree1%n_angles), index2 (tree2%n_angles))
allocate (sig1 (tree1%n_angles), sig2 (tree2%n_angles))
call permutation_init (perm1, permutation_size (perm2))
mask_in = tree1%mask_in
root = tree1%mask_out
i = 0
call tree_scan (tree1, root, perm1, index1, sig1)
i = 0
call tree_scan (tree2, root, perm2, index2, sig2)
call permutation_find (angle_perm, index1, index2)
contains
recursive subroutine tree_scan (tree, k, perm, index, sig)
type(phs_tree_t), intent(in) :: tree
integer(TC), intent(in) :: k
type(permutation_t), intent(in) :: perm
integer, dimension(:), intent(inout) :: index
logical, dimension(:), intent(inout) :: sig
integer(TC) :: k1, k2, kp
logical :: s
if (tree%branch(k)%has_children) then
k1 = tree%branch(k)%daughter(1)
k2 = tree%branch(k)%daughter(2)
s = (tc_permute(k1, perm, mask_in) < tc_permute(k2, perm, mask_in))
kp = tc_permute (k, perm, mask_in)
i = i + 1
index(i) = kp
sig(i) = s
i = i + 1
index(i) = - kp
sig(i) = s
call tree_scan (tree, k1, perm, index, sig)
call tree_scan (tree, k2, perm, index, sig)
end if
end subroutine tree_scan
end subroutine phs_tree_find_angle_permutation
@ %def phs_tree_find_angle_permutation
@
\subsection{Phase-space evaluation}
\subsubsection{Phase-space volume}
We compute the phase-space volume recursively, following the same path
as for computing other kinematical variables. However, the volume
depends just on $\sqrt{\hat s}$, not on the momentum configuration.
Note: counting branches, we may replace this by a simple formula.
<<PHS trees: phs tree: TBP>>=
procedure :: compute_volume => phs_tree_compute_volume
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_compute_volume (tree, sqrts, volume)
class(phs_tree_t), intent(in) :: tree
real(default), intent(in) :: sqrts
real(default), intent(out) :: volume
end subroutine phs_tree_compute_volume
<<PHS trees: procedures>>=
module subroutine phs_tree_compute_volume (tree, sqrts, volume)
class(phs_tree_t), intent(in) :: tree
real(default), intent(in) :: sqrts
real(default), intent(out) :: volume
integer(TC) :: k
k = tree%mask_out
if (tree%branch(k)%has_children) then
call compute_volume_x (tree%branch(k), k, volume, .true.)
else
volume = 1
end if
contains
recursive subroutine compute_volume_x (b, k, volume, initial)
type(phs_branch_t), intent(in) :: b
integer(TC), intent(in) :: k
real(default), intent(out) :: volume
logical, intent(in) :: initial
integer(TC) :: k1, k2
real(default) :: v1, v2
k1 = b%daughter(1); k2 = b%daughter(2)
if (tree%branch(k1)%has_children) then
call compute_volume_x (tree%branch(k1), k1, v1, .false.)
else
v1 = 1
end if
if (tree%branch(k2)%has_children) then
call compute_volume_x (tree%branch(k2), k2, v2, .false.)
else
v2 = 1
end if
if (initial) then
volume = v1 * v2 / (4 * twopi5)
else
volume = v1 * v2 * sqrts**2 / (4 * twopi2)
end if
end subroutine compute_volume_x
end subroutine phs_tree_compute_volume
@ %def phs_tree_compute_volume
@
\subsubsection{Determine momenta}
This is done in two steps: First the masses are determined. This step
may fail, in which case [[ok]] is set to false. If successful, we
generate angles and the actual momenta. The array [[decay_p]] serves
for transferring the individual three-momenta of the daughter
particles in their mother rest frame from the mass generation to the
momentum generation step.
<<PHS trees: phs tree: TBP>>=
procedure :: compute_momenta_from_x => phs_tree_compute_momenta_from_x
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_compute_momenta_from_x &
(tree, prt, factor, volume, sqrts, x, ok)
class(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(inout) :: prt
real(default), intent(out) :: factor, volume
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(in) :: x
logical, intent(out) :: ok
end subroutine phs_tree_compute_momenta_from_x
<<PHS trees: procedures>>=
module subroutine phs_tree_compute_momenta_from_x &
(tree, prt, factor, volume, sqrts, x, ok)
class(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(inout) :: prt
real(default), intent(out) :: factor, volume
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(in) :: x
logical, intent(out) :: ok
real(default), dimension(tree%mask_out) :: decay_p
integer :: n1, n2
integer :: n_out
if (tree%real_phsp) then
n_out = tree%n_externals - tree%n_in - 1
n1 = max (n_out-2, 0)
n2 = n1 + max (2*n_out, 0)
else
n1 = tree%n_msq
n2 = n1 + tree%n_angles
end if
call phs_tree_set_msq &
(tree, prt, factor, volume, decay_p, sqrts, x(1:n1), ok)
if (ok) call phs_tree_set_angles &
(tree, prt, factor, decay_p, sqrts, x(n1+1:n2))
end subroutine phs_tree_compute_momenta_from_x
@ %def phs_tree_compute_momenta_from_x
@ Mass generation is done recursively. The [[ok]] flag causes the
filled tree to be discarded if set to [[.false.]]. This happens if a
three-momentum turns out to be imaginary, indicating impossible
kinematics. The index [[ix]] tells us how far we have used up the
input array [[x]].
<<PHS trees: procedures>>=
subroutine phs_tree_set_msq &
(tree, prt, factor, volume, decay_p, sqrts, x, ok)
type(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(inout) :: prt
real(default), intent(out) :: factor, volume
real(default), dimension(:), intent(out) :: decay_p
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(in) :: x
logical, intent(out) :: ok
integer :: ix
integer(TC) :: k
real(default) :: m_tot
ok =.true.
ix = 1
k = tree%mask_out
m_tot = tree%mass_sum(k)
decay_p(k) = 0.
if (m_tot < sqrts .or. k == 1) then
if (tree%branch(k)%has_children) then
call set_msq_x (tree%branch(k), k, factor, volume, .true.)
else
factor = 1
volume = 1
end if
else
ok = .false.
end if
contains
recursive subroutine set_msq_x (b, k, factor, volume, initial)
type(phs_branch_t), intent(in) :: b
integer(TC), intent(in) :: k
real(default), intent(out) :: factor, volume
logical, intent(in) :: initial
real(default) :: msq, m, m_min, m_max, m1, m2, msq1, msq2, lda, rlda
integer(TC) :: k1, k2
real(default) :: f1, f2, v1, v2
k1 = b%daughter(1); k2 = b%daughter(2)
if (tree%branch(k1)%has_children) then
call set_msq_x (tree%branch(k1), k1, f1, v1, .false.)
if (.not.ok) return
else
f1 = 1; v1 = 1
end if
if (tree%branch(k2)%has_children) then
call set_msq_x (tree%branch(k2), k2, f2, v2, .false.)
if (.not.ok) return
else
f2 = 1; v2 = 1
end if
m_min = tree%mass_sum(k)
if (initial) then
msq = sqrts**2
m = sqrts
m_max = sqrts
factor = f1 * f2
volume = v1 * v2 / (4 * twopi5)
else
m_max = sqrts - m_tot + m_min
call tree%mapping(k)%compute_msq_from_x (sqrts**2, m_min**2, &
m_max**2, msq, factor, x(ix)); ix = ix + 1
if (msq >= 0) then
m = sqrt (msq)
factor = f1 * f2 * factor
volume = v1 * v2 * sqrts**2 / (4 * twopi2)
call prt(k)%set_msq (msq)
call prt(k)%set_defined ()
else
ok = .false.
end if
end if
if (ok) then
msq1 = prt(k1)%get_msq (); m1 = sqrt (msq1)
msq2 = prt(k2)%get_msq (); m2 = sqrt (msq2)
lda = lambda (msq, msq1, msq2)
if (lda > 0 .and. m > m1 + m2 .and. m <= m_max) then
rlda = sqrt (lda)
decay_p(k1) = rlda / (2*m)
decay_p(k2) = - decay_p(k1)
factor = rlda / msq * factor
else
ok = .false.
end if
end if
end subroutine set_msq_x
end subroutine phs_tree_set_msq
@ %def phs_tree_set_msq
@
The heart of phase space generation: Now we have the invariant masses,
let us generate angles. At each branch, we take a Lorentz
transformation and augment it by a boost to the current particle
rest frame, and by rotations $\phi$ and $\theta$ around the $z$ and
$y$ axis, respectively. This transformation is passed down to the
daughter particles, if present.
<<PHS trees: procedures>>=
subroutine phs_tree_set_angles (tree, prt, factor, decay_p, sqrts, x)
type(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(inout) :: prt
real(default), intent(inout) :: factor
real(default), dimension(:), intent(in) :: decay_p
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(in) :: x
integer :: ix
integer(TC) :: k
ix = 1
k = tree%mask_out
call set_angles_x (tree%branch(k), k)
contains
recursive subroutine set_angles_x (b, k, L0)
type(phs_branch_t), intent(in) :: b
integer(TC), intent(in) :: k
type(lorentz_transformation_t), intent(in), optional :: L0
real(default) :: m, msq, ct, st, phi, f, E, p, bg
type(lorentz_transformation_t) :: L, LL
integer(TC) :: k1, k2
type(vector3_t) :: axis
p = decay_p(k)
msq = prt(k)%get_msq (); m = sqrt (msq)
E = sqrt (msq + p**2)
if (present (L0)) then
call prt(k)%set_momentum (L0 * vector4_moving (E,p,3))
else
call prt(k)%set_momentum (vector4_moving (E,p,3))
end if
call prt(k)%set_defined ()
if (b%has_children) then
k1 = b%daughter(1)
k2 = b%daughter(2)
if (m > 0) then
bg = p / m
else
bg = 0
end if
phi = x(ix) * twopi; ix = ix + 1
call tree%mapping(k)%compute_ct_from_x (sqrts**2, ct, st, f, &
x(ix)); ix = ix + 1
factor = factor * f
if (.not. b%has_friend) then
L = LT_compose_r2_r3_b3 (ct, st, cos(phi), sin(phi), bg)
!!! The function above is equivalent to:
! L = boost (bg,3) * rotation (phi,3) * rotation (ct,st,2)
else
LL = boost (-bg,3); if (present (L0)) LL = LL * inverse(L0)
axis = space_part ( &
LL * prt(tree%branch(k)%friend)%get_momentum () )
L = boost(bg,3) * rotation_to_2nd (vector3_canonical(3), axis) &
* LT_compose_r2_r3_b3 (ct, st, cos(phi), sin(phi), 0._default)
end if
if (present (L0)) L = L0 * L
call set_angles_x (tree%branch(k1), k1, L)
call set_angles_x (tree%branch(k2), k2, L)
end if
end subroutine set_angles_x
end subroutine phs_tree_set_angles
@ %def phs_tree_set_angles
@
\subsubsection{Recover random numbers}
For the other channels we want to compute the random numbers that
would have generated the momenta that we already know.
<<PHS trees: phs tree: TBP>>=
procedure :: compute_x_from_momenta => phs_tree_compute_x_from_momenta
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_compute_x_from_momenta &
(tree, prt, factor, sqrts, x)
class(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(in) :: prt
real(default), intent(out) :: factor
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(inout) :: x
end subroutine phs_tree_compute_x_from_momenta
<<PHS trees: procedures>>=
module subroutine phs_tree_compute_x_from_momenta &
(tree, prt, factor, sqrts, x)
class(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(in) :: prt
real(default), intent(out) :: factor
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(inout) :: x
real(default), dimension(tree%mask_out) :: decay_p
integer :: n1, n2
n1 = tree%n_msq
n2 = n1 + tree%n_angles
call phs_tree_get_msq &
(tree, prt, factor, decay_p, sqrts, x(1:n1))
call phs_tree_get_angles &
(tree, prt, factor, decay_p, sqrts, x(n1+1:n2))
end subroutine phs_tree_compute_x_from_momenta
@ %def phs_tree_compute_x_from_momenta
@ The inverse operation follows exactly the same steps. The tree is
[[inout]] because it contains mappings whose parameters can be reset
when the mapping is applied.
<<PHS trees: procedures>>=
subroutine phs_tree_get_msq (tree, prt, factor, decay_p, sqrts, x)
type(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(in) :: prt
real(default), intent(out) :: factor
real(default), dimension(:), intent(out) :: decay_p
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(inout) :: x
integer :: ix
integer(TC) :: k
real(default) :: m_tot
ix = 1
k = tree%mask_out
m_tot = tree%mass_sum(k)
decay_p(k) = 0.
if (tree%branch(k)%has_children) then
call get_msq_x (tree%branch(k), k, factor, .true.)
else
factor = 1
end if
contains
recursive subroutine get_msq_x (b, k, factor, initial)
type(phs_branch_t), intent(in) :: b
integer(TC), intent(in) :: k
real(default), intent(out) :: factor
logical, intent(in) :: initial
real(default) :: msq, m, m_min, m_max, msq1, msq2, lda, rlda
integer(TC) :: k1, k2
real(default) :: f1, f2
k1 = b%daughter(1); k2 = b%daughter(2)
if (tree%branch(k1)%has_children) then
call get_msq_x (tree%branch(k1), k1, f1, .false.)
else
f1 = 1
end if
if (tree%branch(k2)%has_children) then
call get_msq_x (tree%branch(k2), k2, f2, .false.)
else
f2 = 1
end if
m_min = tree%mass_sum(k)
m_max = sqrts - m_tot + m_min
msq = prt(k)%get_msq (); m = sqrt (msq)
if (initial) then
factor = f1 * f2
else
call tree%mapping(k)%compute_x_from_msq (sqrts**2, m_min**2, &
m_max**2, msq, factor, x(ix)); ix = ix + 1
factor = f1 * f2 * factor
end if
msq1 = prt(k1)%get_msq ()
msq2 = prt(k2)%get_msq ()
lda = lambda (msq, msq1, msq2)
if (lda > 0) then
rlda = sqrt (lda)
decay_p(k1) = rlda / (2 * m)
decay_p(k2) = - decay_p(k1)
factor = rlda / msq * factor
else
decay_p(k1) = 0
decay_p(k2) = 0
factor = 0
end if
end subroutine get_msq_x
end subroutine phs_tree_get_msq
@ %def phs_tree_get_msq
@ This subroutine is the most time-critical part of the whole
program. Therefore, we do not exactly parallel the angle generation
routine above but make sure that things get evaluated only if they are
really needed, at the expense of readability. Particularly important
is to have as few multiplications of Lorentz transformations as
possible.
<<PHS trees: procedures>>=
subroutine phs_tree_get_angles (tree, prt, factor, decay_p, sqrts, x)
type(phs_tree_t), intent(inout) :: tree
type(phs_prt_t), dimension(:), intent(in) :: prt
real(default), intent(inout) :: factor
real(default), dimension(:), intent(in) :: decay_p
real(default), intent(in) :: sqrts
real(default), dimension(:), intent(out) :: x
integer :: ix
integer(TC) :: k
ix = 1
k = tree%mask_out
if (tree%branch(k)%has_children) then
call get_angles_x (tree%branch(k), k)
end if
contains
recursive subroutine get_angles_x (b, k, ct0, st0, phi0, L0)
type(phs_branch_t), intent(in) :: b
integer(TC), intent(in) :: k
real(default), intent(in), optional :: ct0, st0, phi0
type(lorentz_transformation_t), intent(in), optional :: L0
real(default) :: cp0, sp0, m, msq, ct, st, phi, bg, f
type(lorentz_transformation_t) :: L, LL
type(vector4_t) :: p1, pf
type(vector3_t) :: n, axis
integer(TC) :: k1, k2, kf
logical :: has_friend, need_L
k1 = b%daughter(1)
k2 = b%daughter(2)
kf = b%friend
has_friend = b%has_friend
if (present(L0)) then
p1 = L0 * prt(k1)%get_momentum ()
if (has_friend) pf = L0 * prt(kf)%get_momentum ()
else
p1 = prt(k1)%get_momentum ()
if (has_friend) pf = prt(kf)%get_momentum ()
end if
if (present(phi0)) then
cp0 = cos (phi0)
sp0 = sin (phi0)
end if
msq = prt(k)%get_msq (); m = sqrt (msq)
if (m > 0) then
bg = decay_p(k) / m
else
bg = 0
end if
if (has_friend) then
if (present (phi0)) then
axis = axis_from_p_r3_r2_b3 (pf, cp0, -sp0, ct0, -st0, -bg)
LL = rotation_to_2nd (axis, vector3_canonical (3)) &
* LT_compose_r3_r2_b3 (cp0, -sp0, ct0, -st0, -bg)
else
axis = axis_from_p_b3 (pf, -bg)
LL = rotation_to_2nd (axis, vector3_canonical(3))
if (.not. vanishes (bg)) LL = LL * boost(-bg, 3)
end if
n = space_part (LL * p1)
else if (present (phi0)) then
n = axis_from_p_r3_r2_b3 (p1, cp0, -sp0, ct0, -st0, -bg)
else
n = axis_from_p_b3 (p1, -bg)
end if
phi = azimuthal_angle (n)
x(ix) = phi / twopi; ix = ix + 1
ct = polar_angle_ct (n)
st = sqrt (1 - ct**2)
call tree%mapping(k)%compute_x_from_ct (sqrts**2, ct, f, &
x(ix)); ix = ix + 1
factor = factor * f
if (tree%branch(k1)%has_children .or. tree%branch(k2)%has_children) then
need_L = .true.
if (has_friend) then
if (present (L0)) then
L = LL * L0
else
L = LL
end if
else if (present (L0)) then
L = LT_compose_r3_r2_b3 (cp0, -sp0, ct0, -st0, -bg) * L0
else if (present (phi0)) then
L = LT_compose_r3_r2_b3 (cp0, -sp0, ct0, -st0, -bg)
else if (bg /= 0) then
L = boost(-bg, 3)
else
need_L = .false.
end if
if (need_L) then
if (tree%branch(k1)%has_children) &
call get_angles_x (tree%branch(k1), k1, ct, st, phi, L)
if (tree%branch(k2)%has_children) &
call get_angles_x (tree%branch(k2), k2, ct, st, phi, L)
else
if (tree%branch(k1)%has_children) &
call get_angles_x (tree%branch(k1), k1, ct, st, phi)
if (tree%branch(k2)%has_children) &
call get_angles_x (tree%branch(k2), k2, ct, st, phi)
end if
end if
end subroutine get_angles_x
end subroutine phs_tree_get_angles
@ %def phs_tree_get_angles
@
\subsubsection{Auxiliary stuff}
This calculates all momenta that are not yet known by summing up
daughter particle momenta. The external particles must be known.
Only composite particles not yet known are calculated.
<<PHS trees: public>>=
public :: phs_tree_combine_particles
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_combine_particles (tree, prt)
type(phs_tree_t), intent(in) :: tree
type(phs_prt_t), dimension(:), intent(inout) :: prt
end subroutine phs_tree_combine_particles
<<PHS trees: procedures>>=
module subroutine phs_tree_combine_particles (tree, prt)
type(phs_tree_t), intent(in) :: tree
type(phs_prt_t), dimension(:), intent(inout) :: prt
call combine_particles_x (tree%mask_out)
contains
recursive subroutine combine_particles_x (k)
integer(TC), intent(in) :: k
integer :: k1, k2
if (tree%branch(k)%has_children) then
k1 = tree%branch(k)%daughter(1); k2 = tree%branch(k)%daughter(2)
call combine_particles_x (k1)
call combine_particles_x (k2)
if (.not. prt(k)%defined) then
call prt(k)%combine (prt(k1), prt(k2))
end if
end if
end subroutine combine_particles_x
end subroutine phs_tree_combine_particles
@ %def phs_tree_combine_particles
@ The previous routine is to be evaluated at runtime. Instead of
scanning trees, we can as well set up a multiplication table. This is
generated here. Note that the table is [[intent(out)]].
<<PHS trees: public>>=
public :: phs_tree_setup_prt_combinations
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_setup_prt_combinations (tree, comb)
type(phs_tree_t), intent(in) :: tree
integer, dimension(:,:), intent(out) :: comb
end subroutine phs_tree_setup_prt_combinations
<<PHS trees: procedures>>=
module subroutine phs_tree_setup_prt_combinations (tree, comb)
type(phs_tree_t), intent(in) :: tree
integer, dimension(:,:), intent(out) :: comb
comb = 0
call setup_prt_combinations_x (tree%mask_out)
contains
recursive subroutine setup_prt_combinations_x (k)
integer(TC), intent(in) :: k
integer, dimension(2) :: kk
if (tree%branch(k)%has_children) then
kk = tree%branch(k)%daughter
call setup_prt_combinations_x (kk(1))
call setup_prt_combinations_x (kk(2))
comb(:,k) = kk
end if
end subroutine setup_prt_combinations_x
end subroutine phs_tree_setup_prt_combinations
@ %def phs_tree_setup_prt_combinations
@ JRR: 2022-01-22 [[reshuffle_mappings]] is commented out, and no
longer used, not clear why?
<<PHS trees: phs tree: TBP>>=
procedure :: reshuffle_mappings => phs_tree_reshuffle_mappings
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_reshuffle_mappings (tree)
class(phs_tree_t), intent(inout) :: tree
end subroutine phs_tree_reshuffle_mappings
<<PHS trees: procedures>>=
module subroutine phs_tree_reshuffle_mappings (tree)
class(phs_tree_t), intent(inout) :: tree
integer(TC) :: k0, k_old, k_new, k2
integer :: i
type(mapping_t) :: mapping_tmp
real(default) :: mass_tmp
do i = 1, size (tree%momentum_link)
if (i /= tree%momentum_link (i)) then
k_old = 2**(i-tree%n_in-1)
k_new = 2**(tree%momentum_link(i)-tree%n_in-1)
k0 = tree%branch(k_old)%mother
k2 = k_new + tree%branch(k_old)%sibling
mapping_tmp = tree%mapping(k0)
mass_tmp = tree%mass_sum(k0)
tree%mapping(k0) = tree%mapping(k2)
tree%mapping(k2) = mapping_tmp
tree%mass_sum(k0) = tree%mass_sum(k2)
tree%mass_sum(k2) = mass_tmp
end if
end do
end subroutine phs_tree_reshuffle_mappings
@ %def phs_tree_reshuffle_mappings
@
<<PHS trees: public>>=
public :: phs_tree_set_momentum_links
<<PHS trees: sub interfaces>>=
module subroutine phs_tree_set_momentum_links (tree, list)
type(phs_tree_t), intent(inout) :: tree
integer, dimension(:), allocatable :: list
end subroutine phs_tree_set_momentum_links
<<PHS trees: procedures>>=
module subroutine phs_tree_set_momentum_links (tree, list)
type(phs_tree_t), intent(inout) :: tree
integer, dimension(:), allocatable :: list
tree%momentum_link = list
end subroutine phs_tree_set_momentum_links
@ %def phs_tree_set_momentum_links
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[phs_trees_ut.f90]]>>=
<<File header>>
module phs_trees_ut
use unit_tests
use phs_trees_uti
<<Standard module head>>
<<PHS trees: public test>>
contains
<<PHS trees: test driver>>
end module phs_trees_ut
@ %def phs_trees_ut
@
<<[[phs_trees_uti.f90]]>>=
<<File header>>
module phs_trees_uti
!!!<<Use kinds>>
use kinds, only: TC
<<Use strings>>
use flavors, only: flavor_t
use model_data, only: model_data_t
use resonances, only: resonance_history_t
use mappings, only: mapping_defaults_t
use phs_trees
<<Standard module head>>
<<PHS trees: test declarations>>
contains
<<PHS trees: tests>>
end module phs_trees_uti
@ %def phs_trees_ut
@ API: driver for the unit tests below.
<<PHS trees: public test>>=
public :: phs_trees_test
<<PHS trees: test driver>>=
subroutine phs_trees_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS trees: execute tests>>
end subroutine phs_trees_test
@ %def phs_trees_test
@
Create a simple $2\to 3$ PHS tree and display it.
<<PHS trees: execute tests>>=
call test (phs_tree_1, "phs_tree_1", &
"check phs tree setup", &
u, results)
<<PHS trees: test declarations>>=
public :: phs_tree_1
<<PHS trees: tests>>=
subroutine phs_tree_1 (u)
integer, intent(in) :: u
type(phs_tree_t) :: tree
type(model_data_t), target :: model
type(flavor_t), dimension(5) :: flv
integer :: i
write (u, "(A)") "* Test output: phs_tree_1"
write (u, "(A)") "* Purpose: test PHS tree routines"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Set up flavors"
write (u, "(A)")
call flv%init ([1, -2, 24, 5, -5], model)
do i = 1, 5
write (u, "(1x)", advance="no")
call flv(i)%write (u)
end do
write (u, *)
write (u, "(A)")
write (u, "(A)") "* Create tree"
write (u, "(A)")
call tree%init (2, 3, 0, 0)
call tree%from_array ([integer(TC) :: 1, 2, 3, 4, 7, 8, 16])
call tree%set_mass_sum (flv)
call tree%set_effective_masses ()
call tree%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call tree%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_tree_1"
end subroutine phs_tree_1
@ %def phs_tree_1
@ The analogous tree with resonance (s-channel) mappings.
<<PHS trees: execute tests>>=
call test (phs_tree_2, "phs_tree_2", &
"check phs tree with resonances", &
u, results)
<<PHS trees: test declarations>>=
public :: phs_tree_2
<<PHS trees: tests>>=
subroutine phs_tree_2 (u)
integer, intent(in) :: u
type(phs_tree_t) :: tree
type(model_data_t), target :: model
type(mapping_defaults_t) :: mapping_defaults
type(flavor_t), dimension(5) :: flv
type(resonance_history_t) :: res_history
integer :: i
write (u, "(A)") "* Test output: phs_tree_2"
write (u, "(A)") "* Purpose: test PHS tree with resonances"
write (u, "(A)")
write (u, "(A)") "* Read model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Set up flavors"
write (u, "(A)")
call flv%init ([1, -2, 24, 5, -5], model)
do i = 1, 5
write (u, "(1x)", advance="no")
call flv(i)%write (u)
end do
write (u, *)
write (u, "(A)")
write (u, "(A)") "* Create tree with mappings"
write (u, "(A)")
call tree%init (2, 3, 0, 0)
call tree%from_array ([integer(TC) :: 1, 2, 3, 4, 7, 8, 16])
call tree%set_mass_sum (flv)
call tree%init_mapping (3_TC, var_str ("s_channel"), -24, model)
call tree%init_mapping (7_TC, var_str ("s_channel"), 23, model)
call tree%set_mapping_parameters (mapping_defaults, variable_limits=.false.)
call tree%set_effective_masses ()
call tree%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract resonances from mappings"
write (u, "(A)")
call tree%extract_resonance_history (res_history)
call res_history%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call tree%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_tree_2"
end subroutine phs_tree_2
@ %def phs_tree_2
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{The phase-space forest}
Simply stated, a phase-space forest is a collection of phase-space
trees. More precisely, a [[phs_forest]] object contains all
parameterizations of phase space that \whizard\ will use for a single
hard process, prepared in the form of [[phs_tree]] objects. This is
suitable for evaluation by the \vamp\ integration package: each
parameterization (tree) is a valid channel in the multi-channel
adaptive integration, and each variable in a tree corresponds to an
integration dimension, defined by an appropriate mapping of the
$(0,1)$ interval to the allowed range of the integration variable.
The trees are grouped in groves. The trees (integration channels)
within a grove share a common weight, assuming that they are related
by some approximate symmetry.
Trees/channels that are related by an exact symmetry are connected by
an array of equivalences; each equivalence object holds the data that
relate one channel to another.
The phase-space setup, i.e., the detailed structure of trees and
forest, are read from a file. Therefore, this module also contains
the syntax definition and the parser needed for interpreting this
file.
<<[[phs_forests.f90]]>>=
<<File header>>
module phs_forests
<<Use kinds>>
use kinds, only: TC
<<Use strings>>
use lorentz
use permutations
use syntax_rules
use parser
use model_data
use flavors
use interactions
use phs_base
use resonances, only: resonance_history_t
use resonances, only: resonance_history_set_t
use mappings
use phs_trees
<<Standard module head>>
<<PHS forests: public>>
<<PHS forests: types>>
<<PHS forests: interfaces>>
<<PHS forests: variables>>
interface
<<PHS forests: sub interfaces>>
end interface
contains
<<PHS forests: main procedures>>
end module phs_forests
@ %def phs_forests
@
<<[[phs_forests_sub.f90]]>>=
<<File header>>
submodule (phs_forests) phs_forests_s
use io_units
use format_defs, only: FMT_19
use diagnostics
use numeric_utils
use ifiles
use lexers
implicit none
contains
<<PHS forests: procedures>>
end submodule phs_forests_s
@ %def phs_forests_s
@
\subsection{Phase-space setup parameters}
This transparent container holds the parameters that the algorithm
needs for phase-space setup, with reasonable defaults.
The threshold mass (for considering a particle as effectively
massless) is specified separately for s- and t-channel. The default is
to treat $W$ and $Z$ bosons as massive in the s-channel, but as
massless in the t-channel. The $b$-quark is treated always massless,
the $t$-quark always massive.
<<PHS forests: public>>=
public :: phs_parameters_t
<<PHS forests: types>>=
type :: phs_parameters_t
real(default) :: sqrts = 0
real(default) :: m_threshold_s = 50._default
real(default) :: m_threshold_t = 100._default
integer :: off_shell = 1
integer :: t_channel = 2
logical :: keep_nonresonant = .true.
contains
<<PHS forests: phs parameters: TBP>>
end type phs_parameters_t
@ %def phs_parameters_t
@ Write phase-space parameters to file.
<<PHS forests: phs parameters: TBP>>=
procedure :: write => phs_parameters_write
<<PHS forests: sub interfaces>>=
module subroutine phs_parameters_write (phs_par, unit)
class(phs_parameters_t), intent(in) :: phs_par
integer, intent(in), optional :: unit
end subroutine phs_parameters_write
<<PHS forests: procedures>>=
module subroutine phs_parameters_write (phs_par, unit)
class(phs_parameters_t), intent(in) :: phs_par
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", phs_par%sqrts
write (u, "(3x,A," // FMT_19 // ")") "m_threshold_s = ", phs_par%m_threshold_s
write (u, "(3x,A," // FMT_19 // ")") "m_threshold_t = ", phs_par%m_threshold_t
write (u, "(3x,A,I0)") "off_shell = ", phs_par%off_shell
write (u, "(3x,A,I0)") "t_channel = ", phs_par%t_channel
write (u, "(3x,A,L1)") "keep_nonresonant = ", phs_par%keep_nonresonant
end subroutine phs_parameters_write
@ %def phs_parameters_write
@ Read phase-space parameters from file.
<<PHS forests: phs parameters: TBP>>=
procedure :: read => phs_parameters_read
<<PHS forests: sub interfaces>>=
module subroutine phs_parameters_read (phs_par, unit)
class(phs_parameters_t), intent(out) :: phs_par
integer, intent(in) :: unit
end subroutine phs_parameters_read
<<PHS forests: procedures>>=
module subroutine phs_parameters_read (phs_par, unit)
class(phs_parameters_t), intent(out) :: phs_par
integer, intent(in) :: unit
character(20) :: dummy
character :: equals
read (unit, *) dummy, equals, phs_par%sqrts
read (unit, *) dummy, equals, phs_par%m_threshold_s
read (unit, *) dummy, equals, phs_par%m_threshold_t
read (unit, *) dummy, equals, phs_par%off_shell
read (unit, *) dummy, equals, phs_par%t_channel
read (unit, *) dummy, equals, phs_par%keep_nonresonant
end subroutine phs_parameters_read
@ %def phs_parameters_write
@ Comparison.
<<PHS forests: interfaces>>=
interface operator(==)
module procedure phs_parameters_eq
end interface
interface operator(/=)
module procedure phs_parameters_ne
end interface
<<PHS forests: sub interfaces>>=
module function phs_parameters_eq (phs_par1, phs_par2) result (equal)
logical :: equal
type(phs_parameters_t), intent(in) :: phs_par1, phs_par2
end function phs_parameters_eq
module function phs_parameters_ne (phs_par1, phs_par2) result (ne)
logical :: ne
type(phs_parameters_t), intent(in) :: phs_par1, phs_par2
end function phs_parameters_ne
<<PHS forests: procedures>>=
module function phs_parameters_eq (phs_par1, phs_par2) result (equal)
logical :: equal
type(phs_parameters_t), intent(in) :: phs_par1, phs_par2
equal = phs_par1%sqrts == phs_par2%sqrts &
.and. phs_par1%m_threshold_s == phs_par2%m_threshold_s &
.and. phs_par1%m_threshold_t == phs_par2%m_threshold_t &
.and. phs_par1%off_shell == phs_par2%off_shell &
.and. phs_par1%t_channel == phs_par2%t_channel &
.and.(phs_par1%keep_nonresonant .eqv. phs_par2%keep_nonresonant)
end function phs_parameters_eq
module function phs_parameters_ne (phs_par1, phs_par2) result (ne)
logical :: ne
type(phs_parameters_t), intent(in) :: phs_par1, phs_par2
ne = phs_par1%sqrts /= phs_par2%sqrts &
.or. phs_par1%m_threshold_s /= phs_par2%m_threshold_s &
.or. phs_par1%m_threshold_t /= phs_par2%m_threshold_t &
.or. phs_par1%off_shell /= phs_par2%off_shell &
.or. phs_par1%t_channel /= phs_par2%t_channel &
.or.(phs_par1%keep_nonresonant .neqv. phs_par2%keep_nonresonant)
end function phs_parameters_ne
@ %def phs_parameters_eq phs_parameters_ne
@
\subsection{Equivalences}
This type holds information about equivalences between phase-space
trees. We make a linked list, where each node contains the two
trees which are equivalent and the corresponding permutation of
external particles. Two more arrays are to be filled: The permutation
of mass variables and the permutation of angular variables, where the
signature indicates a necessary exchange of daughter branches.
<<PHS forests: types>>=
type :: equivalence_t
private
integer :: left, right
type(permutation_t) :: perm
type(permutation_t) :: msq_perm, angle_perm
logical, dimension(:), allocatable :: angle_sig
type(equivalence_t), pointer :: next => null ()
end type equivalence_t
@ %def equivalence_t
<<PHS forests: types>>=
type :: equivalence_list_t
private
integer :: length = 0
type(equivalence_t), pointer :: first => null ()
type(equivalence_t), pointer :: last => null ()
end type equivalence_list_t
@ %def equivalence_list_t
@ Append an equivalence to the list
<<PHS forests: procedures>>=
subroutine equivalence_list_add (eql, left, right, perm)
type(equivalence_list_t), intent(inout) :: eql
integer, intent(in) :: left, right
type(permutation_t), intent(in) :: perm
type(equivalence_t), pointer :: eq
allocate (eq)
eq%left = left
eq%right = right
eq%perm = perm
if (associated (eql%last)) then
eql%last%next => eq
else
eql%first => eq
end if
eql%last => eq
eql%length = eql%length + 1
end subroutine equivalence_list_add
@ %def equivalence_list_add
@ Delete the list contents. Has to be pure because it is called from
an elemental subroutine.
<<PHS forests: procedures>>=
pure subroutine equivalence_list_final (eql)
type(equivalence_list_t), intent(inout) :: eql
type(equivalence_t), pointer :: eq
do while (associated (eql%first))
eq => eql%first
eql%first => eql%first%next
deallocate (eq)
end do
eql%last => null ()
eql%length = 0
end subroutine equivalence_list_final
@ %def equivalence_list_final
@ Make a deep copy of the equivalence list. This allows for deep
copies of groves and forests.
<<PHS forests: interfaces>>=
interface assignment(=)
module procedure equivalence_list_assign
end interface
<<PHS forests: main procedures>>=
subroutine equivalence_list_assign (eql_out, eql_in)
type(equivalence_list_t), intent(out) :: eql_out
type(equivalence_list_t), intent(in) :: eql_in
type(equivalence_t), pointer :: eq, eq_copy
eq => eql_in%first
do while (associated (eq))
allocate (eq_copy)
eq_copy = eq
eq_copy%next => null ()
if (associated (eql_out%first)) then
eql_out%last%next => eq_copy
else
eql_out%first => eq_copy
end if
eql_out%last => eq_copy
eq => eq%next
end do
end subroutine equivalence_list_assign
@ %def equivalence_list_assign
@ The number of list entries
<<PHS forests: procedures>>=
elemental function equivalence_list_length (eql) result (length)
integer :: length
type(equivalence_list_t), intent(in) :: eql
length = eql%length
end function equivalence_list_length
@ %def equivalence_list_length
@ Recursively write the equivalences list
<<PHS forests: procedures>>=
subroutine equivalence_list_write (eql, unit)
type(equivalence_list_t), intent(in) :: eql
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
if (associated (eql%first)) then
call equivalence_write_rec (eql%first, u)
else
write (u, *) " [empty]"
end if
contains
recursive subroutine equivalence_write_rec (eq, u)
type(equivalence_t), intent(in) :: eq
integer, intent(in) :: u
integer :: i
write (u, "(3x,A,1x,I0,1x,I0,2x,A)", advance="no") &
"Equivalence:", eq%left, eq%right, "Final state permutation:"
call permutation_write (eq%perm, u)
write (u, "(1x,12x,1x,A,1x)", advance="no") &
" msq permutation: "
call permutation_write (eq%msq_perm, u)
write (u, "(1x,12x,1x,A,1x)", advance="no") &
" angle permutation:"
call permutation_write (eq%angle_perm, u)
write (u, "(1x,12x,1x,26x)", advance="no")
do i = 1, size (eq%angle_sig)
if (eq%angle_sig(i)) then
write (u, "(1x,A)", advance="no") "+"
else
write (u, "(1x,A)", advance="no") "-"
end if
end do
write (u, *)
if (associated (eq%next)) call equivalence_write_rec (eq%next, u)
end subroutine equivalence_write_rec
end subroutine equivalence_list_write
@ %def equivalence_list_write
@
\subsection{Groves}
A grove is a group of trees (phase-space channels) that share a common
weight in the integration. Within a grove, channels can be declared
equivalent, so they also share their integration grids (up to
symmetries). The grove contains a list of equivalences. The
[[tree_count_offset]] is the total number of trees of the preceding
groves; when the trees are counted per forest (integration channels),
the offset has to be added to all tree indices.
<<PHS forests: types>>=
type :: phs_grove_t
private
integer :: tree_count_offset
type(phs_tree_t), dimension(:), allocatable :: tree
type(equivalence_list_t) :: equivalence_list
end type phs_grove_t
@ %def phs_grove_t
@ Call [[phs_tree_init]] which is also elemental:
<<PHS forests: procedures>>=
elemental subroutine phs_grove_init &
(grove, n_trees, n_in, n_out, n_masses, n_angles)
type(phs_grove_t), intent(inout) :: grove
integer, intent(in) :: n_trees, n_in, n_out, n_masses, n_angles
grove%tree_count_offset = 0
allocate (grove%tree (n_trees))
call grove%tree%init (n_in, n_out, n_masses, n_angles)
end subroutine phs_grove_init
@ %def phs_grove_init
@ The trees do not have pointer components, thus no call to
[[phs_tree_final]]:
<<PHS forests: procedures>>=
elemental subroutine phs_grove_final (grove)
type(phs_grove_t), intent(inout) :: grove
deallocate (grove%tree)
call equivalence_list_final (grove%equivalence_list)
end subroutine phs_grove_final
@ %def phs_grove_final
@ Deep copy. This triggers double free corruption with the Intel
compiler and hence has to remain in the main module.
<<PHS forests: interfaces>>=
interface assignment(=)
module procedure phs_grove_assign0
module procedure phs_grove_assign1
end interface
<<PHS forests: main procedures>>=
subroutine phs_grove_assign0 (grove_out, grove_in)
type(phs_grove_t), intent(out) :: grove_out
type(phs_grove_t), intent(in) :: grove_in
grove_out%tree_count_offset = grove_in%tree_count_offset
if (allocated (grove_in%tree)) then
allocate (grove_out%tree (size (grove_in%tree)))
grove_out%tree = grove_in%tree
end if
grove_out%equivalence_list = grove_in%equivalence_list
end subroutine phs_grove_assign0
subroutine phs_grove_assign1 (grove_out, grove_in)
type(phs_grove_t), dimension(:), intent(out) :: grove_out
type(phs_grove_t), dimension(:), intent(in) :: grove_in
integer :: i
do i = 1, size (grove_in)
call phs_grove_assign0 (grove_out(i), grove_in(i))
end do
end subroutine phs_grove_assign1
@ %def phs_grove_assign
@ Get the global (s-channel) mappings. Implemented as a subroutine
which returns an array (slice).
<<PHS forests: procedures>>=
subroutine phs_grove_assign_s_mappings (grove, mapping)
type(phs_grove_t), intent(in) :: grove
type(mapping_t), dimension(:), intent(out) :: mapping
integer :: i
if (size (mapping) == size (grove%tree)) then
do i = 1, size (mapping)
call grove%tree(i)%assign_s_mapping (mapping(i))
end do
else
call msg_bug ("phs_grove_assign_s_mappings: array size mismatch")
end if
end subroutine phs_grove_assign_s_mappings
@ %def phs_grove_assign_s_mappings
@
\subsection{The forest type}
This is a collection of trees and associated particles. In a given
tree, each branch code corresponds to a particle in the [[prt]] array.
Furthermore, we have an array of mass sums which is independent of the
decay tree and of the particular event. The mappings directly
correspond to the decay trees, and the decay groves collect the trees
in classes. The permutation list consists of all permutations of
outgoing particles that map the decay forest onto itself.
The particle codes [[flv]] (one for each external particle) are needed
for determining masses and such. The trees and associated information
are collected in the [[grove]] array, together with a lookup table
that associates tree indices to groves. Finally, the [[prt]] array
serves as workspace for phase-space evaluation.
The [[prt_combination]] is a list of index pairs, namely the particle
momenta pairs that need to be combined in order to provide all
momentum combinations that the phase-space trees need to know.
<<PHS forests: public>>=
public :: phs_forest_t
<<PHS forests: types>>=
type :: phs_forest_t
private
integer :: n_in, n_out, n_tot
integer :: n_masses, n_angles, n_dimensions
integer :: n_trees, n_equivalences
type(flavor_t), dimension(:), allocatable :: flv
type(phs_grove_t), dimension(:), allocatable :: grove
integer, dimension(:), allocatable :: grove_lookup
type(phs_prt_t), dimension(:), allocatable :: prt_in
type(phs_prt_t), dimension(:), allocatable :: prt_out
type(phs_prt_t), dimension(:), allocatable :: prt
integer(TC), dimension(:,:), allocatable :: prt_combination
type(mapping_t), dimension(:), allocatable :: s_mapping
contains
<<PHS forests: phs forest: TBP>>
end type phs_forest_t
@ %def phs_forest_t
@
The initialization merely allocates memory. We have to know how many
trees there are in each grove, so we can initialize everything. The
number of groves is the size of the [[n_tree]] array.
In the [[grove_lookup]] table we store the grove index that belongs to
each absolute tree index. The difference between the absolute index
and the relative (to the grove) index is stored, for each grove, as
[[tree_count_offset]].
The particle array is allocated according to the total number of
branches each tree has, but not filled.
<<PHS forests: phs forest: TBP>>=
procedure :: init => phs_forest_init
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_init (forest, n_tree, n_in, n_out)
class(phs_forest_t), intent(inout) :: forest
integer, dimension(:), intent(in) :: n_tree
integer, intent(in) :: n_in, n_out
end subroutine phs_forest_init
<<PHS forests: procedures>>=
module subroutine phs_forest_init (forest, n_tree, n_in, n_out)
class(phs_forest_t), intent(inout) :: forest
integer, dimension(:), intent(in) :: n_tree
integer, intent(in) :: n_in, n_out
integer :: g, count, k_root
forest%n_in = n_in
forest%n_out = n_out
forest%n_tot = n_in + n_out
forest%n_masses = max (n_out - 2, 0)
forest%n_angles = max (2*n_out - 2, 0)
forest%n_dimensions = forest%n_masses + forest%n_angles
forest%n_trees = sum (n_tree)
forest%n_equivalences = 0
allocate (forest%grove (size (n_tree)))
call phs_grove_init &
(forest%grove, n_tree, n_in, n_out, forest%n_masses, &
forest%n_angles)
allocate (forest%grove_lookup (forest%n_trees))
count = 0
do g = 1, size (forest%grove)
forest%grove(g)%tree_count_offset = count
forest%grove_lookup (count+1:count+n_tree(g)) = g
count = count + n_tree(g)
end do
allocate (forest%prt_in (n_in))
allocate (forest%prt_out (forest%n_out))
k_root = 2**forest%n_tot - 1
allocate (forest%prt (k_root))
allocate (forest%prt_combination (2, k_root))
allocate (forest%s_mapping (forest%n_trees))
end subroutine phs_forest_init
@ %def phs_forest_init
@ Assign the global (s-channel) mappings.
<<PHS forests: phs forest: TBP>>=
procedure :: set_s_mappings => phs_forest_set_s_mappings
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_set_s_mappings (forest)
class(phs_forest_t), intent(inout) :: forest
end subroutine phs_forest_set_s_mappings
<<PHS forests: procedures>>=
module subroutine phs_forest_set_s_mappings (forest)
class(phs_forest_t), intent(inout) :: forest
integer :: g, i0, i1, n
do g = 1, size (forest%grove)
call forest%get_grove_bounds (g, i0, i1, n)
call phs_grove_assign_s_mappings &
(forest%grove(g), forest%s_mapping(i0:i1))
end do
end subroutine phs_forest_set_s_mappings
@ %def phs_forest_set_s_mappings
@ The grove finalizer is called because it contains the equivalence list:
<<PHS forests: phs forest: TBP>>=
procedure :: final => phs_forest_final
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_final (forest)
class(phs_forest_t), intent(inout) :: forest
end subroutine phs_forest_final
<<PHS forests: procedures>>=
module subroutine phs_forest_final (forest)
class(phs_forest_t), intent(inout) :: forest
if (allocated (forest%grove)) then
call phs_grove_final (forest%grove)
deallocate (forest%grove)
end if
if (allocated (forest%grove_lookup)) deallocate (forest%grove_lookup)
if (allocated (forest%prt)) deallocate (forest%prt)
if (allocated (forest%s_mapping)) deallocate (forest%s_mapping)
end subroutine phs_forest_final
@ %def phs_forest_final
@
\subsection{Screen output}
Write the particles that are non-null, then the trees which point to
them:
<<PHS forests: phs forest: TBP>>=
procedure :: write => phs_forest_write
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_write (forest, unit)
class(phs_forest_t), intent(in) :: forest
integer, intent(in), optional :: unit
end subroutine phs_forest_write
<<PHS forests: procedures>>=
module subroutine phs_forest_write (forest, unit)
class(phs_forest_t), intent(in) :: forest
integer, intent(in), optional :: unit
integer :: u
integer :: i, g, k
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "Phase space forest:"
write (u, "(3x,A,I0)") "n_in = ", forest%n_in
write (u, "(3x,A,I0)") "n_out = ", forest%n_out
write (u, "(3x,A,I0)") "n_tot = ", forest%n_tot
write (u, "(3x,A,I0)") "n_masses = ", forest%n_masses
write (u, "(3x,A,I0)") "n_angles = ", forest%n_angles
write (u, "(3x,A,I0)") "n_dim = ", forest%n_dimensions
write (u, "(3x,A,I0)") "n_trees = ", forest%n_trees
write (u, "(3x,A,I0)") "n_equiv = ", forest%n_equivalences
write (u, "(3x,A)", advance="no") "flavors ="
if (allocated (forest%flv)) then
do i = 1, size (forest%flv)
write (u, "(1x,I0)", advance="no") forest%flv(i)%get_pdg ()
end do
write (u, "(A)")
else
write (u, "(1x,A)") "[empty]"
end if
write (u, "(1x,A)") "Particle combinations:"
if (allocated (forest%prt_combination)) then
do k = 1, size (forest%prt_combination, 2)
if (forest%prt_combination(1, k) /= 0) then
write (u, "(3x,I0,1x,'<=',1x,I0,1x,'+',1x,I0)") &
k, forest%prt_combination(:,k)
end if
end do
else
write (u, "(3x,A)") " [empty]"
end if
write (u, "(1x,A)") "Groves and trees:"
if (allocated (forest%grove)) then
do g = 1, size (forest%grove)
write (u, "(3x,A,1x,I0)") "Grove ", g
call phs_grove_write (forest%grove(g), unit)
end do
else
write (u, "(3x,A)") " [empty]"
end if
write (u, "(1x,A,I0)") "Total number of equivalences: ", &
forest%n_equivalences
write (u, "(A)")
write (u, "(1x,A)") "Global s-channel mappings:"
if (allocated (forest%s_mapping)) then
do i = 1, size (forest%s_mapping)
associate (mapping => forest%s_mapping(i))
if (mapping%is_s_channel () .or. mapping%is_on_shell ()) then
write (u, "(1x,I0,':',1x)", advance="no") i
call forest%s_mapping(i)%write (unit)
end if
end associate
end do
else
write (u, "(3x,A)") " [empty]"
end if
write (u, "(A)")
write (u, "(1x,A)") "Incoming particles:"
if (allocated (forest%prt_in)) then
if (any (forest%prt_in%is_defined ())) then
do i = 1, size (forest%prt_in)
if (forest%prt_in(i)%is_defined ()) then
write (u, "(1x,A,1x,I0)") "Particle", i
call forest%prt_in(i)%write (u)
end if
end do
else
write (u, "(3x,A)") "[all undefined]"
end if
else
write (u, "(3x,A)") " [empty]"
end if
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particles:"
if (allocated (forest%prt_out)) then
if (any (forest%prt_out%is_defined ())) then
do i = 1, size (forest%prt_out)
if (forest%prt_out(i)%is_defined ()) then
write (u, "(1x,A,1x,I0)") "Particle", i
call forest%prt_out(i)%write (u)
end if
end do
else
write (u, "(3x,A)") "[all undefined]"
end if
else
write (u, "(1x,A)") " [empty]"
end if
write (u, "(A)")
write (u, "(1x,A)") "Tree particles:"
if (allocated (forest%prt)) then
if (any (forest%prt%is_defined ())) then
do i = 1, size (forest%prt)
if (forest%prt(i)%is_defined ()) then
write (u, "(1x,A,1x,I0)") "Particle", i
call forest%prt(i)%write (u)
end if
end do
else
write (u, "(3x,A)") "[all undefined]"
end if
else
write (u, "(3x,A)") " [empty]"
end if
end subroutine phs_forest_write
subroutine phs_grove_write (grove, unit)
type(phs_grove_t), intent(in) :: grove
integer, intent(in), optional :: unit
integer :: u
integer :: t
u = given_output_unit (unit); if (u < 0) return
do t = 1, size (grove%tree)
write (u, "(3x,A,I0)") "Tree ", t
call grove%tree(t)%write (unit)
end do
write (u, "(1x,A)") "Equivalence list:"
call equivalence_list_write (grove%equivalence_list, unit)
end subroutine phs_grove_write
@ %def phs_grove_write phs_forest_write
@ Deep copy.
<<PHS forests: public>>=
public :: assignment(=)
<<PHS forests: interfaces>>=
interface assignment(=)
module procedure phs_forest_assign
end interface
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_assign (forest_out, forest_in)
type(phs_forest_t), intent(out) :: forest_out
type(phs_forest_t), intent(in) :: forest_in
end subroutine phs_forest_assign
<<PHS forests: procedures>>=
module subroutine phs_forest_assign (forest_out, forest_in)
type(phs_forest_t), intent(out) :: forest_out
type(phs_forest_t), intent(in) :: forest_in
forest_out%n_in = forest_in%n_in
forest_out%n_out = forest_in%n_out
forest_out%n_tot = forest_in%n_tot
forest_out%n_masses = forest_in%n_masses
forest_out%n_angles = forest_in%n_angles
forest_out%n_dimensions = forest_in%n_dimensions
forest_out%n_trees = forest_in%n_trees
forest_out%n_equivalences = forest_in%n_equivalences
if (allocated (forest_in%flv)) then
allocate (forest_out%flv (size (forest_in%flv)))
forest_out%flv = forest_in%flv
end if
if (allocated (forest_in%grove)) then
allocate (forest_out%grove (size (forest_in%grove)))
forest_out%grove = forest_in%grove
end if
if (allocated (forest_in%grove_lookup)) then
allocate (forest_out%grove_lookup (size (forest_in%grove_lookup)))
forest_out%grove_lookup = forest_in%grove_lookup
end if
if (allocated (forest_in%prt_in)) then
allocate (forest_out%prt_in (size (forest_in%prt_in)))
forest_out%prt_in = forest_in%prt_in
end if
if (allocated (forest_in%prt_out)) then
allocate (forest_out%prt_out (size (forest_in%prt_out)))
forest_out%prt_out = forest_in%prt_out
end if
if (allocated (forest_in%prt)) then
allocate (forest_out%prt (size (forest_in%prt)))
forest_out%prt = forest_in%prt
end if
if (allocated (forest_in%s_mapping)) then
allocate (forest_out%s_mapping (size (forest_in%s_mapping)))
forest_out%s_mapping = forest_in%s_mapping
end if
if (allocated (forest_in%prt_combination)) then
allocate (forest_out%prt_combination &
(2, size (forest_in%prt_combination, 2)))
forest_out%prt_combination = forest_in%prt_combination
end if
end subroutine phs_forest_assign
@ %def phs_forest_assign
@
\subsection{Accessing contents}
Get the number of integration parameters
<<PHS forests: phs forest: TBP>>=
procedure :: get_n_parameters => phs_forest_get_n_parameters
<<PHS forests: sub interfaces>>=
module function phs_forest_get_n_parameters (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
end function phs_forest_get_n_parameters
<<PHS forests: procedures>>=
module function phs_forest_get_n_parameters (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
n = forest%n_dimensions
end function phs_forest_get_n_parameters
@ %def phs_forest_get_n_parameters
@ Get the number of integration channels
<<PHS forests: phs forest: TBP>>=
procedure :: get_n_channels => phs_forest_get_n_channels
<<PHS forests: sub interfaces>>=
module function phs_forest_get_n_channels (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
end function phs_forest_get_n_channels
<<PHS forests: procedures>>=
module function phs_forest_get_n_channels (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
n = forest%n_trees
end function phs_forest_get_n_channels
@ %def phs_forest_get_n_channels
@ Get the number of groves
<<PHS forests: phs forest: TBP>>=
procedure :: get_n_groves => phs_forest_get_n_groves
<<PHS forests: sub interfaces>>=
module function phs_forest_get_n_groves (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
end function phs_forest_get_n_groves
<<PHS forests: procedures>>=
module function phs_forest_get_n_groves (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
n = size (forest%grove)
end function phs_forest_get_n_groves
@ %def phs_forest_get_n_groves
@ Get the index bounds for a specific grove.
<<PHS forests: phs forest: TBP>>=
procedure :: get_grove_bounds => phs_forest_get_grove_bounds
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_get_grove_bounds (forest, g, i0, i1, n)
class(phs_forest_t), intent(in) :: forest
integer, intent(in) :: g
integer, intent(out) :: i0, i1, n
end subroutine phs_forest_get_grove_bounds
<<PHS forests: procedures>>=
module subroutine phs_forest_get_grove_bounds (forest, g, i0, i1, n)
class(phs_forest_t), intent(in) :: forest
integer, intent(in) :: g
integer, intent(out) :: i0, i1, n
n = size (forest%grove(g)%tree)
i0 = forest%grove(g)%tree_count_offset + 1
i1 = forest%grove(g)%tree_count_offset + n
end subroutine phs_forest_get_grove_bounds
@ %def phs_forest_get_grove_bounds
@ Get the number of equivalences
<<PHS forests: phs forest: TBP>>=
procedure :: get_n_equivalences => phs_forest_get_n_equivalences
<<PHS forests: sub interfaces>>=
module function phs_forest_get_n_equivalences (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
end function phs_forest_get_n_equivalences
<<PHS forests: procedures>>=
module function phs_forest_get_n_equivalences (forest) result (n)
integer :: n
class(phs_forest_t), intent(in) :: forest
n = forest%n_equivalences
end function phs_forest_get_n_equivalences
@ %def phs_forest_get_n_equivalences
@ Return true if a particular channel has a global (s-channel)
mapping; also return the resonance mass and width for this mapping.
<<PHS forests: phs forest: TBP>>=
procedure :: get_s_mapping => phs_forest_get_s_mapping
procedure :: get_on_shell => phs_forest_get_on_shell
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_get_s_mapping &
(forest, channel, flag, mass, width)
class(phs_forest_t), intent(in) :: forest
integer, intent(in) :: channel
logical, intent(out) :: flag
real(default), intent(out) :: mass, width
end subroutine phs_forest_get_s_mapping
module subroutine phs_forest_get_on_shell (forest, channel, flag, mass)
class(phs_forest_t), intent(in) :: forest
integer, intent(in) :: channel
logical, intent(out) :: flag
real(default), intent(out) :: mass
end subroutine phs_forest_get_on_shell
<<PHS forests: procedures>>=
module subroutine phs_forest_get_s_mapping &
(forest, channel, flag, mass, width)
class(phs_forest_t), intent(in) :: forest
integer, intent(in) :: channel
logical, intent(out) :: flag
real(default), intent(out) :: mass, width
flag = forest%s_mapping(channel)%is_s_channel ()
if (flag) then
mass = forest%s_mapping(channel)%get_mass ()
width = forest%s_mapping(channel)%get_width ()
else
mass = 0
width = 0
end if
end subroutine phs_forest_get_s_mapping
module subroutine phs_forest_get_on_shell (forest, channel, flag, mass)
class(phs_forest_t), intent(in) :: forest
integer, intent(in) :: channel
logical, intent(out) :: flag
real(default), intent(out) :: mass
flag = forest%s_mapping(channel)%is_on_shell ()
if (flag) then
mass = forest%s_mapping(channel)%get_mass ()
else
mass = 0
end if
end subroutine phs_forest_get_on_shell
@ %def phs_forest_get_s_mapping
@ %def phs_forest_get_on_shell
@
Extract the set of unique resonance histories, in form of an array.
<<PHS forests: phs forest: TBP>>=
procedure :: extract_resonance_history_set &
=> phs_forest_extract_resonance_history_set
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_extract_resonance_history_set &
(forest, res_set, include_trivial)
class(phs_forest_t), intent(in) :: forest
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
end subroutine phs_forest_extract_resonance_history_set
<<PHS forests: procedures>>=
module subroutine phs_forest_extract_resonance_history_set &
(forest, res_set, include_trivial)
class(phs_forest_t), intent(in) :: forest
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
type(resonance_history_t) :: rh
integer :: g, t
logical :: triv
triv = .false.; if (present (include_trivial)) triv = include_trivial
call res_set%init ()
do g = 1, size (forest%grove)
associate (grove => forest%grove(g))
do t = 1, size (grove%tree)
call grove%tree(t)%extract_resonance_history (rh)
call res_set%enter (rh, include_trivial)
end do
end associate
end do
call res_set%freeze ()
end subroutine phs_forest_extract_resonance_history_set
@ %def phs_forest_extract_resonance_history_set
@
\subsection{Read the phase space setup from file}
The phase space setup is stored in a file. The file may be generated
by the [[cascades]] module below, or by other means. This file has to
be read and parsed to create the PHS forest as the internal
phase-space representation.
Create lexer and syntax:
<<PHS forests: procedures>>=
subroutine define_phs_forest_syntax (ifile)
type(ifile_t) :: ifile
call ifile_append (ifile, "SEQ phase_space_list = process_phase_space*")
call ifile_append (ifile, "SEQ process_phase_space = " &
// "process_def process_header phase_space")
call ifile_append (ifile, "SEQ process_def = process process_list")
call ifile_append (ifile, "KEY process")
call ifile_append (ifile, "LIS process_list = process_tag*")
call ifile_append (ifile, "IDE process_tag")
call ifile_append (ifile, "SEQ process_header = " &
// "md5sum_process = md5sum " &
// "md5sum_model_par = md5sum " &
// "md5sum_phs_config = md5sum " &
// "sqrts = real " &
// "m_threshold_s = real " &
// "m_threshold_t = real " &
// "off_shell = integer " &
// "t_channel = integer " &
// "keep_nonresonant = logical")
call ifile_append (ifile, "KEY '='")
call ifile_append (ifile, "KEY '-'")
call ifile_append (ifile, "KEY md5sum_process")
call ifile_append (ifile, "KEY md5sum_model_par")
call ifile_append (ifile, "KEY md5sum_phs_config")
call ifile_append (ifile, "KEY sqrts")
call ifile_append (ifile, "KEY m_threshold_s")
call ifile_append (ifile, "KEY m_threshold_t")
call ifile_append (ifile, "KEY off_shell")
call ifile_append (ifile, "KEY t_channel")
call ifile_append (ifile, "KEY keep_nonresonant")
call ifile_append (ifile, "QUO md5sum = '""' ... '""'")
call ifile_append (ifile, "REA real")
call ifile_append (ifile, "INT integer")
call ifile_append (ifile, "IDE logical")
call ifile_append (ifile, "SEQ phase_space = grove_def+")
call ifile_append (ifile, "SEQ grove_def = grove tree_def+")
call ifile_append (ifile, "KEY grove")
call ifile_append (ifile, "SEQ tree_def = tree bincodes mapping*")
call ifile_append (ifile, "KEY tree")
call ifile_append (ifile, "SEQ bincodes = bincode*")
call ifile_append (ifile, "INT bincode")
call ifile_append (ifile, "SEQ mapping = map bincode channel signed_pdg")
call ifile_append (ifile, "KEY map")
call ifile_append (ifile, "ALT channel = &
&s_channel | t_channel | u_channel | &
&collinear | infrared | radiation | on_shell")
call ifile_append (ifile, "KEY s_channel")
! call ifile_append (ifile, "KEY t_channel") !!! Key already exists
call ifile_append (ifile, "KEY u_channel")
call ifile_append (ifile, "KEY collinear")
call ifile_append (ifile, "KEY infrared")
call ifile_append (ifile, "KEY radiation")
call ifile_append (ifile, "KEY on_shell")
call ifile_append (ifile, "ALT signed_pdg = &
&pdg | negative_pdg")
call ifile_append (ifile, "SEQ negative_pdg = '-' pdg")
call ifile_append (ifile, "INT pdg")
end subroutine define_phs_forest_syntax
@ %def define_phs_forest_syntax
@ The model-file syntax and lexer are fixed, therefore stored as
module variables:
<<PHS forests: variables>>=
type(syntax_t), target, save :: syntax_phs_forest
@ %def syntax_phs_forest
<<PHS forests: public>>=
public :: syntax_phs_forest_init
<<PHS forests: sub interfaces>>=
module subroutine syntax_phs_forest_init ()
end subroutine syntax_phs_forest_init
<<PHS forests: procedures>>=
module subroutine syntax_phs_forest_init ()
type(ifile_t) :: ifile
call define_phs_forest_syntax (ifile)
call syntax_init (syntax_phs_forest, ifile)
call ifile_final (ifile)
end subroutine syntax_phs_forest_init
@ %def syntax_phs_forest_init
<<PHS forests: procedures>>=
subroutine lexer_init_phs_forest (lexer)
type(lexer_t), intent(out) :: lexer
call lexer_init (lexer, &
comment_chars = "#!", &
quote_chars = '"', &
quote_match = '"', &
single_chars = "-", &
special_class = ["="] , &
keyword_list = syntax_get_keyword_list_ptr (syntax_phs_forest))
end subroutine lexer_init_phs_forest
@ %def lexer_init_phs_forest
<<PHS forests: public>>=
public :: syntax_phs_forest_final
<<PHS forests: sub interfaces>>=
module subroutine syntax_phs_forest_final ()
end subroutine syntax_phs_forest_final
<<PHS forests: procedures>>=
module subroutine syntax_phs_forest_final ()
call syntax_final (syntax_phs_forest)
end subroutine syntax_phs_forest_final
@ %def syntax_phs_forest_final
<<PHS forests: public>>=
public :: syntax_phs_forest_write
<<PHS forests: sub interfaces>>=
module subroutine syntax_phs_forest_write (unit)
integer, intent(in), optional :: unit
end subroutine syntax_phs_forest_write
<<PHS forests: procedures>>=
module subroutine syntax_phs_forest_write (unit)
integer, intent(in), optional :: unit
call syntax_write (syntax_phs_forest, unit)
end subroutine syntax_phs_forest_write
@ %def syntax_phs_forest_write
@ The concrete parser and interpreter. Generate an input stream for
the external [[unit]], read the parse tree (with given [[syntax]] and
[[lexer]]) from this stream, and transfer the contents of the parse
tree to the PHS [[forest]].
We look for the matching [[process]] tag, count groves and trees for
initializing the [[forest]], and fill the trees.
If the optional parameters are set, compare the parameters stored in
the file to those. Set [[match]] true if everything agrees.
<<PHS forests: phs forest: TBP>>=
generic :: read => read_file, read_unit, read_parse_tree
procedure :: read_file => phs_forest_read_file
procedure :: read_unit => phs_forest_read_unit
procedure :: read_parse_tree => phs_forest_read_parse_tree
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_read_file &
(forest, filename, process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, &
md5sum_phs_config, phs_par, match)
class(phs_forest_t), intent(out) :: forest
type(string_t), intent(in) :: filename
type(string_t), intent(in) :: process_id
integer, intent(in) :: n_in, n_out
class(model_data_t), intent(in), target :: model
logical, intent(out) :: found
character(32), intent(in), optional :: &
md5sum_process, md5sum_model_par, md5sum_phs_config
type(phs_parameters_t), intent(in), optional :: phs_par
logical, intent(out), optional :: match
end subroutine phs_forest_read_file
module subroutine phs_forest_read_unit &
(forest, unit, process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, md5sum_phs_config, &
phs_par, match)
class(phs_forest_t), intent(out) :: forest
integer, intent(in) :: unit
type(string_t), intent(in) :: process_id
integer, intent(in) :: n_in, n_out
class(model_data_t), intent(in), target :: model
logical, intent(out) :: found
character(32), intent(in), optional :: &
md5sum_process, md5sum_model_par, md5sum_phs_config
type(phs_parameters_t), intent(in), optional :: phs_par
logical, intent(out), optional :: match
end subroutine phs_forest_read_unit
module subroutine phs_forest_read_parse_tree &
(forest, parse_tree, process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, md5sum_phs_config, &
phs_par, match)
class(phs_forest_t), intent(out) :: forest
type(parse_tree_t), intent(in), target :: parse_tree
type(string_t), intent(in) :: process_id
integer, intent(in) :: n_in, n_out
class(model_data_t), intent(in), target :: model
logical, intent(out) :: found
character(32), intent(in), optional :: &
md5sum_process, md5sum_model_par, md5sum_phs_config
type(phs_parameters_t), intent(in), optional :: phs_par
logical, intent(out), optional :: match
end subroutine phs_forest_read_parse_tree
<<PHS forests: procedures>>=
module subroutine phs_forest_read_file &
(forest, filename, process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, &
md5sum_phs_config, phs_par, match)
class(phs_forest_t), intent(out) :: forest
type(string_t), intent(in) :: filename
type(string_t), intent(in) :: process_id
integer, intent(in) :: n_in, n_out
class(model_data_t), intent(in), target :: model
logical, intent(out) :: found
character(32), intent(in), optional :: &
md5sum_process, md5sum_model_par, md5sum_phs_config
type(phs_parameters_t), intent(in), optional :: phs_par
logical, intent(out), optional :: match
type(parse_tree_t), target :: parse_tree
type(stream_t), target :: stream
type(lexer_t) :: lexer
call lexer_init_phs_forest (lexer)
call stream_init (stream, char (filename))
call lexer_assign_stream (lexer, stream)
call parse_tree_init (parse_tree, syntax_phs_forest, lexer)
call phs_forest_read_parse_tree (forest, parse_tree, &
process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, md5sum_phs_config, phs_par, match)
call stream_final (stream)
call lexer_final (lexer)
call parse_tree_final (parse_tree)
end subroutine phs_forest_read_file
module subroutine phs_forest_read_unit &
(forest, unit, process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, md5sum_phs_config, &
phs_par, match)
class(phs_forest_t), intent(out) :: forest
integer, intent(in) :: unit
type(string_t), intent(in) :: process_id
integer, intent(in) :: n_in, n_out
class(model_data_t), intent(in), target :: model
logical, intent(out) :: found
character(32), intent(in), optional :: &
md5sum_process, md5sum_model_par, md5sum_phs_config
type(phs_parameters_t), intent(in), optional :: phs_par
logical, intent(out), optional :: match
type(parse_tree_t), target :: parse_tree
type(stream_t), target :: stream
type(lexer_t) :: lexer
call lexer_init_phs_forest (lexer)
call stream_init (stream, unit)
call lexer_assign_stream (lexer, stream)
call parse_tree_init (parse_tree, syntax_phs_forest, lexer)
call phs_forest_read_parse_tree (forest, parse_tree, &
process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, md5sum_phs_config, &
phs_par, match)
call stream_final (stream)
call lexer_final (lexer)
call parse_tree_final (parse_tree)
end subroutine phs_forest_read_unit
module subroutine phs_forest_read_parse_tree &
(forest, parse_tree, process_id, n_in, n_out, model, found, &
md5sum_process, md5sum_model_par, md5sum_phs_config, &
phs_par, match)
class(phs_forest_t), intent(out) :: forest
type(parse_tree_t), intent(in), target :: parse_tree
type(string_t), intent(in) :: process_id
integer, intent(in) :: n_in, n_out
class(model_data_t), intent(in), target :: model
logical, intent(out) :: found
character(32), intent(in), optional :: &
md5sum_process, md5sum_model_par, md5sum_phs_config
type(phs_parameters_t), intent(in), optional :: phs_par
logical, intent(out), optional :: match
type(parse_node_t), pointer :: node_header, node_phs, node_grove
integer :: n_grove, g
integer, dimension(:), allocatable :: n_tree
integer :: t
node_header => parse_tree_get_process_ptr (parse_tree, process_id)
found = associated (node_header); if (.not. found) return
if (present (match)) then
call phs_forest_check_input (node_header, &
md5sum_process, md5sum_model_par, md5sum_phs_config, phs_par, match)
if (.not. match) return
end if
node_phs => parse_node_get_next_ptr (node_header)
n_grove = parse_node_get_n_sub (node_phs)
allocate (n_tree (n_grove))
do g = 1, n_grove
node_grove => parse_node_get_sub_ptr (node_phs, g)
n_tree(g) = parse_node_get_n_sub (node_grove) - 1
end do
call forest%init (n_tree, n_in, n_out)
do g = 1, n_grove
node_grove => parse_node_get_sub_ptr (node_phs, g)
do t = 1, n_tree(g)
call phs_tree_set (forest%grove(g)%tree(t), &
parse_node_get_sub_ptr (node_grove, t+1), model)
end do
end do
end subroutine phs_forest_read_parse_tree
@ %def phs_forest
@ Check the input for consistency. If any MD5 sum or phase-space
parameter disagrees, the phase-space file cannot be used. The MD5
sum checks are skipped if the stored MD5 sum is empty.
<<PHS forests: procedures>>=
subroutine phs_forest_check_input (pn_header, &
md5sum_process, md5sum_model_par, md5sum_phs_config, phs_par, match)
type(parse_node_t), intent(in), target :: pn_header
character(32), intent(in) :: &
md5sum_process, md5sum_model_par, md5sum_phs_config
type(phs_parameters_t), intent(in), optional :: phs_par
logical, intent(out) :: match
type(parse_node_t), pointer :: pn_md5sum, pn_rval, pn_ival, pn_lval
character(32) :: md5sum
type(phs_parameters_t) :: phs_par_old
character(1) :: lstr
pn_md5sum => parse_node_get_sub_ptr (pn_header, 3)
md5sum = parse_node_get_string (pn_md5sum)
if (md5sum /= "" .and. md5sum /= md5sum_process) then
call msg_message ("Phase space: discarding old configuration &
&(process changed)")
match = .false.; return
end if
pn_md5sum => parse_node_get_next_ptr (pn_md5sum, 3)
md5sum = parse_node_get_string (pn_md5sum)
if (md5sum /= "" .and. md5sum /= md5sum_model_par) then
call msg_message ("Phase space: discarding old configuration &
&(model parameters changed)")
match = .false.; return
end if
pn_md5sum => parse_node_get_next_ptr (pn_md5sum, 3)
md5sum = parse_node_get_string (pn_md5sum)
if (md5sum /= "" .and. md5sum /= md5sum_phs_config) then
call msg_message ("Phase space: discarding old configuration &
&(configuration parameters changed)")
match = .false.; return
end if
if (present (phs_par)) then
pn_rval => parse_node_get_next_ptr (pn_md5sum, 3)
phs_par_old%sqrts = parse_node_get_real (pn_rval)
pn_rval => parse_node_get_next_ptr (pn_rval, 3)
phs_par_old%m_threshold_s = parse_node_get_real (pn_rval)
pn_rval => parse_node_get_next_ptr (pn_rval, 3)
phs_par_old%m_threshold_t = parse_node_get_real (pn_rval)
pn_ival => parse_node_get_next_ptr (pn_rval, 3)
phs_par_old%off_shell = parse_node_get_integer (pn_ival)
pn_ival => parse_node_get_next_ptr (pn_ival, 3)
phs_par_old%t_channel = parse_node_get_integer (pn_ival)
pn_lval => parse_node_get_next_ptr (pn_ival, 3)
lstr = parse_node_get_string (pn_lval)
read (lstr, "(L1)") phs_par_old%keep_nonresonant
if (phs_par_old /= phs_par) then
call msg_message &
("Phase space: discarding old configuration &
&(configuration parameters changed)")
match = .false.; return
end if
end if
match = .true.
end subroutine phs_forest_check_input
@ %def phs_forest_check_input
@ Initialize a specific tree in the forest, using the contents of the
'tree' node. First, count the bincodes, allocate an array and read
them in, and make the tree. Each $t$-channel tree is flipped to
$s$-channel. Then, find mappings and initialize them.
<<PHS forests: procedures>>=
subroutine phs_tree_set (tree, node, model)
type(phs_tree_t), intent(inout) :: tree
type(parse_node_t), intent(in), target :: node
class(model_data_t), intent(in), target :: model
type(parse_node_t), pointer :: node_bincodes, node_mapping, pn_pdg
integer :: n_bincodes, offset
integer(TC), dimension(:), allocatable :: bincode
integer :: b, n_mappings, m
integer(TC) :: k
type(string_t) :: type
integer :: pdg
node_bincodes => parse_node_get_sub_ptr (node, 2)
if (associated (node_bincodes)) then
select case (char (parse_node_get_rule_key (node_bincodes)))
case ("bincodes")
n_bincodes = parse_node_get_n_sub (node_bincodes)
offset = 2
case default
n_bincodes = 0
offset = 1
end select
else
n_bincodes = 0
offset = 2
end if
allocate (bincode (n_bincodes))
do b = 1, n_bincodes
bincode(b) = parse_node_get_integer &
(parse_node_get_sub_ptr (node_bincodes, b))
end do
call phs_tree_from_array (tree, bincode)
call tree%flip_t_to_s_channel ()
call tree%canonicalize ()
n_mappings = parse_node_get_n_sub (node) - offset
do m = 1, n_mappings
node_mapping => parse_node_get_sub_ptr (node, m + offset)
k = parse_node_get_integer &
(parse_node_get_sub_ptr (node_mapping, 2))
type = parse_node_get_key &
(parse_node_get_sub_ptr (node_mapping, 3))
pn_pdg => parse_node_get_sub_ptr (node_mapping, 4)
select case (char (pn_pdg%get_rule_key ()))
case ("pdg")
pdg = pn_pdg%get_integer ()
case ("negative_pdg")
pdg = - parse_node_get_integer (pn_pdg%get_sub_ptr (2))
end select
call tree%init_mapping (k, type, pdg, model)
end do
end subroutine phs_tree_set
@ %def phs_tree_set
@
\subsection{Preparation}
The trees that we read from file do not carry flavor information.
This is set separately:
The flavor list must be unique for a unique set of masses; if a given
particle can have different flavor, the mass must be degenerate, so we
can choose one of the possible flavor combinations.
<<PHS forests: phs forest: TBP>>=
procedure :: set_flavors => phs_forest_set_flavors
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_set_flavors (forest, flv, reshuffle, flv_extra)
class(phs_forest_t), intent(inout) :: forest
type(flavor_t), dimension(:), intent(in) :: flv
integer, intent(in), dimension(:), allocatable, optional :: reshuffle
type(flavor_t), intent(in), optional :: flv_extra
end subroutine phs_forest_set_flavors
<<PHS forests: procedures>>=
module subroutine phs_forest_set_flavors (forest, flv, reshuffle, flv_extra)
class(phs_forest_t), intent(inout) :: forest
type(flavor_t), dimension(:), intent(in) :: flv
integer, intent(in), dimension(:), allocatable, optional :: reshuffle
type(flavor_t), intent(in), optional :: flv_extra
integer :: i, n_flv0
if (present (reshuffle) .and. present (flv_extra)) then
n_flv0 = size (flv)
do i = 1, n_flv0
if (reshuffle(i) <= n_flv0) then
forest%flv(i) = flv (reshuffle(i))
else
forest%flv(i) = flv_extra
end if
end do
else
allocate (forest%flv (size (flv)))
forest%flv = flv
end if
end subroutine phs_forest_set_flavors
@ %def phs_forest_set_flavors
@
<<PHS forests: phs forest: TBP>>=
procedure :: set_momentum_links => phs_forest_set_momentum_links
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_set_momentum_links (forest, list)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in), dimension(:), allocatable :: list
end subroutine phs_forest_set_momentum_links
<<PHS forests: procedures>>=
module subroutine phs_forest_set_momentum_links (forest, list)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in), dimension(:), allocatable :: list
integer :: g, t
do g = 1, size (forest%grove)
do t = 1, size (forest%grove(g)%tree)
associate (tree => forest%grove(g)%tree(t))
call phs_tree_set_momentum_links (tree, list)
!!! call tree%reshuffle_mappings ()
end associate
end do
end do
end subroutine phs_forest_set_momentum_links
@ %def phs_forest_set_momentum_links
@ Once the parameter set is fixed, the masses and the widths of the
particles are known and the [[mass_sum]] arrays as well as the mapping
parameters can be computed. Note that order is important: we first
compute the mass sums, then the ordinary mappings. The resonances
obtained here determine the effective masses, which in turn are used
to implement step mappings for resonance decay products that are not
mapped otherwise.
<<PHS forests: phs forest: TBP>>=
procedure :: set_parameters => phs_forest_set_parameters
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_set_parameters &
(forest, mapping_defaults, variable_limits)
class(phs_forest_t), intent(inout) :: forest
type(mapping_defaults_t), intent(in) :: mapping_defaults
logical, intent(in) :: variable_limits
end subroutine phs_forest_set_parameters
<<PHS forests: procedures>>=
module subroutine phs_forest_set_parameters &
(forest, mapping_defaults, variable_limits)
class(phs_forest_t), intent(inout) :: forest
type(mapping_defaults_t), intent(in) :: mapping_defaults
logical, intent(in) :: variable_limits
integer :: g, t
do g = 1, size (forest%grove)
do t = 1, size (forest%grove(g)%tree)
call forest%grove(g)%tree(t)%set_mass_sum (forest%flv(forest%n_in+1:))
call forest%grove(g)%tree(t)%set_mapping_parameters &
(mapping_defaults, variable_limits)
call forest%grove(g)%tree(t)%set_effective_masses ()
if (mapping_defaults%step_mapping) then
call forest%grove(g)%tree(t)%set_step_mappings &
(mapping_defaults%step_mapping_exp, variable_limits)
end if
end do
end do
end subroutine phs_forest_set_parameters
@ %def phs_forest_set_parameters
@ Generate the particle combination table. Scan all trees and merge
their individual combination tables. At the end, valid entries are
non-zero, and they indicate the indices of a pair of particles to be
combined to a new particle. If a particle is accessible by more than
one tree (this is usual), only keep the first possibility.
<<PHS forests: phs forest: TBP>>=
procedure :: setup_prt_combinations => phs_forest_setup_prt_combinations
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_setup_prt_combinations (forest)
class(phs_forest_t), intent(inout) :: forest
end subroutine phs_forest_setup_prt_combinations
<<PHS forests: procedures>>=
module subroutine phs_forest_setup_prt_combinations (forest)
class(phs_forest_t), intent(inout) :: forest
integer :: g, t
integer, dimension(:,:), allocatable :: tree_prt_combination
forest%prt_combination = 0
allocate (tree_prt_combination (2, size (forest%prt_combination, 2)))
do g = 1, size (forest%grove)
do t = 1, size (forest%grove(g)%tree)
call phs_tree_setup_prt_combinations &
(forest%grove(g)%tree(t), tree_prt_combination)
where (tree_prt_combination /= 0 .and. forest%prt_combination == 0)
forest%prt_combination = tree_prt_combination
end where
end do
end do
end subroutine phs_forest_setup_prt_combinations
@ %def phs_forest_setup_prt_combinations
@
\subsection{Accessing the particle arrays}
Set the incoming particles from the contents of an interaction.
<<PHS forests: phs forest: TBP>>=
generic :: set_prt_in => set_prt_in_int, set_prt_in_mom
procedure :: set_prt_in_int => phs_forest_set_prt_in_int
procedure :: set_prt_in_mom => phs_forest_set_prt_in_mom
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_set_prt_in_int (forest, int, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(interaction_t), intent(in) :: int
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
end subroutine phs_forest_set_prt_in_int
module subroutine phs_forest_set_prt_in_mom (forest, mom, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(vector4_t), dimension(size (forest%prt_in)), intent(in) :: mom
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
end subroutine phs_forest_set_prt_in_mom
<<PHS forests: procedures>>=
module subroutine phs_forest_set_prt_in_int (forest, int, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(interaction_t), intent(in) :: int
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
if (present (lt_cm_to_lab)) then
call forest%prt_in%set_momentum (inverse (lt_cm_to_lab) * &
int%get_momenta (outgoing=.false.))
else
call forest%prt_in%set_momentum (int%get_momenta (outgoing=.false.))
end if
associate (m_in => forest%flv(:forest%n_in)%get_mass ())
call forest%prt_in%set_msq (m_in ** 2)
end associate
call forest%prt_in%set_defined ()
end subroutine phs_forest_set_prt_in_int
module subroutine phs_forest_set_prt_in_mom (forest, mom, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(vector4_t), dimension(size (forest%prt_in)), intent(in) :: mom
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
if (present (lt_cm_to_lab)) then
call forest%prt_in%set_momentum (inverse (lt_cm_to_lab) * mom)
else
call forest%prt_in%set_momentum (mom)
end if
associate (m_in => forest%flv(:forest%n_in)%get_mass ())
call forest%prt_in%set_msq (m_in ** 2)
end associate
call forest%prt_in%set_defined ()
end subroutine phs_forest_set_prt_in_mom
@ %def phs_forest_set_prt_in
@ Set the outgoing particles from the contents of an interaction.
<<PHS forests: phs forest: TBP>>=
generic :: set_prt_out => set_prt_out_int, set_prt_out_mom
procedure :: set_prt_out_int => phs_forest_set_prt_out_int
procedure :: set_prt_out_mom => phs_forest_set_prt_out_mom
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_set_prt_out_int (forest, int, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(interaction_t), intent(in) :: int
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
end subroutine phs_forest_set_prt_out_int
module subroutine phs_forest_set_prt_out_mom (forest, mom, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(vector4_t), dimension(size (forest%prt_out)), intent(in) :: mom
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
end subroutine phs_forest_set_prt_out_mom
<<PHS forests: procedures>>=
module subroutine phs_forest_set_prt_out_int (forest, int, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(interaction_t), intent(in) :: int
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
if (present (lt_cm_to_lab)) then
call forest%prt_out%set_momentum (inverse (lt_cm_to_lab) * &
int%get_momenta (outgoing=.true.))
else
call forest%prt_out%set_momentum (int%get_momenta (outgoing=.true.))
end if
associate (m_out => forest%flv(forest%n_in+1:)%get_mass ())
call forest%prt_out%set_msq (m_out ** 2)
end associate
call forest%prt_out%set_defined ()
end subroutine phs_forest_set_prt_out_int
module subroutine phs_forest_set_prt_out_mom (forest, mom, lt_cm_to_lab)
class(phs_forest_t), intent(inout) :: forest
type(vector4_t), dimension(size (forest%prt_out)), intent(in) :: mom
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
if (present (lt_cm_to_lab)) then
call forest%prt_out%set_momentum (inverse (lt_cm_to_lab) * mom)
else
call forest%prt_out%set_momentum (mom)
end if
associate (m_out => forest%flv(forest%n_in+1:)%get_mass ())
call forest%prt_out%set_msq (m_out ** 2)
end associate
call forest%prt_out%set_defined ()
end subroutine phs_forest_set_prt_out_mom
@ %def phs_forest_set_prt_out
@ Combine particles as described by the particle combination table.
Particle momentum sums will be calculated only if the resulting
particle is contained in at least one of the trees in the current
forest. The others are kept undefined.
<<PHS forests: phs forest: TBP>>=
procedure :: combine_particles => phs_forest_combine_particles
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_combine_particles (forest)
class(phs_forest_t), intent(inout) :: forest
end subroutine phs_forest_combine_particles
<<PHS forests: procedures>>=
module subroutine phs_forest_combine_particles (forest)
class(phs_forest_t), intent(inout) :: forest
integer :: k
integer, dimension(2) :: kk
do k = 1, size (forest%prt_combination, 2)
kk = forest%prt_combination(:,k)
if (kk(1) /= 0) then
call forest%prt(k)%combine (forest%prt(kk(1)), forest%prt(kk(2)))
end if
end do
end subroutine phs_forest_combine_particles
@ %def phs_forest_combine_particles
@ Extract the outgoing particles and insert into an interaction.
<<PHS forests: phs forest: TBP>>=
procedure :: get_prt_out => phs_forest_get_prt_out
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_get_prt_out (forest, int, lt_cm_to_lab)
class(phs_forest_t), intent(in) :: forest
type(interaction_t), intent(inout) :: int
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
end subroutine phs_forest_get_prt_out
<<PHS forests: procedures>>=
module subroutine phs_forest_get_prt_out (forest, int, lt_cm_to_lab)
class(phs_forest_t), intent(in) :: forest
type(interaction_t), intent(inout) :: int
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
if (present (lt_cm_to_lab)) then
call int%set_momenta (lt_cm_to_lab * &
forest%prt_out%get_momentum (), outgoing=.true.)
else
call int%set_momenta (forest%prt_out%get_momentum (), &
outgoing=.true.)
end if
end subroutine phs_forest_get_prt_out
@ %def phs_forest_get_prt_out
@ Extract the outgoing particle momenta
<<PHS forests: phs forest: TBP>>=
procedure :: get_momenta_out => phs_forest_get_momenta_out
<<PHS forests: sub interfaces>>=
module function phs_forest_get_momenta_out (forest, lt_cm_to_lab) result (p)
class(phs_forest_t), intent(in) :: forest
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
type(vector4_t), dimension(size (forest%prt_out)) :: p
end function phs_forest_get_momenta_out
<<PHS forests: procedures>>=
module function phs_forest_get_momenta_out (forest, lt_cm_to_lab) result (p)
class(phs_forest_t), intent(in) :: forest
type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
type(vector4_t), dimension(size (forest%prt_out)) :: p
p = forest%prt_out%get_momentum ()
if (present (lt_cm_to_lab)) p = p * lt_cm_to_lab
end function phs_forest_get_momenta_out
@ %def phs_forest_get_momenta_out
@
\subsection{Find equivalences among phase-space trees}
Scan phase space for equivalences. We generate the complete set of
unique permutations for the given list of outgoing particles, and use
this for scanning equivalences within each grove.
@ We scan all pairs of trees, using all permutations. This implies
that trivial equivalences are included, and equivalences between
different trees are recorded twice. This is intentional.
<<PHS forests: procedures>>=
subroutine phs_grove_set_equivalences (grove, perm_array)
type(phs_grove_t), intent(inout) :: grove
type(permutation_t), dimension(:), intent(in) :: perm_array
type(equivalence_t), pointer :: eq
integer :: t1, t2, i
do t1 = 1, size (grove%tree)
do t2 = 1, size (grove%tree)
SCAN_PERM: do i = 1, size (perm_array)
if (phs_tree_equivalent &
(grove%tree(t1), grove%tree(t2), perm_array(i))) then
call equivalence_list_add &
(grove%equivalence_list, t1, t2, perm_array(i))
eq => grove%equivalence_list%last
call phs_tree_find_msq_permutation &
(grove%tree(t1), grove%tree(t2), eq%perm, &
eq%msq_perm)
call phs_tree_find_angle_permutation &
(grove%tree(t1), grove%tree(t2), eq%perm, &
eq%angle_perm, eq%angle_sig)
end if
end do SCAN_PERM
end do
end do
end subroutine phs_grove_set_equivalences
@ %def phs_grove_set_equivalences
<<PHS forests: phs forest: TBP>>=
procedure :: set_equivalences => phs_forest_set_equivalences
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_set_equivalences (forest)
class(phs_forest_t), intent(inout) :: forest
end subroutine phs_forest_set_equivalences
<<PHS forests: procedures>>=
module subroutine phs_forest_set_equivalences (forest)
class(phs_forest_t), intent(inout) :: forest
type(permutation_t), dimension(:), allocatable :: perm_array
integer :: i
call permutation_array_make &
(perm_array, forest%flv(forest%n_in+1:)%get_pdg ())
do i = 1, size (forest%grove)
call phs_grove_set_equivalences (forest%grove(i), perm_array)
end do
forest%n_equivalences = sum (forest%grove%equivalence_list%length)
end subroutine phs_forest_set_equivalences
@ %def phs_forest_set_equivalences
@
\subsection{Interface for channel equivalences}
Here, we store the equivalence list in the appropriate containers that
the [[phs_base]] module provides. There is one separate list for each
channel.
<<PHS forests: phs forest: TBP>>=
procedure :: get_equivalences => phs_forest_get_equivalences
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_get_equivalences &
(forest, channel, azimuthal_dependence)
class(phs_forest_t), intent(in) :: forest
type(phs_channel_t), dimension(:), intent(out) :: channel
logical, intent(in) :: azimuthal_dependence
end subroutine phs_forest_get_equivalences
<<PHS forests: procedures>>=
module subroutine phs_forest_get_equivalences &
(forest, channel, azimuthal_dependence)
class(phs_forest_t), intent(in) :: forest
type(phs_channel_t), dimension(:), intent(out) :: channel
logical, intent(in) :: azimuthal_dependence
integer :: n_masses, n_angles
integer :: mode_azimuthal_angle
integer, dimension(:), allocatable :: n_eq
type(equivalence_t), pointer :: eq
integer, dimension(:), allocatable :: perm, mode
integer :: g, c, j, left, right
n_masses = forest%n_masses
n_angles = forest%n_angles
allocate (n_eq (forest%n_trees), source = 0)
allocate (perm (forest%n_dimensions))
allocate (mode (forest%n_dimensions), source = EQ_IDENTITY)
do g = 1, size (forest%grove)
eq => forest%grove(g)%equivalence_list%first
do while (associated (eq))
left = eq%left + forest%grove(g)%tree_count_offset
n_eq(left) = n_eq(left) + 1
eq => eq%next
end do
end do
do c = 1, size (channel)
allocate (channel(c)%eq (n_eq(c)))
do j = 1, n_eq(c)
call channel(c)%eq(j)%init (forest%n_dimensions)
end do
end do
n_eq = 0
if (azimuthal_dependence) then
mode_azimuthal_angle = EQ_IDENTITY
else
mode_azimuthal_angle = EQ_INVARIANT
end if
do g = 1, size (forest%grove)
eq => forest%grove(g)%equivalence_list%first
do while (associated (eq))
left = eq%left + forest%grove(g)%tree_count_offset
right = eq%right + forest%grove(g)%tree_count_offset
do j = 1, n_masses
perm(j) = permute (j, eq%msq_perm)
mode(j) = EQ_IDENTITY
end do
do j = 1, n_angles
perm(n_masses+j) = n_masses + permute (j, eq%angle_perm)
if (j == 1) then
mode(n_masses+j) = mode_azimuthal_angle ! first az. angle
else if (mod(j,2) == 1) then
mode(n_masses+j) = EQ_SYMMETRIC ! other az. angles
else if (eq%angle_sig(j)) then
mode(n_masses+j) = EQ_IDENTITY ! polar angle +
else
mode(n_masses+j) = EQ_INVERT ! polar angle -
end if
end do
n_eq(left) = n_eq(left) + 1
associate (eq_cur => channel(left)%eq(n_eq(left)))
eq_cur%c = right
eq_cur%perm = perm
eq_cur%mode = mode
end associate
eq => eq%next
end do
end do
end subroutine phs_forest_get_equivalences
@ %def phs_forest_get_equivalences
@
\subsection{Phase-space evaluation}
Given one row of the [[x]] parameter array and the corresponding
channel index, compute first all relevant momenta and then recover the
remainder of the [[x]] array, the Jacobians [[phs_factor]], and the
phase-space [[volume]].
The output argument [[ok]] indicates whether this was successful.
<<PHS forests: phs forest: TBP>>=
procedure :: evaluate_selected_channel => phs_forest_evaluate_selected_channel
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_evaluate_selected_channel &
(forest, channel, active, sqrts, x, phs_factor, volume, ok)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in) :: channel
logical, dimension(:), intent(in) :: active
real(default), intent(in) :: sqrts
real(default), dimension(:,:), intent(inout) :: x
real(default), dimension(:), intent(out) :: phs_factor
real(default), intent(out) :: volume
logical, intent(out) :: ok
end subroutine phs_forest_evaluate_selected_channel
<<PHS forests: procedures>>=
module subroutine phs_forest_evaluate_selected_channel &
(forest, channel, active, sqrts, x, phs_factor, volume, ok)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in) :: channel
logical, dimension(:), intent(in) :: active
real(default), intent(in) :: sqrts
real(default), dimension(:,:), intent(inout) :: x
real(default), dimension(:), intent(out) :: phs_factor
real(default), intent(out) :: volume
logical, intent(out) :: ok
integer :: g, t
integer(TC) :: k, k_root, k_in
g = forest%grove_lookup (channel)
t = channel - forest%grove(g)%tree_count_offset
call forest%prt%set_undefined ()
call forest%prt_out%set_undefined ()
k_in = forest%n_tot
do k = 1,forest%n_in
forest%prt(ibset(0,k_in-k)) = forest%prt_in(k)
end do
do k = 1, forest%n_out
call forest%prt(ibset(0,k-1))%set_msq &
(forest%flv(forest%n_in+k)%get_mass () ** 2)
end do
k_root = 2**forest%n_out - 1
select case (forest%n_in)
case (1)
forest%prt(k_root) = forest%prt_in(1)
case (2)
call forest%prt(k_root)%combine (forest%prt_in(1), forest%prt_in(2))
end select
call forest%grove(g)%tree(t)%compute_momenta_from_x (forest%prt, &
phs_factor(channel), volume, sqrts, x(:,channel), ok)
if (ok) then
do k = 1, forest%n_out
forest%prt_out(k) = forest%prt(ibset(0,k-1))
end do
end if
end subroutine phs_forest_evaluate_selected_channel
@ %def phs_forest_evaluate_selected_channel
@ The remainder: recover $x$ values for all channels except for the current
channel.
NOTE: OpenMP not used for the first loop. [[combine_particles]] is not a
channel-local operation.
<<PHS forests: phs forest: TBP>>=
procedure :: evaluate_other_channels => phs_forest_evaluate_other_channels
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_evaluate_other_channels &
(forest, channel, active, sqrts, x, phs_factor, combine)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in) :: channel
logical, dimension(:), intent(in) :: active
real(default), intent(in) :: sqrts
real(default), dimension(:,:), intent(inout) :: x
real(default), dimension(:), intent(inout) :: phs_factor
logical, intent(in) :: combine
end subroutine phs_forest_evaluate_other_channels
<<PHS forests: procedures>>=
module subroutine phs_forest_evaluate_other_channels &
(forest, channel, active, sqrts, x, phs_factor, combine)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in) :: channel
logical, dimension(:), intent(in) :: active
real(default), intent(in) :: sqrts
real(default), dimension(:,:), intent(inout) :: x
real(default), dimension(:), intent(inout) :: phs_factor
logical, intent(in) :: combine
integer :: g, t, ch, n_channel
g = forest%grove_lookup (channel)
t = channel - forest%grove(g)%tree_count_offset
n_channel = forest%n_trees
if (combine) then
do ch = 1, n_channel
if (ch == channel) cycle
if (active(ch)) then
g = forest%grove_lookup(ch)
t = ch - forest%grove(g)%tree_count_offset
call phs_tree_combine_particles &
(forest%grove(g)%tree(t), forest%prt)
end if
end do
end if
!OMP PARALLEL PRIVATE (g,t,ch) SHARED(active,forest,sqrts,x,channel)
!OMP DO SCHEDULE(STATIC)
do ch = 1, n_channel
if (ch == channel) cycle
if (active(ch)) then
g = forest%grove_lookup(ch)
t = ch - forest%grove(g)%tree_count_offset
call forest%grove(g)%tree(t)%compute_x_from_momenta (forest%prt, &
phs_factor(ch), sqrts, x(:,ch))
end if
end do
!OMP END DO
!OMP END PARALLEL
end subroutine phs_forest_evaluate_other_channels
@ %def phs_forest_evaluate_other_channels
@ The complement: recover one row of the [[x]] array and the
associated Jacobian entry, corresponding to
[[channel]], from incoming and outgoing momenta. Also compute the
phase-space volume.
<<PHS forests: phs forest: TBP>>=
procedure :: recover_channel => phs_forest_recover_channel
<<PHS forests: sub interfaces>>=
module subroutine phs_forest_recover_channel &
(forest, channel, sqrts, x, phs_factor, volume)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in) :: channel
real(default), intent(in) :: sqrts
real(default), dimension(:,:), intent(inout) :: x
real(default), dimension(:), intent(inout) :: phs_factor
real(default), intent(out) :: volume
end subroutine phs_forest_recover_channel
<<PHS forests: procedures>>=
module subroutine phs_forest_recover_channel &
(forest, channel, sqrts, x, phs_factor, volume)
class(phs_forest_t), intent(inout) :: forest
integer, intent(in) :: channel
real(default), intent(in) :: sqrts
real(default), dimension(:,:), intent(inout) :: x
real(default), dimension(:), intent(inout) :: phs_factor
real(default), intent(out) :: volume
integer :: g, t
integer(TC) :: k, k_in
g = forest%grove_lookup (channel)
t = channel - forest%grove(g)%tree_count_offset
call forest%prt%set_undefined ()
k_in = forest%n_tot
forall (k = 1:forest%n_in)
forest%prt(ibset(0,k_in-k)) = forest%prt_in(k)
end forall
forall (k = 1:forest%n_out)
forest%prt(ibset(0,k-1)) = forest%prt_out(k)
end forall
call forest%combine_particles ()
call forest%grove(g)%tree(t)%compute_volume (sqrts, volume)
call forest%grove(g)%tree(t)%compute_x_from_momenta (forest%prt, &
phs_factor(channel), sqrts, x(:,channel))
end subroutine phs_forest_recover_channel
@ %def phs_forest_recover_channel
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[phs_forests_ut.f90]]>>=
<<File header>>
module phs_forests_ut
use unit_tests
use phs_forests_uti
<<Standard module head>>
<<PHS forests: public test>>
contains
<<PHS forests: test driver>>
end module phs_forests_ut
@ %def phs_forests_ut
@
<<[[phs_forests_uti.f90]]>>=
<<File header>>
module phs_forests_uti
<<Use kinds>>
<<Use strings>>
use io_units
use format_defs, only: FMT_12
use lorentz
use flavors
use interactions
use model_data
use mappings
use phs_base
use resonances, only: resonance_history_set_t
use phs_forests
<<Standard module head>>
<<PHS forests: test declarations>>
contains
<<PHS forests: tests>>
end module phs_forests_uti
@ %def phs_forests_ut
@ API: driver for the unit tests below.
<<PHS forests: public test>>=
public :: phs_forests_test
<<PHS forests: test driver>>=
subroutine phs_forests_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS forests: execute tests>>
end subroutine phs_forests_test
@ %def phs_forests_test
@
\subsubsection{Basic universal test}
Write a possible phase-space file for a $2\to 3$ process and make the
corresponding forest, print the forest. Choose some in-particle
momenta and a random-number array and evaluate out-particles and
phase-space factors.
<<PHS forests: execute tests>>=
call test (phs_forest_1, "phs_forest_1", &
"check phs forest setup", &
u, results)
<<PHS forests: test declarations>>=
public :: phs_forest_1
<<PHS forests: tests>>=
subroutine phs_forest_1 (u)
use os_interface
integer, intent(in) :: u
type(phs_forest_t) :: forest
type(phs_channel_t), dimension(:), allocatable :: channel
type(model_data_t), target :: model
type(string_t) :: process_id
type(flavor_t), dimension(5) :: flv
type(string_t) :: filename
type(interaction_t) :: int
integer :: unit_fix
type(mapping_defaults_t) :: mapping_defaults
logical :: found_process, ok
integer :: n_channel, ch, i
logical, dimension(4) :: active = .true.
real(default) :: sqrts = 1000
real(default), dimension(5,4) :: x
real(default), dimension(4) :: factor
real(default) :: volume
write (u, "(A)") "* Test output: PHS forest"
write (u, "(A)") "* Purpose: test PHS forest routines"
write (u, "(A)")
write (u, "(A)") "* Reading model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Create phase-space file 'phs_forest_test.phs'"
write (u, "(A)")
call flv%init ([11, -11, 11, -11, 22], model)
unit_fix = free_unit ()
open (file="phs_forest_test.phs", unit=unit_fix, action="write")
write (unit_fix, *) "process foo"
write (unit_fix, *) 'md5sum_process = "6ABA33BC2927925D0F073B1C1170780A"'
write (unit_fix, *) 'md5sum_model_par = "1A0B151EE6E2DEB92D880320355A3EAB"'
write (unit_fix, *) 'md5sum_phs_config = "B6A8877058809A8BDD54753CDAB83ACE"'
write (unit_fix, *) "sqrts = 100.00000000000000"
write (unit_fix, *) "m_threshold_s = 50.000000000000000"
write (unit_fix, *) "m_threshold_t = 100.00000000000000"
write (unit_fix, *) "off_shell = 2"
write (unit_fix, *) "t_channel = 6"
write (unit_fix, *) "keep_nonresonant = F"
write (unit_fix, *) ""
write (unit_fix, *) " grove"
write (unit_fix, *) " tree 3 7"
write (unit_fix, *) " map 3 s_channel 23"
write (unit_fix, *) " tree 5 7"
write (unit_fix, *) " tree 6 7"
write (unit_fix, *) " grove"
write (unit_fix, *) " tree 9 11"
write (unit_fix, *) " map 9 t_channel 22"
close (unit_fix)
write (u, "(A)")
write (u, "(A)") "* Read phase-space file 'phs_forest_test.phs'"
call syntax_phs_forest_init ()
process_id = "foo"
filename = "phs_forest_test.phs"
call forest%read (filename, process_id, 2, 3, model, found_process)
write (u, "(A)")
write (u, "(A)") "* Set parameters, flavors, equiv, momenta"
write (u, "(A)")
call forest%set_flavors (flv)
call forest%set_parameters (mapping_defaults, .false.)
call forest%setup_prt_combinations ()
call forest%set_equivalences ()
call int%basic_init (2, 0, 3)
call int%set_momentum &
(vector4_moving (500._default, 500._default, 3), 1)
call int%set_momentum &
(vector4_moving (500._default,-500._default, 3), 2)
call forest%set_prt_in (int)
n_channel = 2
x = 0
x(:,n_channel) = [0.3, 0.4, 0.1, 0.9, 0.6]
write (u, "(A)") " Input values:"
write (u, "(3x,5(1x," // FMT_12 // "))") x(:,n_channel)
write (u, "(A)")
write (u, "(A)") "* Evaluating phase space"
call forest%evaluate_selected_channel (n_channel, active, sqrts, &
x, factor, volume, ok)
call forest%evaluate_other_channels (n_channel, active, sqrts, &
x, factor, combine=.true.)
call forest%get_prt_out (int)
write (u, "(A)") " Output values:"
do ch = 1, 4
write (u, "(3x,5(1x," // FMT_12 // "))") x(:,ch)
end do
call int%basic_write (u)
write (u, "(A)") " Factors:"
write (u, "(3x,5(1x," // FMT_12 // "))") factor
write (u, "(A)") " Volume:"
write (u, "(3x,5(1x," // FMT_12 // "))") volume
call forest%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute equivalences"
n_channel = 4
allocate (channel (n_channel))
call forest%get_equivalences (channel, .true.)
do i = 1, n_channel
write (u, "(1x,I0,':')", advance = "no") ch
call channel(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
call forest%final ()
call syntax_phs_forest_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_forest_1"
end subroutine phs_forest_1
@ %def phs_forest_1
@
\subsubsection{Resonance histories}
Read a suitably nontrivial forest from file and recover the set of
resonance histories.
<<PHS forests: execute tests>>=
call test (phs_forest_2, "phs_forest_2", &
"handle phs forest resonance content", &
u, results)
<<PHS forests: test declarations>>=
public :: phs_forest_2
<<PHS forests: tests>>=
subroutine phs_forest_2 (u)
use os_interface
integer, intent(in) :: u
integer :: unit_fix
type(phs_forest_t) :: forest
type(model_data_t), target :: model
type(string_t) :: process_id
type(string_t) :: filename
logical :: found_process
type(resonance_history_set_t) :: res_set
integer :: i
write (u, "(A)") "* Test output: phs_forest_2"
write (u, "(A)") "* Purpose: test PHS forest routines"
write (u, "(A)")
write (u, "(A)") "* Reading model file"
call model%init_sm_test ()
write (u, "(A)")
write (u, "(A)") "* Create phase-space file 'phs_forest_2.phs'"
write (u, "(A)")
unit_fix = free_unit ()
open (file="phs_forest_2.phs", unit=unit_fix, action="write")
write (unit_fix, *) "process foo"
write (unit_fix, *) 'md5sum_process = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"'
write (unit_fix, *) 'md5sum_model_par = "1A0B151EE6E2DEB92D880320355A3EAB"'
write (unit_fix, *) 'md5sum_phs_config = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"'
write (unit_fix, *) "sqrts = 100.00000000000000"
write (unit_fix, *) "m_threshold_s = 50.000000000000000"
write (unit_fix, *) "m_threshold_t = 100.00000000000000"
write (unit_fix, *) "off_shell = 2"
write (unit_fix, *) "t_channel = 6"
write (unit_fix, *) "keep_nonresonant = F"
write (unit_fix, *) ""
write (unit_fix, *) " grove"
write (unit_fix, *) " tree 3 7"
write (unit_fix, *) " tree 3 7"
write (unit_fix, *) " map 3 s_channel -24"
write (unit_fix, *) " tree 5 7"
write (unit_fix, *) " tree 3 7"
write (unit_fix, *) " map 3 s_channel -24"
write (unit_fix, *) " map 7 s_channel 23"
write (unit_fix, *) " tree 5 7"
write (unit_fix, *) " map 7 s_channel 25"
write (unit_fix, *) " tree 3 11"
write (unit_fix, *) " map 3 s_channel -24"
close (unit_fix)
write (u, "(A)") "* Read phase-space file 'phs_forest_2.phs'"
call syntax_phs_forest_init ()
process_id = "foo"
filename = "phs_forest_2.phs"
call forest%read (filename, process_id, 2, 3, model, found_process)
write (u, "(A)")
write (u, "(A)") "* Extract resonance history set"
write (u, "(A)")
call forest%extract_resonance_history_set (res_set)
call res_set%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
call forest%final ()
call syntax_phs_forest_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_forest_2"
end subroutine phs_forest_2
@ %def phs_forest_2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Finding phase space parameterizations}
If the phase space configuration is not found in the appropriate file,
we should generate one.
The idea is to construct all Feynman diagrams subject to certain
constraints which eliminate everything that is probably irrelevant for
the integration. These Feynman diagrams (cascades) are grouped in
groves by finding equivalence classes related by symmetry and ordered
with respect to their importance (resonances). Finally, the result
(or part of it) is written to file and used for the integration.
This module may eventually disappear and be replaced by CAML code.
In particular, we need here a set of Feynman rules (vertices with
particle codes, but not the factors). Thus, the module works for the
Standard Model only.
Note that this module is stand-alone, it communicates to the main
program only via the generated ASCII phase-space configuration file.
<<[[cascades.f90]]>>=
<<File header>>
module cascades
<<Use kinds>>
use kinds, only: TC, i8, i32
<<Use strings>>
<<Use debug>>
use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
use physics_defs, only: UNDEFINED
use model_data
use flavors
use resonances, only: resonance_info_t
use resonances, only: resonance_history_t
use resonances, only: resonance_history_set_t
use phs_forests
<<Standard module head>>
<<Cascades: public>>
<<Cascades: parameters>>
<<Cascades: types>>
<<Cascades: interfaces>>
interface
<<Cascades: sub interfaces>>
end interface
end module cascades
@ %def cascades
@
<<[[cascades_sub.f90]]>>=
<<File header>>
submodule (cascades) cascades_s
use io_units
use constants, only: one
use format_defs, only: FMT_12, FMT_19
use numeric_utils
use diagnostics
use hashes
use sorting
use lorentz
implicit none
contains
<<Cascades: procedures>>
end submodule cascades_s
@ %def cascades_s
@
\subsection{The mapping modes}
The valid mapping modes, to be used below. We will make use of the convention
that mappings of internal particles have a positive value. Only for positive
values, the flavor code is propagated when combining cascades.
<<Mapping modes>>=
integer, parameter :: &
& EXTERNAL_PRT = -1, &
& NO_MAPPING = 0, S_CHANNEL = 1, T_CHANNEL = 2, U_CHANNEL = 3, &
& RADIATION = 4, COLLINEAR = 5, INFRARED = 6, &
& STEP_MAPPING_E = 11, STEP_MAPPING_H = 12, &
& ON_SHELL = 99
@ %def EXTERNAL_PRT
@ %def NO_MAPPING S_CHANNEL T_CHANNEL U_CHANNEL
@ %def RADIATION COLLINEAR INFRARED
@ %def STEP_MAPPING_E STEP_MAPPING_H
@ %def ON_SHELL
<<Cascades: parameters>>=
<<Mapping modes>>
@
\subsection{The cascade type}
A cascade is essentially the same as a decay tree (both definitions
may be merged in a later version). It contains a linked tree of
nodes, each of which representing an internal particle. In contrast
to decay trees, each node has a definite particle code. These nodes
need not be modified, therefore we can use pointers and do not have to
copy them. Thus, physically each cascades has only a single node, the
mother particle. However, to be able to compare trees quickly, we
store in addition an array of binary codes which is always sorted in
ascending order. This is accompanied by a corresponding list of
particle codes. The index is the location of the corresponding
cascade in the cascade set, this may be used to access the daughters
directly.
The real mass is the particle mass belonging to the particle code.
The minimal mass is the sum of the real masses of all its daughters;
this is the kinematical cutoff. The effective mass may be zero if the
particle mass is below a certain threshold; it may be the real mass if
the particle is resonant; or it may be some other value.
The logical [[t_channel]] is set if this a $t$-channel line, while
[[initial]] is true only for an initial particle. Note that both
initial particles are also [[t_channel]] by definition, and that they
are distinguished by the direction of the tree: One of them decays
and is the root of the tree, while the other one is one of the leaves.
The cascade is a list of nodes (particles) which are linked via the
[[daughter]] entries. The node is the mother particle of
the decay cascade. Much of the information in the nodes is repeated
in arrays, to be accessible more easily. The arrays will be kept
sorted by binary codes.
The counter [[n_off_shell]] is increased for each internal line that
is neither resonant nor log-enhanced. It is set to zero if the
current line is resonant, since this implies on-shell particle production
and subsequent decay.
The counter [[n_t_channel]] is non-negative once an initial particle
is included in the tree: then, it counts the number of $t$-channel lines.
The [[multiplicity]] is the number of branchings to follow until all
daughters are on-shell. A resonant or non-decaying particle has
multiplicity one. Merging nodes, the multiplicities add unless the
mother is a resonance. An initial or final node has multiplicity
zero.
The arrays correspond to the subnode tree [[tree]] of the current
cascade. PDG codes are stored only for those positions which are
resonant, with the exception of the last entry, i.e., the current node.
Other positions, in particular external legs, are assigned undefined
PDG code.
A cascade is uniquely identified by its tree, the tree of PDG codes,
and the tree of mappings. The tree of resonances is kept only to mask
the PDG tree as described above.
<<Cascades: types>>=
type :: cascade_t
private
! counters
integer :: index = 0
integer :: grove = 0
! status
logical :: active = .false.
logical :: complete = .false.
logical :: incoming = .false.
! this node
integer(TC) :: bincode = 0
type(flavor_t) :: flv
integer :: pdg = UNDEFINED
logical :: is_vector = .false.
real(default) :: m_min = 0
real(default) :: m_rea = 0
real(default) :: m_eff = 0
integer :: mapping = NO_MAPPING
logical :: on_shell = .false.
logical :: resonant = .false.
logical :: log_enhanced = .false.
logical :: t_channel = .false.
! global tree properties
integer :: multiplicity = 0
integer :: internal = 0
integer :: n_off_shell = 0
integer :: n_resonances = 0
integer :: n_log_enhanced = 0
integer :: n_t_channel = 0
integer :: res_hash = 0
! the sub-node tree
integer :: depth = 0
integer(TC), dimension(:), allocatable :: tree
integer, dimension(:), allocatable :: tree_pdg
integer, dimension(:), allocatable :: tree_mapping
logical, dimension(:), allocatable :: tree_resonant
! branch connections
logical :: has_children = .false.
type(cascade_t), pointer :: daughter1 => null ()
type(cascade_t), pointer :: daughter2 => null ()
type(cascade_t), pointer :: mother => null ()
! next in list
type(cascade_t), pointer :: next => null ()
contains
<<Cascades: cascade: TBP>>
end type cascade_t
@ %def cascade_t
<<Cascades: procedures>>=
subroutine cascade_init (cascade, depth)
type(cascade_t), intent(out) :: cascade
integer, intent(in) :: depth
integer, save :: index = 0
index = cascade_index ()
cascade%index = index
cascade%depth = depth
cascade%active = .true.
allocate (cascade%tree (depth))
allocate (cascade%tree_pdg (depth))
allocate (cascade%tree_mapping (depth))
allocate (cascade%tree_resonant (depth))
end subroutine cascade_init
@ %def cascade_init
@ Keep and increment a global index
<<Cascades: procedures>>=
function cascade_index (seed) result (index)
integer :: index
integer, intent(in), optional :: seed
integer, save :: i = 0
if (present (seed)) i = seed
i = i + 1
index = i
end function cascade_index
@ %def cascade_index
@ We need three versions of writing cascades. This goes to the
phase-space file.
For t/u channel mappings, we use the absolute value of the PDG code.
<<Cascades: procedures>>=
subroutine cascade_write_file_format (cascade, model, unit)
type(cascade_t), intent(in) :: cascade
class(model_data_t), intent(in), target :: model
integer, intent(in), optional :: unit
type(flavor_t) :: flv
integer :: u, i
2 format(3x,A,1x,I3,1x,A,1x,I9,1x,'!',1x,A)
u = given_output_unit (unit); if (u < 0) return
call write_reduced (cascade%tree, u)
write (u, "(A)")
do i = 1, cascade%depth
call flv%init (cascade%tree_pdg(i), model)
select case (cascade%tree_mapping(i))
case (NO_MAPPING, EXTERNAL_PRT)
case (S_CHANNEL)
write(u,2) 'map', &
cascade%tree(i), 's_channel', cascade%tree_pdg(i), &
char (flv%get_name ())
case (T_CHANNEL)
write(u,2) 'map', &
cascade%tree(i), 't_channel', abs (cascade%tree_pdg(i)), &
char (flv%get_name ())
case (U_CHANNEL)
write(u,2) 'map', &
cascade%tree(i), 'u_channel', abs (cascade%tree_pdg(i)), &
char (flv%get_name ())
case (RADIATION)
write(u,2) 'map', &
cascade%tree(i), 'radiation', cascade%tree_pdg(i), &
char (flv%get_name ())
case (COLLINEAR)
write(u,2) 'map', &
cascade%tree(i), 'collinear', cascade%tree_pdg(i), &
char (flv%get_name ())
case (INFRARED)
write(u,2) 'map', &
cascade%tree(i), 'infrared ', cascade%tree_pdg(i), &
char (flv%get_name ())
case (ON_SHELL)
write(u,2) 'map', &
cascade%tree(i), 'on_shell ', cascade%tree_pdg(i), &
char (flv%get_name ())
case default
call msg_bug (" Impossible mapping mode encountered")
end select
end do
contains
subroutine write_reduced (array, unit)
integer(TC), dimension(:), intent(in) :: array
integer, intent(in) :: unit
integer :: i
write (u, "(3x,A,1x)", advance="no") "tree"
do i = 1, size (array)
if (decay_level (array(i)) > 1) then
write (u, "(1x,I0)", advance="no") array(i)
end if
end do
end subroutine write_reduced
elemental function decay_level (k) result (l)
integer(TC), intent(in) :: k
integer :: l
integer :: i
l = 0
do i = 0, bit_size(k) - 1
if (btest(k,i)) l = l + 1
end do
end function decay_level
subroutine start_comment (u)
integer, intent(in) :: u
write(u, '(1x,A)', advance='no') '!'
end subroutine start_comment
end subroutine cascade_write_file_format
@ %def cascade_write_file_format
@ This creates metapost source for graphical display:
<<Cascades: procedures>>=
subroutine cascade_write_graph_format (cascade, count, unit)
type(cascade_t), intent(in) :: cascade
integer, intent(in) :: count
integer, intent(in), optional :: unit
integer :: u
integer(TC) :: mask
type(string_t) :: left_str, right_str
u = given_output_unit (unit); if (u < 0) return
mask = 2**((cascade%depth+3)/2) - 1
left_str = ""
right_str = ""
write (u, '(A)') "\begin{minipage}{105pt}"
write (u, '(A)') "\vspace{30pt}"
write (u, '(A)') "\begin{center}"
write (u, '(A)') "\begin{fmfgraph*}(55,55)"
call graph_write (cascade, mask)
write (u, '(A)') "\fmfleft{" // char (extract (left_str, 2)) // "}"
write (u, '(A)') "\fmfright{" // char (extract (right_str, 2)) // "}"
write (u, '(A)') "\end{fmfgraph*}\\"
write (u, '(A,I5,A)') "\fbox{$", count, "$}"
write (u, '(A)') "\end{center}"
write (u, '(A)') "\end{minipage}"
write (u, '(A)') "%"
contains
recursive subroutine graph_write (cascade, mask, reverse)
type(cascade_t), intent(in) :: cascade
integer(TC), intent(in) :: mask
logical, intent(in), optional :: reverse
type(flavor_t) :: anti
logical :: rev
rev = .false.; if (present(reverse)) rev = reverse
if (cascade%has_children) then
if (.not.rev) then
call vertex_write (cascade, cascade%daughter1, mask)
call vertex_write (cascade, cascade%daughter2, mask)
else
call vertex_write (cascade, cascade%daughter2, mask, .true.)
call vertex_write (cascade, cascade%daughter1, mask, .true.)
end if
if (cascade%complete) then
call vertex_write (cascade, cascade%mother, mask, .true.)
write (u, '(A,I0,A)') "\fmfv{d.shape=square}{v0}"
end if
else
if (cascade%incoming) then
anti = cascade%flv%anti ()
call external_write (cascade%bincode, anti%get_tex_name (), &
left_str)
else
call external_write (cascade%bincode, cascade%flv%get_tex_name (), &
right_str)
end if
end if
end subroutine graph_write
recursive subroutine vertex_write (cascade, daughter, mask, reverse)
type(cascade_t), intent(in) :: cascade, daughter
integer(TC), intent(in) :: mask
logical, intent(in), optional :: reverse
integer :: bincode
if (cascade%complete) then
bincode = 0
else
bincode = cascade%bincode
end if
call graph_write (daughter, mask, reverse)
if (daughter%has_children) then
call line_write (bincode, daughter%bincode, daughter%flv, &
mapping=daughter%mapping)
else
call line_write (bincode, daughter%bincode, daughter%flv)
end if
end subroutine vertex_write
subroutine line_write (i1, i2, flv, mapping)
integer(TC), intent(in) :: i1, i2
type(flavor_t), intent(in) :: flv
integer, intent(in), optional :: mapping
integer :: k1, k2
type(string_t) :: prt_type
select case (flv%get_spin_type ())
case (SCALAR); prt_type = "plain"
case (SPINOR); prt_type = "fermion"
case (VECTOR); prt_type = "boson"
case (VECTORSPINOR); prt_type = "fermion"
case (TENSOR); prt_type = "dbl_wiggly"
case default; prt_type = "dashes"
end select
if (flv%is_antiparticle ()) then
k1 = i2; k2 = i1
else
k1 = i1; k2 = i2
end if
if (present (mapping)) then
select case (mapping)
case (S_CHANNEL)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=blue,lab=\sm\blue$" // &
& char (flv%get_tex_name ()) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (T_CHANNEL, U_CHANNEL)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=cyan,lab=\sm\cyan$" // &
& char (flv%get_tex_name ()) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (RADIATION)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=green,lab=\sm\green$" // &
& char (flv%get_tex_name ()) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (COLLINEAR)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=magenta,lab=\sm\magenta$" // &
& char (flv%get_tex_name ()) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (INFRARED)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=red,lab=\sm\red$" // &
& char (flv%get_tex_name ()) // "$}" // &
& "{v", k1, ",v", k2, "}"
case default
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=black}" // &
& "{v", k1, ",v", k2, "}"
end select
else
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& "}" // &
& "{v", k1, ",v", k2, "}"
end if
end subroutine line_write
subroutine external_write (bincode, name, ext_str)
integer(TC), intent(in) :: bincode
type(string_t), intent(in) :: name
type(string_t), intent(inout) :: ext_str
character(len=20) :: str
write (str, '(A2,I0)') ",v", bincode
ext_str = ext_str // trim (str)
write (u, '(A,I0,A,I0,A)') "\fmflabel{\sm$" &
// char (name) &
// "\,(", bincode, ")" &
// "$}{v", bincode, "}"
end subroutine external_write
end subroutine cascade_write_graph_format
@ %def cascade_write_graph_format
@ This is for screen/debugging output:
<<Cascades: procedures>>=
subroutine cascade_write (cascade, unit)
type(cascade_t), intent(in) :: cascade
integer, intent(in), optional :: unit
integer :: u
character(9) :: depth
u = given_output_unit (unit); if (u < 0) return
write (u, "(A,(1x,I7))") 'Cascade #', cascade%index
write (u, "(A,(1x,I7))") ' Grove: #', cascade%grove
write (u, "(A,3(1x,L1))") ' act/cmp/inc: ', &
cascade%active, cascade%complete, cascade%incoming
write (u, "(A,I0)") ' Bincode: ', cascade%bincode
write (u, "(A)", advance="no") ' Flavor: '
call cascade%flv%write (unit)
write (u, "(A,I9)") ' Active flavor:', cascade%pdg
write (u, "(A,L1)") ' Is vector: ', cascade%is_vector
write (u, "(A,3(1x," // FMT_19 // "))") ' Mass (m/r/e): ', &
cascade%m_min, cascade%m_rea, cascade%m_eff
write (u, "(A,I1)") ' Mapping: ', cascade%mapping
write (u, "(A,3(1x,L1))") ' res/log/tch: ', &
cascade%resonant, cascade%log_enhanced, cascade%t_channel
write (u, "(A,(1x,I7))") ' Multiplicity: ', cascade%multiplicity
write (u, "(A,2(1x,I7))") ' n intern/off: ', &
cascade%internal, cascade%n_off_shell
write (u, "(A,3(1x,I7))") ' n res/log/tch:', &
cascade%n_resonances, cascade%n_log_enhanced, cascade%n_t_channel
write (u, "(A,I7)") ' Depth: ', cascade%depth
write (depth, "(I7)") cascade%depth
write (u, "(A," // depth // "(1x,I7))") &
' Tree: ', cascade%tree
write (u, "(A," // depth // "(1x,I7))") &
' Tree(PDG): ', cascade%tree_pdg
write (u, "(A," // depth // "(1x,I7))") &
' Tree(mapping):', cascade%tree_mapping
write (u, "(A," // depth // "(1x,L1))") &
' Tree(res): ', cascade%tree_resonant
if (cascade%has_children) then
write (u, "(A,I7,1x,I7)") ' Daughter1/2: ', &
cascade%daughter1%index, cascade%daughter2%index
end if
if (associated (cascade%mother)) then
write (u, "(A,I7)") ' Mother: ', cascade%mother%index
end if
end subroutine cascade_write
@ %def cascade_write
@
\subsection{Creating new cascades}
This initializes a single-particle cascade (external, final state).
The PDG entry in the tree is set undefined because the cascade is not
resonant. However, the flavor entry is set, so the cascade flavor
is identified nevertheless.
<<Cascades: procedures>>=
subroutine cascade_init_outgoing (cascade, flv, pos, m_thr)
type(cascade_t), intent(out) :: cascade
type(flavor_t), intent(in) :: flv
integer, intent(in) :: pos
real(default), intent(in) :: m_thr
call cascade_init (cascade, 1)
cascade%bincode = ibset (0_TC, pos-1)
cascade%flv = flv
cascade%pdg = cascade%flv%get_pdg ()
cascade%is_vector = flv%get_spin_type () == VECTOR
cascade%m_min = flv%get_mass ()
cascade%m_rea = cascade%m_min
if (cascade%m_rea >= m_thr) then
cascade%m_eff = cascade%m_rea
end if
cascade%on_shell = .true.
cascade%multiplicity = 1
cascade%tree(1) = cascade%bincode
cascade%tree_pdg(1) = cascade%pdg
cascade%tree_mapping(1) = EXTERNAL_PRT
cascade%tree_resonant(1) = .false.
end subroutine cascade_init_outgoing
@ %def cascade_init_outgoing
@ The same for an incoming line:
<<Cascades: procedures>>=
subroutine cascade_init_incoming (cascade, flv, pos, m_thr)
type(cascade_t), intent(out) :: cascade
type(flavor_t), intent(in) :: flv
integer, intent(in) :: pos
real(default), intent(in) :: m_thr
call cascade_init (cascade, 1)
cascade%incoming = .true.
cascade%bincode = ibset (0_TC, pos-1)
cascade%flv = flv%anti ()
cascade%pdg = cascade%flv%get_pdg ()
cascade%is_vector = flv%get_spin_type () == VECTOR
cascade%m_min = flv%get_mass ()
cascade%m_rea = cascade%m_min
if (cascade%m_rea >= m_thr) then
cascade%m_eff = cascade%m_rea
end if
cascade%on_shell = .true.
cascade%n_t_channel = 0
cascade%n_off_shell = 0
cascade%tree(1) = cascade%bincode
cascade%tree_pdg(1) = cascade%pdg
cascade%tree_mapping(1) = EXTERNAL_PRT
cascade%tree_resonant(1) = .false.
end subroutine cascade_init_incoming
@ %def cascade_init_outgoing
@
\subsection{Tools}
This function returns true if the two cascades share no common
external particle. This is a requirement for joining them.
<<Cascades: interfaces>>=
interface operator(.disjunct.)
module procedure cascade_disjunct
end interface
<<Cascades: sub interfaces>>=
module function cascade_disjunct (cascade1, cascade2) result (flag)
logical :: flag
type(cascade_t), intent(in) :: cascade1, cascade2
end function cascade_disjunct
<<Cascades: procedures>>=
module function cascade_disjunct (cascade1, cascade2) result (flag)
logical :: flag
type(cascade_t), intent(in) :: cascade1, cascade2
flag = iand (cascade1%bincode, cascade2%bincode) == 0
end function cascade_disjunct
@ %def cascade_disjunct
@ %def .disjunct.
@ Compute a hash code for the resonance pattern of a cascade. We count the
number of times each particle appears as a resonance.
We pack the PDG codes of the resonances in two arrays (s-channel and
t-channel), sort them both, concatenate the results, transfer to
[[i8]] integers, and compute the hash code from this byte stream.
For t/u-channel, we remove the sign for antiparticles since this is not
well-defined.
<<Cascades: procedures>>=
subroutine cascade_assign_resonance_hash (cascade)
type(cascade_t), intent(inout) :: cascade
integer(i8), dimension(1) :: mold
cascade%res_hash = hash (transfer &
([sort (pack (cascade%tree_pdg, &
cascade%tree_resonant)), &
sort (pack (abs (cascade%tree_pdg), &
cascade%tree_mapping == T_CHANNEL .or. &
cascade%tree_mapping == U_CHANNEL))], &
mold))
end subroutine cascade_assign_resonance_hash
@ %def cascade_assign_resonance_hash
@
\subsection{Hash entries for cascades}
We will set up a hash array which contains keys of and pointers to
cascades. We hold a list of cascade (pointers) within each bucket.
This is not for collision resolution, but for keeping similar, but
unequal cascades together.
<<Cascades: types>>=
type :: cascade_p
type(cascade_t), pointer :: cascade => null ()
type(cascade_p), pointer :: next => null ()
end type cascade_p
@ %def cascade_p
@ Here is the bucket or hash entry type:
<<Cascades: types>>=
type :: hash_entry_t
integer(i32) :: hashval = 0
integer(i8), dimension(:), allocatable :: key
type(cascade_p), pointer :: first => null ()
type(cascade_p), pointer :: last => null ()
end type hash_entry_t
@ %def hash_entry_t
<<Cascades: public>>=
public :: hash_entry_init
<<Cascades: sub interfaces>>=
module subroutine hash_entry_init (entry, entry_in)
type(hash_entry_t), intent(out) :: entry
type(hash_entry_t), intent(in) :: entry_in
end subroutine hash_entry_init
<<Cascades: procedures>>=
module subroutine hash_entry_init (entry, entry_in)
type(hash_entry_t), intent(out) :: entry
type(hash_entry_t), intent(in) :: entry_in
type(cascade_p), pointer :: casc_iter, casc_copy
entry%hashval = entry_in%hashval
entry%key = entry_in%key
casc_iter => entry_in%first
do while (associated (casc_iter))
allocate (casc_copy)
casc_copy = casc_iter
casc_copy%next => null ()
if (associated (entry%first)) then
entry%last%next => casc_copy
else
entry%first => casc_copy
end if
entry%last => casc_copy
casc_iter => casc_iter%next
end do
end subroutine hash_entry_init
@ %def hash_entry_init
@ Finalize: just deallocate the list; the contents are just pointers.
<<Cascades: procedures>>=
subroutine hash_entry_final (hash_entry)
type(hash_entry_t), intent(inout) :: hash_entry
type(cascade_p), pointer :: current
do while (associated (hash_entry%first))
current => hash_entry%first
hash_entry%first => current%next
deallocate (current)
end do
end subroutine hash_entry_final
@ %def hash_entry_final
@ Output: concise format for debugging, just list cascade indices.
<<Cascades: procedures>>=
subroutine hash_entry_write (hash_entry, unit)
type(hash_entry_t), intent(in) :: hash_entry
integer, intent(in), optional :: unit
type(cascade_p), pointer :: current
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)", advance="no") "Entry:"
do i = 1, size (hash_entry%key)
write (u, "(1x,I0)", advance="no") hash_entry%key(i)
end do
write (u, "(1x,A)", advance="no") "->"
current => hash_entry%first
do while (associated (current))
write (u, "(1x,I7)", advance="no") current%cascade%index
current => current%next
end do
write (u, *)
end subroutine hash_entry_write
@ %def hash_entry_write
@ This function adds a cascade pointer to the bucket. If [[ok]] is
present, check first if it is already there and return failure if yes.
If [[cascade_ptr]] is also present, set it to the current cascade if
successful. If not, set it to the cascade that is already there.
<<Cascades: procedures>>=
subroutine hash_entry_add_cascade_ptr (hash_entry, cascade, ok, cascade_ptr)
type(hash_entry_t), intent(inout) :: hash_entry
type(cascade_t), intent(in), target :: cascade
logical, intent(out), optional :: ok
type(cascade_t), optional, pointer :: cascade_ptr
type(cascade_p), pointer :: current
if (present (ok)) then
call hash_entry_check_cascade (hash_entry, cascade, ok, cascade_ptr)
if (.not. ok) return
end if
allocate (current)
current%cascade => cascade
if (associated (hash_entry%last)) then
hash_entry%last%next => current
else
hash_entry%first => current
end if
hash_entry%last => current
end subroutine hash_entry_add_cascade_ptr
@ %def hash_entry_add_cascade_ptr
@ This function checks whether a cascade is already in the bucket.
For incomplete cascades, we look for an exact match. It should suffice
to verify the tree, the PDG codes, and the mapping modes. This is the
information that is written to the phase space file.
For complete cascades, we ignore the PDG code at positions with
mappings infrared, collinear, or t/u-channel. Thus a cascade which is
distinguished only by PDG code at such places, is flagged existent.
If the convention is followed that light particles come before heavier
ones (in the model definition), this ensures that the lightest
particle is kept in the appropriate place, corresponding to the
strongest peak.
For external cascades (incoming/outgoing) we take the PDG code into
account even though it is zeroed in the PDG-code tree.
<<Cascades: procedures>>=
subroutine hash_entry_check_cascade (hash_entry, cascade, ok, cascade_ptr)
type(hash_entry_t), intent(in), target :: hash_entry
type(cascade_t), intent(in), target :: cascade
logical, intent(out) :: ok
type(cascade_t), optional, pointer :: cascade_ptr
type(cascade_p), pointer :: current
integer, dimension(:), allocatable :: tree_pdg
ok = .true.
allocate (tree_pdg (size (cascade%tree_pdg)))
if (cascade%complete) then
where (cascade%tree_mapping == INFRARED .or. &
cascade%tree_mapping == COLLINEAR .or. &
cascade%tree_mapping == T_CHANNEL .or. &
cascade%tree_mapping == U_CHANNEL)
tree_pdg = 0
elsewhere
tree_pdg = cascade%tree_pdg
end where
else
tree_pdg = cascade%tree_pdg
end if
current => hash_entry%first
do while (associated (current))
if (current%cascade%depth == cascade%depth) then
if (all (current%cascade%tree == cascade%tree)) then
if (all (current%cascade%tree_mapping == cascade%tree_mapping)) &
then
if (all (current%cascade%tree_pdg .match. tree_pdg)) then
if (present (cascade_ptr)) cascade_ptr => current%cascade
ok = .false.; return
end if
end if
end if
end if
current => current%next
end do
if (present (cascade_ptr)) cascade_ptr => cascade
end subroutine hash_entry_check_cascade
@ %def hash_entry_check_cascade
@ For PDG codes, we specify that the undefined code matches any code.
This is already defined for flavor objects, but here we need it for
the codes themselves.
<<Cascades: interfaces>>=
interface operator(.match.)
module procedure pdg_match
end interface
<<Cascades: sub interfaces>>=
elemental module function pdg_match (pdg1, pdg2) result (flag)
logical :: flag
integer(TC), intent(in) :: pdg1, pdg2
end function pdg_match
<<Cascades: procedures>>=
elemental module function pdg_match (pdg1, pdg2) result (flag)
logical :: flag
integer(TC), intent(in) :: pdg1, pdg2
select case (pdg1)
case (0)
flag = .true.
case default
select case (pdg2)
case (0)
flag = .true.
case default
flag = pdg1 == pdg2
end select
end select
end function pdg_match
@ %def .match.
@
\subsection{The cascade set}
The cascade set will later be transformed into the decay forest. It
is set up as a linked list. In addition to the usual [[first]] and
[[last]] pointers, there is a [[first_t]] pointer which points to the
first t-channel cascade (after all s-channel cascades), and a
[[first_k]] pointer which points to the first final cascade (with a
keystone).
As an auxiliary device, the object contains a hash array with
associated parameters where an additional pointer is stored for each
cascade. The keys are made from the relevant cascade data. This hash
is used for fast detection (and thus avoidance) of double entries in
the cascade list.
<<Cascades: public>>=
public :: cascade_set_t
<<Cascades: types>>=
type :: cascade_set_t
private
class(model_data_t), pointer :: model
integer :: n_in, n_out, n_tot
type(flavor_t), dimension(:,:), allocatable :: flv
integer :: depth_out, depth_tot
real(default) :: sqrts = 0
real(default) :: m_threshold_s = 0
real(default) :: m_threshold_t = 0
integer :: off_shell = 0
integer :: t_channel = 0
logical :: keep_nonresonant
integer :: n_groves = 0
! The cascade list
type(cascade_t), pointer :: first => null ()
type(cascade_t), pointer :: last => null ()
type(cascade_t), pointer :: first_t => null ()
type(cascade_t), pointer :: first_k => null ()
! The hashtable
integer :: n_entries = 0
real :: fill_ratio = 0
integer :: n_entries_max = 0
integer(i32) :: mask = 0
logical :: fatal_beam_decay = .true.
type(hash_entry_t), dimension(:), allocatable :: entry
end type cascade_set_t
@ %def cascade_set_t
@
<<Cascades: public>>=
interface cascade_set_init
module procedure cascade_set_init_base
module procedure cascade_set_init_from_cascade
end interface
@ %def cascade_set_init
@ This might be broken. Test before using.
<<Cascades: sub interfaces>>=
module subroutine cascade_set_init_from_cascade &
(cascade_set, cascade_set_in)
type(cascade_set_t), intent(out) :: cascade_set
type(cascade_set_t), intent(in), target :: cascade_set_in
end subroutine cascade_set_init_from_cascade
<<Cascades: procedures>>=
module subroutine cascade_set_init_from_cascade &
(cascade_set, cascade_set_in)
type(cascade_set_t), intent(out) :: cascade_set
type(cascade_set_t), intent(in), target :: cascade_set_in
type(cascade_t), pointer :: casc_iter, casc_copy
cascade_set%model => cascade_set_in%model
cascade_set%n_in = cascade_set_in%n_in
cascade_set%n_out = cascade_set_in%n_out
cascade_set%n_tot = cascade_set_in%n_tot
cascade_set%flv = cascade_set_in%flv
cascade_set%depth_out = cascade_set_in%depth_out
cascade_set%depth_tot = cascade_set_in%depth_tot
cascade_set%sqrts = cascade_set_in%sqrts
cascade_set%m_threshold_s = cascade_set_in%m_threshold_s
cascade_set%m_threshold_t = cascade_set_in%m_threshold_t
cascade_set%off_shell = cascade_set_in%off_shell
cascade_set%t_channel = cascade_set_in%t_channel
cascade_set%keep_nonresonant = cascade_set_in%keep_nonresonant
cascade_set%n_groves = cascade_set_in%n_groves
casc_iter => cascade_set_in%first
do while (associated (casc_iter))
allocate (casc_copy)
casc_copy = casc_iter
casc_copy%next => null ()
if (associated (cascade_set%first)) then
cascade_set%last%next => casc_copy
else
cascade_set%first => casc_copy
end if
cascade_set%last => casc_copy
casc_iter => casc_iter%next
end do
cascade_set%n_entries = cascade_set_in%n_entries
cascade_set%fill_ratio = cascade_set_in%fill_ratio
cascade_set%n_entries_max = cascade_set_in%n_entries_max
cascade_set%mask = cascade_set_in%mask
cascade_set%fatal_beam_decay = cascade_set_in%fatal_beam_decay
allocate (cascade_set%entry (0:cascade_set%mask))
cascade_set%entry = cascade_set_in%entry
end subroutine cascade_set_init_from_cascade
@ %def cascade_set_init_from_cascade
@ Return true if there are cascades which are active and complete, so
the phase space file would be nonempty.
<<Cascades: public>>=
public :: cascade_set_is_valid
<<Cascades: sub interfaces>>=
module function cascade_set_is_valid (cascade_set) result (flag)
logical :: flag
type(cascade_set_t), intent(in) :: cascade_set
end function cascade_set_is_valid
<<Cascades: procedures>>=
module function cascade_set_is_valid (cascade_set) result (flag)
logical :: flag
type(cascade_set_t), intent(in) :: cascade_set
type(cascade_t), pointer :: cascade
flag = .false.
cascade => cascade_set%first_k
do while (associated (cascade))
if (cascade%active .and. cascade%complete) then
flag = .true.
return
end if
cascade => cascade%next
end do
end function cascade_set_is_valid
@ %def cascade_set_is_valid
@ The initializer sets up the hash table with some initial size
guessed by looking at the number of external particles. We choose 256
for 3 external particles and a factor of 4 for each additional
particle, limited at $2^{30}$=1G.
<<Cascades: parameters>>=
real, parameter, public :: CASCADE_SET_FILL_RATIO = 0.1
<<Cascades: sub interfaces>>=
module subroutine cascade_set_init_base (cascade_set, model, &
n_in, n_out, phs_par, fatal_beam_decay, flv)
type(cascade_set_t), intent(out) :: cascade_set
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_in, n_out
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
type(flavor_t), dimension(:,:), intent(in), optional :: flv
end subroutine cascade_set_init_base
<<Cascades: procedures>>=
module subroutine cascade_set_init_base (cascade_set, model, &
n_in, n_out, phs_par, fatal_beam_decay, flv)
type(cascade_set_t), intent(out) :: cascade_set
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_in, n_out
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
type(flavor_t), dimension(:,:), intent(in), optional :: flv
integer :: size_guess
integer :: i, j
cascade_set%model => model
cascade_set%n_in = n_in
cascade_set%n_out = n_out
cascade_set%n_tot = n_in + n_out
if (present (flv)) then
allocate (cascade_set%flv (size (flv, 1), size (flv, 2)))
do i = 1, size (flv, 2)
do j = 1, size (flv, 1)
call cascade_set%flv(j,i)%init (flv(j,i)%get_pdg (), model)
end do
end do
end if
select case (n_in)
case (1); cascade_set%depth_out = 2 * n_out - 3
case (2); cascade_set%depth_out = 2 * n_out - 1
end select
cascade_set%depth_tot = 2 * cascade_set%n_tot - 3
cascade_set%sqrts = phs_par%sqrts
cascade_set%m_threshold_s = phs_par%m_threshold_s
cascade_set%m_threshold_t = phs_par%m_threshold_t
cascade_set%off_shell = phs_par%off_shell
cascade_set%t_channel = phs_par%t_channel
cascade_set%keep_nonresonant = phs_par%keep_nonresonant
cascade_set%fill_ratio = CASCADE_SET_FILL_RATIO
size_guess = ishft (256, min (2 * (cascade_set%n_tot - 3), 22))
cascade_set%n_entries_max = size_guess * cascade_set%fill_ratio
cascade_set%mask = size_guess - 1
allocate (cascade_set%entry (0:cascade_set%mask))
cascade_set%fatal_beam_decay = fatal_beam_decay
end subroutine cascade_set_init_base
@ %def cascade_set_init_base
@ The finalizer has to delete both the hash and the list.
<<Cascades: public>>=
public :: cascade_set_final
<<Cascades: sub interfaces>>=
module subroutine cascade_set_final (cascade_set)
type(cascade_set_t), intent(inout), target :: cascade_set
end subroutine cascade_set_final
<<Cascades: procedures>>=
module subroutine cascade_set_final (cascade_set)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), pointer :: current
integer :: i
if (allocated (cascade_set%entry)) then
do i = 0, cascade_set%mask
call hash_entry_final (cascade_set%entry(i))
end do
deallocate (cascade_set%entry)
end if
do while (associated (cascade_set%first))
current => cascade_set%first
cascade_set%first => cascade_set%first%next
deallocate (current)
end do
end subroutine cascade_set_final
@ %def cascade_set_final
@ Write the process in ASCII format, in columns that are headed by the
corresponding bincode.
<<Cascades: public>>=
public :: cascade_set_write_process_bincode_format
<<Cascades: sub interfaces>>=
module subroutine cascade_set_write_process_bincode_format &
(cascade_set, unit)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: unit
end subroutine cascade_set_write_process_bincode_format
<<Cascades: procedures>>=
module subroutine cascade_set_write_process_bincode_format &
(cascade_set, unit)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: unit
integer, dimension(:), allocatable :: bincode, field_width
integer :: n_in, n_out, n_tot, n_flv
integer :: u, f, i, bc
character(20) :: str
type(string_t) :: fmt_head
type(string_t), dimension(:), allocatable :: fmt_proc
u = given_output_unit (unit); if (u < 0) return
if (.not. allocated (cascade_set%flv)) return
write (u, "('!',1x,A)") "List of subprocesses with particle bincodes:"
n_in = cascade_set%n_in
n_out = cascade_set%n_out
n_tot = cascade_set%n_tot
n_flv = size (cascade_set%flv, 2)
allocate (bincode (n_tot), field_width (n_tot), fmt_proc (n_tot))
bc = 1
do i = 1, n_out
bincode(n_in + i) = bc
bc = 2 * bc
end do
do i = n_in, 1, -1
bincode(i) = bc
bc = 2 * bc
end do
do i = 1, n_tot
write (str, "(I0)") bincode(i)
field_width(i) = len_trim (str)
do f = 1, n_flv
field_width(i) = max (field_width(i), &
len (cascade_set%flv(i,f)%get_name ()))
end do
end do
fmt_head = "('!'"
do i = 1, n_tot
fmt_head = fmt_head // ",1x,"
fmt_proc(i) = "(1x,"
write (str, "(I0)") field_width(i)
fmt_head = fmt_head // "I" // trim(str)
fmt_proc(i) = fmt_proc(i) // "A" // trim(str)
if (i == n_in) then
fmt_head = fmt_head // ",1x,' '"
end if
end do
do i = 1, n_tot
fmt_proc(i) = fmt_proc(i) // ")"
end do
fmt_head = fmt_head // ")"
write (u, char (fmt_head)) bincode
do f = 1, n_flv
write (u, "('!')", advance="no")
do i = 1, n_tot
write (u, char (fmt_proc(i)), advance="no") &
char (cascade_set%flv(i,f)%get_name ())
if (i == n_in) write (u, "(1x,'=>')", advance="no")
end do
write (u, *)
end do
write (u, char (fmt_head)) bincode
end subroutine cascade_set_write_process_bincode_format
@ %def cascade_set_write_process_tex_format
@ Write the process as a \LaTeX\ expression.
<<Cascades: procedures>>=
subroutine cascade_set_write_process_tex_format (cascade_set, unit)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: unit
integer :: u, f, i
u = given_output_unit (unit); if (u < 0) return
if (.not. allocated (cascade_set%flv)) return
write (u, "(A)") "\begin{align*}"
do f = 1, size (cascade_set%flv, 2)
do i = 1, cascade_set%n_in
if (i > 1) write (u, "(A)", advance="no") "\quad "
write (u, "(A)", advance="no") &
char (cascade_set%flv(i,f)%get_tex_name ())
end do
write (u, "(A)", advance="no") "\quad &\to\quad "
do i = cascade_set%n_in + 1, cascade_set%n_tot
if (i > cascade_set%n_in + 1) write (u, "(A)", advance="no") "\quad "
write (u, "(A)", advance="no") &
char (cascade_set%flv(i,f)%get_tex_name ())
end do
if (f < size (cascade_set%flv, 2)) then
write (u, "(A)") "\\"
else
write (u, "(A)") ""
end if
end do
write (u, "(A)") "\end{align*}"
end subroutine cascade_set_write_process_tex_format
@ %def cascade_set_write_process_tex_format
@ Three output routines: phase-space file, graph source code, and
screen output.
This version generates the phase space file. It deals only with
complete cascades.
<<Cascades: public>>=
public :: cascade_set_write_file_format
<<Cascades: sub interfaces>>=
module subroutine cascade_set_write_file_format (cascade_set, unit)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: unit
end subroutine cascade_set_write_file_format
<<Cascades: procedures>>=
module subroutine cascade_set_write_file_format (cascade_set, unit)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: unit
type(cascade_t), pointer :: cascade
integer :: u, grove, count
logical :: first_in_grove
u = given_output_unit (unit); if (u < 0) return
count = 0
do grove = 1, cascade_set%n_groves
first_in_grove = .true.
cascade => cascade_set%first_k
do while (associated (cascade))
if (cascade%active .and. cascade%complete) then
if (cascade%grove == grove) then
if (first_in_grove) then
first_in_grove = .false.
write (u, "(A)")
write (u, "(1x,'!',1x,A,1x,I0,A)", advance='no') &
'Multiplicity =', cascade%multiplicity, ","
select case (cascade%n_resonances)
case (0)
write (u, '(1x,A)', advance='no') 'no resonances, '
case (1)
write (u, '(1x,A)', advance='no') '1 resonance, '
case default
write (u, '(1x,I0,1x,A)', advance='no') &
cascade%n_resonances, 'resonances, '
end select
write (u, '(1x,I0,1x,A)', advance='no') &
cascade%n_log_enhanced, 'logs, '
write (u, '(1x,I0,1x,A)', advance='no') &
cascade%n_off_shell, 'off-shell, '
select case (cascade%n_t_channel)
case (0); write (u, '(1x,A)') 's-channel graph'
case (1); write (u, '(1x,A)') '1 t-channel line'
case default
write(u,'(1x,I0,1x,A)') &
cascade%n_t_channel, 't-channel lines'
end select
write (u, '(1x,A,I0)') 'grove #', grove
end if
count = count + 1
write (u, "(1x,'!',1x,A,I0)") "Channel #", count
call cascade_write_file_format (cascade, cascade_set%model, u)
end if
end if
cascade => cascade%next
end do
end do
end subroutine cascade_set_write_file_format
@ %def cascade_set_write_file_format
@ This is the graph output format, the driver-file
<<Cascades: public>>=
public :: cascade_set_write_graph_format
<<Cascades: sub interfaces>>=
module subroutine cascade_set_write_graph_format &
(cascade_set, filename, process_id, unit)
type(cascade_set_t), intent(in), target :: cascade_set
type(string_t), intent(in) :: filename, process_id
integer, intent(in), optional :: unit
end subroutine cascade_set_write_graph_format
<<Cascades: procedures>>=
module subroutine cascade_set_write_graph_format &
(cascade_set, filename, process_id, unit)
type(cascade_set_t), intent(in), target :: cascade_set
type(string_t), intent(in) :: filename, process_id
integer, intent(in), optional :: unit
type(cascade_t), pointer :: cascade
integer :: u, grove, count, pgcount
logical :: first_in_grove
u = given_output_unit (unit); if (u < 0) return
write (u, '(A)') "\documentclass[10pt]{article}"
write (u, '(A)') "\usepackage{amsmath}"
write (u, '(A)') "\usepackage{feynmp}"
write (u, '(A)') "\usepackage{url}"
write (u, '(A)') "\usepackage{color}"
write (u, *)
write (u, '(A)') "\textwidth 18.5cm"
write (u, '(A)') "\evensidemargin -1.5cm"
write (u, '(A)') "\oddsidemargin -1.5cm"
write (u, *)
write (u, '(A)') "\newcommand{\blue}{\color{blue}}"
write (u, '(A)') "\newcommand{\green}{\color{green}}"
write (u, '(A)') "\newcommand{\red}{\color{red}}"
write (u, '(A)') "\newcommand{\magenta}{\color{magenta}}"
write (u, '(A)') "\newcommand{\cyan}{\color{cyan}}"
write (u, '(A)') "\newcommand{\sm}{\footnotesize}"
write (u, '(A)') "\setlength{\parindent}{0pt}"
write (u, '(A)') "\setlength{\parsep}{20pt}"
write (u, *)
write (u, '(A)') "\begin{document}"
write (u, '(A)') "\begin{fmffile}{" // char (filename) // "}"
write (u, '(A)') "\fmfcmd{color magenta; magenta = red + blue;}"
write (u, '(A)') "\fmfcmd{color cyan; cyan = green + blue;}"
write (u, '(A)') "\begin{fmfshrink}{0.5}"
write (u, '(A)') "\begin{flushleft}"
write (u, *)
write (u, '(A)') "\noindent" // &
& "\textbf{\large\texttt{WHIZARD} phase space channels}" // &
& "\hfill\today"
write (u, *)
write (u, '(A)') "\vspace{10pt}"
write (u, '(A)') "\noindent" // &
& "\textbf{Process:} \url{" // char (process_id) // "}"
call cascade_set_write_process_tex_format (cascade_set, u)
write (u, *)
write (u, '(A)') "\noindent" // &
& "\textbf{Note:} These are pseudo Feynman graphs that "
write (u, '(A)') "visualize phase-space parameterizations " // &
& "(``integration channels''). "
write (u, '(A)') "They do \emph{not} indicate Feynman graphs used for the " // &
& "matrix element."
write (u, *)
write (u, '(A)') "\textbf{Color code:} " // &
& "{\blue resonance,} " // &
& "{\cyan t-channel,} " // &
& "{\green radiation,} "
write (u, '(A)') "{\red infrared,} " // &
& "{\magenta collinear,} " // &
& "external/off-shell"
write (u, *)
write (u, '(A)') "\noindent" // &
& "\textbf{Black square:} Keystone, indicates ordering of " // &
& "phase space parameters."
write (u, *)
write (u, '(A)') "\vspace{-20pt}"
count = 0
pgcount = 0
do grove = 1, cascade_set%n_groves
first_in_grove = .true.
cascade => cascade_set%first
do while (associated (cascade))
if (cascade%active .and. cascade%complete) then
if (cascade%grove == grove) then
if (first_in_grove) then
first_in_grove = .false.
write (u, *)
write (u, '(A)') "\vspace{20pt}"
write (u, '(A)') "\begin{tabular}{l}"
write (u, '(A,I5,A)') &
& "\fbox{\bf Grove \boldmath$", grove, "$} \\[10pt]"
write (u, '(A,I1,A)') "Multiplicity: ", &
cascade%multiplicity, "\\"
write (u, '(A,I1,A)') "Resonances: ", &
cascade%n_resonances, "\\"
write (u, '(A,I1,A)') "Log-enhanced: ", &
cascade%n_log_enhanced, "\\"
write (u, '(A,I1,A)') "Off-shell: ", &
cascade%n_off_shell, "\\"
write (u, '(A,I1,A)') "t-channel: ", &
cascade%n_t_channel, ""
write (u, '(A)') "\end{tabular}"
end if
count = count + 1
call cascade_write_graph_format (cascade, count, unit)
if (pgcount >= 250) then
write (u, '(A)') "\clearpage"
pgcount = 0
end if
end if
end if
cascade => cascade%next
end do
end do
write (u, '(A)') "\end{flushleft}"
write (u, '(A)') "\end{fmfshrink}"
write (u, '(A)') "\end{fmffile}"
write (u, '(A)') "\end{document}"
end subroutine cascade_set_write_graph_format
@ %def cascade_set_write_graph_format
@ This is for screen output and debugging:
<<Cascades: public>>=
public :: cascade_set_write
<<Cascades: sub interfaces>>=
module subroutine cascade_set_write &
(cascade_set, unit, active_only, complete_only)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: unit
logical, intent(in), optional :: active_only, complete_only
end subroutine cascade_set_write
<<Cascades: procedures>>=
module subroutine cascade_set_write &
(cascade_set, unit, active_only, complete_only)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: unit
logical, intent(in), optional :: active_only, complete_only
logical :: active, complete
type(cascade_t), pointer :: cascade
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
active = .true.; if (present (active_only)) active = active_only
complete = .false.; if (present (complete_only)) complete = complete_only
write (u, "(A)") "Cascade set:"
write (u, "(3x,A)", advance="no") "Model:"
if (associated (cascade_set%model)) then
write (u, "(1x,A)") char (cascade_set%model%get_name ())
else
write (u, "(1x,A)") "[none]"
end if
write (u, "(3x,A)", advance="no") "n_in/out/tot ="
write (u, "(3(1x,I7))") &
cascade_set%n_in, cascade_set%n_out, cascade_set%n_tot
write (u, "(3x,A)", advance="no") "depth_out/tot ="
write (u, "(2(1x,I7))") cascade_set%depth_out, cascade_set%depth_tot
write (u, "(3x,A)", advance="no") "mass thr(s/t) ="
write (u, "(2(1x," // FMT_19 // "))") &
cascade_set%m_threshold_s, cascade_set%m_threshold_t
write (u, "(3x,A)", advance="no") "off shell ="
write (u, "(1x,I7)") cascade_set%off_shell
write (u, "(3x,A)", advance="no") "keep_nonreson ="
write (u, "(1x,L1)") cascade_set%keep_nonresonant
write (u, "(3x,A)", advance="no") "n_groves ="
write (u, "(1x,I7)") cascade_set%n_groves
write (u, "(A)")
write (u, "(A)") "Cascade list:"
if (associated (cascade_set%first)) then
cascade => cascade_set%first
do while (associated (cascade))
if (active .and. .not. cascade%active) cycle
if (complete .and. .not. cascade%complete) cycle
call cascade_write (cascade, unit)
cascade => cascade%next
end do
else
write (u, "(A)") "[empty]"
end if
write (u, "(A)") "Hash array"
write (u, "(3x,A)", advance="no") "n_entries ="
write (u, "(1x,I7)") cascade_set%n_entries
write (u, "(3x,A)", advance="no") "fill_ratio ="
write (u, "(1x," // FMT_12 // ")") cascade_set%fill_ratio
write (u, "(3x,A)", advance="no") "n_entries_max ="
write (u, "(1x,I7)") cascade_set%n_entries_max
write (u, "(3x,A)", advance="no") "mask ="
write (u, "(1x,I0)") cascade_set%mask
do i = 0, ubound (cascade_set%entry, 1)
if (allocated (cascade_set%entry(i)%key)) then
write (u, "(1x,I7)") i
call hash_entry_write (cascade_set%entry(i), u)
end if
end do
end subroutine cascade_set_write
@ %def cascade_set_write
@
\subsection{Adding cascades}
Add a deep copy of a cascade to the set. The copy has all content of the
original, but the pointers are nullified. We do not care whether insertion
was successful or not. The pointer argument, if present, is assigned to the
input cascade, or to the hash entry if it is already present.
The procedure is recursive: any daughter or mother entries are also
deep-copied and added to the cascade set before the current copy is added.
<<Cascades: procedures>>=
recursive subroutine cascade_set_add_copy &
(cascade_set, cascade_in, cascade_ptr)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in) :: cascade_in
type(cascade_t), optional, pointer :: cascade_ptr
type(cascade_t), pointer :: cascade
logical :: ok
allocate (cascade)
cascade = cascade_in
if (associated (cascade_in%daughter1)) call cascade_set_add_copy &
(cascade_set, cascade_in%daughter1, cascade%daughter1)
if (associated (cascade_in%daughter2)) call cascade_set_add_copy &
(cascade_set, cascade_in%daughter2, cascade%daughter2)
if (associated (cascade_in%mother)) call cascade_set_add_copy &
(cascade_set, cascade_in%mother, cascade%mother)
cascade%next => null ()
call cascade_set_add (cascade_set, cascade, ok, cascade_ptr)
if (.not. ok) deallocate (cascade)
end subroutine cascade_set_add_copy
@ %def cascade_set_add_copy
@ Add a cascade to the set. This does not deep-copy. We first try to insert
it in the hash array. If successful, add it to the list. Failure indicates
that it is already present, and we drop it.
The hash key is built solely from the tree array, so neither particle
codes nor resonances count, just topology.
Technically, hash and list receive only pointers, so the cascade can
be considered as being in either of both. We treat it as part of the
list.
<<Cascades: procedures>>=
subroutine cascade_set_add (cascade_set, cascade, ok, cascade_ptr)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade
logical, intent(out) :: ok
type(cascade_t), optional, pointer :: cascade_ptr
integer(i8), dimension(1) :: mold
call cascade_set_hash_insert &
(cascade_set, transfer (cascade%tree, mold), cascade, ok, cascade_ptr)
if (ok) call cascade_set_list_add (cascade_set, cascade)
end subroutine cascade_set_add
@ %def cascade_set_add
@ Add a new cascade to the list:
<<Cascades: procedures>>=
subroutine cascade_set_list_add (cascade_set, cascade)
type(cascade_set_t), intent(inout) :: cascade_set
type(cascade_t), intent(in), target :: cascade
if (associated (cascade_set%last)) then
cascade_set%last%next => cascade
else
cascade_set%first => cascade
end if
cascade_set%last => cascade
end subroutine cascade_set_list_add
@ %def cascade_set_list_add
@ Add a cascade entry to the hash array:
<<Cascades: procedures>>=
subroutine cascade_set_hash_insert &
(cascade_set, key, cascade, ok, cascade_ptr)
type(cascade_set_t), intent(inout), target :: cascade_set
integer(i8), dimension(:), intent(in) :: key
type(cascade_t), intent(in), target :: cascade
logical, intent(out) :: ok
type(cascade_t), optional, pointer :: cascade_ptr
integer(i32) :: h
if (cascade_set%n_entries >= cascade_set%n_entries_max) &
call cascade_set_hash_expand (cascade_set)
h = hash (key)
call cascade_set_hash_insert_rec &
(cascade_set, h, h, key, cascade, ok, cascade_ptr)
end subroutine cascade_set_hash_insert
@ %def cascade_set_hash_insert
@ Double the hashtable size when necesssary:
<<Cascades: procedures>>=
subroutine cascade_set_hash_expand (cascade_set)
type(cascade_set_t), intent(inout), target :: cascade_set
type(hash_entry_t), dimension(:), allocatable, target :: table_tmp
type(cascade_p), pointer :: current
integer :: i, s
allocate (table_tmp (0:cascade_set%mask))
table_tmp = cascade_set%entry
deallocate (cascade_set%entry)
s = 2 * size (table_tmp)
cascade_set%n_entries = 0
cascade_set%n_entries_max = s * cascade_set%fill_ratio
cascade_set%mask = s - 1
allocate (cascade_set%entry (0:cascade_set%mask))
do i = 0, ubound (table_tmp, 1)
current => table_tmp(i)%first
do while (associated (current))
call cascade_set_hash_insert_rec &
(cascade_set, table_tmp(i)%hashval, table_tmp(i)%hashval, &
table_tmp(i)%key, current%cascade)
current => current%next
end do
end do
end subroutine cascade_set_hash_expand
@ %def cascade_set_hash_expand
@ Insert the cascade at the bucket determined by the hash value. If
the bucket is filled, check first for a collision (unequal keys). In
that case, choose the following bucket and repeat. Otherwise, add the
cascade to the bucket.
If the bucket is empty, record the hash value, allocate and store the
key, and then add the cascade to the bucket.
If [[ok]] is present, before insertion we check whether the cascade is
already stored, and return failure if yes.
<<Cascades: procedures>>=
recursive subroutine cascade_set_hash_insert_rec &
(cascade_set, h, hashval, key, cascade, ok, cascade_ptr)
type(cascade_set_t), intent(inout) :: cascade_set
integer(i32), intent(in) :: h, hashval
integer(i8), dimension(:), intent(in) :: key
type(cascade_t), intent(in), target :: cascade
logical, intent(out), optional :: ok
type(cascade_t), optional, pointer :: cascade_ptr
integer(i32) :: i
i = iand (h, cascade_set%mask)
if (allocated (cascade_set%entry(i)%key)) then
if (size (cascade_set%entry(i)%key) /= size (key)) then
call cascade_set_hash_insert_rec &
(cascade_set, h + 1, hashval, key, cascade, ok, cascade_ptr)
else if (any (cascade_set%entry(i)%key /= key)) then
call cascade_set_hash_insert_rec &
(cascade_set, h + 1, hashval, key, cascade, ok, cascade_ptr)
else
call hash_entry_add_cascade_ptr &
(cascade_set%entry(i), cascade, ok, cascade_ptr)
end if
else
cascade_set%entry(i)%hashval = hashval
allocate (cascade_set%entry(i)%key (size (key)))
cascade_set%entry(i)%key = key
call hash_entry_add_cascade_ptr &
(cascade_set%entry(i), cascade, ok, cascade_ptr)
cascade_set%n_entries = cascade_set%n_entries + 1
end if
end subroutine cascade_set_hash_insert_rec
@ %def cascade_set_hash_insert_rec
@
\subsection{External particles}
We want to initialize the cascade set with the outgoing particles. In
case of multiple processes, initial cascades are prepared for all of
them. The hash array check ensures that no particle appears more than
once at the same place.
<<Cascades: interfaces>>=
interface cascade_set_add_outgoing
module procedure cascade_set_add_outgoing1
module procedure cascade_set_add_outgoing2
end interface
<<Cascades: sub interfaces>>=
module subroutine cascade_set_add_outgoing1 (cascade_set, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
type(flavor_t), dimension(:), intent(in) :: flv
end subroutine cascade_set_add_outgoing1
module subroutine cascade_set_add_outgoing2 (cascade_set, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
type(flavor_t), dimension(:,:), intent(in) :: flv
end subroutine cascade_set_add_outgoing2
<<Cascades: procedures>>=
module subroutine cascade_set_add_outgoing2 (cascade_set, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
type(flavor_t), dimension(:,:), intent(in) :: flv
integer :: pos, prc, n_out, n_prc
type(cascade_t), pointer :: cascade
logical :: ok
n_out = size (flv, dim=1)
n_prc = size (flv, dim=2)
do prc = 1, n_prc
do pos = 1, n_out
allocate (cascade)
call cascade_init_outgoing &
(cascade, flv(pos,prc), pos, cascade_set%m_threshold_s)
call cascade_set_add (cascade_set, cascade, ok)
if (.not. ok) then
deallocate (cascade)
end if
end do
end do
end subroutine cascade_set_add_outgoing2
module subroutine cascade_set_add_outgoing1 (cascade_set, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
type(flavor_t), dimension(:), intent(in) :: flv
integer :: pos, n_out
type(cascade_t), pointer :: cascade
logical :: ok
n_out = size (flv, dim=1)
do pos = 1, n_out
allocate (cascade)
call cascade_init_outgoing &
(cascade, flv(pos), pos, cascade_set%m_threshold_s)
call cascade_set_add (cascade_set, cascade, ok)
if (.not. ok) then
deallocate (cascade)
end if
end do
end subroutine cascade_set_add_outgoing1
@ %def cascade_set_add_outgoing
@ The incoming particles are added one at a time. Nevertheless, we
may have several processes which are looped over. At the first
opportunity, we set the pointer [[first_t]] in the cascade set which
should point to the first t-channel cascade.
Return the indices of the first and last cascade generated.
<<Cascades: interfaces>>=
interface cascade_set_add_incoming
module procedure cascade_set_add_incoming0
module procedure cascade_set_add_incoming1
end interface
<<Cascades: sub interfaces>>=
module subroutine cascade_set_add_incoming1 (cascade_set, n1, n2, pos, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
integer, intent(out) :: n1, n2
integer, intent(in) :: pos
type(flavor_t), dimension(:), intent(in) :: flv
end subroutine cascade_set_add_incoming1
module subroutine cascade_set_add_incoming0 (cascade_set, n1, n2, pos, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
integer, intent(out) :: n1, n2
integer, intent(in) :: pos
type(flavor_t), intent(in) :: flv
end subroutine cascade_set_add_incoming0
<<Cascades: procedures>>=
module subroutine cascade_set_add_incoming1 (cascade_set, n1, n2, pos, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
integer, intent(out) :: n1, n2
integer, intent(in) :: pos
type(flavor_t), dimension(:), intent(in) :: flv
integer :: prc, n_prc
type(cascade_t), pointer :: cascade
logical :: ok
n1 = 0
n2 = 0
n_prc = size (flv)
do prc = 1, n_prc
allocate (cascade)
call cascade_init_incoming &
(cascade, flv(prc), pos, cascade_set%m_threshold_t)
call cascade_set_add (cascade_set, cascade, ok)
if (ok) then
if (n1 == 0) n1 = cascade%index
n2 = cascade%index
if (.not. associated (cascade_set%first_t)) then
cascade_set%first_t => cascade
end if
else
deallocate (cascade)
end if
end do
end subroutine cascade_set_add_incoming1
module subroutine cascade_set_add_incoming0 (cascade_set, n1, n2, pos, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
integer, intent(out) :: n1, n2
integer, intent(in) :: pos
type(flavor_t), intent(in) :: flv
type(cascade_t), pointer :: cascade
logical :: ok
n1 = 0
n2 = 0
allocate (cascade)
call cascade_init_incoming &
(cascade, flv, pos, cascade_set%m_threshold_t)
call cascade_set_add (cascade_set, cascade, ok)
if (ok) then
if (n1 == 0) n1 = cascade%index
n2 = cascade%index
if (.not. associated (cascade_set%first_t)) then
cascade_set%first_t => cascade
end if
else
deallocate (cascade)
end if
end subroutine cascade_set_add_incoming0
@ %def cascade_set_add_incoming
@
\subsection{Cascade combination I: flavor assignment}
We have two disjunct cascades, now use the vertex table to determine
the possible flavors of the combination cascade. For each
possibility, try to generate a new cascade. The total cascade depth
has to be one less than the limit, because this is reached by setting
the keystone.
<<Cascades: procedures>>=
subroutine cascade_match_pair (cascade_set, cascade1, cascade2, s_channel)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade1, cascade2
logical, intent(in) :: s_channel
integer, dimension(:), allocatable :: pdg3
integer :: i, depth_max
type(flavor_t) :: flv
if (s_channel) then
depth_max = cascade_set%depth_out
else
depth_max = cascade_set%depth_tot
end if
if (cascade1%depth + cascade2%depth < depth_max) then
call cascade_set%model%match_vertex ( &
cascade1%flv%get_pdg (), &
cascade2%flv%get_pdg (), &
pdg3)
do i = 1, size (pdg3)
call flv%init (pdg3(i), cascade_set%model)
if (s_channel) then
call cascade_combine_s (cascade_set, cascade1, cascade2, flv)
else
call cascade_combine_t (cascade_set, cascade1, cascade2, flv)
end if
end do
deallocate (pdg3)
end if
end subroutine cascade_match_pair
@ %def cascade_match_pair
@ The triplet version takes a third cascade, and we check whether this
triplet has a matching vertex in the database. If yes, we make a
keystone cascade.
<<Cascades: procedures>>=
subroutine cascade_match_triplet &
(cascade_set, cascade1, cascade2, cascade3, s_channel)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade1, cascade2, cascade3
logical, intent(in) :: s_channel
integer :: depth_max
depth_max = cascade_set%depth_tot
if (cascade1%depth + cascade2%depth + cascade3%depth == depth_max) then
if (cascade_set%model%check_vertex ( &
cascade1%flv%get_pdg (), &
cascade2%flv%get_pdg (), &
cascade3%flv%get_pdg ())) then
call cascade_combine_keystone &
(cascade_set, cascade1, cascade2, cascade3, s_channel)
end if
end if
end subroutine cascade_match_triplet
@ %def cascade_match_triplet
@
\subsection{Cascade combination II: kinematics setup and check}
Having three matching flavors, we start constructing the combination
cascade. We look at the mass hierarchies and determine whether the
cascade is to be kept. In passing we set mapping modes, resonance
properties and such.
If successful, the cascade is finalized. For a resonant cascade, we
prepare in addition a copy without the resonance.
<<Cascades: procedures>>=
subroutine cascade_combine_s (cascade_set, cascade1, cascade2, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade1, cascade2
type(flavor_t), intent(in) :: flv
type(cascade_t), pointer :: cascade3, cascade4
logical :: keep
keep = .false.
allocate (cascade3)
call cascade_init (cascade3, cascade1%depth + cascade2%depth + 1)
cascade3%bincode = ior (cascade1%bincode, cascade2%bincode)
cascade3%flv = flv%anti ()
cascade3%pdg = cascade3%flv%get_pdg ()
cascade3%is_vector = flv%get_spin_type () == VECTOR
cascade3%m_min = cascade1%m_min + cascade2%m_min
cascade3%m_rea = flv%get_mass ()
if (cascade3%m_rea > cascade_set%m_threshold_s) then
cascade3%m_eff = cascade3%m_rea
end if
! Potentially resonant cases [sqrts = m_rea for on-shell decay]
if (cascade3%m_rea > cascade3%m_min &
.and. cascade3%m_rea <= cascade_set%sqrts) then
if (flv%get_width () /= 0) then
if (cascade1%on_shell .or. cascade2%on_shell) then
keep = .true.
cascade3%mapping = S_CHANNEL
cascade3%resonant = .true.
end if
else
call warn_decay (flv)
end if
! Collinear and IR singular cases
else if (cascade3%m_rea < cascade_set%sqrts) then
! Massless splitting
if (cascade1%m_eff == 0 .and. cascade2%m_eff == 0 &
.and. cascade3%depth <= 3) then
keep = .true.
cascade3%log_enhanced = .true.
if (cascade3%is_vector) then
if (cascade1%is_vector .and. cascade2%is_vector) then
cascade3%mapping = COLLINEAR ! three-vector-vertex
else
cascade3%mapping = INFRARED ! vector splitting into matter
end if
else
if (cascade1%is_vector .or. cascade2%is_vector) then
cascade3%mapping = COLLINEAR ! vector radiation off matter
else
cascade3%mapping = INFRARED ! scalar radiation/splitting
end if
end if
! IR radiation off massive particle
else if (cascade3%m_eff > 0 .and. cascade1%m_eff > 0 &
.and. cascade2%m_eff == 0 &
.and. (cascade1%on_shell .or. cascade1%mapping == RADIATION) &
.and. abs (cascade3%m_eff - cascade1%m_eff) &
< cascade_set%m_threshold_s) &
then
keep = .true.
cascade3%log_enhanced = .true.
cascade3%mapping = RADIATION
else if (cascade3%m_eff > 0 .and. cascade2%m_eff > 0 &
.and. cascade1%m_eff == 0 &
.and. (cascade2%on_shell .or. cascade2%mapping == RADIATION) &
.and. abs (cascade3%m_eff - cascade2%m_eff) &
< cascade_set%m_threshold_s) &
then
keep = .true.
cascade3%log_enhanced = .true.
cascade3%mapping = RADIATION
end if
end if
! Non-singular cases, including failed resonances
if (.not. keep) then
! Two on-shell particles from a virtual mother
if (cascade1%on_shell .or. cascade2%on_shell) then
keep = .true.
cascade3%m_eff = max (cascade3%m_min, &
cascade1%m_eff + cascade2%m_eff)
if (cascade3%m_eff < cascade_set%m_threshold_s) then
cascade3%m_eff = 0
end if
end if
end if
! Complete and register the cascade (two in case of resonance)
if (keep) then
cascade3%on_shell = cascade3%resonant .or. cascade3%log_enhanced
if (cascade3%resonant) then
cascade3%pdg = cascade3%flv%get_pdg ()
if (cascade_set%keep_nonresonant) then
allocate (cascade4)
cascade4 = cascade3
cascade4%index = cascade_index ()
cascade4%pdg = UNDEFINED
cascade4%mapping = NO_MAPPING
cascade4%resonant = .false.
cascade4%on_shell = .false.
end if
cascade3%m_min = cascade3%m_rea
call cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
if (cascade_set%keep_nonresonant) then
call cascade_fusion (cascade_set, cascade1, cascade2, cascade4)
end if
else
call cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
end if
else
deallocate (cascade3)
end if
contains
subroutine warn_decay (flv)
type(flavor_t), intent(in) :: flv
integer :: i
integer, dimension(MAX_WARN_RESONANCE), save :: warned_code = 0
LOOP_WARNED: do i = 1, MAX_WARN_RESONANCE
if (warned_code(i) == 0) then
warned_code(i) = flv%get_pdg ()
write (msg_buffer, "(A)") &
& " Intermediate decay of zero-width particle " &
& // char (flv%get_name ()) &
& // " may be possible."
call msg_warning
exit LOOP_WARNED
else if (warned_code(i) == flv%get_pdg ()) then
exit LOOP_WARNED
end if
end do LOOP_WARNED
end subroutine warn_decay
end subroutine cascade_combine_s
@ %def cascade_combine_s
<<Cascades: parameters>>=
integer, parameter, public :: MAX_WARN_RESONANCE = 50
@ %def MAX_WARN_RESONANCE
@ This is the t-channel version. [[cascade1]] is t-channel and
contains the seed, [[cascade2]] is s-channel. We check for
kinematically allowed beam decay (which is a fatal error), or massless
splitting / soft radiation. The cascade is kept in all remaining
cases and submitted for registration.
<<Cascades: procedures>>=
subroutine cascade_combine_t (cascade_set, cascade1, cascade2, flv)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade1, cascade2
type(flavor_t), intent(in) :: flv
type(cascade_t), pointer :: cascade3
allocate (cascade3)
call cascade_init (cascade3, cascade1%depth + cascade2%depth + 1)
cascade3%bincode = ior (cascade1%bincode, cascade2%bincode)
cascade3%flv = flv%anti ()
cascade3%pdg = abs (cascade3%flv%get_pdg ())
cascade3%is_vector = flv%get_spin_type () == VECTOR
if (cascade1%incoming) then
cascade3%m_min = cascade2%m_min
else
cascade3%m_min = cascade1%m_min + cascade2%m_min
end if
cascade3%m_rea = flv%get_mass ()
if (cascade3%m_rea > cascade_set%m_threshold_t) then
cascade3%m_eff = max (cascade3%m_rea, cascade2%m_eff)
else if (cascade2%m_eff > cascade_set%m_threshold_t) then
cascade3%m_eff = cascade2%m_eff
else
cascade3%m_eff = 0
end if
! Allowed decay of beam particle
if (cascade1%incoming &
.and. cascade1%m_rea > cascade2%m_rea + cascade3%m_rea) then
call beam_decay (cascade_set%fatal_beam_decay)
! Massless splitting
else if (cascade1%m_eff == 0 &
.and. cascade2%m_eff < cascade_set%m_threshold_t &
.and. cascade3%m_eff == 0) then
cascade3%mapping = U_CHANNEL
cascade3%log_enhanced = .true.
! IR radiation off massive particle
else if (cascade1%m_eff /= 0 .and. cascade2%m_eff == 0 &
.and. cascade3%m_eff /= 0 &
.and. (cascade1%on_shell .or. cascade1%mapping == RADIATION) &
.and. abs (cascade1%m_eff - cascade3%m_eff) &
< cascade_set%m_threshold_t) &
then
cascade3%pdg = flv%get_pdg ()
cascade3%log_enhanced = .true.
cascade3%mapping = RADIATION
end if
cascade3%t_channel = .true.
call cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
contains
subroutine beam_decay (fatal_beam_decay)
logical, intent(in) :: fatal_beam_decay
write (msg_buffer, "(1x,A,1x,'->',1x,A,1x,A)") &
char (cascade1%flv%get_name ()), &
char (cascade3%flv%get_name ()), &
char (cascade2%flv%get_name ())
call msg_message
write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
char (cascade1%flv%get_name ()), cascade1%m_rea
call msg_message
write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
char (cascade3%flv%get_name ()), cascade3%m_rea
call msg_message
write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
char (cascade2%flv%get_name ()), cascade2%m_rea
call msg_message
if (fatal_beam_decay) then
call msg_fatal (" Phase space: Initial beam particle can decay")
else
call msg_warning (" Phase space: Initial beam particle can decay")
end if
end subroutine beam_decay
end subroutine cascade_combine_t
@ %def cascade_combine_t
@ Here we complete a decay cascade. The third input is the
single-particle cascade for the initial particle. There is no
resonance or mapping assignment. The only condition for keeping the
cascade is the mass sum of the final state, which must be less than
the available energy.
Two modifications are necessary for scattering cascades: a pure
s-channel diagram (cascade1 is the incoming particle) do not have a
logarithmic mapping at top-level. And in a t-channel diagram, the
last line exchanged is mapped t-channel, not u-channel. Finally, we
can encounter the case of a $2\to 1$ process, where cascade1 is
incoming, and cascade2 is the outgoing particle. In all three cases
we register a new cascade with the modified mapping.
<<Cascades: procedures>>=
subroutine cascade_combine_keystone &
(cascade_set, cascade1, cascade2, cascade3, s_channel)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade1, cascade2, cascade3
logical, intent(in) :: s_channel
type(cascade_t), pointer :: cascade4, cascade0
logical :: keep, ok
keep = .false.
allocate (cascade4)
call cascade_init &
(cascade4, cascade1%depth + cascade2%depth + cascade3%depth)
cascade4%complete = .true.
if (s_channel) then
cascade4%bincode = ior (cascade1%bincode, cascade2%bincode)
else
cascade4%bincode = cascade3%bincode
end if
cascade4%flv = cascade3%flv
cascade4%pdg = cascade3%pdg
cascade4%mapping = EXTERNAL_PRT
cascade4%is_vector = cascade3%is_vector
cascade4%m_min = cascade1%m_min + cascade2%m_min
cascade4%m_rea = cascade3%m_rea
cascade4%m_eff = cascade3%m_rea
if (cascade4%m_min < cascade_set%sqrts) then
keep = .true.
end if
if (keep) then
if (cascade1%incoming .and. cascade2%log_enhanced) then
allocate (cascade0)
cascade0 = cascade2
cascade0%next => null ()
cascade0%index = cascade_index ()
cascade0%mapping = NO_MAPPING
cascade0%log_enhanced = .false.
cascade0%n_log_enhanced = cascade0%n_log_enhanced - 1
cascade0%tree_mapping(cascade0%depth) = NO_MAPPING
call cascade_keystone &
(cascade_set, cascade1, cascade0, cascade3, cascade4, ok)
if (ok) then
call cascade_set_add (cascade_set, cascade0, ok)
else
deallocate (cascade0)
end if
else if (cascade1%t_channel .and. cascade1%mapping == U_CHANNEL) then
allocate (cascade0)
cascade0 = cascade1
cascade0%next => null ()
cascade0%index = cascade_index ()
cascade0%mapping = T_CHANNEL
cascade0%tree_mapping(cascade0%depth) = T_CHANNEL
call cascade_keystone &
(cascade_set, cascade0, cascade2, cascade3, cascade4, ok)
if (ok) then
call cascade_set_add (cascade_set, cascade0, ok)
else
deallocate (cascade0)
end if
else if (cascade1%incoming .and. cascade2%depth == 1) then
allocate (cascade0)
cascade0 = cascade2
cascade0%next => null ()
cascade0%index = cascade_index ()
cascade0%mapping = ON_SHELL
cascade0%tree_mapping(cascade0%depth) = ON_SHELL
call cascade_keystone &
(cascade_set, cascade1, cascade0, cascade3, cascade4, ok)
if (ok) then
call cascade_set_add (cascade_set, cascade0, ok)
else
deallocate (cascade0)
end if
else
call cascade_keystone &
(cascade_set, cascade1, cascade2, cascade3, cascade4, ok)
end if
else
deallocate (cascade4)
end if
end subroutine cascade_combine_keystone
@ %def cascade_combine_keystone
@
\subsection{Cascade combination III: node connections and tree fusion}
Here we assign global tree properties. If the allowed number of
off-shell lines is exceeded, discard the new cascade. Otherwise,
assign the trees, sort them, and assign connections. Finally, append
the cascade to the list. This may fail (because in the hash array
there is already an equivalent cascade). On failure, discard the
cascade.
<<Cascades: procedures>>=
subroutine cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade1, cascade2
type(cascade_t), pointer :: cascade3
integer :: i1, i2, i3, i4
logical :: ok
cascade3%internal = (cascade3%depth - 3) / 2
if (cascade3%resonant) then
cascade3%multiplicity = 1
cascade3%n_resonances = &
cascade1%n_resonances + cascade2%n_resonances + 1
else
cascade3%multiplicity = cascade1%multiplicity + cascade2%multiplicity
cascade3%n_resonances = cascade1%n_resonances + cascade2%n_resonances
end if
if (cascade3%log_enhanced) then
cascade3%n_log_enhanced = &
cascade1%n_log_enhanced + cascade2%n_log_enhanced + 1
else
cascade3%n_log_enhanced = &
cascade1%n_log_enhanced + cascade2%n_log_enhanced
end if
if (cascade3%resonant) then
cascade3%n_off_shell = 0
else if (cascade3%log_enhanced) then
cascade3%n_off_shell = cascade1%n_off_shell + cascade2%n_off_shell
else
cascade3%n_off_shell = cascade1%n_off_shell + cascade2%n_off_shell + 1
end if
if (cascade3%t_channel) then
cascade3%n_t_channel = cascade1%n_t_channel + 1
end if
if (cascade3%n_off_shell > cascade_set%off_shell) then
deallocate (cascade3)
else if (cascade3%n_t_channel > cascade_set%t_channel) then
deallocate (cascade3)
else
i1 = cascade1%depth
i2 = i1 + 1
i3 = i1 + cascade2%depth
i4 = cascade3%depth
cascade3%tree(:i1) = cascade1%tree
where (cascade1%tree_mapping > NO_MAPPING)
cascade3%tree_pdg(:i1) = cascade1%tree_pdg
elsewhere
cascade3%tree_pdg(:i1) = UNDEFINED
end where
cascade3%tree_mapping(:i1) = cascade1%tree_mapping
cascade3%tree_resonant(:i1) = cascade1%tree_resonant
cascade3%tree(i2:i3) = cascade2%tree
where (cascade2%tree_mapping > NO_MAPPING)
cascade3%tree_pdg(i2:i3) = cascade2%tree_pdg
elsewhere
cascade3%tree_pdg(i2:i3) = UNDEFINED
end where
cascade3%tree_mapping(i2:i3) = cascade2%tree_mapping
cascade3%tree_resonant(i2:i3) = cascade2%tree_resonant
cascade3%tree(i4) = cascade3%bincode
cascade3%tree_pdg(i4) = cascade3%pdg
cascade3%tree_mapping(i4) = cascade3%mapping
cascade3%tree_resonant(i4) = cascade3%resonant
call tree_sort (cascade3%tree, &
cascade3%tree_pdg, cascade3%tree_mapping, cascade3%tree_resonant)
cascade3%has_children = .true.
cascade3%daughter1 => cascade1
cascade3%daughter2 => cascade2
call cascade_set_add (cascade_set, cascade3, ok)
if (.not. ok) deallocate (cascade3)
end if
end subroutine cascade_fusion
@ %def cascade_fusion
@ Here we combine a cascade pair with an incoming particle, i.e., we
set a keystone. Otherwise, this is similar. On the first
opportunity, we set the [[first_k]] pointer in the cascade set.
<<Cascades: procedures>>=
subroutine cascade_keystone &
(cascade_set, cascade1, cascade2, cascade3, cascade4, ok)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), intent(in), target :: cascade1, cascade2, cascade3
type(cascade_t), pointer :: cascade4
logical, intent(out) :: ok
integer :: i1, i2, i3, i4
cascade4%internal = (cascade4%depth - 3) / 2
cascade4%multiplicity = cascade1%multiplicity + cascade2%multiplicity
cascade4%n_resonances = cascade1%n_resonances + cascade2%n_resonances
cascade4%n_off_shell = cascade1%n_off_shell + cascade2%n_off_shell
cascade4%n_log_enhanced = &
cascade1%n_log_enhanced + cascade2%n_log_enhanced
cascade4%n_t_channel = cascade1%n_t_channel + cascade2%n_t_channel
if (cascade4%n_off_shell > cascade_set%off_shell) then
deallocate (cascade4)
ok = .false.
else if (cascade4%n_t_channel > cascade_set%t_channel) then
deallocate (cascade4)
ok = .false.
else
i1 = cascade1%depth
i2 = i1 + 1
i3 = i1 + cascade2%depth
i4 = cascade4%depth
cascade4%tree(:i1) = cascade1%tree
where (cascade1%tree_mapping > NO_MAPPING)
cascade4%tree_pdg(:i1) = cascade1%tree_pdg
elsewhere
cascade4%tree_pdg(:i1) = UNDEFINED
end where
cascade4%tree_mapping(:i1) = cascade1%tree_mapping
cascade4%tree_resonant(:i1) = cascade1%tree_resonant
cascade4%tree(i2:i3) = cascade2%tree
where (cascade2%tree_mapping > NO_MAPPING)
cascade4%tree_pdg(i2:i3) = cascade2%tree_pdg
elsewhere
cascade4%tree_pdg(i2:i3) = UNDEFINED
end where
cascade4%tree_mapping(i2:i3) = cascade2%tree_mapping
cascade4%tree_resonant(i2:i3) = cascade2%tree_resonant
cascade4%tree(i4) = cascade4%bincode
cascade4%tree_pdg(i4) = UNDEFINED
cascade4%tree_mapping(i4) = cascade4%mapping
cascade4%tree_resonant(i4) = .false.
call tree_sort (cascade4%tree, &
cascade4%tree_pdg, cascade4%tree_mapping, cascade4%tree_resonant)
cascade4%has_children = .true.
cascade4%daughter1 => cascade1
cascade4%daughter2 => cascade2
cascade4%mother => cascade3
call cascade_set_add (cascade_set, cascade4, ok)
if (ok) then
if (.not. associated (cascade_set%first_k)) then
cascade_set%first_k => cascade4
end if
else
deallocate (cascade4)
end if
end if
end subroutine cascade_keystone
@ %def cascade_keystone
@
Sort a tree (array of binary codes) and particle code array
simultaneously, by ascending binary codes. A convenient method is to
use the [[maxloc]] function iteratively, to find and remove the
largest entry in the tree array one by one.
<<Cascades: procedures>>=
subroutine tree_sort (tree, pdg, mapping, resonant)
integer(TC), dimension(:), intent(inout) :: tree
integer, dimension(:), intent(inout) :: pdg, mapping
logical, dimension(:), intent(inout) :: resonant
integer(TC), dimension(size(tree)) :: tree_tmp
integer, dimension(size(pdg)) :: pdg_tmp, mapping_tmp
logical, dimension(size(resonant)) :: resonant_tmp
integer, dimension(1) :: pos
integer :: i
tree_tmp = tree
pdg_tmp = pdg
mapping_tmp = mapping
resonant_tmp = resonant
do i = size(tree),1,-1
pos = maxloc (tree_tmp)
tree(i) = tree_tmp (pos(1))
pdg(i) = pdg_tmp (pos(1))
mapping(i) = mapping_tmp (pos(1))
resonant(i) = resonant_tmp (pos(1))
tree_tmp(pos(1)) = 0
end do
end subroutine tree_sort
@ %def tree_sort
@
\subsection{Cascade set generation}
These procedures loop over cascades and build up the cascade set. After each
iteration of the innermost loop, we set a breakpoint.
s-channel: We use a nested scan to combine all cascades with all other
cascades.
<<Cascades: procedures>>=
subroutine cascade_set_generate_s (cascade_set)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), pointer :: cascade1, cascade2
cascade1 => cascade_set%first
LOOP1: do while (associated (cascade1))
cascade2 => cascade_set%first
LOOP2: do while (associated (cascade2))
if (cascade2%index >= cascade1%index) exit LOOP2
if (cascade1 .disjunct. cascade2) then
call cascade_match_pair (cascade_set, cascade1, cascade2, .true.)
end if
call terminate_now_if_signal ()
cascade2 => cascade2%next
end do LOOP2
cascade1 => cascade1%next
end do LOOP1
end subroutine cascade_set_generate_s
@ %def cascade_set_generate_s
@ The t-channel cascades are directed and have a seed (one of the
incoming particles) and a target (the other one). We loop over all
possible seeds and targets. Inside this, we loop over all t-channel
cascades ([[cascade1]]) and s-channel cascades ([[cascade2]]) and try
to combine them.
<<Cascades: procedures>>=
subroutine cascade_set_generate_t (cascade_set, pos_seed, pos_target)
type(cascade_set_t), intent(inout), target :: cascade_set
integer, intent(in) :: pos_seed, pos_target
type(cascade_t), pointer :: cascade_seed, cascade_target
type(cascade_t), pointer :: cascade1, cascade2
integer(TC) :: bc_seed, bc_target
bc_seed = ibset (0_TC, pos_seed-1)
bc_target = ibset (0_TC, pos_target-1)
cascade_seed => cascade_set%first_t
LOOP_SEED: do while (associated (cascade_seed))
if (cascade_seed%bincode == bc_seed) then
cascade_target => cascade_set%first_t
LOOP_TARGET: do while (associated (cascade_target))
if (cascade_target%bincode == bc_target) then
cascade1 => cascade_set%first_t
LOOP_T: do while (associated (cascade1))
if ((cascade1 .disjunct. cascade_target) &
.and. .not. (cascade1 .disjunct. cascade_seed)) then
cascade2 => cascade_set%first
LOOP_S: do while (associated (cascade2))
if ((cascade2 .disjunct. cascade_target) &
.and. (cascade2 .disjunct. cascade1)) then
call cascade_match_pair &
(cascade_set, cascade1, cascade2, .false.)
end if
call terminate_now_if_signal ()
cascade2 => cascade2%next
end do LOOP_S
end if
call terminate_now_if_signal ()
cascade1 => cascade1%next
end do LOOP_T
end if
call terminate_now_if_signal ()
cascade_target => cascade_target%next
end do LOOP_TARGET
end if
call terminate_now_if_signal ()
cascade_seed => cascade_seed%next
end do LOOP_SEED
end subroutine cascade_set_generate_t
@ %def cascade_set_generate_t
@ This part completes the phase space for decay processes. It is
similar to s-channel cascade generation, but combines two cascade with
the particular cascade of the incoming particle. This particular
cascade is expected to be pointed at by [[first_t]].
<<Cascades: procedures>>=
subroutine cascade_set_generate_decay (cascade_set)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), pointer :: cascade1, cascade2
type(cascade_t), pointer :: cascade_in
cascade_in => cascade_set%first_t
cascade1 => cascade_set%first
do while (associated (cascade1))
if (cascade1 .disjunct. cascade_in) then
cascade2 => cascade1%next
do while (associated (cascade2))
if ((cascade2 .disjunct. cascade1) &
.and. (cascade2 .disjunct. cascade_in)) then
call cascade_match_triplet (cascade_set, &
cascade1, cascade2, cascade_in, .true.)
end if
call terminate_now_if_signal ()
cascade2 => cascade2%next
end do
end if
call terminate_now_if_signal ()
cascade1 => cascade1%next
end do
end subroutine cascade_set_generate_decay
@ %def cascade_set_generate_decay
@ This part completes the phase space for scattering processes. We
combine a t-channel cascade (containing the seed) with a s-channel
cascade and the target.
<<Cascades: procedures>>=
subroutine cascade_set_generate_scattering &
(cascade_set, ns1, ns2, nt1, nt2, pos_seed, pos_target)
type(cascade_set_t), intent(inout), target :: cascade_set
integer, intent(in) :: pos_seed, pos_target
integer, intent(in) :: ns1, ns2, nt1, nt2
type(cascade_t), pointer :: cascade_seed, cascade_target
type(cascade_t), pointer :: cascade1, cascade2
integer(TC) :: bc_seed, bc_target
bc_seed = ibset (0_TC, pos_seed-1)
bc_target = ibset (0_TC, pos_target-1)
cascade_seed => cascade_set%first_t
LOOP_SEED: do while (associated (cascade_seed))
if (cascade_seed%index < ns1) then
cascade_seed => cascade_seed%next
cycle LOOP_SEED
else if (cascade_seed%index > ns2) then
exit LOOP_SEED
else if (cascade_seed%bincode == bc_seed) then
cascade_target => cascade_set%first_t
LOOP_TARGET: do while (associated (cascade_target))
if (cascade_target%index < nt1) then
cascade_target => cascade_target%next
cycle LOOP_TARGET
else if (cascade_target%index > nt2) then
exit LOOP_TARGET
else if (cascade_target%bincode == bc_target) then
cascade1 => cascade_set%first_t
LOOP_T: do while (associated (cascade1))
if ((cascade1 .disjunct. cascade_target) &
.and. .not. (cascade1 .disjunct. cascade_seed)) then
cascade2 => cascade_set%first
LOOP_S: do while (associated (cascade2))
if ((cascade2 .disjunct. cascade_target) &
.and. (cascade2 .disjunct. cascade1)) then
call cascade_match_triplet (cascade_set, &
cascade1, cascade2, cascade_target, .false.)
end if
call terminate_now_if_signal ()
cascade2 => cascade2%next
end do LOOP_S
end if
call terminate_now_if_signal ()
cascade1 => cascade1%next
end do LOOP_T
end if
call terminate_now_if_signal ()
cascade_target => cascade_target%next
end do LOOP_TARGET
end if
call terminate_now_if_signal ()
cascade_seed => cascade_seed%next
end do LOOP_SEED
end subroutine cascade_set_generate_scattering
@ %def cascade_set_generate_scattering
@
\subsection{Groves}
Before assigning groves, assign hashcodes to the resonance patterns, so they
can easily be compared.
<<Cascades: procedures>>=
subroutine cascade_set_assign_resonance_hash (cascade_set)
type(cascade_set_t), intent(inout) :: cascade_set
type(cascade_t), pointer :: cascade
cascade => cascade_set%first_k
do while (associated (cascade))
call cascade_assign_resonance_hash (cascade)
cascade => cascade%next
end do
end subroutine cascade_set_assign_resonance_hash
@ %def cascade_assign_resonance_hash
@ After all cascades are recorded, we group the complete cascades in
groves. A grove consists of cascades with identical multiplicity,
number of resonances, log-enhanced, t-channel lines, and resonance flavors.
<<Cascades: procedures>>=
subroutine cascade_set_assign_groves (cascade_set)
type(cascade_set_t), intent(inout), target :: cascade_set
type(cascade_t), pointer :: cascade1, cascade2
integer :: multiplicity
integer :: n_resonances, n_log_enhanced, n_t_channel, n_off_shell
integer :: res_hash
integer :: grove
grove = 0
cascade1 => cascade_set%first_k
do while (associated (cascade1))
if (cascade1%active .and. cascade1%complete &
.and. cascade1%grove == 0) then
grove = grove + 1
cascade1%grove = grove
multiplicity = cascade1%multiplicity
n_resonances = cascade1%n_resonances
n_log_enhanced = cascade1%n_log_enhanced
n_off_shell = cascade1%n_off_shell
n_t_channel = cascade1%n_t_channel
res_hash = cascade1%res_hash
cascade2 => cascade1%next
do while (associated (cascade2))
if (cascade2%grove == 0) then
if (cascade2%multiplicity == multiplicity &
.and. cascade2%n_resonances == n_resonances &
.and. cascade2%n_log_enhanced == n_log_enhanced &
.and. cascade2%n_off_shell == n_off_shell &
.and. cascade2%n_t_channel == n_t_channel &
.and. cascade2%res_hash == res_hash) then
cascade2%grove = grove
end if
end if
call terminate_now_if_signal ()
cascade2 => cascade2%next
end do
end if
call terminate_now_if_signal ()
cascade1 => cascade1%next
end do
cascade_set%n_groves = grove
end subroutine cascade_set_assign_groves
@ %def cascade_set_assign_groves
@
\subsection{Generate the phase space file}
Generate a complete phase space configuration.
For each flavor assignment: First, all s-channel
graphs that can be built up from the outgoing particles. Then we
distinguish (1) decay, where we complete the s-channel graphs by
connecting to the input line, and (2) scattering, where we now
generate t-channel graphs by introducing an incoming particle, and
complete this by connecting to the other incoming particle.
After all cascade sets have been generated, merge them into a common set.
This eliminates redunancies between flavor assignments.
<<Cascades: public>>=
public :: cascade_set_generate
<<Cascades: sub interfaces>>=
module subroutine cascade_set_generate &
(cascade_set, model, n_in, n_out, flv, phs_par, fatal_beam_decay)
type(cascade_set_t), intent(out) :: cascade_set
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_in, n_out
type(flavor_t), dimension(:,:), intent(in) :: flv
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
end subroutine cascade_set_generate
<<Cascades: procedures>>=
module subroutine cascade_set_generate &
(cascade_set, model, n_in, n_out, flv, phs_par, fatal_beam_decay)
type(cascade_set_t), intent(out) :: cascade_set
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_in, n_out
type(flavor_t), dimension(:,:), intent(in) :: flv
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
type(cascade_set_t), dimension(:), allocatable :: cset
type(cascade_t), pointer :: cascade
integer :: i
if (phase_space_vanishes (phs_par%sqrts, n_in, flv)) return
call cascade_set_init (cascade_set, model, n_in, n_out, phs_par, &
fatal_beam_decay, flv)
allocate (cset (size (flv, 2)))
do i = 1, size (cset)
call cascade_set_generate_single (cset(i), &
model, n_in, n_out, flv(:,i), phs_par, fatal_beam_decay)
cascade => cset(i)%first_k
do while (associated (cascade))
if (cascade%active .and. cascade%complete) then
call cascade_set_add_copy (cascade_set, cascade)
end if
cascade => cascade%next
end do
call cascade_set_final (cset(i))
end do
cascade_set%first_k => cascade_set%first
call cascade_set_assign_resonance_hash (cascade_set)
call cascade_set_assign_groves (cascade_set)
end subroutine cascade_set_generate
@ %def cascade_set_generate
@ This generates phase space for a single channel, without assigning groves.
<<Cascades: procedures>>=
subroutine cascade_set_generate_single (cascade_set, &
model, n_in, n_out, flv, phs_par, fatal_beam_decay)
type(cascade_set_t), intent(out) :: cascade_set
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_in, n_out
type(flavor_t), dimension(:), intent(in) :: flv
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
integer :: n11, n12, n21, n22
call cascade_set_init (cascade_set, model, n_in, n_out, phs_par, &
fatal_beam_decay)
call cascade_set_add_outgoing (cascade_set, flv(n_in+1:))
call cascade_set_generate_s (cascade_set)
select case (n_in)
case(1)
call cascade_set_add_incoming &
(cascade_set, n11, n12, n_out + 1, flv(1))
call cascade_set_generate_decay (cascade_set)
case(2)
call cascade_set_add_incoming &
(cascade_set, n11, n12, n_out + 1, flv(2))
call cascade_set_add_incoming &
(cascade_set, n21, n22, n_out + 2, flv(1))
call cascade_set_generate_t (cascade_set, n_out + 1, n_out + 2)
call cascade_set_generate_t (cascade_set, n_out + 2, n_out + 1)
call cascade_set_generate_scattering &
(cascade_set, n11, n12, n21, n22, n_out + 1, n_out + 2)
call cascade_set_generate_scattering &
(cascade_set, n21, n22, n11, n12, n_out + 2, n_out + 1)
end select
end subroutine cascade_set_generate_single
@ %def cascade_set_generate_single
@ Sanity check: Before anything else is done, check if there could
possibly be any phase space.
<<Cascades: public>>=
public :: phase_space_vanishes
<<Cascades: sub interfaces>>=
module function phase_space_vanishes (sqrts, n_in, flv) result (flag)
logical :: flag
real(default), intent(in) :: sqrts
integer, intent(in) :: n_in
type(flavor_t), dimension(:,:), intent(in) :: flv
end function phase_space_vanishes
<<Cascades: procedures>>=
module function phase_space_vanishes (sqrts, n_in, flv) result (flag)
logical :: flag
real(default), intent(in) :: sqrts
integer, intent(in) :: n_in
type(flavor_t), dimension(:,:), intent(in) :: flv
real(default), dimension(:,:), allocatable :: mass
real(default), dimension(:), allocatable :: mass_in, mass_out
integer :: n_prt, n_flv, i, j
flag = .false.
if (sqrts <= 0) then
call msg_error ("Phase space vanishes (sqrts must be positive)")
flag = .true.; return
end if
n_prt = size (flv, 1)
n_flv = size (flv, 2)
allocate (mass (n_prt, n_flv), mass_in (n_flv), mass_out (n_flv))
mass = flv%get_mass ()
mass_in = sum (mass(:n_in,:), 1)
mass_out = sum (mass(n_in+1:,:), 1)
if (any (mass_in > sqrts)) then
call msg_error ("Mass sum of incoming particles " &
// "is more than available energy")
flag = .true.; return
end if
if (any (mass_out > sqrts)) then
call msg_error ("Mass sum of outgoing particles " &
// "is more than available energy")
flag = .true.; return
end if
end function phase_space_vanishes
@ %def phase_space_vanishes
@
\subsection{Return the resonance histories for subtraction}
This appears to be essential (re-export of some imported assignment?)!
<<Cascades: public>>=
public :: assignment(=)
@
Extract the resonance set from a complete cascade.
<<Cascades: cascade: TBP>>=
procedure :: extract_resonance_history => cascade_extract_resonance_history
<<Cascades: sub interfaces>>=
module subroutine cascade_extract_resonance_history &
(cascade, res_hist, model, n_out)
class(cascade_t), intent(in), target :: cascade
type(resonance_history_t), intent(out) :: res_hist
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_out
end subroutine cascade_extract_resonance_history
<<Cascades: procedures>>=
module subroutine cascade_extract_resonance_history &
(cascade, res_hist, model, n_out)
class(cascade_t), intent(in), target :: cascade
type(resonance_history_t), intent(out) :: res_hist
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_out
type(resonance_info_t) :: resonance
integer :: i, mom_id, pdg
if (debug_on) call msg_debug2 (D_PHASESPACE, "cascade_extract_resonance_history")
if (cascade%n_resonances > 0) then
if (cascade%has_children) then
if (debug_on) call msg_debug2 (D_PHASESPACE, "cascade has resonances and children")
do i = 1, size(cascade%tree_resonant)
if (cascade%tree_resonant (i)) then
mom_id = cascade%tree (i)
pdg = cascade%tree_pdg (i)
call resonance%init (mom_id, pdg, model, n_out)
if (debug2_active (D_PHASESPACE)) then
print *, 'D: Adding resonance'
call resonance%write ()
end if
call res_hist%add_resonance (resonance)
end if
end do
end if
end if
end subroutine cascade_extract_resonance_history
@ %def cascade_extract_resonance_history
@
<<Cascades: public>>=
public :: cascade_set_get_n_trees
<<Cascades: sub interfaces>>=
module function cascade_set_get_n_trees (cascade_set) result (n)
type(cascade_set_t), intent(in), target :: cascade_set
integer :: n
end function cascade_set_get_n_trees
<<Cascades: procedures>>=
module function cascade_set_get_n_trees (cascade_set) result (n)
type(cascade_set_t), intent(in), target :: cascade_set
integer :: n
type(cascade_t), pointer :: cascade
integer :: grove
if (debug_on) call msg_debug (D_PHASESPACE, "cascade_set_get_n_trees")
n = 0
do grove = 1, cascade_set%n_groves
cascade => cascade_set%first_k
do while (associated (cascade))
if (cascade%active .and. cascade%complete) then
if (cascade%grove == grove) then
n = n + 1
end if
end if
cascade => cascade%next
end do
end do
if (debug_on) call msg_debug (D_PHASESPACE, "n", n)
end function cascade_set_get_n_trees
@ %def cascade_set_get_n_trees
@ Distill the set of resonance histories from the cascade set. The
result is an array which contains each valid history exactly once.
<<Cascades: public>>=
public :: cascade_set_get_resonance_histories
<<Cascades: sub interfaces>>=
module subroutine cascade_set_get_resonance_histories &
(cascade_set, n_filter, res_hists)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: n_filter
type(resonance_history_t), dimension(:), allocatable, intent(out) :: &
res_hists
end subroutine cascade_set_get_resonance_histories
<<Cascades: procedures>>=
module subroutine cascade_set_get_resonance_histories &
(cascade_set, n_filter, res_hists)
type(cascade_set_t), intent(in), target :: cascade_set
integer, intent(in), optional :: n_filter
type(resonance_history_t), dimension(:), allocatable, intent(out) :: &
res_hists
type(resonance_history_t), dimension(:), allocatable :: tmp
type(cascade_t), pointer :: cascade
type(resonance_history_t) :: res_hist
type(resonance_history_set_t) :: res_hist_set
integer :: grove, i, n_hists
logical :: included, add_to_list
if (debug_on) call msg_debug &
(D_PHASESPACE, "cascade_set_get_resonance_histories")
call res_hist_set%init (n_filter = n_filter)
do grove = 1, cascade_set%n_groves
cascade => cascade_set%first_k
do while (associated (cascade))
if (cascade%active .and. cascade%complete) then
if (cascade%grove == grove) then
if (debug_on) call msg_debug2 (D_PHASESPACE, "grove", grove)
call cascade%extract_resonance_history &
(res_hist, cascade_set%model, cascade_set%n_out)
call res_hist_set%enter (res_hist)
end if
end if
cascade => cascade%next
end do
end do
call res_hist_set%freeze ()
call res_hist_set%to_array (res_hists)
end subroutine cascade_set_get_resonance_histories
@ %def cascade_set_get_resonance_histories
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[cascades_ut.f90]]>>=
<<File header>>
module cascades_ut
use unit_tests
use cascades_uti
<<Standard module head>>
<<Cascades: public test>>
contains
<<Cascades: test driver>>
end module cascades_ut
@ %def cascades_ut
@
<<[[cascades_uti.f90]]>>=
<<File header>>
module cascades_uti
<<Use kinds>>
<<Use strings>>
use numeric_utils
use flavors
use model_data
use phs_forests, only: phs_parameters_t
use resonances, only: resonance_history_t
use cascades
<<Standard module head>>
<<Cascades: test declarations>>
contains
<<Cascades: tests>>
end module cascades_uti
@ %def cascades_ut
@ API: driver for the unit tests below.
<<Cascades: public test>>=
public :: cascades_test
<<Cascades: test driver>>=
subroutine cascades_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Cascades: execute tests>>
end subroutine cascades_test
@ %def cascades_test
\subsubsection{Check cascade setup}
@ Checking the basic setup up of the phase space cascade parameterizations.
<<Cascades: execute tests>>=
call test (cascades_1, "cascades_1", &
"check cascade setup", &
u, results)
<<Cascades: test declarations>>=
public :: cascades_1
<<Cascades: tests>>=
subroutine cascades_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(5,2) :: flv
type(cascade_set_t) :: cascade_set
type(phs_parameters_t) :: phs_par
write (u, "(A)") "* Test output: cascades_1"
write (u, "(A)") "* Purpose: test cascade phase space functions"
write (u, "(A)")
write (u, "(A)") "* Initializing"
write (u, "(A)")
call model%init_sm_test ()
call flv(1,1)%init ( 2, model)
call flv(2,1)%init (-2, model)
call flv(3,1)%init ( 1, model)
call flv(4,1)%init (-1, model)
call flv(5,1)%init (21, model)
call flv(1,2)%init ( 2, model)
call flv(2,2)%init (-2, model)
call flv(3,2)%init ( 2, model)
call flv(4,2)%init (-2, model)
call flv(5,2)%init (21, model)
phs_par%sqrts = 1000._default
phs_par%off_shell = 2
write (u, "(A)")
write (u, "(A)") "* Generating the cascades"
write (u, "(A)")
call cascade_set_generate (cascade_set, model, 2, 3, flv, phs_par,.true.)
call cascade_set_write (cascade_set, u)
call cascade_set_write_file_format (cascade_set, u)
write (u, "(A)") "* Cleanup"
write (u, "(A)")
call cascade_set_final (cascade_set)
call model%final ()
write (u, *)
write (u, "(A)") "* Test output end: cascades_1"
end subroutine cascades_1
@ %def cascades_1
@
\subsubsection{Check resonance history}
<<Cascades: execute tests>>=
call test(cascades_2, "cascades_2", &
"Check resonance history", u, results)
<<Cascades: test declarations>>=
public :: cascades_2
<<Cascades: tests>>=
subroutine cascades_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(5,1) :: flv
type(cascade_set_t) :: cascade_set
type(phs_parameters_t) :: phs_par
type(resonance_history_t), dimension(:), allocatable :: res_hists
integer :: n, i
write (u, "(A)") "* Test output: cascades_2"
write (u, "(A)") "* Purpose: Check resonance history"
write (u, "(A)")
write (u, "(A)") "* Initializing"
write (u, "(A)")
call model%init_sm_test ()
call flv(1,1)%init ( 2, model)
call flv(2,1)%init (-2, model)
call flv(3,1)%init ( 1, model)
call flv(4,1)%init (-1, model)
call flv(5,1)%init (22, model)
phs_par%sqrts = 1000._default
phs_par%off_shell = 2
write (u, "(A)")
write (u, "(A)") "* Generating the cascades"
write (u, "(A)")
call cascade_set_generate (cascade_set, model, 2, 3, flv, phs_par,.true.)
call cascade_set_get_resonance_histories (cascade_set, res_hists = res_hists)
n = cascade_set_get_n_trees (cascade_set)
call assert_equal (u, n, 24, "Number of trees")
do i = 1, size(res_hists)
call res_hists(i)%write (u)
write (u, "(A)")
end do
write (u, "(A)") "* Cleanup"
write (u, "(A)")
call cascade_set_final (cascade_set)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: cascades_2"
end subroutine cascades_2
@ %def cascades_2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{A lexer for O'Mega's phase-space output}
This module provides three data types. One of them is the type
[[dag_string_t]] which should contain the information of all Feynman
diagrams in the factorized form which is provided by O'Mega in its
phase-space outout. This output is translated into a string of tokens (in
the form of an a array of the type [[dag_token_t]]) which have a certain
meaning. The purpose of this module is only to identify these tokens
correctly and to provide some procedures and interfaces which allow us to
use these strings in a similar way as variables of the basic character
type or the type [[iso_varying_string]]. Both [[character]] and
[[iso_varying_string]] have some disadvantages at least if one wants to
keep support for some older compiler versions. These can be circumvented
by the [[dag_string_t]] type. Finally the [[dag_chain_t]] type is used
to create a larger string in several steps without always recreating the
string, which is done in the form of a simple linked list. In the end
one can create a single [[dag_string]] out of this list, which is more
useful.
<<[[cascades2_lexer.f90]]>>=
<<File header>>
module cascades2_lexer
<<Use kinds>>
use kinds, only: TC, i8
<<Standard module head>>
<<Cascades2 lexer: public>>
<<Cascades2 lexer: parameters>>
<<Cascades2 lexer: types>>
<<Cascades2 lexer: interfaces>>
interface
<<Cascades2 lexer: sub interfaces>>
end interface
end module cascades2_lexer
@ %def cascades2_lexer
@
<<[[cascades2_lexer_sub.f90]]>>=
<<File header>>
submodule (cascades2_lexer) cascades2_lexer_s
implicit none
contains
<<Cascades2 lexer: procedures>>
end submodule cascades2_lexer_s
@ %def cascades2_lexer_s
@
This is the token type. By default the variable [[type]] is [[EMPTY_TK]]
but can obtain other values corresponding to the parameters defined below.
The type of the token corresponds to a particular sequence of characters.
When the token corresponds to a node of a tree, i.e. some particle in the
Feynman diagram, the type is [[NODE_TK]] and the [[particle_name]] variable
is holding the name of the particle. O'Megas output contains in
addition to the particle name some numbers which indicate the external
momenta that are flowing through this line. These numbers are translated
into a binary code and saved in the variable [[bincode]]. In this case
the number 1 corresponds to a bit set at position 0, 2 corresponds to a
bit set at position 1, etc. Instead of numbers which are composed out of
several digits, letters are used, i.e. A instead of 10 (bit at position 9),
B instead of 11 (bit at position 10), etc.\\
When the DAG is reconstructed from a [[dag_string]] which was built from
O'Mega's output, this string is modified such that a substring (a set of
tokens) is replaced by a single token where the type variable is one of
the three parameters [[DAG_NODE_TK]], [[DAG_OPTIONS_TK]] and
[[DAG_COMBINATION_TK]]. These parameters correspond to the three types
[[dag_node_t]], [[dag_options_t]] and [[dag_combination_t]] (see [[cascades2]]
for more information. In this case, since these objects are organized
in arrays, the [[index]] variable holds the corresponding position in
the array.\\
In any case, we want to be able to reproduce the character string from
which a token (or a string) has been created. The variable [[char_len]]
is the length of this string. For tokens with the type [[DAG_NODE_TK]],
[[DAG_OPTIONS_TK]] and [[DAG_COMBINATION_TK]] we use output of the form
[[<N23>]], [[<O23>]] or [[<C23>]] which is useful for debugging the parser.
Here 23 is the [[index]] and [[N]], [[O]] or [[C]] obviously corresponds
to the [[type]].
<<Cascades2 lexer: parameters>>=
integer, parameter :: PRT_NAME_LEN = 20
@ %def PRT_NAME_LEN
<<Cascades2 lexer: public>>=
public :: dag_token_t
<<Cascades2 lexer: types>>=
type :: dag_token_t
integer :: type = EMPTY_TK
integer :: char_len = 0
integer(TC) :: bincode = 0
character(len=PRT_NAME_LEN) :: particle_name=""
integer :: index = 0
contains
<<Cascades2 lexer: dag token: TBP>>
end type dag_token_t
@ %def dag_token_t
@ This is the string type. It also holds the number of characters in the
corresponding character string. It contains an array of tokens. If the
[[dag_string]] is constructed using the type [[dag_chain_t]], which creates
a linked list, we also need the pointer [[next]].
<<Cascades2 lexer: public>>=
public :: dag_string_t
<<Cascades2 lexer: types>>=
type :: dag_string_t
integer :: char_len = 0
type(dag_token_t), dimension(:), allocatable :: t
type(dag_string_t), pointer :: next => null ()
contains
<<Cascades2 lexer: dag string: TBP>>
end type dag_string_t
@ %def dag_string_t
@ This is the chain of [[dag_strings]]. It allows us to construct a large
string by appending new strings to the linked list, which can later be
merged to a single string. This is very useful because the file written
by O'Mega contains large strings where each string contains all Feynman
diagrams in a factorized form, but these large strings are cut into
several pieces and distributed over many lines. As the file can become
large, rewriting a new [[dag_string]] (or [[iso_varying_string]]) would
consume more and more time with each additional line. For recreating a
single [[dag_string]] out of this chain, we need the total character
length and the sum of all sizes of the [[dag_token]] arrays [[t]].
<<Cascades2 lexer: public>>=
public :: dag_chain_t
<<Cascades2 lexer: types>>=
type :: dag_chain_t
integer :: char_len = 0
integer :: t_size = 0
type(dag_string_t), pointer :: first => null ()
type(dag_string_t), pointer :: last => null ()
contains
<<Cascades2 lexer: dag chain: TBP>>
end type dag_chain_t
@ %def dag_chain_t
@ We define two parameters holding the characters corresponding to a
backslash and a blanc space.
<<Cascades2 lexer: parameters>>=
character(len=1), parameter, public :: BACKSLASH_CHAR = "\\"
character(len=1), parameter :: BLANC_CHAR = " "
@ %def BACKSLASH_CHAR BLANC_CHAR
@ These are the parameters which correspond to meaningful types
of [[token]].
<<Cascades2 lexer: parameters>>=
integer, parameter, public :: NEW_LINE_TK = -2
integer, parameter :: BLANC_SPACE_TK = -1
integer, parameter :: EMPTY_TK = 0
integer, parameter, public :: NODE_TK = 1
integer, parameter, public :: DAG_NODE_TK = 2
integer, parameter, public :: DAG_OPTIONS_TK = 3
integer, parameter, public :: DAG_COMBINATION_TK = 4
integer, parameter, public :: COLON_TK = 11
integer, parameter, public :: COMMA_TK = 12
integer, parameter, public :: VERTICAL_BAR_TK = 13
integer, parameter, public :: OPEN_PAR_TK = 21
integer, parameter, public :: CLOSED_PAR_TK = 22
integer, parameter, public :: OPEN_CURLY_TK = 31
integer, parameter, public :: CLOSED_CURLY_TK = 32
@ %def NEW_LINE_TK BLANC_SPACE_TK EMPTY_TK NODE_TK
@ %def COLON_TK COMMA_TK VERTICAL_LINE_TK OPEN_PAR_TK
@ %def CLOSED_PAR_TK OPEN_CURLY_TK CLOSED_CURLY_TK
@ Different sorts of assignment. This contains the conversion
of a [[character]] variable into a [[dag_token]] or [[dag_string]].
<<Cascades2 lexer: public>>=
public :: assignment (=)
<<Cascades2 lexer: interfaces>>=
interface assignment (=)
module procedure dag_token_assign_from_char_string
module procedure dag_token_assign_from_dag_token
module procedure dag_string_assign_from_dag_token
module procedure dag_string_assign_from_char_string
module procedure dag_string_assign_from_dag_string
module procedure dag_string_assign_from_dag_token_array
end interface assignment (=)
@ %def interfaces
<<Cascades2 lexer: dag token: TBP>>=
procedure :: init_dag_object_token => dag_token_init_dag_object_token
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_token_init_dag_object_token (dag_token, type, index)
class(dag_token_t), intent(out) :: dag_token
integer, intent(in) :: index
integer :: type
end subroutine dag_token_init_dag_object_token
<<Cascades2 lexer: procedures>>=
module subroutine dag_token_init_dag_object_token (dag_token, type, index)
class(dag_token_t), intent(out) :: dag_token
integer, intent(in) :: index
integer :: type
dag_token%type = type
dag_token%char_len = integer_n_dec_digits (index) + 3
dag_token%index = index
contains
function integer_n_dec_digits (number) result (n_digits)
integer, intent(in) :: number
integer :: n_digits
integer :: div_number
n_digits = 0
div_number = number
do
div_number = div_number / 10
n_digits = n_digits + 1
if (div_number == 0) exit
end do
end function integer_n_dec_digits
end subroutine dag_token_init_dag_object_token
@ %def dag_token_init_dag_object_token
<<Cascades2 lexer: sub interfaces>>=
elemental module subroutine dag_token_assign_from_char_string &
(dag_token, char_string)
type(dag_token_t), intent(out) :: dag_token
character(len=*), intent(in) :: char_string
end subroutine dag_token_assign_from_char_string
<<Cascades2 lexer: procedures>>=
elemental module subroutine dag_token_assign_from_char_string &
(dag_token, char_string)
type(dag_token_t), intent(out) :: dag_token
character(len=*), intent(in) :: char_string
integer :: i, j
logical :: set_bincode
integer :: bit_pos
character(len=10) :: index_char
dag_token%char_len = len (char_string)
if (dag_token%char_len == 1) then
select case (char_string(1:1))
case (BACKSLASH_CHAR)
dag_token%type = NEW_LINE_TK
case (" ")
dag_token%type = BLANC_SPACE_TK
case (":")
dag_token%type = COLON_TK
case (",")
dag_token%type = COMMA_TK
case ("|")
dag_token%type = VERTICAL_BAR_TK
case ("(")
dag_token%type = OPEN_PAR_TK
case (")")
dag_token%type = CLOSED_PAR_TK
case ("{")
dag_token%type = OPEN_CURLY_TK
case ("}")
dag_token%type = CLOSED_CURLY_TK
end select
else if (char_string(1:1) == "<") then
select case (char_string(2:2))
case ("N")
dag_token%type = DAG_NODE_TK
case ("O")
dag_token%type = DAG_OPTIONS_TK
case ("C")
dag_token%type = DAG_COMBINATION_TK
end select
read(char_string(3:dag_token%char_len-1), fmt="(I10)") dag_token%index
else
dag_token%bincode = 0
set_bincode = .false.
do i=1, dag_token%char_len
select case (char_string(i:i))
case ("[")
dag_token%type = NODE_TK
if (i > 1) then
do j = 1, i - 1
dag_token%particle_name(j:j) = char_string(j:j)
end do
end if
set_bincode = .true.
case ("]")
set_bincode = .false.
case default
dag_token%type = NODE_TK
if (set_bincode) then
select case (char_string(i:i))
case ("1", "2", "3", "4", "5", "6", "7", "8", "9")
read (char_string(i:i), fmt="(I1)") bit_pos
case ("A")
bit_pos = 10
case ("B")
bit_pos = 11
case ("C")
bit_pos = 12
end select
dag_token%bincode = ibset(dag_token%bincode, bit_pos - 1)
end if
end select
if (dag_token%type /= NODE_TK) exit
end do
end if
end subroutine dag_token_assign_from_char_string
@ %def dag_token_assign_from_char_string
<<Cascades2 lexer: sub interfaces>>=
elemental module subroutine dag_token_assign_from_dag_token &
(token_out, token_in)
type(dag_token_t), intent(out) :: token_out
type(dag_token_t), intent(in) :: token_in
end subroutine dag_token_assign_from_dag_token
<<Cascades2 lexer: procedures>>=
elemental module subroutine dag_token_assign_from_dag_token &
(token_out, token_in)
type(dag_token_t), intent(out) :: token_out
type(dag_token_t), intent(in) :: token_in
token_out%type = token_in%type
token_out%char_len = token_in%char_len
token_out%bincode = token_in%bincode
token_out%particle_name = token_in%particle_name
token_out%index = token_in%index
end subroutine dag_token_assign_from_dag_token
@ %def dag_token_assign_from_dag_token
<<Cascades2 lexer: sub interfaces>>=
elemental module subroutine dag_string_assign_from_dag_token &
(dag_string, dag_token)
type(dag_string_t), intent(out) :: dag_string
type(dag_token_t), intent(in) :: dag_token
end subroutine dag_string_assign_from_dag_token
<<Cascades2 lexer: procedures>>=
elemental module subroutine dag_string_assign_from_dag_token &
(dag_string, dag_token)
type(dag_string_t), intent(out) :: dag_string
type(dag_token_t), intent(in) :: dag_token
allocate (dag_string%t(1))
dag_string%t(1) = dag_token
dag_string%char_len = dag_token%char_len
end subroutine dag_string_assign_from_dag_token
@ %def dag_string_assign_from_dag_token
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_string_assign_from_dag_token_array &
(dag_string, dag_token)
type(dag_string_t), intent(out) :: dag_string
type(dag_token_t), dimension(:), intent(in) :: dag_token
end subroutine dag_string_assign_from_dag_token_array
<<Cascades2 lexer: procedures>>=
module subroutine dag_string_assign_from_dag_token_array &
(dag_string, dag_token)
type(dag_string_t), intent(out) :: dag_string
type(dag_token_t), dimension(:), intent(in) :: dag_token
allocate (dag_string%t(size(dag_token)))
dag_string%t = dag_token
dag_string%char_len = sum(dag_token%char_len)
end subroutine dag_string_assign_from_dag_token_array
@ %def dag_string_assign_from_dag_token_array
<<Cascades2 lexer: sub interfaces>>=
elemental module subroutine dag_string_assign_from_char_string &
(dag_string, char_string)
type(dag_string_t), intent(out) :: dag_string
character(len=*), intent(in) :: char_string
end subroutine dag_string_assign_from_char_string
<<Cascades2 lexer: procedures>>=
elemental module subroutine dag_string_assign_from_char_string &
(dag_string, char_string)
type(dag_string_t), intent(out) :: dag_string
character(len=*), intent(in) :: char_string
type(dag_token_t), dimension(:), allocatable :: token
integer :: token_pos
integer :: i
character(len=len(char_string)) :: node_char
integer :: node_char_len
node_char = ""
dag_string%char_len = len (char_string)
if (dag_string%char_len > 0) then
allocate (token(dag_string%char_len))
token_pos = 0
node_char_len = 0
do i=1, dag_string%char_len
select case (char_string(i:i))
case (BACKSLASH_CHAR, " ", ":", ",", "|", "(", ")", "{", "}")
if (node_char_len > 0) then
token_pos = token_pos + 1
token(token_pos) = node_char(:node_char_len)
node_char_len = 0
end if
token_pos = token_pos + 1
token(token_pos) = char_string(i:i)
case default
node_char_len = node_char_len + 1
node_char(node_char_len:node_char_len) = char_string(i:i)
end select
end do
if (node_char_len > 0) then
token_pos = token_pos + 1
token(token_pos) = node_char(:node_char_len)
end if
if (token_pos > 0) then
allocate (dag_string%t(token_pos))
dag_string%t = token(:token_pos)
deallocate (token)
end if
end if
end subroutine dag_string_assign_from_char_string
@ %def dag_string_assign_from_char_string
<<Cascades2 lexer: sub interfaces>>=
elemental module subroutine dag_string_assign_from_dag_string &
(string_out, string_in)
type(dag_string_t), intent(out) :: string_out
type(dag_string_t), intent(in) :: string_in
end subroutine dag_string_assign_from_dag_string
<<Cascades2 lexer: procedures>>=
elemental module subroutine dag_string_assign_from_dag_string &
(string_out, string_in)
type(dag_string_t), intent(out) :: string_out
type(dag_string_t), intent(in) :: string_in
if (allocated (string_in%t)) then
allocate (string_out%t (size(string_in%t)))
string_out%t = string_in%t
end if
string_out%char_len = string_in%char_len
end subroutine dag_string_assign_from_dag_string
@ %def dag_string_assign_from_dag_string
@ Concatenate strings/tokens. The result is always a [[dag_string]].
<<Cascades2 lexer: public>>=
public :: operator (//)
<<Cascades2 lexer: interfaces>>=
interface operator (//)
module procedure concat_dag_token_dag_token
module procedure concat_dag_string_dag_token
module procedure concat_dag_token_dag_string
module procedure concat_dag_string_dag_string
end interface operator (//)
@ %def interfaces
<<Cascades2 lexer: sub interfaces>>=
module function concat_dag_token_dag_token &
(token1, token2) result (res_string)
type(dag_token_t), intent(in) :: token1, token2
type(dag_string_t) :: res_string
end function concat_dag_token_dag_token
<<Cascades2 lexer: procedures>>=
module function concat_dag_token_dag_token &
(token1, token2) result (res_string)
type(dag_token_t), intent(in) :: token1, token2
type(dag_string_t) :: res_string
if (token1%type == EMPTY_TK) then
call dag_string_assign_from_dag_token (res_string, token2)
else if (token2%type == EMPTY_TK) then
call dag_string_assign_from_dag_token (res_string, token1)
else
allocate (res_string%t(2))
res_string%t(1) = token1
res_string%t(2) = token2
res_string%char_len = token1%char_len + token2%char_len
end if
end function concat_dag_token_dag_token
@ %def concat_dag_token_dag_token
<<Cascades2 lexer: sub interfaces>>=
module function concat_dag_string_dag_token &
(dag_string, dag_token) result (res_string)
type(dag_string_t), intent(in) :: dag_string
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t) :: res_string
end function concat_dag_string_dag_token
<<Cascades2 lexer: procedures>>=
module function concat_dag_string_dag_token &
(dag_string, dag_token) result (res_string)
type(dag_string_t), intent(in) :: dag_string
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t) :: res_string
integer :: t_size
if (dag_string%char_len == 0) then
call dag_string_assign_from_dag_token (res_string, dag_token)
else if (dag_token%type == EMPTY_TK) then
res_string = dag_string
else
t_size = size (dag_string%t)
allocate (res_string%t(t_size+1))
res_string%t(:t_size) = dag_string%t
res_string%t(t_size+1) = dag_token
res_string%char_len = dag_string%char_len + dag_token%char_len
end if
end function concat_dag_string_dag_token
@ %def concat_dag_string_dag_token
<<Cascades2 lexer: sub interfaces>>=
module function concat_dag_token_dag_string &
(dag_token, dag_string) result (res_string)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
type(dag_string_t) :: res_string
integer :: t_size
end function concat_dag_token_dag_string
<<Cascades2 lexer: procedures>>=
module function concat_dag_token_dag_string &
(dag_token, dag_string) result (res_string)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
type(dag_string_t) :: res_string
integer :: t_size
if (dag_token%type == EMPTY_TK) then
res_string = dag_string
else if (dag_string%char_len == 0) then
call dag_string_assign_from_dag_token (res_string, dag_token)
else
t_size = size (dag_string%t)
allocate (res_string%t(t_size+1))
res_string%t(2:t_size+1) = dag_string%t
res_string%t(1) = dag_token
res_string%char_len = dag_token%char_len + dag_string%char_len
end if
end function concat_dag_token_dag_string
@ %def concat_dag_token_dag_string
<<Cascades2 lexer: sub interfaces>>=
module function concat_dag_string_dag_string &
(string1, string2) result (res_string)
type(dag_string_t), intent(in) :: string1, string2
type(dag_string_t) :: res_string
end function concat_dag_string_dag_string
<<Cascades2 lexer: procedures>>=
module function concat_dag_string_dag_string &
(string1, string2) result (res_string)
type(dag_string_t), intent(in) :: string1, string2
type(dag_string_t) :: res_string
integer :: t1_size, t2_size, t_size
if (string1%char_len == 0) then
res_string = string2
else if (string2%char_len == 0) then
res_string = string1
else
t1_size = size (string1%t)
t2_size = size (string2%t)
t_size = t1_size + t2_size
if (t_size > 0) then
allocate (res_string%t(t_size))
res_string%t(:t1_size) = string1%t
res_string%t(t1_size+1:) = string2%t
res_string%char_len = string1%char_len + string2%char_len
end if
end if
end function concat_dag_string_dag_string
@ %def concat_dag_string_dag_string
@ Compare strings/tokens/characters. Each character is relevant, including
all blanc spaces. An exception is the [[newline]] character which is not
treated by the types used in this module (not to confused with the type
parameter [[NEW_LINE_TK]] which corresponds to the backslash character
and simply tells us that the string continues on the next line in the file).
<<Cascades2 lexer: public>>=
public :: operator (==)
<<Cascades2 lexer: interfaces>>=
interface operator (==)
module procedure dag_token_eq_dag_token
module procedure dag_string_eq_dag_string
module procedure dag_token_eq_dag_string
module procedure dag_string_eq_dag_token
module procedure dag_token_eq_char_string
module procedure char_string_eq_dag_token
module procedure dag_string_eq_char_string
module procedure char_string_eq_dag_string
end interface operator (==)
@ %def interfaces
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_token_eq_dag_token &
(token1, token2) result (flag)
type(dag_token_t), intent(in) :: token1, token2
logical :: flag
end function dag_token_eq_dag_token
<<Cascades2 lexer: procedures>>=
elemental module function dag_token_eq_dag_token &
(token1, token2) result (flag)
type(dag_token_t), intent(in) :: token1, token2
logical :: flag
flag = (token1%type == token2%type) .and. &
(token1%char_len == token2%char_len) .and. &
(token1%bincode == token2%bincode) .and. &
(token1%index == token2%index) .and. &
(token1%particle_name == token2%particle_name)
end function dag_token_eq_dag_token
@ %def dag_token_eq_dag_token
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_string_eq_dag_string &
(string1, string2) result (flag)
type(dag_string_t), intent(in) :: string1, string2
logical :: flag
end function dag_string_eq_dag_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_string_eq_dag_string &
(string1, string2) result (flag)
type(dag_string_t), intent(in) :: string1, string2
logical :: flag
flag = (string1%char_len == string2%char_len) .and. &
(allocated (string1%t) .eqv. allocated (string2%t))
if (flag) then
if (allocated (string1%t)) flag = all (string1%t == string2%t)
end if
end function dag_string_eq_dag_string
@ %def dag_string_eq_dag_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_token_eq_dag_string &
(dag_token, dag_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
end function dag_token_eq_dag_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_token_eq_dag_string &
(dag_token, dag_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
flag = size (dag_string%t) == 1 .and. &
dag_string%char_len == dag_token%char_len
if (flag) flag = (dag_string%t(1) == dag_token)
end function dag_token_eq_dag_string
@ %def dag_token_eq_dag_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_string_eq_dag_token &
(dag_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
end function dag_string_eq_dag_token
<<Cascades2 lexer: procedures>>=
elemental module function dag_string_eq_dag_token &
(dag_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
flag = (dag_token == dag_string)
end function dag_string_eq_dag_token
@ %def dag_string_eq_dag_token
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_token_eq_char_string &
(dag_token, char_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
end function dag_token_eq_char_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_token_eq_char_string &
(dag_token, char_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
flag = (char (dag_token) == char_string)
end function dag_token_eq_char_string
@ %def dag_token_eq_char_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function char_string_eq_dag_token &
(char_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
end function char_string_eq_dag_token
<<Cascades2 lexer: procedures>>=
elemental module function char_string_eq_dag_token &
(char_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
flag = (char (dag_token) == char_string)
end function char_string_eq_dag_token
@ %def char_string_eq_dag_token
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_string_eq_char_string &
(dag_string, char_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
end function dag_string_eq_char_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_string_eq_char_string &
(dag_string, char_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
flag = (char (dag_string) == char_string)
end function dag_string_eq_char_string
@ %def dag_string_eq_char_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function char_string_eq_dag_string &
(char_string, dag_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
end function char_string_eq_dag_string
<<Cascades2 lexer: procedures>>=
elemental module function char_string_eq_dag_string &
(char_string, dag_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
flag = (char (dag_string) == char_string)
end function char_string_eq_dag_string
@ %def char_string_eq_dag_string
<<Cascades2 lexer: public>>=
public :: operator (/=)
<<Cascades2 lexer: interfaces>>=
interface operator (/=)
module procedure dag_token_ne_dag_token
module procedure dag_string_ne_dag_string
module procedure dag_token_ne_dag_string
module procedure dag_string_ne_dag_token
module procedure dag_token_ne_char_string
module procedure char_string_ne_dag_token
module procedure dag_string_ne_char_string
module procedure char_string_ne_dag_string
end interface operator (/=)
@ %def interfaces
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_token_ne_dag_token &
(token1, token2) result (flag)
type(dag_token_t), intent(in) :: token1, token2
logical :: flag
end function dag_token_ne_dag_token
<<Cascades2 lexer: procedures>>=
elemental module function dag_token_ne_dag_token &
(token1, token2) result (flag)
type(dag_token_t), intent(in) :: token1, token2
logical :: flag
flag = .not. (token1 == token2)
end function dag_token_ne_dag_token
@ %def dag_token_ne_dag_token
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_string_ne_dag_string &
(string1, string2) result (flag)
type(dag_string_t), intent(in) :: string1, string2
logical :: flag
end function dag_string_ne_dag_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_string_ne_dag_string &
(string1, string2) result (flag)
type(dag_string_t), intent(in) :: string1, string2
logical :: flag
flag = .not. (string1 == string2)
end function dag_string_ne_dag_string
@ %def dag_string_ne_dag_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_token_ne_dag_string &
(dag_token, dag_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
end function dag_token_ne_dag_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_token_ne_dag_string &
(dag_token, dag_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
flag = .not. (dag_token == dag_string)
end function dag_token_ne_dag_string
@ %def dag_token_ne_dag_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_string_ne_dag_token &
(dag_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
end function dag_string_ne_dag_token
<<Cascades2 lexer: procedures>>=
elemental module function dag_string_ne_dag_token &
(dag_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
type(dag_string_t), intent(in) :: dag_string
logical :: flag
flag = .not. (dag_string == dag_token)
end function dag_string_ne_dag_token
@ %def dag_string_ne_dag_token
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_token_ne_char_string &
(dag_token, char_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
end function dag_token_ne_char_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_token_ne_char_string &
(dag_token, char_string) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
flag = .not. (dag_token == char_string)
end function dag_token_ne_char_string
@ %def dag_token_ne_char_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function char_string_ne_dag_token &
(char_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
end function char_string_ne_dag_token
<<Cascades2 lexer: procedures>>=
elemental module function char_string_ne_dag_token &
(char_string, dag_token) result (flag)
type(dag_token_t), intent(in) :: dag_token
character(len=*), intent(in) :: char_string
logical :: flag
flag = .not. (char_string == dag_token)
end function char_string_ne_dag_token
@ %def char_string_ne_dag_token
<<Cascades2 lexer: sub interfaces>>=
elemental module function dag_string_ne_char_string &
(dag_string, char_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
end function dag_string_ne_char_string
<<Cascades2 lexer: procedures>>=
elemental module function dag_string_ne_char_string &
(dag_string, char_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
flag = .not. (dag_string == char_string)
end function dag_string_ne_char_string
@ %def dag_string_ne_char_string
<<Cascades2 lexer: sub interfaces>>=
elemental module function char_string_ne_dag_string &
(char_string, dag_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
end function char_string_ne_dag_string
<<Cascades2 lexer: procedures>>=
elemental module function char_string_ne_dag_string &
(char_string, dag_string) result (flag)
type(dag_string_t), intent(in) :: dag_string
character(len=*), intent(in) :: char_string
logical :: flag
flag = .not. (char_string == dag_string)
end function char_string_ne_dag_string
@ %def char_string_ne_dag_string
@ Convert a [[dag_token]] or [[dag_string]] to character.
<<Cascades2 lexer: public>>=
public :: char
<<Cascades2 lexer: interfaces>>=
interface char
module procedure char_dag_token
module procedure char_dag_string
end interface char
@ %def interfaces
<<Cascades2 lexer: sub interfaces>>=
pure module function char_dag_token (dag_token) result (char_string)
type(dag_token_t), intent(in) :: dag_token
character (dag_token%char_len) :: char_string
end function char_dag_token
<<Cascades2 lexer: procedures>>=
pure module function char_dag_token (dag_token) result (char_string)
type(dag_token_t), intent(in) :: dag_token
character (dag_token%char_len) :: char_string
integer :: i
integer :: name_len
integer :: bc_pos
integer :: n_digits
character(len=9) :: fmt_spec
select case (dag_token%type)
case (EMPTY_TK)
char_string = ""
case (NEW_LINE_TK)
char_string = BACKSLASH_CHAR
case (BLANC_SPACE_TK)
char_string = " "
case (COLON_TK)
char_string = ":"
case (COMMA_TK)
char_string = ","
case (VERTICAL_BAR_TK)
char_string = "|"
case (OPEN_PAR_TK)
char_string = "("
case (CLOSED_PAR_TK)
char_string = ")"
case (OPEN_CURLY_TK)
char_string = "{"
case (CLOSED_CURLY_TK)
char_string = "}"
case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
n_digits = dag_token%char_len - 3
fmt_spec = ""
if (n_digits > 9) then
write (fmt_spec, fmt="(A,I2,A)") "(A,I", n_digits, ",A)"
else
write (fmt_spec, fmt="(A,I1,A)") "(A,I", n_digits, ",A)"
end if
select case (dag_token%type)
case (DAG_NODE_TK)
write (char_string, fmt=fmt_spec) "<N", dag_token%index, ">"
case (DAG_OPTIONS_TK)
write (char_string, fmt=fmt_spec) "<O", dag_token%index, ">"
case (DAG_COMBINATION_TK)
write (char_string, fmt=fmt_spec) "<C", dag_token%index, ">"
end select
case (NODE_TK)
name_len = len_trim (dag_token%particle_name)
char_string = dag_token%particle_name
bc_pos = name_len + 1
char_string(bc_pos:bc_pos) = "["
do i=0, bit_size (dag_token%bincode) - 1
if (btest (dag_token%bincode, i)) then
bc_pos = bc_pos + 1
select case (i)
case (0, 1, 2, 3, 4, 5, 6, 7, 8)
write (char_string(bc_pos:bc_pos), fmt="(I1)") i + 1
case (9)
write (char_string(bc_pos:bc_pos), fmt="(A1)") "A"
case (10)
write (char_string(bc_pos:bc_pos), fmt="(A1)") "B"
case (11)
write (char_string(bc_pos:bc_pos), fmt="(A1)") "C"
end select
bc_pos = bc_pos + 1
if (bc_pos == dag_token%char_len) then
write (char_string(bc_pos:bc_pos), fmt="(A1)") "]"
return
else
write (char_string(bc_pos:bc_pos), fmt="(A1)") "/"
end if
end if
end do
end select
end function char_dag_token
@ %def char_dag_token
<<Cascades2 lexer: sub interfaces>>=
pure module function char_dag_string (dag_string) result (char_string)
type(dag_string_t), intent(in) :: dag_string
character (dag_string%char_len) :: char_string
end function char_dag_string
<<Cascades2 lexer: procedures>>=
pure module function char_dag_string (dag_string) result (char_string)
type(dag_string_t), intent(in) :: dag_string
character (dag_string%char_len) :: char_string
integer :: pos
integer :: i
char_string = ""
pos = 0
do i=1, size(dag_string%t)
char_string(pos+1:pos+dag_string%t(i)%char_len) = char (dag_string%t(i))
pos = pos + dag_string%t(i)%char_len
end do
end function char_dag_string
@ %def char_dag_string
@ Remove all tokens which are irrelevant for parsing. These are of type
[[NEW_LINE_TK]], [[BLANC_SPACE_TK]] and [[EMTPY_TK]].
<<Cascades2 lexer: dag string: TBP>>=
procedure :: clean => dag_string_clean
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_string_clean (dag_string)
class(dag_string_t), intent(inout) :: dag_string
end subroutine dag_string_clean
<<Cascades2 lexer: procedures>>=
module subroutine dag_string_clean (dag_string)
class(dag_string_t), intent(inout) :: dag_string
type(dag_token_t), dimension(:), allocatable :: tmp_token
integer :: n_keep
integer :: i
n_keep = 0
dag_string%char_len = 0
allocate (tmp_token (size(dag_string%t)))
do i=1, size (dag_string%t)
select case (dag_string%t(i)%type)
case(NEW_LINE_TK, BLANC_SPACE_TK, EMPTY_TK)
case default
n_keep = n_keep + 1
tmp_token(n_keep) = dag_string%t(i)
dag_string%char_len = dag_string%char_len + dag_string%t(i)%char_len
end select
end do
deallocate (dag_string%t)
allocate (dag_string%t(n_keep))
dag_string%t = tmp_token(:n_keep)
end subroutine dag_string_clean
@ %def dag_string_clean
@ If we operate explicitly on the [[token]] array [[t]] of a [[dag_string]],
the variable [[char_len]] is not automatically modified. It can however be
determined afterwards using the following subroutine.
<<Cascades2 lexer: dag string: TBP>>=
procedure :: update_char_len => dag_string_update_char_len
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_string_update_char_len (dag_string)
class(dag_string_t), intent(inout) :: dag_string
end subroutine dag_string_update_char_len
<<Cascades2 lexer: procedures>>=
module subroutine dag_string_update_char_len (dag_string)
class(dag_string_t), intent(inout) :: dag_string
integer :: char_len
integer :: i
char_len = 0
if (allocated (dag_string%t)) then
do i=1, size (dag_string%t)
char_len = char_len + dag_string%t(i)%char_len
end do
end if
dag_string%char_len = char_len
end subroutine dag_string_update_char_len
@ %def dag_string_update_char_len
@ Append a [[dag_string]] to a [[dag_chain]]. The argument [[char_string]]
is of type [[character]] because the subroutine is used for reading from
the file produced by O'Mega which is first read line by line to a character
variable.
<<Cascades2 lexer: dag chain: TBP>>=
procedure :: append => dag_chain_append_string
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_chain_append_string (dag_chain, char_string)
class(dag_chain_t), intent(inout) :: dag_chain
character(len=*), intent(in) :: char_string
end subroutine dag_chain_append_string
<<Cascades2 lexer: procedures>>=
module subroutine dag_chain_append_string (dag_chain, char_string)
class(dag_chain_t), intent(inout) :: dag_chain
character(len=*), intent(in) :: char_string
if (.not. associated (dag_chain%first)) then
allocate (dag_chain%first)
dag_chain%last => dag_chain%first
else
allocate (dag_chain%last%next)
dag_chain%last => dag_chain%last%next
end if
dag_chain%last = char_string
dag_chain%char_len = dag_chain%char_len + dag_chain%last%char_len
dag_chain%t_size = dag_chain%t_size + size (dag_chain%last%t)
end subroutine dag_chain_append_string
@ %def dag_chain_append_string
@ Reduce the linked list of [[dag_string]] objects which are attached
to a given [[dag_chain]] object to a single [[dag_string]].
<<Cascades2 lexer: dag chain: TBP>>=
procedure :: compress => dag_chain_compress
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_chain_compress (dag_chain)
class(dag_chain_t), intent(inout) :: dag_chain
end subroutine dag_chain_compress
<<Cascades2 lexer: procedures>>=
module subroutine dag_chain_compress (dag_chain)
class(dag_chain_t), intent(inout) :: dag_chain
type(dag_string_t), pointer :: current
type(dag_string_t), pointer :: remove
integer :: filled_t
current => dag_chain%first
dag_chain%first => null ()
allocate (dag_chain%first)
dag_chain%last => dag_chain%first
dag_chain%first%char_len = dag_chain%char_len
allocate (dag_chain%first%t (dag_chain%t_size))
filled_t = 0
do while (associated (current))
dag_chain%first%t(filled_t+1:filled_t+size(current%t)) = current%t
filled_t = filled_t + size (current%t)
remove => current
current => current%next
deallocate (remove)
end do
end subroutine dag_chain_compress
@ %def dag_chain_compress
@ Finalizer for [[dag_string_t]].
<<Cascades2 lexer: dag string: TBP>>=
procedure :: final => dag_string_final
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_string_final (dag_string)
class(dag_string_t), intent(inout) :: dag_string
end subroutine dag_string_final
<<Cascades2 lexer: procedures>>=
module subroutine dag_string_final (dag_string)
class(dag_string_t), intent(inout) :: dag_string
if (allocated (dag_string%t)) deallocate (dag_string%t)
dag_string%next => null ()
end subroutine dag_string_final
@ %def dag_string_final
@ Finalizer for [[dag_chain_t]].
<<Cascades2 lexer: dag chain: TBP>>=
procedure :: final => dag_chain_final
<<Cascades2 lexer: sub interfaces>>=
module subroutine dag_chain_final (dag_chain)
class(dag_chain_t), intent(inout) :: dag_chain
end subroutine dag_chain_final
<<Cascades2 lexer: procedures>>=
module subroutine dag_chain_final (dag_chain)
class(dag_chain_t), intent(inout) :: dag_chain
type(dag_string_t), pointer :: current
current => dag_chain%first
do while (associated (current))
dag_chain%first => dag_chain%first%next
call current%final ()
deallocate (current)
current => dag_chain%first
end do
dag_chain%last => null ()
end subroutine dag_chain_final
@ %def dag_chain_final
<<[[cascades2_lexer_ut.f90]]>>=
<<File header>>
module cascades2_lexer_ut
use unit_tests
use cascades2_lexer_uti
<<Standard module head>>
<<Cascades2 lexer: public test>>
contains
<<Cascades2 lexer: test driver>>
end module cascades2_lexer_ut
@ %def cascades2_lexer_ut
@
<<[[cascades2_lexer_uti.f90]]>>=
<<File header>>
module cascades2_lexer_uti
<<Use kinds>>
<<Use strings>>
use numeric_utils
use cascades2_lexer
<<Standard module head>>
<<Cascades2 lexer: test declarations>>
contains
<<Cascades2 lexer: tests>>
end module cascades2_lexer_uti
@ %def cascades2_lexer_uti
@ API: driver for the unit tests below.
<<Cascades2 lexer: public test>>=
public :: cascades2_lexer_test
<<Cascades2 lexer: test driver>>=
subroutine cascades2_lexer_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Cascades2 lexer: execute tests>>
end subroutine cascades2_lexer_test
@ %def cascades2_lexer_test
@
<<Cascades2 lexer: execute tests>>=
call test (cascades2_lexer_1, "cascades2_lexer_1", &
"make phase-space", u, results)
<<Cascades2 lexer: test declarations>>=
public :: cascades2_lexer_1
<<Cascades2 lexer: tests>>=
subroutine cascades2_lexer_1 (u)
integer, intent(in) :: u
integer :: u_in = 8
character(len=300) :: line
integer :: stat
logical :: fail
type(dag_string_t) :: dag_string
write (u, "(A)") "* Test output: cascades2_lexer_1"
write (u, "(A)") "* Purpose: read lines of O'Mega's phase space output, translate"
write (u, "(A)") "* to dag_string, retranslate to character string and"
write (u, "(A)") "* compare"
write (u, "(A)")
open (unit=u_in, file="cascades2_lexer_1.fds", status='old', action='read')
stat = 0
fail = .false.
read (unit=u_in, fmt="(A)", iostat=stat) line
do while (stat == 0 .and. .not. fail)
read (unit=u_in, fmt="(A)", iostat=stat) line
if (stat /= 0) exit
dag_string = line
fail = (char(dag_string) /= line)
end do
if (fail) then
write (u, "(A)") "* Test result: Test failed!"
else
write (u, "(A)") "* Test result: Test passed"
end if
close (u_in)
write (u, *)
write (u, "(A)") "* Test output end: cascades2_lexer_1"
end subroutine cascades2_lexer_1
@ %def cascades2_lexer_1
@%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{An alternative cascades module}
This module might replace the module [[cascades]], which generates
suitable phase space parametrizations and generates the phase space file.
The mappings, as well as the criteria to determine these, do not change.
The advantage of this module is that it makes use of the [[O'Mega]] matrix
element generator which provides the relevant Feynman diagrams (the ones
which can be constructed only from 3-vertices). In principle, the
construction of these diagrams is also one of the tasks of the existing
[[cascades]] module, in which the diagrams would correspond to a set of
cascades. It starts by creating cascades which correspond to the
outgoing particles. These are combined to a new cascade using the
vertices of the model. In this way, since each cascade knows the
daughter cascades from which it is built, complete Feynman diagrams are
represented by sets of cascades, as soon as the existing cascades can be
recombined with the incoming particle(s).
In this module, the Feynman diagrams are represented by the type
[[feyngraph_t]], which represents the Feynman diagrams as a tree of
nodes. The object which contains the necessary kinematical information
to determine mappings, and hence sensible phase space parametrizations
is of another type, called [[kingraph_t]], which is built from a
corresponding [[feyngraph]] object.
There are two types of output which can be produced by [[O'Mega]] and
are potentially relevant here. The first type contains all tree
diagrams for the process under consideration, where each line of the
output corresponds to one Feynman diagram. This output is easy to read,
but can be very large, depending on the number of particles involved in
the process. Moreover, it repeats substructures of the diagrams which
are part of more than one diagram. One could in principle work with
this output and construct a [[feyngraph]] from each line, if allowed,
i.e. if there are only 3-vertices.
The other output contains also all of these Feynman diagrams, but in
a factorized form. This means that the substructures which appear in
several Feynman diagrams, are written only once, if possible. This
leads to a much shorter input file, which speeds up the parsing
process. Furthermore it makes it possible to reconstruct the
[[feyngraphs]] in such a way that the calculations concerning
subdiagrams which reappear in other [[feyngraphs]] have to be
performed only once. This is already the case in the existing
[[cascades]] module but can be exploited more efficiently here
because the possible graphs are well known from the input file, whereas
the [[cascades]] module would create a large number of [[cascades]]
which do not lead to a complete Feynman diagram of the given process.
<<[[cascades2.f90]]>>=
<<File header>>
module cascades2
use, intrinsic :: iso_fortran_env, only : input_unit, output_unit, error_unit
<<Use kinds>>
use kinds, only: TC, i8
<<Use strings>>
<<Use debug>>
use diagnostics
use flavors
use model_data
use phs_forests, only: phs_parameters_t
use resonances, only: resonance_info_t
use resonances, only: resonance_history_t
use resonances, only: resonance_history_set_t
use cascades2_lexer
<<Standard module head>>
<<Cascades2: public>>
<<Cascades2: parameters>>
<<Cascades2: types>>
<<Cascades2: interfaces>>
interface
<<Cascades2: sub interfaces>>
end interface
contains
<<Cascades2: main procedures>>
end module cascades2
@ %def cascades2
@
<<[[cascades2_sub.f90]]>>=
<<File header>>
submodule (cascades2) cascades2_s
use sorting
use io_units
use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
use hashes
use cascades, only: phase_space_vanishes, MAX_WARN_RESONANCE
implicit none
contains
<<Cascades2: procedures>>
end submodule cascades2_s
@ %def cascades2_s
@
\subsection{Particle properties}
We define a type holding the properties of the particles which are needed
for parsing and finding the phase space parametrizations and mappings.
The properties of all particles which appear in the parsed
Feynman diagrams for the given process will be stored in a central place,
and only pointers to these objects are used.
<<Cascades2: types>>=
type :: part_prop_t
character(len=LABEL_LEN) :: particle_label
integer :: pdg = 0
real(default) :: mass = 0.
real :: width = 0.
integer :: spin_type = 0
logical :: is_vector = .false.
logical :: empty = .true.
type(part_prop_t), pointer :: anti => null ()
type(string_t) :: tex_name
contains
<<Cascades2: part prop: TBP>>
end type part_prop_t
@ %def part_prop_t
@ The [[particle_label]] in [[part_prop_t]] is simply the particle name
(e.g. 'W+'). The corresponding variable in the type [[f_node_t]] contains
some additional information related to the external momenta, see below.
The length of the [[character]] variable is fixed as:
<<Cascades2: parameters>>=
integer, parameter :: LABEL_LEN=30
@ %def LABEL_LEN
<<Cascades2: part prop: TBP>>=
procedure :: final => part_prop_final
<<Cascades2: sub interfaces>>=
module subroutine part_prop_final (part)
class(part_prop_t), intent(inout) :: part
end subroutine part_prop_final
<<Cascades2: procedures>>=
module subroutine part_prop_final (part)
class(part_prop_t), intent(inout) :: part
part%anti => null ()
end subroutine part_prop_final
@ %def part_prop_final
@
\subsection{The mapping modes}
The possible mappings are essentially the same as in [[cascades]], but we
introduce in addition the mapping constant [[NON_RESONANT]], which does
not refer to a new mapping; it corresponds to the nonresonant version of
a potentially resonant particle (or [[k_node]]). This becomes relevant
when we compare [[k_nodes]] to eliminate equivalences.
<<Cascades2: parameters>>=
integer, parameter :: &
& NONRESONANT = -2, EXTERNAL_PRT = -1, &
& NO_MAPPING = 0, S_CHANNEL = 1, T_CHANNEL = 2, U_CHANNEL = 3, &
& RADIATION = 4, COLLINEAR = 5, INFRARED = 6, &
& STEP_MAPPING_E = 11, STEP_MAPPING_H = 12, &
& ON_SHELL = 99
@ %def NONRESONANT EXTERNAL_PRT
@ %def NO_MAPPING S_CHANNEL T_CHANNEL U_CHANNEL
@ %def RADIATION COLLINEAR INFRARED
@ %def STEP_MAPPING_E STEP_MAPPING_H
@ %def ON_SHELL
@
\subsection{Grove properties}
The channels or [[kingraphs]] will be grouped in groves, i.e. sets of
channels, which share some characteristic numbers. These numbers are
stored in the following type:
<<Cascades2: types>>=
type :: grove_prop_t
integer :: multiplicity = 0
integer :: n_resonances = 0
integer :: n_log_enhanced = 0
integer :: n_off_shell = 0
integer :: n_t_channel = 0
integer :: res_hash = 0
end type grove_prop_t
@ %def grove_prop_t
@
\subsection{The tree type}
This type contains all the information which is needed to
reconstruct a [[feyngraph]] or [[kingraph]]. We store bincodes, pdg codes
and mappings for all nodes of a valid [[kingraph]]. If we label the
external particles as given in the process definition with integer
numbers representing their position in the process definition, the bincode
would be the number that one obtains by setting the bit at the position
that is given by this number. If we combine two particles/nodes to a third
one (using a three-vertex of the given model), the bincode is the number which
one obtains by setting all the bits which are set for the two particles.
The [[pdg]] and [[mapping]] are simply the pdg-code and mapping at the
position (i.e. propagator or external particle) which is specified by the
corresponding bincode. We use [[tree_t]] not only for completed [[kingraphs]],
but also for all [[k_nodes]], which are a subtree of a [[kingraph]].
<<Cascades2: types>>=
type :: tree_t
integer(TC), dimension(:), allocatable :: bc
integer, dimension(:), allocatable :: pdg
integer, dimension(:), allocatable :: mapping
integer :: n_entries = 0
logical :: keep = .true.
logical :: empty = .true.
contains
<<Cascades2: tree: TBP>>
end type tree_t
@ %def tree_t
<<Cascades2: tree: TBP>>=
procedure :: final => tree_final
<<Cascades2: sub interfaces>>=
module subroutine tree_final (tree)
class(tree_t), intent(inout) :: tree
end subroutine tree_final
<<Cascades2: procedures>>=
module subroutine tree_final (tree)
class(tree_t), intent(inout) :: tree
if (allocated (tree%bc)) deallocate (tree%bc)
if (allocated (tree%pdg)) deallocate (tree%pdg)
if (allocated (tree%mapping)) deallocate (tree%mapping)
end subroutine tree_final
@ %def tree_final
<<Cascades2: interfaces>>=
interface assignment (=)
module procedure tree_assign
end interface assignment (=)
<<Cascades2: sub interfaces>>=
module subroutine tree_assign (tree1, tree2)
type(tree_t), intent(inout) :: tree1
type(tree_t), intent(in) :: tree2
end subroutine tree_assign
<<Cascades2: procedures>>=
module subroutine tree_assign (tree1, tree2)
type(tree_t), intent(inout) :: tree1
type(tree_t), intent(in) :: tree2
if (allocated (tree2%bc)) then
allocate (tree1%bc(size(tree2%bc)))
tree1%bc = tree2%bc
end if
if (allocated (tree2%pdg)) then
allocate (tree1%pdg(size(tree2%pdg)))
tree1%pdg = tree2%pdg
end if
if (allocated (tree2%mapping)) then
allocate (tree1%mapping(size(tree2%mapping)))
tree1%mapping = tree2%mapping
end if
tree1%n_entries = tree2%n_entries
tree1%keep = tree2%keep
tree1%empty = tree2%empty
end subroutine tree_assign
@ %def tree_assign
@
\subsection{Add entries to the tree}
The following procedures fill the arrays in [[tree_t]] with entries
resulting from the bincode and mapping assignment.
<<Cascades2: tree: TBP>>=
procedure :: add_entry_from_numbers => tree_add_entry_from_numbers
procedure :: add_entry_from_node => tree_add_entry_from_node
generic :: add_entry => add_entry_from_numbers, add_entry_from_node
@ Here we add a single entry to each of the arrays. This will exclusively
be used for external particles.
<<Cascades2: sub interfaces>>=
module subroutine tree_add_entry_from_numbers (tree, bincode, pdg, mapping)
class(tree_t), intent(inout) :: tree
integer(TC), intent(in) :: bincode
integer, intent(in) :: pdg
integer, intent(in) :: mapping
end subroutine tree_add_entry_from_numbers
<<Cascades2: procedures>>=
module subroutine tree_add_entry_from_numbers (tree, bincode, pdg, mapping)
class(tree_t), intent(inout) :: tree
integer(TC), intent(in) :: bincode
integer, intent(in) :: pdg
integer, intent(in) :: mapping
integer :: pos
if (tree%empty) then
allocate (tree%bc(1))
allocate (tree%pdg(1))
allocate (tree%mapping(1))
pos = tree%n_entries + 1
tree%bc(pos) = bincode
tree%pdg(pos) = pdg
tree%mapping(pos) = mapping
tree%n_entries = pos
tree%empty = .false.
end if
end subroutine tree_add_entry_from_numbers
@ %def tree_add_entry_from_numbers
@ Here we merge two existing subtrees and a single entry (bc, pdg and
mapping).
<<Cascades2: procedures>>=
subroutine tree_merge (tree, tree1, tree2, bc, pdg, mapping)
class(tree_t), intent(inout) :: tree
type(tree_t), intent(in) :: tree1, tree2
integer(TC), intent(in) :: bc
integer, intent(in) :: pdg, mapping
integer :: tree_size
integer :: i1, i2
if (tree%empty) then
i1 = tree1%n_entries
i2 = tree1%n_entries + tree2%n_entries
!! Proof: tree_size > 0 (always)
tree_size = tree1%n_entries + tree2%n_entries + 1
allocate (tree%bc (tree_size))
allocate (tree%pdg (tree_size))
allocate (tree%mapping (tree_size))
if (.not. tree1%empty) then
tree%bc(:i1) = tree1%bc
tree%pdg(:i1) = tree1%pdg
tree%mapping(:i1) = tree1%mapping
end if
if (.not. tree2%empty) then
tree%bc(i1+1:i2) = tree2%bc
tree%pdg(i1+1:i2) = tree2%pdg
tree%mapping(i1+1:i2) = tree2%mapping
end if
tree%bc(tree_size) = bc
tree%pdg(tree_size) = pdg
tree%mapping(tree_size) = mapping
tree%n_entries = tree_size
tree%empty = .false.
end if
end subroutine tree_merge
@ %def tree_merge
@ Here we add entries to a tree for a given [[k_node]], which means that
we first have to determine whether the node is external or internal.
The arrays are sorted after the entries have been added (see below for
details).
<<Cascades2: sub interfaces>>=
module subroutine tree_add_entry_from_node (tree, node)
class(tree_t), intent(inout) :: tree
type(k_node_t), intent(in) :: node
end subroutine tree_add_entry_from_node
<<Cascades2: procedures>>=
module subroutine tree_add_entry_from_node (tree, node)
class(tree_t), intent(inout) :: tree
type(k_node_t), intent(in) :: node
integer :: pdg
if (node%t_line) then
pdg = abs (node%particle%pdg)
else
pdg = node%particle%pdg
end if
if (associated (node%daughter1) .and. &
associated (node%daughter2)) then
call tree_merge (tree, node%daughter1%subtree, &
node%daughter2%subtree, node%bincode, &
node%particle%pdg, node%mapping)
else
call tree_add_entry_from_numbers (tree, node%bincode, &
node%particle%pdg, node%mapping)
end if
call tree%sort ()
end subroutine tree_add_entry_from_node
@ %def tree_add_entry_from_node
@ For a well-defined order of the elements of the arrays in [[tree_t]],
the elements can be sorted. The bincodes (entries of [[bc]]) are
simply ordered by size, the [[pdg]] and [[mapping]] entries go to the
positions of the corresponding [[bc]] values.
<<Cascades2: tree: TBP>>=
procedure :: sort => tree_sort
<<Cascades2: sub interfaces>>=
module subroutine tree_sort (tree)
class(tree_t), intent(inout) :: tree
end subroutine tree_sort
<<Cascades2: procedures>>=
module subroutine tree_sort (tree)
class(tree_t), intent(inout) :: tree
integer(TC), dimension(size(tree%bc)) :: bc_tmp
integer, dimension(size(tree%pdg)) :: pdg_tmp, mapping_tmp
integer, dimension(1) :: pos
integer :: i
bc_tmp = tree%bc
pdg_tmp = tree%pdg
mapping_tmp = tree%mapping
do i = size(tree%bc),1,-1
pos = maxloc (bc_tmp)
tree%bc(i) = bc_tmp (pos(1))
tree%pdg(i) = pdg_tmp (pos(1))
tree%mapping(i) = mapping_tmp (pos(1))
bc_tmp(pos(1)) = 0
end do
end subroutine tree_sort
@ %def tree_sort
@
\subsection{Graph types}
We define an abstract type which will give rise to two different types:
The type [[feyngraph_t]] contains the pure information of the
corresponding Feynman diagram, but also a list of objects of the
[[kingraph]] type which contain the kinematically relevant data for the
mapping calculation as well as the mappings themselves. Every graph
should have an index which is unique. Graphs which are not needed any
more can be disabled by setting the [[keep]] variable to [[false]].
<<Cascades2: types>>=
type, abstract :: graph_t
integer :: index = 0
integer :: n_nodes = 0
logical :: keep = .true.
end type graph_t
@ %def graph_t
@ This is the type representing the Feynman diagrams which are read from
an input file created by O'Mega. It is a tree of nodes, which we call
[[f_nodes]], so that [[feyngraph_t]] contains a pointer to the root of
this tree, and each node can have two daughter nodes. The case of only
one associated daughter should never appear, because in the method of
phase space parametrization which is used here, we combine always two
particle momenta to a third one. The [[feyngraphs]] will be arranged in
a linked list. This is why we have a pointer to the next graph. The
[[kingraphs]] on the other hand are arranged in linked lists which are
attached to the corresponding [[feyngraph]]. In general, a [[feyngraph]]
can give rise to more than one [[kingraph]] because we make a copy
every time a particle can be resonant, so that in the copy we keep
the particle nonresonant.
<<Cascades2: types>>=
type, extends (graph_t) :: feyngraph_t
type(string_t) :: omega_feyngraph_output
type(f_node_t), pointer :: root => null ()
type(feyngraph_t), pointer :: next => null()
type(kingraph_t), pointer :: kin_first => null ()
type(kingraph_t), pointer :: kin_last => null ()
contains
<<Cascades2: feyngraph: TBP>>
end type feyngraph_t
@ %def feyngraph_t
@ A container for a pointer of type [[feyngraph_t]]. This is used to
realize arrays of these pointers.
<<Cascades2: types>>=
type :: feyngraph_ptr_t
type(feyngraph_t), pointer :: graph => null ()
end type feyngraph_ptr_t
@ %def feyngraph_ptr_t
@
The length of a string describing a Feynman diagram which is produced by
O'Mega is fixed by the parameter
<<Cascades2: parameters>>=
integer, parameter :: FEYNGRAPH_LEN=300
@ %def feyngraph_len
<<Cascades2: feyngraph: TBP>>=
procedure :: final => feyngraph_final
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_final (graph)
class(feyngraph_t), intent(inout) :: graph
end subroutine feyngraph_final
<<Cascades2: procedures>>=
module subroutine feyngraph_final (graph)
class(feyngraph_t), intent(inout) :: graph
type(kingraph_t), pointer :: current
graph%root => null ()
graph%kin_last => null ()
do while (associated (graph%kin_first))
current => graph%kin_first
graph%kin_first => graph%kin_first%next
call current%final ()
deallocate (current)
end do
end subroutine feyngraph_final
@ %def feyngraph_final
This is the type of graph which is used to find the phase space channels,
or in other words, each kingraph could correspond to a channel, if it is
not eliminated for kinematical reasons or due to an equivalence. For the
linked list which is attached to the corresponding [[feyngraph]], we
need the [[next]] pointer, whereas [[grove_next]] points to the next
[[kingraph]] within a grove. The information which is relevant for the
specification of a channel is stored in [[tree]]. We use [[grove_prop]]
to sort the [[kingraph]] in a grove in which all [[kingraphs]] are
characterized by the numbers contained in [[grove_prop]]. Later these
groves are further subdevided using the resonance hash. A [[kingraph]]
which is constructed directly from the output of O'Mega, is not
[[inverse]]. In this case the first incoming particle is the root ofthe
tree. In a scattering process, we can also construct a [[kingraph]]
where the root of the tree is the second incoming particle. In this
case the value of [[inverse]] is [[.true.]].
<<Cascades2: types>>=
type, extends (graph_t) :: kingraph_t
type(k_node_t), pointer :: root => null ()
type(kingraph_t), pointer :: next => null()
type(kingraph_t), pointer :: grove_next => null ()
type(tree_t) :: tree
type(grove_prop_t) :: grove_prop
logical :: inverse = .false.
integer :: prc_component = 0
contains
<<Cascades2: kingraph: TBP>>
end type kingraph_t
@ %def kingraph_t
@ Another container for a pointer to emulate arrays of pointers:
<<Cascades2: types>>=
type :: kingraph_ptr_t
type(kingraph_t), pointer :: graph => null ()
end type kingraph_ptr_t
@ %def kingraph_ptr_t
@
<<Cascades2: kingraph: TBP>>=
procedure :: final => kingraph_final
<<Cascades2: sub interfaces>>=
module subroutine kingraph_final (graph)
class(kingraph_t), intent(inout) :: graph
end subroutine kingraph_final
<<Cascades2: procedures>>=
module subroutine kingraph_final (graph)
class(kingraph_t), intent(inout) :: graph
graph%root => null ()
graph%next => null ()
graph%grove_next => null ()
call graph%tree%final ()
end subroutine kingraph_final
@ %def kingraph_final
@
\subsection{The node types}
We define an abstract type containing variables which are needed for
[[f_node_t]] as well as [[k_node_t]]. We say that a node is on the
t-line if it lies between the two nodes which correspond to the two
incoming particles. [[incoming]] and [[tline]] are used only for
scattering processes and remain [[.false.]] in decay processes. The
variable [[n_subtree_nodes]] holds the number of nodes (including the
node itself) of the subtree of which the node is the root.
<<Cascades2: types>>=
type, abstract :: node_t
type(part_prop_t), pointer :: particle => null ()
logical :: incoming = .false.
logical :: t_line = .false.
integer :: index = 0
logical :: keep = .true.
integer :: n_subtree_nodes = 1
end type node_t
@ %def node_t
@ We use two different list types for the different kinds of nodes. We
therefore start with an abstract type:
<<Cascades2: types>>=
type, abstract :: list_t
integer :: n_entries = 0
end type list_t
@ %def list_t
@ Since the contents of the lists are different, we introduce two
different entry types. Since the trees of nodes use pointers, the nodes
should only be allocated by a type-bound procedure of the corresponding
list type, such that we can keep track of all nodes, eventually reuse
and in the end deallocate nodes correctly, without forgetting any nodes.
Here is the type for the [[k_nodes]]. The list is a linked list. We want
to reuse (recycle) the [[k_nodes]] which are neither [[incoming]] nore
[[t_line]].
<<Cascades2: types>>=
type :: k_node_entry_t
type(k_node_t), pointer :: node => null ()
type(k_node_entry_t), pointer :: next => null ()
logical :: recycle = .false.
contains
<<Cascades2: k node entry: TBP>>
end type k_node_entry_t
@ %def k_node_entry_t
<<Cascades2: k node entry: TBP>>=
procedure :: final => k_node_entry_final
<<Cascades2: sub interfaces>>=
module subroutine k_node_entry_final (entry)
class(k_node_entry_t), intent(inout) :: entry
end subroutine k_node_entry_final
<<Cascades2: procedures>>=
module subroutine k_node_entry_final (entry)
class(k_node_entry_t), intent(inout) :: entry
if (associated (entry%node)) then
call entry%node%final
deallocate (entry%node)
end if
entry%next => null ()
end subroutine k_node_entry_final
@ %def k_node_entry_final
<<Cascades2: k node entry: TBP>>=
procedure :: write => k_node_entry_write
<<Cascades2: sub interfaces>>=
module subroutine k_node_entry_write (k_node_entry, u)
class(k_node_entry_t), intent(in) :: k_node_entry
integer, intent(in) :: u
end subroutine k_node_entry_write
<<Cascades2: procedures>>=
module subroutine k_node_entry_write (k_node_entry, u)
class(k_node_entry_t), intent(in) :: k_node_entry
integer, intent(in) :: u
end subroutine k_node_entry_write
@ %def k_node_entry_write
@ Here is the list type for [[k_nodes]]. A [[k_node_list]] can be
declared to be an observer. In this case it does not create any nodes by
itself, but the entries set their pointers to existing nodes. In this
way we can use the list structure and the type bound procedures for
existing nodes.
<<Cascades2: types>>=
type, extends (list_t) :: k_node_list_t
type(k_node_entry_t), pointer :: first => null ()
type(k_node_entry_t), pointer :: last => null ()
integer :: n_recycle
logical :: observer = .false.
contains
<<Cascades2: k node list: TBP>>
end type k_node_list_t
@ %def k_node_list_t
<<Cascades2: k node list: TBP>>=
procedure :: final => k_node_list_final
<<Cascades2: sub interfaces>>=
module subroutine k_node_list_final (list)
class(k_node_list_t), intent(inout) :: list
end subroutine k_node_list_final
<<Cascades2: procedures>>=
module subroutine k_node_list_final (list)
class(k_node_list_t), intent(inout) :: list
type(k_node_entry_t), pointer :: current
do while (associated (list%first))
current => list%first
list%first => list%first%next
if (list%observer) current%node => null ()
call current%final ()
deallocate (current)
end do
end subroutine k_node_list_final
@ %def k_node_list_final
@ The [[f_node_t]] type contains the [[particle_label]] variable which is
extracted from the input file. It consists not only of the particle
name, but also of some numbers in brackets. These numbers indicate which
external particles are part of the subtree of this node. The [[f_node]]
contains also a list of [[k_nodes]]. Therefore, if the nodes are not
[[incoming]] or [[t_line]], the mapping calculations for these
[[k_nodes]] which can appear in several [[kingraphs]] have to be
performed only once.
<<Cascades2: types>>=
type, extends (node_t) :: f_node_t
type(f_node_t), pointer :: daughter1 => null ()
type(f_node_t), pointer :: daughter2 => null ()
character(len=LABEL_LEN) :: particle_label
type(k_node_list_t) :: k_node_list
contains
<<Cascades2: f node: TBP>>
end type f_node_t
@ %def f_node_t
@ The finalizer nullifies the daughter pointers, since they are
deallocated, like the [[f_node]] itself, with the finalizer of the
[[f_node_list]].
<<Cascades2: f node: TBP>>=
procedure :: final => f_node_final
<<Cascades2: sub interfaces>>=
recursive module subroutine f_node_final (node)
class(f_node_t), intent(inout) :: node
end subroutine f_node_final
<<Cascades2: procedures>>=
recursive module subroutine f_node_final (node)
class(f_node_t), intent(inout) :: node
call node%k_node_list%final ()
node%daughter1 => null ()
node%daughter2 => null ()
end subroutine f_node_final
@ %def f_node_final
@ Finaliser for [[f_node_entry]].
<<Cascades2: f node entry: TBP>>=
procedure :: final => f_node_entry_final
<<Cascades2: sub interfaces>>=
module subroutine f_node_entry_final (entry)
class(f_node_entry_t), intent(inout) :: entry
end subroutine f_node_entry_final
<<Cascades2: procedures>>=
module subroutine f_node_entry_final (entry)
class(f_node_entry_t), intent(inout) :: entry
if (associated (entry%node)) then
call entry%node%final ()
deallocate (entry%node)
end if
entry%next => null ()
end subroutine f_node_entry_final
@ %def f_node_entry_final
@ Set index if not yet done, i.e. if it is zero.
<<Cascades2: f node: TBP>>=
procedure :: set_index => f_node_set_index
<<Cascades2: sub interfaces>>=
module subroutine f_node_set_index (f_node)
class(f_node_t), intent(inout) :: f_node
end subroutine f_node_set_index
<<Cascades2: procedures>>=
module subroutine f_node_set_index (f_node)
class(f_node_t), intent(inout) :: f_node
integer, save :: counter = 0
if (f_node%index == 0) then
counter = counter + 1
f_node%index = counter
end if
end subroutine f_node_set_index
@ %def f_node_set_index
@
Type for the nodes of the tree (lines of the Feynman diagrams). We
also need a type containing a pointer to a node, which is needed for
creating arrays of pointers. This will be used for scattering
processes where we can take either the first or the second particle to
be the root of the tree. Since we need both cases for the calculations
and O'Mega only gives us one of these, we have to perform a
transformation of the graph in which some nodes (on the line which we
hereafter call t-line) need to know their mother and sister nodes,
which become their daughters within this transformation.
<<Cascades2: types>>=
type :: f_node_ptr_t
type(f_node_t), pointer :: node => null ()
contains
<<Cascades2: f node ptr: TBP>>
end type f_node_ptr_t
@ %def f_node_ptr_t
<<Cascades2: f node ptr: TBP>>=
procedure :: final => f_node_ptr_final
<<Cascades2: sub interfaces>>=
module subroutine f_node_ptr_final (f_node_ptr)
class(f_node_ptr_t), intent(inout) :: f_node_ptr
end subroutine f_node_ptr_final
<<Cascades2: procedures>>=
module subroutine f_node_ptr_final (f_node_ptr)
class(f_node_ptr_t), intent(inout) :: f_node_ptr
f_node_ptr%node => null ()
end subroutine f_node_ptr_final
@ %def f_node_ptr_final
<<Cascades2: interfaces>>=
interface assignment (=)
module procedure f_node_ptr_assign
end interface assignment (=)
<<Cascades2: sub interfaces>>=
module subroutine f_node_ptr_assign (ptr1, ptr2)
type(f_node_ptr_t), intent(out) :: ptr1
type(f_node_ptr_t), intent(in) :: ptr2
end subroutine f_node_ptr_assign
<<Cascades2: procedures>>=
module subroutine f_node_ptr_assign (ptr1, ptr2)
type(f_node_ptr_t), intent(out) :: ptr1
type(f_node_ptr_t), intent(in) :: ptr2
ptr1%node => ptr2%node
end subroutine f_node_ptr_assign
@ %def f_node_ptr_assign
@
<<Cascades2: types>>=
type :: k_node_ptr_t
type(k_node_t), pointer :: node => null ()
end type k_node_ptr_t
@ %def k_node_ptr_t
@
<<Cascades2: types>>=
type, extends (node_t) :: k_node_t
type(k_node_t), pointer :: daughter1 => null ()
type(k_node_t), pointer :: daughter2 => null ()
type(k_node_t), pointer :: inverse_daughter1 => null ()
type(k_node_t), pointer :: inverse_daughter2 => null ()
type(f_node_t), pointer :: f_node => null ()
type(tree_t) :: subtree
real (default) :: ext_mass_sum = 0.
real (default) :: effective_mass = 0.
logical :: resonant = .false.
logical :: on_shell = .false.
logical :: log_enhanced = .false.
integer :: mapping = NO_MAPPING
integer(TC) :: bincode = 0
logical :: mapping_assigned = .false.
logical :: is_nonresonant_copy = .false.
logical :: subtree_checked = .false.
integer :: n_off_shell = 0
integer :: n_log_enhanced = 0
integer :: n_resonances = 0
integer :: multiplicity = 0
integer :: n_t_channel = 0
integer :: f_node_index = 0
contains
<<Cascades2: k node: TBP>>
end type k_node_t
@ %def k_node_t
@
Subroutine for [[k_node]] assignment.
<<Cascades2: interfaces>>=
interface assignment (=)
module procedure k_node_assign
end interface assignment (=)
<<Cascades2: sub interfaces>>=
module subroutine k_node_assign (k_node1, k_node2)
type(k_node_t), intent(inout) :: k_node1
type(k_node_t), intent(in) :: k_node2
end subroutine k_node_assign
<<Cascades2: procedures>>=
module subroutine k_node_assign (k_node1, k_node2)
type(k_node_t), intent(inout) :: k_node1
type(k_node_t), intent(in) :: k_node2
k_node1%f_node => k_node2%f_node
k_node1%particle => k_node2%particle
k_node1%incoming = k_node2%incoming
k_node1%t_line = k_node2%t_line
k_node1%keep = k_node2%keep
k_node1%n_subtree_nodes = k_node2%n_subtree_nodes
k_node1%ext_mass_sum = k_node2%ext_mass_sum
k_node1%effective_mass = k_node2%effective_mass
k_node1%resonant = k_node2%resonant
k_node1%on_shell = k_node2%on_shell
k_node1%log_enhanced = k_node2%log_enhanced
k_node1%mapping = k_node2%mapping
k_node1%bincode = k_node2%bincode
k_node1%mapping_assigned = k_node2%mapping_assigned
k_node1%is_nonresonant_copy = k_node2%is_nonresonant_copy
k_node1%n_off_shell = k_node2%n_off_shell
k_node1%n_log_enhanced = k_node2%n_log_enhanced
k_node1%n_resonances = k_node2%n_resonances
k_node1%multiplicity = k_node2%multiplicity
k_node1%n_t_channel = k_node2%n_t_channel
k_node1%f_node_index = k_node2%f_node_index
end subroutine k_node_assign
@ %def k_node_assign
@ The finalizer of [[k_node_t]] nullifies all pointers to nodes, since the
deallocation of these nodes takes place in the finalizer of the list by which
they were created.
<<Cascades2: k node: TBP>>=
procedure :: final => k_node_final
<<Cascades2: sub interfaces>>=
recursive module subroutine k_node_final (k_node)
class(k_node_t), intent(inout) :: k_node
end subroutine k_node_final
<<Cascades2: procedures>>=
recursive module subroutine k_node_final (k_node)
class(k_node_t), intent(inout) :: k_node
k_node%daughter1 => null ()
k_node%daughter2 => null ()
k_node%inverse_daughter1 => null ()
k_node%inverse_daughter2 => null ()
k_node%f_node => null ()
end subroutine k_node_final
@ %def k_node_final
@ Set an index to a [[k_node]], if not yet done, i.e. if it is zero. The
indices are simply positive integer numbers starting from 1.
<<Cascades2: k node: TBP>>=
procedure :: set_index => k_node_set_index
<<Cascades2: sub interfaces>>=
module subroutine k_node_set_index (k_node)
class(k_node_t), intent(inout) :: k_node
end subroutine k_node_set_index
<<Cascades2: procedures>>=
module subroutine k_node_set_index (k_node)
class(k_node_t), intent(inout) :: k_node
integer, save :: counter = 0
if (k_node%index == 0) then
counter = counter + 1
k_node%index = counter
end if
end subroutine k_node_set_index
@ %def k_node_set_index
@ The process type (decay or scattering) is given by an integer which is
equal to the number of incoming particles.
<<Cascades2: public>>=
public :: DECAY, SCATTERING
<<Cascades2: parameters>>=
integer, parameter :: DECAY=1, SCATTERING=2
@ %def decay scattering
@ The entries of the [[f_node_list]] contain the substring of the input
file from which the node's subtree will be constructed (or a modified
string containing placeholders for substrings). We use the
length of this string for fast comparison to find the nodes in the
[[f_node_list]] which we want to reuse.
<<Cascades2: types>>=
type :: f_node_entry_t
character(len=FEYNGRAPH_LEN) :: subtree_string
integer :: string_len = 0
type(f_node_t), pointer :: node => null ()
type(f_node_entry_t), pointer :: next => null ()
integer :: subtree_size = 0
contains
<<Cascades2: f node entry: TBP>>
end type f_node_entry_t
@ %def f_node_entry_t
@ A write method for [[f_node_entry]].
<<Cascades2: f node entry: TBP>>=
procedure :: write => f_node_entry_write
<<Cascades2: sub interfaces>>=
module subroutine f_node_entry_write (f_node_entry, u)
class(f_node_entry_t), intent(in) :: f_node_entry
integer, intent(in) :: u
end subroutine f_node_entry_write
<<Cascades2: procedures>>=
module subroutine f_node_entry_write (f_node_entry, u)
class(f_node_entry_t), intent(in) :: f_node_entry
integer, intent(in) :: u
write (unit=u, fmt='(A)') trim(f_node_entry%subtree_string)
end subroutine f_node_entry_write
@ %def f_node_entry_write
<<Cascades2: interfaces>>=
interface assignment (=)
module procedure f_node_entry_assign
end interface assignment (=)
<<Cascades2: sub interfaces>>=
module subroutine f_node_entry_assign (entry1, entry2)
type(f_node_entry_t), intent(out) :: entry1
type(f_node_entry_t), intent(in) :: entry2
end subroutine f_node_entry_assign
<<Cascades2: procedures>>=
module subroutine f_node_entry_assign (entry1, entry2)
type(f_node_entry_t), intent(out) :: entry1
type(f_node_entry_t), intent(in) :: entry2
entry1%node => entry2%node
entry1%subtree_string = entry2%subtree_string
entry1%string_len = entry2%string_len
entry1%subtree_size = entry2%subtree_size
end subroutine f_node_entry_assign
@ %def f_node_entry_assign
@ This is the list type for [[f_nodes]]. The variable [[max_tree_size]]
is the number of nodes which appear in a complete graph.
<<Cascades2: types>>=
type, extends (list_t) :: f_node_list_t
type(f_node_entry_t), pointer :: first => null ()
type(f_node_entry_t), pointer :: last => null ()
type(k_node_list_t), pointer :: k_node_list => null ()
integer :: max_tree_size = 0
contains
<<Cascades2: f node list: TBP>>
end type f_node_list_t
@ %def f_node_list_t
@ Add an entry to the [[f_node_list]]. If the node might be reused, we check first
using the [[subtree_string]] if there is already a node in the list which
is the root of exactly the same subtree. Otherwise we add an entry to the
list and allocate the node. In both cases we return a pointer to the node
which allows to access the node.
<<Cascades2: f node list: TBP>>=
procedure :: add_entry => f_node_list_add_entry
<<Cascades2: sub interfaces>>=
module subroutine f_node_list_add_entry (list, subtree_string, &
ptr_to_node, recycle, subtree_size)
class(f_node_list_t), intent(inout) :: list
character(len=*), intent(in) :: subtree_string
type(f_node_t), pointer, intent(out) :: ptr_to_node
logical, intent(in) :: recycle
integer, intent(in), optional :: subtree_size
end subroutine f_node_list_add_entry
<<Cascades2: procedures>>=
module subroutine f_node_list_add_entry (list, subtree_string, &
ptr_to_node, recycle, subtree_size)
class(f_node_list_t), intent(inout) :: list
character(len=*), intent(in) :: subtree_string
type(f_node_t), pointer, intent(out) :: ptr_to_node
logical, intent(in) :: recycle
integer, intent(in), optional :: subtree_size
type(f_node_entry_t), pointer :: current
type(f_node_entry_t), pointer :: second
integer :: subtree_len
ptr_to_node => null ()
if (recycle) then
subtree_len = len_trim (subtree_string)
current => list%first
do while (associated (current))
if (present (subtree_size)) then
if (current%subtree_size /= subtree_size) exit
end if
if (current%string_len == subtree_len) then
if (trim (current%subtree_string) == trim (subtree_string)) then
ptr_to_node => current%node
exit
end if
end if
current => current%next
end do
end if
if (.not. associated (ptr_to_node)) then
if (list%n_entries == 0) then
allocate (list%first)
list%last => list%first
else
second => list%first
list%first => null ()
allocate (list%first)
list%first%next => second
end if
list%n_entries = list%n_entries + 1
list%first%subtree_string = trim(subtree_string)
list%first%string_len = subtree_len
if (present (subtree_size)) list%first%subtree_size = subtree_size
allocate (list%first%node)
call list%first%node%set_index ()
ptr_to_node => list%first%node
end if
end subroutine f_node_list_add_entry
@ %def f_node_list_add_entry
@ A write method for debugging.
<<Cascades2: f node list: TBP>>=
procedure :: write => f_node_list_write
<<Cascades2: sub interfaces>>=
module subroutine f_node_list_write (f_node_list, u)
class(f_node_list_t), intent(in) :: f_node_list
integer, intent(in) :: u
end subroutine f_node_list_write
<<Cascades2: procedures>>=
module subroutine f_node_list_write (f_node_list, u)
class(f_node_list_t), intent(in) :: f_node_list
integer, intent(in) :: u
type(f_node_entry_t), pointer :: current
integer :: pos = 0
current => f_node_list%first
do while (associated (current))
pos = pos + 1
write (unit=u, fmt='(A,I10)') 'entry #: ', pos
call current%write (u)
write (unit=u, fmt=*)
current => current%next
end do
end subroutine f_node_list_write
@ %def f_node_list_write
<<Cascades2: interfaces>>=
interface assignment (=)
module procedure k_node_entry_assign
end interface assignment (=)
<<Cascades2: sub interfaces>>=
module subroutine k_node_entry_assign (entry1, entry2)
type(k_node_entry_t), intent(out) :: entry1
type(k_node_entry_t), intent(in) :: entry2
end subroutine k_node_entry_assign
<<Cascades2: procedures>>=
module subroutine k_node_entry_assign (entry1, entry2)
type(k_node_entry_t), intent(out) :: entry1
type(k_node_entry_t), intent(in) :: entry2
entry1%node => entry2%node
entry1%recycle = entry2%recycle
end subroutine k_node_entry_assign
@ %def k_node_entry_assign
@ Add an entry to the [[k_node_list]]. We have to specify if the
node can be reused. The check for existing reusable nodes happens with
[[k_node_list_get_nodes]] (see below).
<<Cascades2: k node list: TBP>>=
procedure :: add_entry => k_node_list_add_entry
<<Cascades2: sub interfaces>>=
recursive module subroutine k_node_list_add_entry &
(list, ptr_to_node, recycle)
class(k_node_list_t), intent(inout) :: list
type(k_node_t), pointer, intent(out) :: ptr_to_node
logical, intent(in) :: recycle
end subroutine k_node_list_add_entry
<<Cascades2: procedures>>=
recursive module subroutine k_node_list_add_entry &
(list, ptr_to_node, recycle)
class(k_node_list_t), intent(inout) :: list
type(k_node_t), pointer, intent(out) :: ptr_to_node
logical, intent(in) :: recycle
if (list%n_entries == 0) then
allocate (list%first)
list%last => list%first
else
allocate (list%last%next)
list%last => list%last%next
end if
list%n_entries = list%n_entries + 1
list%last%recycle = recycle
allocate (list%last%node)
call list%last%node%set_index ()
ptr_to_node => list%last%node
end subroutine k_node_list_add_entry
@ %def k_node_list_add_entry
@ We need a similar subroutine for adding only a pointer to a list. This
is needed for a [[k_node_list]] which is only an observer, i.e. it does
not create any nodes by itself.
<<Cascades2: k node list: TBP>>=
procedure :: add_pointer => k_node_list_add_pointer
<<Cascades2: sub interfaces>>=
module subroutine k_node_list_add_pointer (list, ptr_to_node, recycle)
class(k_node_list_t), intent(inout) :: list
type(k_node_t), pointer, intent(in) :: ptr_to_node
logical, optional, intent(in) :: recycle
end subroutine k_node_list_add_pointer
<<Cascades2: procedures>>=
module subroutine k_node_list_add_pointer (list, ptr_to_node, recycle)
class(k_node_list_t), intent(inout) :: list
type(k_node_t), pointer, intent(in) :: ptr_to_node
logical, optional, intent(in) :: recycle
logical :: rec
if (present (recycle)) then
rec = recycle
else
rec = .false.
end if
if (list%n_entries == 0) then
allocate (list%first)
list%last => list%first
else
allocate (list%last%next)
list%last => list%last%next
end if
list%n_entries = list%n_entries + 1
list%last%recycle = rec
list%last%node => ptr_to_node
end subroutine k_node_list_add_pointer
@ %def k_node_list_add_pointer
@ The [[k_node_list]] can also be used to collect [[k_nodes]] which belong to
different [[f_nodes]] in order to compare these. This is done only for nodes
which have the same number of subtree nodes. We compare all nodes of the
list with each other (as long as the node is not deactivated, i.e. if
the [[keep]] variable is set to [[.true.]]) using the subroutine
[[subtree_select]]. If it turns out that two nodes are equivalent, we
keep only one of them. The term equivalent in this module refers to trees
or subtrees which differ in the pdg codes at positions where
the trivial mapping is used ([[NO_MAPPING]] or [[NON_RESONANT]]) so that
the mass of the particle does not matter. Depending on the available
couplings, two equivalent subtrees could eventually lead to the same phase
space channels, which is why only one of them is kept.
<<Cascades2: k node list: TBP>>=
procedure :: check_subtree_equivalences => &
k_node_list_check_subtree_equivalences
<<Cascades2: sub interfaces>>=
module subroutine k_node_list_check_subtree_equivalences (list, model)
class(k_node_list_t), intent(inout) :: list
type(model_data_t), intent(in) :: model
end subroutine k_node_list_check_subtree_equivalences
<<Cascades2: procedures>>=
module subroutine k_node_list_check_subtree_equivalences (list, model)
class(k_node_list_t), intent(inout) :: list
type(model_data_t), intent(in) :: model
type(k_node_ptr_t), dimension (:), allocatable :: set
type(k_node_entry_t), pointer :: current
integer :: pos
integer :: i,j
if (list%n_entries == 0) return
allocate (set (list%n_entries))
current => list%first
pos = 0
do while (associated (current))
pos = pos + 1
set(pos)%node => current%node
current => current%next
end do
do i=1, list%n_entries
if (set(i)%node%keep) then
do j=i+1, list%n_entries
if (set(j)%node%keep) then
if (set(i)%node%bincode == set(j)%node%bincode) then
call subtree_select (set(i)%node%subtree,set(j)%node%subtree, model)
if (.not. set(i)%node%subtree%keep) then
set(i)%node%keep = .false.
exit
else if (.not. set(j)%node%subtree%keep) then
set(j)%node%keep = .false.
end if
end if
end if
end do
end if
end do
deallocate (set)
end subroutine k_node_list_check_subtree_equivalences
@ %def k_node_list_check_subtree_equivalences
@ This subroutine is used to obtain all [[k_nodes]] of a [[k_node_list]]
which can be recycled and are not disabled for some reason. We pass an
allocatable array of the type [[k_node_ptr_t]] which will be allocated
if there are any such nodes in the list and the pointers will be
associated with these nodes.
<<Cascades2: k node list: TBP>>=
procedure :: get_nodes => k_node_list_get_nodes
<<Cascades2: sub interfaces>>=
module subroutine k_node_list_get_nodes (list, nodes)
class(k_node_list_t), intent(inout) :: list
type(k_node_ptr_t), dimension(:), allocatable, intent(out) :: nodes
end subroutine k_node_list_get_nodes
<<Cascades2: procedures>>=
module subroutine k_node_list_get_nodes (list, nodes)
class(k_node_list_t), intent(inout) :: list
type(k_node_ptr_t), dimension(:), allocatable, intent(out) :: nodes
integer :: n_nodes
integer :: pos
type(k_node_entry_t), pointer :: current, garbage
n_nodes = 0
current => list%first
do while (associated (current))
if (current%recycle .and. current%node%keep) n_nodes = n_nodes + 1
current => current%next
end do
if (n_nodes /= 0) then
pos = 1
allocate (nodes (n_nodes))
do while (associated (list%first) .and. .not. list%first%node%keep)
garbage => list%first
list%first => list%first%next
call garbage%final ()
deallocate (garbage)
end do
current => list%first
do while (associated (current))
do while (associated (current%next))
if (.not. current%next%node%keep) then
garbage => current%next
current%next => current%next%next
call garbage%final
deallocate (garbage)
else
exit
end if
end do
if (current%recycle .and. current%node%keep) then
nodes(pos)%node => current%node
pos = pos + 1
end if
current => current%next
end do
end if
end subroutine k_node_list_get_nodes
@ %def k_node_list_get_nodes
Gfortran 7/8/9 bug, has to remain in the main module:
<<Cascades2: f node list: TBP>>=
procedure :: final => f_node_list_final
<<Cascades2: main procedures>>=
subroutine f_node_list_final (list)
class(f_node_list_t) :: list
type(f_node_entry_t), pointer :: current
list%k_node_list => null ()
do while (associated (list%first))
current => list%first
list%first => list%first%next
call current%final ()
deallocate (current)
end do
end subroutine f_node_list_final
@ %def f_node_list_final
@
\subsection{The grove list}
First a type is introduced in order to speed up the comparison of kingraphs
with the purpose to quickly find the graphs that might be equivalent.
This is done solely on the basis of a number (which is given
by the value of [[depth]] in [[compare_tree_t]]) of bincodes, which are
the highest ones that do not belong to external particles.
The highest such value determines the index of the element in the [[entry]]
array of the [[compare_tree]]. The next lower such value determines
the index of the element in the [[entry]] array of this [[entry]], and so
on and so forth. This results in a tree structure where the number of
levels is given by [[depth]] and should not be too large for reasons of
memory.
This is the entry type.
<<Cascades2: types>>=
type :: compare_tree_entry_t
type(compare_tree_entry_t), dimension(:), pointer :: entry => null ()
type(kingraph_ptr_t), dimension(:), allocatable :: graph_entry
contains
<<Cascades2: compare tree entry: TBP>>
end type compare_tree_entry_t
@ %def compare_tree_entry_t
@ This is the tree type.
<<Cascades2: types>>=
type :: compare_tree_t
integer :: depth = 3
type(compare_tree_entry_t), dimension(:), pointer :: entry => null ()
contains
<<Cascades2: compare tree: TBP>>
end type compare_tree_t
@ %def compare_tree_t
@ Finalizers for both types. The one for the entry type has to be recursive.
<<Cascades2: compare tree: TBP>>=
procedure :: final => compare_tree_final
<<Cascades2: sub interfaces>>=
module subroutine compare_tree_final (ctree)
class(compare_tree_t), intent(inout) :: ctree
end subroutine compare_tree_final
<<Cascades2: procedures>>=
module subroutine compare_tree_final (ctree)
class(compare_tree_t), intent(inout) :: ctree
integer :: i
if (associated (ctree%entry)) then
do i=1, size (ctree%entry)
call ctree%entry(i)%final ()
deallocate (ctree%entry)
end do
end if
end subroutine compare_tree_final
@ %def compare_tree_final
<<Cascades2: compare tree entry: TBP>>=
procedure :: final => compare_tree_entry_final
<<Cascades2: sub interfaces>>=
recursive module subroutine compare_tree_entry_final (ct_entry)
class(compare_tree_entry_t), intent(inout) :: ct_entry
end subroutine compare_tree_entry_final
<<Cascades2: procedures>>=
recursive module subroutine compare_tree_entry_final (ct_entry)
class(compare_tree_entry_t), intent(inout) :: ct_entry
integer :: i
if (associated (ct_entry%entry)) then
do i=1, size (ct_entry%entry)
call ct_entry%entry(i)%final ()
end do
deallocate (ct_entry%entry)
else
deallocate (ct_entry%graph_entry)
end if
end subroutine compare_tree_entry_final
@ %def compare_tree_entry_final
@ Check the presence of a graph which is considered as equivalent and
select between the two. If there is no such graph, the current one
is added to the list. First the entry has to be found:
<<Cascades2: compare tree: TBP>>=
procedure :: check_kingraph => compare_tree_check_kingraph
<<Cascades2: sub interfaces>>=
module subroutine compare_tree_check_kingraph &
(ctree, kingraph, model, preliminary)
class(compare_tree_t), intent(inout) :: ctree
type(kingraph_t), intent(inout), pointer :: kingraph
type(model_data_t), intent(in) :: model
logical, intent(in) :: preliminary
end subroutine compare_tree_check_kingraph
<<Cascades2: procedures>>=
module subroutine compare_tree_check_kingraph &
(ctree, kingraph, model, preliminary)
class(compare_tree_t), intent(inout) :: ctree
type(kingraph_t), intent(inout), pointer :: kingraph
type(model_data_t), intent(in) :: model
logical, intent(in) :: preliminary
integer :: i
integer :: pos
integer(TC) :: sz
integer(TC), dimension(:), allocatable :: identifier
if (.not. associated (ctree%entry)) then
sz = 0_TC
do i = size(kingraph%tree%bc), 1, -1
sz = ior (sz, kingraph%tree%bc(i))
end do
if (sz > 0) then
allocate (ctree%entry (sz))
else
call msg_bug ("Compare tree could not be created")
end if
end if
allocate (identifier (ctree%depth))
pos = 0
do i = size(kingraph%tree%bc), 1, -1
if (popcnt (kingraph%tree%bc(i)) /= 1) then
pos = pos + 1
identifier(pos) = kingraph%tree%bc(i)
if (pos == ctree%depth) exit
end if
end do
if (size (identifier) > 1) then
call ctree%entry(identifier(1))%check_kingraph (kingraph, model, &
preliminary, identifier(1), identifier(2:))
else if (size (identifier) == 1) then
call ctree%entry(identifier(1))%check_kingraph &
(kingraph, model, preliminary)
end if
deallocate (identifier)
end subroutine compare_tree_check_kingraph
@ %def compare_tree_check_kingraph
@ Then the graphs of the entry are checked.
<<Cascades2: compare tree entry: TBP>>=
procedure :: check_kingraph => compare_tree_entry_check_kingraph
<<Cascades2: sub interfaces>>=
recursive module subroutine compare_tree_entry_check_kingraph (ct_entry, &
kingraph, model, preliminary, subtree_size, identifier)
class(compare_tree_entry_t), intent(inout) :: ct_entry
type(kingraph_t), pointer, intent(inout) :: kingraph
type(model_data_t), intent(in) :: model
logical, intent(in) :: preliminary
integer, intent(in), optional :: subtree_size
integer, dimension (:), intent(in), optional :: identifier
end subroutine compare_tree_entry_check_kingraph
<<Cascades2: procedures>>=
recursive module subroutine compare_tree_entry_check_kingraph (ct_entry, &
kingraph, model, preliminary, subtree_size, identifier)
class(compare_tree_entry_t), intent(inout) :: ct_entry
type(kingraph_t), pointer, intent(inout) :: kingraph
type(model_data_t), intent(in) :: model
logical, intent(in) :: preliminary
integer, intent(in), optional :: subtree_size
integer, dimension (:), intent(in), optional :: identifier
if (present (identifier)) then
if (.not. associated (ct_entry%entry)) &
allocate (ct_entry%entry(subtree_size))
if (size (identifier) > 1) then
call ct_entry%entry(identifier(1))%check_kingraph (kingraph, &
model, preliminary, identifier(1), identifier(2:))
else if (size (identifier) == 1) then
call ct_entry%entry(identifier(1))%check_kingraph (kingraph, &
model, preliminary)
end if
else
if (allocated (ct_entry%graph_entry)) then
call perform_check
else
allocate (ct_entry%graph_entry(1))
ct_entry%graph_entry(1)%graph => kingraph
end if
end if
contains
subroutine perform_check
integer :: i
logical :: rebuild
rebuild = .true.
do i=1, size(ct_entry%graph_entry)
if (ct_entry%graph_entry(i)%graph%keep) then
if (preliminary .or. &
ct_entry%graph_entry(i)%graph%prc_component /= &
kingraph%prc_component) then
call kingraph_select (ct_entry%graph_entry(i)%graph, &
kingraph, model, preliminary)
if (.not. kingraph%keep) then
return
else if (rebuild .and. .not. &
ct_entry%graph_entry(i)%graph%keep) then
ct_entry%graph_entry(i)%graph => kingraph
rebuild = .false.
end if
end if
end if
end do
if (rebuild) call rebuild_graph_entry
end subroutine perform_check
subroutine rebuild_graph_entry
type(kingraph_ptr_t), dimension(:), allocatable :: tmp_ptr
integer :: i
integer :: pos
allocate (tmp_ptr(size(ct_entry%graph_entry)+1))
pos = 0
do i=1, size(ct_entry%graph_entry)
pos = pos + 1
tmp_ptr(pos)%graph => ct_entry%graph_entry(i)%graph
end do
pos = pos + 1
tmp_ptr(pos)%graph => kingraph
deallocate (ct_entry%graph_entry)
allocate (ct_entry%graph_entry (pos))
do i=1, pos
ct_entry%graph_entry(i)%graph => tmp_ptr(i)%graph
end do
deallocate (tmp_ptr)
end subroutine rebuild_graph_entry
end subroutine compare_tree_entry_check_kingraph
@ %def compare_tree_entry_check_kingraph
@ The grove to which a completed [[kingraph]] will be added is determined by the
entries of [[grove_prop]]. We use another list type (linked list) to
arrange the groves. Each [[grove]] contains again a linked list of
[[kingraphs]].
<<Cascades2: types>>=
type :: grove_t
type(grove_prop_t) :: grove_prop
type(grove_t), pointer :: next => null ()
type(kingraph_t), pointer :: first => null ()
type(kingraph_t), pointer :: last => null ()
type(compare_tree_t) :: compare_tree
contains
<<Cascades2: grove: TBP>>
end type grove_t
@ %def grove_t
@ Container for a pointer of type [[grove_t]]:
<<Cascades2: types>>=
type :: grove_ptr_t
type(grove_t), pointer :: grove => null ()
end type grove_ptr_t
@ %def grove_ptr_t
<<Cascades2: grove: TBP>>=
procedure :: final => grove_final
<<Cascades2: sub interfaces>>=
module subroutine grove_final (grove)
class(grove_t), intent(inout) :: grove
end subroutine grove_final
<<Cascades2: procedures>>=
module subroutine grove_final (grove)
class(grove_t), intent(inout) :: grove
grove%first => null ()
grove%last => null ()
grove%next => null ()
end subroutine grove_final
@ %def grove_final
@ This is the list type:
<<Cascades2: types>>=
type :: grove_list_t
type(grove_t), pointer :: first => null ()
contains
<<Cascades2: grove list: TBP>>
end type grove_list_t
@ %def grove_list_t
Gfortran 7/8/9 bug, has to remain in the main module:
<<Cascades2: grove list: TBP>>=
procedure :: final => grove_list_final
<<Cascades2: main procedures>>=
subroutine grove_list_final (list)
class(grove_list_t), intent(inout) :: list
class(grove_t), pointer :: current
do while (associated (list%first))
current => list%first
list%first => list%first%next
call current%final ()
deallocate (current)
end do
end subroutine grove_list_final
@ %def grove_list_final
@
\subsection{The feyngraph set}
The fundament of the module is the public type [[feyngraph_set_t]]. It
is not only a linked list of all [[feyngraphs]] but contains an array
of all particle properties ([[particle]]), an [[f_node_list]] and a
pointer of the type [[grove_list_t]], since several [[feyngraph_sets]]
can share a common [[grove_list]]. In addition it keeps the data which
unambiguously specifies the process, as well as the model which
provides information which allows us to choose between equivalent
subtrees or complete [[kingraphs]].
<<Cascades2: public>>=
public :: feyngraph_set_t
<<Cascades2: types>>=
type :: feyngraph_set_t
type(model_data_t), pointer :: model => null ()
type(flavor_t), dimension(:,:), allocatable :: flv
integer :: n_in = 0
integer :: n_out = 0
integer :: process_type = DECAY
type(phs_parameters_t) :: phs_par
logical :: fatal_beam_decay = .true.
type(part_prop_t), dimension (:), pointer :: particle => null ()
type(f_node_list_t) :: f_node_list
type(feyngraph_t), pointer :: first => null ()
type(feyngraph_t), pointer :: last => null ()
integer :: n_graphs = 0
type(grove_list_t), pointer :: grove_list => null ()
logical :: use_dag = .true.
type(dag_t), pointer :: dag => null ()
type(feyngraph_set_t), dimension (:), pointer :: fset => null ()
contains
<<Cascades2: feyngraph set: TBP>>
end type feyngraph_set_t
@ %def feyngraph_set_t
@ This final procedure contains calls to all other necessary final
procedures. Gfortran 7/8/9 bug, has to remain in the main module:
<<Cascades2: feyngraph set: TBP>>=
procedure :: final => feyngraph_set_final
<<Cascades2: main procedures>>=
recursive subroutine feyngraph_set_final (set)
class(feyngraph_set_t), intent(inout) :: set
class(feyngraph_t), pointer :: current
integer :: i
if (associated (set%fset)) then
do i=1, size (set%fset)
call set%fset(i)%final ()
end do
deallocate (set%fset)
else
set%particle => null ()
set%grove_list => null ()
end if
set%model => null ()
if (allocated (set%flv)) deallocate (set%flv)
set%last => null ()
do while (associated (set%first))
current => set%first
set%first => set%first%next
call current%final ()
deallocate (current)
end do
if (associated (set%particle)) then
do i = 1, size (set%particle)
call set%particle(i)%final ()
end do
deallocate (set%particle)
end if
if (associated (set%grove_list)) then
if (debug_on) call msg_debug (D_PHASESPACE, "grove_list: final")
call set%grove_list%final ()
deallocate (set%grove_list)
end if
if (debug_on) call msg_debug (D_PHASESPACE, "f_node_list: final")
call set%f_node_list%final ()
if (associated (set%dag)) then
if (debug_on) call msg_debug (D_PHASESPACE, "dag: final")
if (associated (set%dag)) then
call set%dag%final ()
deallocate (set%dag)
end if
end if
end subroutine feyngraph_set_final
@ %def feyngraph_set_final
@
\subsection{Construct the feyngraph set}
We construct the [[feyngraph_set]] from an input file. Therefore we pass
a unit to [[feyngraph_set_build]]. The parsing subroutines are chosen
depending on the value of [[use_dag]]. In the DAG output, which is the one
that is produced by default, we have to work on a string of one line,
where the lenght of this string becomes larger the more particles are
involved in the process. The other output (which is now only used in a
unit test) contains one Feynman diagram per line and each line starts with an open
parenthesis so that we read the file line per line and create a
[[feyngraph]] for every line. Only after this, nodes are created. In both
decay and scattering processes the diagrams are represented like in a decay
process, i.e. in a scattering process one of the incoming particles appears
as an outgoing particle.
<<Cascades2: feyngraph set: TBP>>=
procedure :: build => feyngraph_set_build
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_set_build (feyngraph_set, u_in)
class(feyngraph_set_t), intent(inout) :: feyngraph_set
integer, intent(in) :: u_in
end subroutine feyngraph_set_build
<<Cascades2: procedures>>=
module subroutine feyngraph_set_build (feyngraph_set, u_in)
class(feyngraph_set_t), intent(inout) :: feyngraph_set
integer, intent(in) :: u_in
integer :: stat = 0
character(len=FEYNGRAPH_LEN) :: omega_feyngraph_output
type(feyngraph_t), pointer :: current_graph
type(feyngraph_t), pointer :: compare_graph
logical :: present
if (feyngraph_set%use_dag) then
allocate (feyngraph_set%dag)
if (.not. associated (feyngraph_set%first)) then
call feyngraph_set%dag%read_string (u_in, feyngraph_set%flv(:,1))
call feyngraph_set%dag%construct (feyngraph_set)
call feyngraph_set%dag%make_feyngraphs (feyngraph_set)
end if
else
if (.not. associated (feyngraph_set%first)) then
read (unit=u_in, fmt='(A)', iostat=stat, advance='yes') &
omega_feyngraph_output
if (omega_feyngraph_output(1:1) == '(') then
allocate (feyngraph_set%first)
feyngraph_set%first%omega_feyngraph_output = &
trim(omega_feyngraph_output)
feyngraph_set%last => feyngraph_set%first
feyngraph_set%n_graphs = feyngraph_set%n_graphs + 1
else
call msg_fatal ("Invalid input file")
end if
read (unit=u_in, fmt='(A)', iostat=stat, advance='yes') &
omega_feyngraph_output
do while (stat == 0)
if (omega_feyngraph_output(1:1) == '(') then
compare_graph => feyngraph_set%first
present = .false.
do while (associated (compare_graph))
if (len_trim(compare_graph%omega_feyngraph_output) &
== len_trim(omega_feyngraph_output)) then
if (compare_graph%omega_feyngraph_output == &
omega_feyngraph_output) then
present = .true.
exit
end if
end if
compare_graph => compare_graph%next
end do
if (.not. present) then
allocate (feyngraph_set%last%next)
feyngraph_set%last => feyngraph_set%last%next
feyngraph_set%last%omega_feyngraph_output = &
trim(omega_feyngraph_output)
feyngraph_set%n_graphs = feyngraph_set%n_graphs + 1
end if
read (unit=u_in, fmt='(A)', iostat=stat, advance='yes') &
omega_feyngraph_output
else
exit
end if
end do
current_graph => feyngraph_set%first
do while (associated (current_graph))
call feyngraph_construct (feyngraph_set, current_graph)
current_graph => current_graph%next
end do
feyngraph_set%f_node_list%max_tree_size = feyngraph_set%first%n_nodes
end if
end if
end subroutine feyngraph_set_build
@ %def feyngraph_set_build
@ Read the string from the file. The output which is produced by O'Mega
contains the DAG in a factorised form as a long string, distributed over
several lines (in addition, in the case of a scattering process, it
contains a similar string for the same process, but with the other
incoming particle as the root of the tree structure). In general, such a
file can contain many of these strings, belonging to different process
components. Therefore we first have to find the correct position of the
string for the process in question. Therefore we look for a line
containing a pair of colons, in which case the line contains a process
string. Then we check if the process string describes the correct
process, which is done by checking for all the incoming and outgoing
particle names. If the process is correct, the dag output should start
in the following line. As long as we do not find the correct process
string, we continue searching. If we reach the end of the file, we
rewind the unit once, and repeat searching. If the process is still not
found, there must be some sort of error.
<<Cascades2: dag: TBP>>=
procedure :: read_string => dag_read_string
<<Cascades2: sub interfaces>>=
module subroutine dag_read_string (dag, u_in, flv)
class(dag_t), intent(inout) :: dag
integer, intent(in) :: u_in
type(flavor_t), dimension(:), intent(in) :: flv
end subroutine dag_read_string
<<Cascades2: procedures>>=
module subroutine dag_read_string (dag, u_in, flv)
class(dag_t), intent(inout) :: dag
integer, intent(in) :: u_in
type(flavor_t), dimension(:), intent(in) :: flv
character(len=BUFFER_LEN) :: process_string
logical :: process_found
logical :: rewound
!!! Find process string in file
process_found = .false.
rewound = .false.
do while (.not. process_found)
process_string = ""
read (unit=u_in, fmt='(A)') process_string
if (len_trim(process_string) /= 0) then
if (index (process_string, "::") > 0) then
process_found = process_string_match (trim (process_string), flv)
end if
else if (.not. rewound) then
rewind (u_in)
rewound = .true.
else
call msg_bug ("Process string not found in O'Mega input file.")
end if
end do
call fds_file_get_line (u_in, dag%string)
call dag%string%clean ()
if (.not. allocated (dag%string%t) .or. dag%string%char_len == 0) &
call msg_bug ("Process string not found in O'Mega input file.")
end subroutine dag_read_string
@ %def dag_read_string
@ The output of factorized Feynman diagrams which is created by O'Mega
for a given process could in principle be written to a single line in
the file. This can however lead to different problems with different
compilers as soon as such lines become too long. This is the reason why
the line is cut into smaller pieces. This means that a new line starts
after each vertical bar. For this long string the type [[dag_string_t]]
has been introduced. In order to read the file quickly into such a
[[dag_string]] we use another type, [[dag_chain_t]] which is a linked
list of such [[dag_strings]]. This has the advantage that we do not
have to recreate a new [[dag_string]] for every line which has been
read from file. Only in the end of this operation we compress the
list of strings to a single string, removing useless [[dag_tokens]],
such as blanc space tokens. This subroutine reads all lines starting
from the position in the file the unit is connected to, until no
backslash character is found at the end of a line (the backslash
means that the next line also belongs to the current string).
<<Cascades2: parameters>>=
integer, parameter :: BUFFER_LEN = 1000
integer, parameter :: STACK_SIZE = 100
@ %def BUFFER_LEN STACK_SIZE
<<Cascades2: procedures>>=
subroutine fds_file_get_line (u, string)
integer, intent(in) :: u
type(dag_string_t), intent(out) :: string
type(dag_chain_t) :: chain
integer :: string_size, current_len
character(len=BUFFER_LEN) :: buffer
integer :: fragment_len
integer :: stat
current_len = 0
stat = 0
string_size = 0
do while (stat == 0)
read (unit=u, fmt='(A)', iostat=stat) buffer
if (stat /= 0) exit
fragment_len = len_trim (buffer)
if (fragment_len == 0) then
exit
else if (buffer (fragment_len:fragment_len) == BACKSLASH_CHAR) then
fragment_len = fragment_len - 1
end if
call chain%append (buffer(:fragment_len))
if (buffer(fragment_len+1:fragment_len+1) /= BACKSLASH_CHAR) exit
end do
if (associated (chain%first)) then
call chain%compress ()
string = chain%first
call chain%final ()
end if
end subroutine fds_file_get_line
@ %def fds_file_get_line
@ We check, if the process string which has been read from file
corresponds to the process for which we want to extract the Feynman
diagrams.
<<Cascades2: procedures>>=
function process_string_match (string, flv) result (match)
character(len=*), intent(in) :: string
type(flavor_t), dimension(:), intent(in) :: flv
logical :: match
integer :: pos
integer :: occurence
integer :: i
pos = 1
match = .false.
do i=1, size (flv)
occurence = index (string(pos:), char(flv(i)%get_name()))
if (occurence > 0) then
pos = pos + occurence
match = .true.
else
match = .false.
exit
end if
end do
end function process_string_match
@ %def process_string_match
@
\subsection{Particle properties}
This subroutine initializes a model instance with the Standard Model
data. It is only relevant for a unit test.
We do not have to care about the model initialization in this module
because the [[model]] is passed to [[feyngraph_set_generate]] when
it is called.
<<Cascades2: public>>=
public :: init_sm_full_test
<<Cascades2: sub interfaces>>=
module subroutine init_sm_full_test (model)
class(model_data_t), intent(out) :: model
end subroutine init_sm_full_test
<<Cascades2: procedures>>=
module subroutine init_sm_full_test (model)
class(model_data_t), intent(out) :: model
type(field_data_t), pointer :: field
integer, parameter :: n_real = 17
integer, parameter :: n_field = 21
integer, parameter :: n_vtx = 56
integer :: i
call model%init (var_str ("SM_vertex_test"), &
n_real, 0, n_field, n_vtx)
call model%init_par (1, var_str ("mZ"), 91.1882_default)
call model%init_par (2, var_str ("mW"), 80.419_default)
call model%init_par (3, var_str ("mH"), 125._default)
call model%init_par (4, var_str ("me"), 0.000510997_default)
call model%init_par (5, var_str ("mmu"), 0.105658389_default)
call model%init_par (6, var_str ("mtau"), 1.77705_default)
call model%init_par (7, var_str ("ms"), 0.095_default)
call model%init_par (8, var_str ("mc"), 1.2_default)
call model%init_par (9, var_str ("mb"), 4.2_default)
call model%init_par (10, var_str ("mtop"), 173.1_default)
call model%init_par (11, var_str ("wtop"), 1.523_default)
call model%init_par (12, var_str ("wZ"), 2.443_default)
call model%init_par (13, var_str ("wW"), 2.049_default)
call model%init_par (14, var_str ("wH"), 0.004143_default)
call model%init_par (15, var_str ("ee"), 0.3079561542961_default)
call model%init_par (16, var_str ("cw"), 8.819013863636E-01_default)
call model%init_par (17, var_str ("sw"), 4.714339240339E-01_default)
i = 0
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("D_QUARK"), 1)
call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
call field%set (name = [var_str ("d")], anti = [var_str ("dbar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("U_QUARK"), 2)
call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
call field%set (name = [var_str ("u")], anti = [var_str ("ubar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("S_QUARK"), 3)
call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
call field%set (mass_data=model%get_par_real_ptr (7))
call field%set (name = [var_str ("s")], anti = [var_str ("sbar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("C_QUARK"), 4)
call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
call field%set (mass_data=model%get_par_real_ptr (8))
call field%set (name = [var_str ("c")], anti = [var_str ("cbar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("B_QUARK"), 5)
call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
call field%set (mass_data=model%get_par_real_ptr (9))
call field%set (name = [var_str ("b")], anti = [var_str ("bbar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("T_QUARK"), 6)
call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
call field%set (mass_data=model%get_par_real_ptr (10))
call field%set (width_data=model%get_par_real_ptr (11))
call field%set (name = [var_str ("t")], anti = [var_str ("tbar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("E_LEPTON"), 11)
call field%set (spin_type=2)
call field%set (mass_data=model%get_par_real_ptr (4))
call field%set (name = [var_str ("e-")], anti = [var_str ("e+")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("E_NEUTRINO"), 12)
call field%set (spin_type=2, is_left_handed=.true.)
call field%set (name = [var_str ("nue")], anti = [var_str ("nuebar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("MU_LEPTON"), 13)
call field%set (spin_type=2)
call field%set (mass_data=model%get_par_real_ptr (5))
call field%set (name = [var_str ("mu-")], anti = [var_str ("mu+")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("MU_NEUTRINO"), 14)
call field%set (spin_type=2, is_left_handed=.true.)
call field%set (name = [var_str ("numu")], anti = [var_str ("numubar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("TAU_LEPTON"), 15)
call field%set (spin_type=2)
call field%set (mass_data=model%get_par_real_ptr (6))
call field%set (name = [var_str ("tau-")], anti = [var_str ("tau+")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("TAU_NEUTRINO"), 16)
call field%set (spin_type=2, is_left_handed=.true.)
call field%set (name = [var_str ("nutau")], anti = [var_str ("nutaubar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("GLUON"), 21)
call field%set (spin_type=3, color_type=8)
call field%set (name = [var_str ("gl")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("PHOTON"), 22)
call field%set (spin_type=3)
call field%set (name = [var_str ("A")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("Z_BOSON"), 23)
call field%set (spin_type=3)
call field%set (mass_data=model%get_par_real_ptr (1))
call field%set (width_data=model%get_par_real_ptr (12))
call field%set (name = [var_str ("Z")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("W_BOSON"), 24)
call field%set (spin_type=3)
call field%set (mass_data=model%get_par_real_ptr (2))
call field%set (width_data=model%get_par_real_ptr (13))
call field%set (name = [var_str ("W+")], anti = [var_str ("W-")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("HIGGS"), 25)
call field%set (spin_type=1)
call field%set (mass_data=model%get_par_real_ptr (3))
call field%set (width_data=model%get_par_real_ptr (14))
call field%set (name = [var_str ("H")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("PROTON"), 2212)
call field%set (spin_type=2)
call field%set (name = [var_str ("p")], anti = [var_str ("pbar")])
! call field%set (mass_data=model%get_par_real_ptr (12))
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("HADRON_REMNANT_SINGLET"), 91)
call field%set (color_type=1)
call field%set (name = [var_str ("hr1")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("HADRON_REMNANT_TRIPLET"), 92)
call field%set (color_type=3)
call field%set (name = [var_str ("hr3")], anti = [var_str ("hr3bar")])
i = i + 1
field => model%get_field_ptr_by_index (i)
call field%init (var_str ("HADRON_REMNANT_OCTET"), 93)
call field%set (color_type=8)
call field%set (name = [var_str ("hr8")])
call model%freeze_fields ()
i = 0
i = i + 1
!!! QED
call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("A")])
i = i + 1
!!!
call model%set_vertex (i, [var_str ("e+"), var_str ("e-"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("mu+"), var_str ("mu-"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("tau+"), var_str ("tau-"), var_str ("A")])
i = i + 1
!!! QCD
call model%set_vertex (i, [var_str ("gl"), var_str ("gl"), var_str ("gl")])
i = i + 1
call model%set_vertex (i, [var_str ("gl"), var_str ("gl"), &
var_str ("gl"), var_str ("gl")])
i = i + 1
!!!
call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("gl")])
i = i + 1
call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("gl")])
i = i + 1
call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("gl")])
i = i + 1
call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("gl")])
i = i + 1
call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("gl")])
i = i + 1
call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("gl")])
i = i + 1
!!! Neutral currents
call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("Z")])
i = i + 1
!!!
call model%set_vertex (i, [var_str ("e+"), var_str ("e-"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("mu+"), var_str ("muu-"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("tau+"), var_str ("tau-"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("nuebar"), var_str ("nue"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("numubar"), var_str ("numu"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("nutaubar"), var_str ("nutau"), &
var_str ("Z")])
i = i + 1
!!! Charged currents
call model%set_vertex (i, [var_str ("ubar"), var_str ("d"), var_str ("W+")])
i = i + 1
call model%set_vertex (i, [var_str ("cbar"), var_str ("s"), var_str ("W+")])
i = i + 1
call model%set_vertex (i, [var_str ("tbar"), var_str ("b"), var_str ("W+")])
i = i + 1
call model%set_vertex (i, [var_str ("dbar"), var_str ("u"), var_str ("W-")])
i = i + 1
call model%set_vertex (i, [var_str ("sbar"), var_str ("c"), var_str ("W-")])
i = i + 1
call model%set_vertex (i, [var_str ("bbar"), var_str ("t"), var_str ("W-")])
i = i + 1
!!!
call model%set_vertex (i, [var_str ("nuebar"), var_str ("e-"), var_str ("W+")])
i = i + 1
call model%set_vertex (i, [var_str ("numubar"), var_str ("mu-"), var_str ("W+")])
i = i + 1
call model%set_vertex (i, [var_str ("nutaubar"), var_str ("tau-"), var_str ("W+")])
i = i + 1
call model%set_vertex (i, [var_str ("e+"), var_str ("nue"), var_str ("W-")])
i = i + 1
call model%set_vertex (i, [var_str ("mu+"), var_str ("numu"), var_str ("W-")])
i = i + 1
call model%set_vertex (i, [var_str ("tau+"), var_str ("nutau"), var_str ("W-")])
i = i + 1
!!! Yukawa
!!! keeping only 3rd generation for the moment
! call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("H")])
! i = i + 1
! call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("H")])
! i = i + 1
call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("H")])
i = i + 1
call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("H")])
i = i + 1
! call model%set_vertex (i, [var_str ("mubar"), var_str ("mu"), var_str ("H")])
! i = i + 1
call model%set_vertex (i, [var_str ("taubar"), var_str ("tau"), var_str ("H")])
i = i + 1
!!! Vector-boson self-interactions
call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("Z")])
i = i + 1
!!!
call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("Z"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("W+"), var_str ("W+"), var_str ("W-"), var_str ("W-")])
i = i + 1
call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("Z"), var_str ("A")])
i = i + 1
call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("A"), var_str ("A")])
i = i + 1
!!! Higgs - vector boson
! call model%set_vertex (i, [var_str ("H"), var_str ("Z"), var_str ("A")])
! i = i + 1
! call model%set_vertex (i, [var_str ("H"), var_str ("A"), var_str ("A")])
! i = i + 1
! call model%set_vertex (i, [var_str ("H"), var_str ("gl"), var_str ("gl")])
! i = i + 1
!!!
call model%set_vertex (i, [var_str ("H"), var_str ("W+"), var_str ("W-")])
i = i + 1
call model%set_vertex (i, [var_str ("H"), var_str ("Z"), var_str ("Z")])
i = i + 1
call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("W+"), var_str ("W-")])
i = i + 1
call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("Z"), var_str ("Z")])
i = i + 1
!!! Higgs self-interactions
call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("H")])
i = i + 1
call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("H"), var_str ("H")])
i = i + 1
call model%freeze_vertices ()
end subroutine init_sm_full_test
@ %def init_sm_full_test
@ Initialize a [[part_prop]] object by passing a [[particle_label]],
which is simply the particle name. [[part_prop]] should be part of the
[[particle]] array of [[feyngraph_set]]. We use the [[model]] of
[[feyngraph_set]] to obtain the relevant data of the particle which is
needed to find [[phase_space]] parametrizations. When a [[part_prop]]
is initialized, we add and initialize also the corresponding anti-
particle [[part_prop]] if it is not yet in the array.
<<Cascades2: part prop: TBP>>=
procedure :: init => part_prop_init
<<Cascades2: sub interfaces>>=
recursive module subroutine part_prop_init &
(part_prop, feyngraph_set, particle_label)
class(part_prop_t), intent(out), target :: part_prop
type(feyngraph_set_t), intent(inout) :: feyngraph_set
character(len=*), intent(in) :: particle_label
end subroutine part_prop_init
<<Cascades2: procedures>>=
recursive module subroutine part_prop_init &
(part_prop, feyngraph_set, particle_label)
class(part_prop_t), intent(out), target :: part_prop
type(feyngraph_set_t), intent(inout) :: feyngraph_set
character(len=*), intent(in) :: particle_label
type(flavor_t) :: flv, anti
type(string_t) :: name
integer :: i
name = particle_label
call flv%init (name, feyngraph_set%model)
part_prop%particle_label = particle_label
part_prop%pdg = flv%get_pdg ()
part_prop%mass = flv%get_mass ()
part_prop%width = flv%get_width()
part_prop%spin_type = flv%get_spin_type ()
part_prop%is_vector = flv%get_spin_type () == VECTOR
part_prop%empty = .false.
part_prop%tex_name = flv%get_tex_name ()
anti = flv%anti ()
if (flv%get_pdg() == anti%get_pdg()) then
select type (part_prop)
type is (part_prop_t)
part_prop%anti => part_prop
end select
else
do i=1, size (feyngraph_set%particle)
if (feyngraph_set%particle(i)%pdg == (- part_prop%pdg)) then
part_prop%anti => feyngraph_set%particle(i)
exit
else if (feyngraph_set%particle(i)%empty) then
part_prop%anti => feyngraph_set%particle(i)
call feyngraph_set%particle(i)%init &
(feyngraph_set, char(anti%get_name()))
exit
end if
end do
end if
end subroutine part_prop_init
@ %def part_prop_init
@ This subroutine assigns to a node the particle properties. Since these
properties do not change and are simply read from the model file, we
use pointers to the elements of the [[particle]] array of the
[[feyngraph_set]]. If there is no corresponding array element, we
have to initialize the first empty element of the array.
<<Cascades2: parameters>>=
integer, parameter :: PRT_ARRAY_SIZE = 200
<<Cascades2: f node: TBP>>=
procedure :: assign_particle_properties => f_node_assign_particle_properties
<<Cascades2: sub interfaces>>=
module subroutine f_node_assign_particle_properties (node, feyngraph_set)
class(f_node_t), intent(inout ) :: node
type(feyngraph_set_t), intent(inout) :: feyngraph_set
end subroutine f_node_assign_particle_properties
<<Cascades2: procedures>>=
module subroutine f_node_assign_particle_properties (node, feyngraph_set)
class(f_node_t), intent(inout ) :: node
type(feyngraph_set_t), intent(inout) :: feyngraph_set
character(len=LABEL_LEN) :: particle_label
integer :: i
particle_label = node%particle_label(1:index (node%particle_label, '[')-1)
if (.not. associated (feyngraph_set%particle)) then
allocate (feyngraph_set%particle (PRT_ARRAY_SIZE))
end if
do i = 1, size (feyngraph_set%particle)
if (particle_label == feyngraph_set%particle(i)%particle_label) then
node%particle => feyngraph_set%particle(i)
exit
else if (feyngraph_set%particle(i)%empty) then
call feyngraph_set%particle(i)%init (feyngraph_set, particle_label)
node%particle => feyngraph_set%particle(i)
exit
end if
end do
!!! Since the O'Mega output uses the anti-particles instead of the
!!! particles specified in the process definition, we revert this
!!! here. An exception is the first particle in the parsable DAG output
node%particle => node%particle%anti
end subroutine f_node_assign_particle_properties
@ %def f_node_assign_particle_properties
@ From the output of a Feynman diagram (in the non-factorized output)
we need to find out how many daughter nodes would be required to
reconstruct it correctly, to make sure that we keep
only those [[feyngraphs]] which are constructed solely on the basis of
the 3-vertices which are provided by the model. The number of daughter
particles can easily be determined from the syntax of O'Mega's output:
The particle which appears before the colon ':' is the mother particle.
The particles or subtrees (i.e. whole parentheses) follow after the
colon and are separated by commas.
<<Cascades2: procedures>>=
function get_n_daughters (subtree_string, pos_first_colon) &
result (n_daughters)
character(len=*), intent(in) :: subtree_string
integer, intent(in) :: pos_first_colon
integer :: n_daughters
integer :: n_open_par
integer :: i
n_open_par = 1
n_daughters = 0
if (len_trim(subtree_string) > 0) then
if (pos_first_colon > 0) then
do i=pos_first_colon, len_trim(subtree_string)
if (subtree_string(i:i) == ',') then
if (n_open_par == 1) n_daughters = n_daughters + 1
else if (subtree_string(i:i) == '(') then
n_open_par = n_open_par + 1
else if (subtree_string(i:i) == ')') then
n_open_par = n_open_par - 1
end if
end do
if (n_open_par == 0) then
n_daughters = n_daughters + 1
end if
end if
end if
end function get_n_daughters
@ %def get_n_daughters
@
\subsection{Reconstruction of trees}
The reconstruction of a tree or subtree with the non-factorized input can
be done recursively, i.e. we first find the root of the tree in the
string and create an [[f_node]]. Then we look for daughters, which in the
string appear either as single particles or subtrees (which are of the
same form as the tree which we want to reconstruct. Therefore the
subroutine can simply be called again and again until there are no more
daughter nodes to create. When we meet a vertex which requires more than
two daughter particles, we stop the recursion and disable the node using
its [[keep]] variable. Whenever a daughter node is not kept, we do not
keep the mother node as well.
<<Cascades2: procedures>>=
recursive subroutine node_construct_subtree_rec (feyngraph_set, &
feyngraph, subtree_string, mother_node)
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(feyngraph_t), intent(inout) :: feyngraph
character(len=*), intent(in) :: subtree_string
type(f_node_t), pointer, intent(inout) :: mother_node
integer :: n_daughters
integer :: pos_first_colon
integer :: current_daughter
integer :: pos_subtree_begin, pos_subtree_end
integer :: i
integer :: n_open_par
if (.not. associated (mother_node)) then
call feyngraph_set%f_node_list%add_entry (subtree_string, mother_node, .true.)
current_daughter = 1
n_open_par = 1
pos_first_colon = index (subtree_string, ':')
n_daughters = get_n_daughters (subtree_string, pos_first_colon)
if (pos_first_colon == 0) then
mother_node%particle_label = subtree_string
else
mother_node%particle_label = subtree_string(2:pos_first_colon-1)
end if
if (.not. associated (mother_node%particle)) then
call mother_node%assign_particle_properties (feyngraph_set)
end if
if (n_daughters /= 2 .and. n_daughters /= 0) then
mother_node%keep = .false.
feyngraph%keep = .false.
return
end if
pos_subtree_begin = pos_first_colon + 1
do i = pos_first_colon + 1, len(trim(subtree_string))
if (current_daughter == 2) then
pos_subtree_end = len(trim(subtree_string)) - 1
call node_construct_subtree_rec (feyngraph_set, feyngraph, &
subtree_string(pos_subtree_begin:pos_subtree_end), &
mother_node%daughter2)
exit
else if (subtree_string(i:i) == ',') then
if (n_open_par == 1) then
pos_subtree_end = i - 1
call node_construct_subtree_rec (feyngraph_set, feyngraph, &
subtree_string(pos_subtree_begin:pos_subtree_end), &
mother_node%daughter1)
current_daughter = 2
pos_subtree_begin = i + 1
end if
else if (subtree_string(i:i) == '(') then
n_open_par = n_open_par + 1
else if (subtree_string(i:i) == ')') then
n_open_par = n_open_par - 1
end if
end do
end if
if (associated (mother_node%daughter1)) then
if (.not. mother_node%daughter1%keep) then
mother_node%keep = .false.
end if
end if
if (associated (mother_node%daughter2)) then
if (.not. mother_node%daughter2%keep) then
mother_node%keep = .false.
end if
end if
if (associated (mother_node%daughter1) .and. &
associated (mother_node%daughter2)) then
mother_node%n_subtree_nodes = &
mother_node%daughter1%n_subtree_nodes &
+ mother_node%daughter2%n_subtree_nodes + 1
end if
if (.not. mother_node%keep) then
feyngraph%keep = .false.
end if
end subroutine node_construct_subtree_rec
@ %def node_construct_subtree_rec
@ When the non-factorized version of the O'Mega output is used, the
[[feyngraph]] is reconstructed from the contents of its [[string_t]]
variable [[omega_feyngraph_output]]. This can be used for the recursive
reconstruction of the tree of [[k_nodes]] with
[[node_construct_subtree_rec]].
<<Cascades2: procedures>>=
subroutine feyngraph_construct (feyngraph_set, feyngraph)
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(feyngraph_t), pointer, intent(inout) :: feyngraph
call node_construct_subtree_rec (feyngraph_set, feyngraph, &
char(feyngraph%omega_feyngraph_output), feyngraph%root)
feyngraph%n_nodes = feyngraph%root%n_subtree_nodes
end subroutine feyngraph_construct
@ %def feyngraph_construct
@ We introduce another node type, which is called [[dag_node_t]] and
is used to reproduce the dag structure which is represented by the input.
The [[dag_nodes]] can have several combinations of daughters 1 and 2.
The [[dag]] type contains an array of [[dag_nodes]] and is only used
for the reconstruction of [[feyngraphs]] which are factorized as well, but
in the other direction as the original output. This means in particular
that the outgoing particles in the output file (which there can appear
many times) exist only once as [[f_nodes]]. To represent combinations of
daughters and alternatives (options), we further use the types
[[dag_options_t]] and [[dag_combination_t]]. The [[dag_nodes]],
[[dag_options]] and [[dag_combinations]] correspond to a substring of
the string which has been read from file (and transformed into an object
of type [[dag_string_t]], which is simply another compact representation
of this string), or a modified version of this substring. The aim is to
create only one object for a given substring, even if it appears several
times in the original string and then create trees of [[f_nodes]], which
build up the [[feyngraph]], such that as many [[f_nodes]] as possible can be reused.
An outgoing particle (always interpreting the input as a decay) is
called a [[leaf]] in the context of a [[dag]].
<<Cascades2: types>>=
type :: dag_node_t
integer :: string_len
type(dag_string_t) :: string
logical :: leaf = .false.
type(f_node_ptr_t), dimension (:), allocatable :: f_node
integer :: subtree_size = 0
contains
<<Cascades2: dag node: TBP>>
end type dag_node_t
@ %def dag_node_t
<<Cascades2: dag node: TBP>>=
procedure :: final => dag_node_final
<<Cascades2: sub interfaces>>=
module subroutine dag_node_final (dag_node)
class(dag_node_t), intent(inout) :: dag_node
end subroutine dag_node_final
<<Cascades2: procedures>>=
module subroutine dag_node_final (dag_node)
class(dag_node_t), intent(inout) :: dag_node
integer :: i
call dag_node%string%final ()
if (allocated (dag_node%f_node)) then
do i=1, size (dag_node%f_node)
if (associated (dag_node%f_node(i)%node)) then
call dag_node%f_node(i)%node%final ()
deallocate (dag_node%f_node(i)%node)
end if
end do
deallocate (dag_node%f_node)
end if
end subroutine dag_node_final
@ %def dag_node_final
@ Whenever there are more than one possible subtrees (represented by
a [[dag_node]]) or combinations of subtrees to daughters (represented
by [[dag_combination_t]]), we use the type [[dag_options_t]]. In the
syntax of the factorized output, options are listed within curly
braces, separated by horizontal bars.
<<Cascades2: types>>=
type :: dag_options_t
integer :: string_len
type(dag_string_t) :: string
type(f_node_ptr_t), dimension (:), allocatable :: f_node_ptr1
type(f_node_ptr_t), dimension (:), allocatable :: f_node_ptr2
contains
<<Cascades2: dag options: TBP>>
end type dag_options_t
@ %def dag_node_options_t
<<Cascades2: dag options: TBP>>=
procedure :: final => dag_options_final
<<Cascades2: sub interfaces>>=
module subroutine dag_options_final (dag_options)
class(dag_options_t), intent(inout) :: dag_options
end subroutine dag_options_final
<<Cascades2: procedures>>=
module subroutine dag_options_final (dag_options)
class(dag_options_t), intent(inout) :: dag_options
integer :: i
call dag_options%string%final ()
if (allocated (dag_options%f_node_ptr1)) then
do i=1, size (dag_options%f_node_ptr1)
dag_options%f_node_ptr1(i)%node => null ()
end do
deallocate (dag_options%f_node_ptr1)
end if
if (allocated (dag_options%f_node_ptr2)) then
do i=1, size (dag_options%f_node_ptr2)
dag_options%f_node_ptr2(i)%node => null ()
end do
deallocate (dag_options%f_node_ptr2)
end if
end subroutine dag_options_final
@ %def dag_options_final
@ A pair of two daughters (which can be [[dag_nodes]] or [[dag_options]])
is represented by the type [[dag_combination_t]]. In the original string,
a [[dag_combination]] appears between parentheses, which contain a comma,
but not a colon. If we find a colon between these parentheses, it is a
a [[dag_node]] instead.
<<Cascades2: types>>=
type :: dag_combination_t
integer :: string_len
type(dag_string_t) :: string
integer, dimension (2) :: combination
type(f_node_ptr_t), dimension (:), allocatable :: f_node_ptr1
type(f_node_ptr_t), dimension (:), allocatable :: f_node_ptr2
contains
<<Cascades2: dag combination: TBP>>
end type dag_combination_t
@ %def dag_combination_t
<<Cascades2: dag combination: TBP>>=
procedure :: final => dag_combination_final
<<Cascades2: sub interfaces>>=
module subroutine dag_combination_final (dag_combination)
class(dag_combination_t), intent(inout) :: dag_combination
end subroutine dag_combination_final
<<Cascades2: procedures>>=
module subroutine dag_combination_final (dag_combination)
class(dag_combination_t), intent(inout) :: dag_combination
integer :: i
call dag_combination%string%final ()
if (allocated (dag_combination%f_node_ptr1)) then
do i=1, size (dag_combination%f_node_ptr1)
dag_combination%f_node_ptr1(i)%node => null ()
end do
deallocate (dag_combination%f_node_ptr1)
end if
if (allocated (dag_combination%f_node_ptr2)) then
do i=1, size (dag_combination%f_node_ptr2)
dag_combination%f_node_ptr2(i)%node => null ()
end do
deallocate (dag_combination%f_node_ptr2)
end if
end subroutine dag_combination_final
@ %def dag_combination_final
@ Here is the type representing the DAG, i.e. it holds arrays of the
[[dag_nodes]], [[dag_options]] and [[dag_combinations]]. The root node
of the [[dag]] is the last filled element of the [[node]] array.
<<Cascades2: types>>=
type :: dag_t
type(dag_string_t) :: string
type(dag_node_t), dimension (:), allocatable :: node
type(dag_options_t), dimension (:), allocatable :: options
type(dag_combination_t), dimension (:), allocatable :: combination
integer :: n_nodes = 0
integer :: n_options = 0
integer :: n_combinations = 0
contains
<<Cascades2: dag: TBP>>
end type dag_t
@ %def dag_t
<<Cascades2: dag: TBP>>=
procedure :: final => dag_final
<<Cascades2: sub interfaces>>=
module subroutine dag_final (dag)
class(dag_t), intent(inout) :: dag
end subroutine dag_final
<<Cascades2: procedures>>=
module subroutine dag_final (dag)
class(dag_t), intent(inout) :: dag
integer :: i
call dag%string%final ()
if (allocated (dag%node)) then
do i=1, size (dag%node)
call dag%node(i)%final ()
end do
deallocate (dag%node)
end if
if (allocated (dag%options)) then
do i=1, size (dag%options)
call dag%options(i)%final ()
end do
deallocate (dag%options)
end if
if (allocated (dag%combination)) then
do i=1, size (dag%combination)
call dag%combination(i)%final ()
end do
deallocate (dag%combination)
end if
end subroutine dag_final
@ %def dag_final
@ We construct the DAG from the given [[dag_string]] which is modified
several times so that in the end the remaining string corresponds to a
simple [[dag_node]], the root of the factorized tree. This means that
we first identify the leaves, i.e. outgoing particles. Then we identify
[[dag_nodes]], [[dag_combinations]] and [[options]] until the number of
these objects does not change any more. Identifying means that we add
a corresponding object to the array (if not yet present), which can be
identified with the corresponding substring, and replace the substring
in the original [[dag_string]] by a [[dag_token]] of the corresponding
type (in the char output of this token, this corresponds to a place
holder like e.g. '<O23>' which in this particular case corresponds to
an option and can be found at the position 23 in the array). The
character output of the substrings turns out to be very useful for
debugging.
<<Cascades2: dag: TBP>>=
procedure :: construct => dag_construct
<<Cascades2: sub interfaces>>=
module subroutine dag_construct (dag, feyngraph_set)
class(dag_t), intent(inout) :: dag
type(feyngraph_set_t), intent(inout) :: feyngraph_set
end subroutine dag_construct
<<Cascades2: procedures>>=
module subroutine dag_construct (dag, feyngraph_set)
class(dag_t), intent(inout) :: dag
type(feyngraph_set_t), intent(inout) :: feyngraph_set
integer :: n_nodes
integer :: n_options
integer :: n_combinations
logical :: continue_loop
integer :: subtree_size
integer :: i,j
subtree_size = 1
call dag%get_nodes_and_combinations (leaves = .true.)
do i=1, dag%n_nodes
call dag%node(i)%make_f_nodes (feyngraph_set, dag)
end do
continue_loop = .true.
subtree_size = subtree_size + 2
do while (continue_loop)
n_nodes = dag%n_nodes
n_options = dag%n_options
n_combinations = dag%n_combinations
call dag%get_nodes_and_combinations (leaves = .false.)
if (n_nodes /= dag%n_nodes) then
dag%node(n_nodes+1:dag%n_nodes)%subtree_size = subtree_size
do i = n_nodes+1, dag%n_nodes
call dag%node(i)%make_f_nodes (feyngraph_set, dag)
end do
subtree_size = subtree_size + 2
end if
if (n_combinations /= dag%n_combinations) then
!$OMP PARALLEL DO
do i = n_combinations+1, dag%n_combinations
call dag%combination(i)%make_f_nodes (feyngraph_set, dag)
end do
!$OMP END PARALLEL DO
end if
call dag%get_options ()
if (n_options /= dag%n_options) then
!$OMP PARALLEL DO
do i = n_options+1, dag%n_options
call dag%options(i)%make_f_nodes (feyngraph_set, dag)
end do
!$OMP END PARALLEL DO
end if
if (n_nodes == dag%n_nodes .and. n_options == dag%n_options &
.and. n_combinations == dag%n_combinations) then
continue_loop = .false.
end if
end do
!!! add root node to dag
call dag%add_node (dag%string%t, leaf = .false.)
dag%node(dag%n_nodes)%subtree_size = subtree_size
call dag%node(dag%n_nodes)%make_f_nodes (feyngraph_set, dag)
if (debug2_active (D_PHASESPACE)) then
call dag%write (output_unit)
end if
!!! set indices for all f_nodes
do i=1, dag%n_nodes
if (allocated (dag%node(i)%f_node)) then
do j=1, size (dag%node(i)%f_node)
if (associated (dag%node(i)%f_node(j)%node)) &
call dag%node(i)%f_node(j)%node%set_index ()
end do
end if
end do
end subroutine dag_construct
@ %def dag_construct
@ Identify [[dag_nodes]] and [[dag_combinations]]. Leaves are simply
nodes (i.e. of type [[NODE_TK]]) where only one bit in the bincode is
set. The [[dag_nodes]] and [[dag_combinations]] have in common that they
are surrounded by parentheses. There is however a way to distinguish
between them because the corresponding substring contains a colon (or
[[dag_token]] with type [[COLON_TK]]) if it is a [[dag_node]]. Otherwise
it is a [[dag_combination]]. The string of the [[dag_node]] or
[[dag_combination]] should not contain curly braces, because these
correspond to [[dag_options]] and should be identified before.
<<Cascades2: dag: TBP>>=
procedure :: get_nodes_and_combinations => dag_get_nodes_and_combinations
<<Cascades2: sub interfaces>>=
module subroutine dag_get_nodes_and_combinations (dag, leaves)
class(dag_t), intent(inout) :: dag
logical, intent(in) :: leaves
end subroutine dag_get_nodes_and_combinations
<<Cascades2: procedures>>=
module subroutine dag_get_nodes_and_combinations (dag, leaves)
class(dag_t), intent(inout) :: dag
logical, intent(in) :: leaves
type(dag_string_t) :: new_string
integer :: i, j, k
integer :: i_node
integer :: new_size
integer :: first_colon
logical :: combination
!!! Create nodes also for external particles, except for the incoming one
!!! which appears as the root of the tree. These can easily be identified
!!! by their bincodes, since they should contain only one bit which is set.
if (leaves) then
first_colon = &
minloc (dag%string%t%type, 1, dag%string%t%type == COLON_TK)
do i = first_colon + 1, size (dag%string%t)
if (dag%string%t(i)%type == NODE_TK) then
if (popcnt(dag%string%t(i)%bincode) == 1) then
call dag%add_node (dag%string%t(i:i), .true., i_node)
call dag%string%t(i)%init_dag_object_token (DAG_NODE_TK, i_node)
end if
end if
end do
call dag%string%update_char_len ()
else
!!! Create a node or combination for every closed pair of parentheses
!!! which do not contain any other parentheses or curly braces.
!!! A node (not outgoing) contains a colon. This is not the case
!!! for combinations, which we use as the criteria to distinguish
!!! between both.
allocate (new_string%t (size (dag%string%t)))
i = 1
new_size = 0
do while (i <= size(dag%string%t))
if (dag%string%t(i)%type == OPEN_PAR_TK) then
combination = .true.
do j = i+1, size (dag%string%t)
select case (dag%string%t(j)%type)
case (CLOSED_PAR_TK)
new_size = new_size + 1
if (combination) then
call dag%add_combination (dag%string%t(i:j), i_node)
call new_string%t(new_size)%init_dag_object_token &
(DAG_COMBINATION_TK, i_node)
else
call dag%add_node (dag%string%t(i:j), leaves, i_node)
call new_string%t(new_size)%init_dag_object_token &
(DAG_NODE_TK, i_node)
end if
i = j + 1
exit
case (OPEN_PAR_TK, OPEN_CURLY_TK, CLOSED_CURLY_TK)
new_size = new_size + 1
new_string%t(new_size) = dag%string%t(i)
i = i + 1
exit
case (COLON_TK)
combination = .false.
end select
end do
else
new_size = new_size + 1
new_string%t(new_size) = dag%string%t(i)
i = i + 1
end if
end do
dag%string = new_string%t(:new_size)
call dag%string%update_char_len ()
end if
end subroutine dag_get_nodes_and_combinations
@ %def dag_get_nodes_and_combinations
@ Identify [[dag_options]], i.e. lists of rival nodes or combinations
of nodes. These are identified by the surrounding curly braces. They
should not contain any parentheses any more, because these correspond
either to nodes or to combinations and should be identified before.
<<Cascades2: dag: TBP>>=
procedure :: get_options => dag_get_options
<<Cascades2: sub interfaces>>=
module subroutine dag_get_options (dag)
class(dag_t), intent(inout) :: dag
end subroutine dag_get_options
<<Cascades2: procedures>>=
module subroutine dag_get_options (dag)
class(dag_t), intent(inout) :: dag
type(dag_string_t) :: new_string
integer :: i, j, k
integer :: new_size
integer :: i_options
character(len=10) :: index_char
integer :: index_start, index_end
!!! Create a node or combination for every closed pair of parentheses
!!! which do not contain any other parentheses or curly braces.
!!! A node (not outgoing) contains a colon. This is not the case
!!! for combinations, which we use as the criteria to distinguish
!!! between both.
allocate (new_string%t (size (dag%string%t)))
i = 1
new_size = 0
do while (i <= size(dag%string%t))
if (dag%string%t(i)%type == OPEN_CURLY_TK) then
do j = i+1, size (dag%string%t)
select case (dag%string%t(j)%type)
case (CLOSED_CURLY_TK)
new_size = new_size + 1
call dag%add_options (dag%string%t(i:j), i_options)
call new_string%t(new_size)%init_dag_object_token (DAG_OPTIONS_TK, i_options)
i = j + 1
exit
case (OPEN_PAR_TK, CLOSED_PAR_TK, OPEN_CURLY_TK)
new_size = new_size + 1
new_string%t(new_size) = dag%string%t(i)
i = i + 1
exit
end select
end do
else
new_size = new_size + 1
new_string%t(new_size) = dag%string%t(i)
i = i + 1
end if
end do
dag%string = new_string%t(:new_size)
call dag%string%update_char_len ()
end subroutine dag_get_options
@ %def dag_get_options
@ Add a [[dag_node]] to the list. The optional argument returns the index
of the node. The node might already exist. In this case we only return
the index.
<<Cascades2: dag: TBP>>=
procedure :: add_node => dag_add_node
<<Cascades2: parameters>>=
integer, parameter :: DAG_STACK_SIZE = 1000
<<Cascades2: sub interfaces>>=
module subroutine dag_add_node (dag, string, leaf, i_node)
class(dag_t), intent(inout) :: dag
type(dag_token_t), dimension (:), intent(in) :: string
logical, intent(in) :: leaf
integer, intent(out), optional :: i_node
end subroutine dag_add_node
<<Cascades2: procedures>>=
module subroutine dag_add_node (dag, string, leaf, i_node)
class(dag_t), intent(inout) :: dag
type(dag_token_t), dimension (:), intent(in) :: string
logical, intent(in) :: leaf
integer, intent(out), optional :: i_node
type(dag_node_t), dimension (:), allocatable :: tmp_node
integer :: string_len
integer :: i
string_len = sum (string%char_len)
if (.not. allocated (dag%node)) then
allocate (dag%node (DAG_STACK_SIZE))
else if (dag%n_nodes == size (dag%node)) then
allocate (tmp_node (dag%n_nodes))
tmp_node = dag%node
deallocate (dag%node)
allocate (dag%node (dag%n_nodes+DAG_STACK_SIZE))
dag%node(:dag%n_nodes) = tmp_node
deallocate (tmp_node)
end if
do i = 1, dag%n_nodes
if (dag%node(i)%string_len == string_len) then
if (size (dag%node(i)%string%t) == size (string)) then
if (all(dag%node(i)%string%t == string)) then
if (present (i_node)) i_node = i
return
end if
end if
end if
end do
dag%n_nodes = dag%n_nodes + 1
dag%node(dag%n_nodes)%string = string
dag%node(dag%n_nodes)%string_len = string_len
if (present (i_node)) i_node = dag%n_nodes
dag%node(dag%n_nodes)%leaf = leaf
end subroutine dag_add_node
@ %def dag_add_node
@ A similar subroutine for options.
<<Cascades2: dag: TBP>>=
procedure :: add_options => dag_add_options
<<Cascades2: sub interfaces>>=
module subroutine dag_add_options (dag, string, i_options)
class(dag_t), intent(inout) :: dag
type(dag_token_t), dimension (:), intent(in) :: string
integer, intent(out), optional :: i_options
end subroutine dag_add_options
<<Cascades2: procedures>>=
module subroutine dag_add_options (dag, string, i_options)
class(dag_t), intent(inout) :: dag
type(dag_token_t), dimension (:), intent(in) :: string
integer, intent(out), optional :: i_options
type(dag_options_t), dimension (:), allocatable :: tmp_options
integer :: string_len
integer :: i
string_len = sum (string%char_len)
if (.not. allocated (dag%options)) then
allocate (dag%options (DAG_STACK_SIZE))
else if (dag%n_options == size (dag%options)) then
allocate (tmp_options (dag%n_options))
tmp_options = dag%options
deallocate (dag%options)
allocate (dag%options (dag%n_options+DAG_STACK_SIZE))
dag%options(:dag%n_options) = tmp_options
deallocate (tmp_options)
end if
do i = 1, dag%n_options
if (dag%options(i)%string_len == string_len) then
if (size (dag%options(i)%string%t) == size (string)) then
if (all(dag%options(i)%string%t == string)) then
if (present (i_options)) i_options = i
return
end if
end if
end if
end do
dag%n_options = dag%n_options + 1
dag%options(dag%n_options)%string = string
dag%options(dag%n_options)%string_len = string_len
if (present (i_options)) i_options = dag%n_options
end subroutine dag_add_options
@ %def dag_add_options
@ A similar subroutine for combinations.
<<Cascades2: dag: TBP>>=
procedure :: add_combination => dag_add_combination
<<Cascades2: sub interfaces>>=
module subroutine dag_add_combination (dag, string, i_combination)
class(dag_t), intent(inout) :: dag
type(dag_token_t), dimension (:), intent(in) :: string
integer, intent(out), optional :: i_combination
end subroutine dag_add_combination
<<Cascades2: procedures>>=
module subroutine dag_add_combination (dag, string, i_combination)
class(dag_t), intent(inout) :: dag
type(dag_token_t), dimension (:), intent(in) :: string
integer, intent(out), optional :: i_combination
type(dag_combination_t), dimension (:), allocatable :: tmp_combination
integer :: string_len
integer :: i
string_len = sum (string%char_len)
if (.not. allocated (dag%combination)) then
allocate (dag%combination (DAG_STACK_SIZE))
else if (dag%n_combinations == size (dag%combination)) then
allocate (tmp_combination (dag%n_combinations))
tmp_combination = dag%combination
deallocate (dag%combination)
allocate (dag%combination (dag%n_combinations+DAG_STACK_SIZE))
dag%combination(:dag%n_combinations) = tmp_combination
deallocate (tmp_combination)
end if
do i = 1, dag%n_combinations
if (dag%combination(i)%string_len == string_len) then
if (size (dag%combination(i)%string%t) == size (string)) then
if (all(dag%combination(i)%string%t == string)) then
i_combination = i
return
end if
end if
end if
end do
dag%n_combinations = dag%n_combinations + 1
dag%combination(dag%n_combinations)%string = string
dag%combination(dag%n_combinations)%string_len = string_len
if (present (i_combination)) i_combination = dag%n_combinations
end subroutine dag_add_combination
@ %def dag_add_combination
@ For a given [[dag_node]] we want to create all [[f_nodes]]. If the node
is not a leaf, it contains in its string placeholders for options or
combinations. For these objects there are similar subroutines which are
needed here to obtain the sets of daughter nodes. If the [[dag_node]] is
a leaf, it corresponds to an external particle and the token contains the
particle name.
<<Cascades2: dag node: TBP>>=
procedure :: make_f_nodes => dag_node_make_f_nodes
<<Cascades2: sub interfaces>>=
module subroutine dag_node_make_f_nodes (dag_node, feyngraph_set, dag)
class(dag_node_t), intent(inout) :: dag_node
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(dag_t), intent(inout) :: dag
end subroutine dag_node_make_f_nodes
<<Cascades2: procedures>>=
module subroutine dag_node_make_f_nodes (dag_node, feyngraph_set, dag)
class(dag_node_t), intent(inout) :: dag_node
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(dag_t), intent(inout) :: dag
character(len=LABEL_LEN) :: particle_label
integer :: i, j
integer, dimension (2) :: obj
integer, dimension (2) :: i_obj
integer :: n_obj
integer :: pos
integer :: new_size, size1, size2
integer, dimension(:), allocatable :: match
if (allocated (dag_node%f_node)) return
pos = minloc (dag_node%string%t%type, 1,dag_node%string%t%type == NODE_TK)
particle_label = char (dag_node%string%t(pos))
if (dag_node%leaf) then
!!! construct subtree with procedure similar to the one for the old output
allocate (dag_node%f_node(1))
allocate (dag_node%f_node(1)%node)
dag_node%f_node(1)%node%particle_label = particle_label
call dag_node%f_node(1)%node%assign_particle_properties (feyngraph_set)
if (.not. dag_node%f_node(1)%node%keep) then
deallocate (dag_node%f_node)
return
end if
else
n_obj = 0
do i = 1, size (dag_node%string%t)
select case (dag_node%string%t(i)%type)
case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
n_obj = n_obj + 1
if (n_obj > 2) return
obj(n_obj) = dag_node%string%t(i)%type
i_obj(n_obj) = dag_node%string%t(i)%index
end select
end do
if (n_obj == 1) then
if (obj(1) == DAG_OPTIONS_TK) then
if (allocated (dag%options(i_obj(1))%f_node_ptr1)) then
size1 = size(dag%options(i_obj(1))%f_node_ptr1)
allocate (dag_node%f_node(size1))
do i=1, size1
allocate (dag_node%f_node(i)%node)
dag_node%f_node(i)%node%particle_label = particle_label
call dag_node%f_node(i)%node%assign_particle_properties (feyngraph_set)
dag_node%f_node(i)%node%daughter1 => dag%options(i_obj(1))%f_node_ptr1(i)%node
dag_node%f_node(i)%node%daughter2 => dag%options(i_obj(1))%f_node_ptr2(i)%node
dag_node%f_node(i)%node%n_subtree_nodes = &
dag%options(i_obj(1))%f_node_ptr1(i)%node%n_subtree_nodes &
+ dag%options(i_obj(1))%f_node_ptr2(i)%node%n_subtree_nodes + 1
end do
end if
else if (obj(1) == DAG_COMBINATION_TK) then
if (allocated (dag%combination(i_obj(1))%f_node_ptr1)) then
size1 = size(dag%combination(i_obj(1))%f_node_ptr1)
allocate (dag_node%f_node(size1))
do i=1, size1
allocate (dag_node%f_node(i)%node)
dag_node%f_node(i)%node%particle_label = particle_label
call dag_node%f_node(i)%node%assign_particle_properties (feyngraph_set)
dag_node%f_node(i)%node%daughter1 => dag%combination(i_obj(1))%f_node_ptr1(i)%node
dag_node%f_node(i)%node%daughter2 => dag%combination(i_obj(1))%f_node_ptr2(i)%node
dag_node%f_node(i)%node%n_subtree_nodes = &
dag%combination(i_obj(1))%f_node_ptr1(i)%node%n_subtree_nodes &
+ dag%combination(i_obj(1))%f_node_ptr2(i)%node%n_subtree_nodes + 1
end do
end if
end if
!!! simply set daughter pointers, daughters are already combined correctly
else if (n_obj == 2) then
size1 = 0
size2 = 0
if (obj(1) == DAG_NODE_TK) then
if (allocated (dag%node(i_obj(1))%f_node)) then
do i=1, size (dag%node(i_obj(1))%f_node)
if (dag%node(i_obj(1))%f_node(i)%node%keep) size1 = size1 + 1
end do
end if
else if (obj(1) == DAG_OPTIONS_TK) then
if (allocated (dag%options(i_obj(1))%f_node_ptr1)) then
do i=1, size (dag%options(i_obj(1))%f_node_ptr1)
if (dag%options(i_obj(1))%f_node_ptr1(i)%node%keep) size1 = size1 + 1
end do
end if
end if
if (obj(2) == DAG_NODE_TK) then
if (allocated (dag%node(i_obj(2))%f_node)) then
do i=1, size (dag%node(i_obj(2))%f_node)
if (dag%node(i_obj(2))%f_node(i)%node%keep) size2 = size2 + 1
end do
end if
else if (obj(2) == DAG_OPTIONS_TK) then
if (allocated (dag%options(i_obj(2))%f_node_ptr1)) then
do i=1, size (dag%options(i_obj(2))%f_node_ptr1)
if (dag%options(i_obj(2))%f_node_ptr1(i)%node%keep) size2 = size2 + 1
end do
end if
end if
!!! make all combinations of daughters
select case (obj(1))
case (DAG_NODE_TK)
select case (obj(2))
case (DAG_NODE_TK)
call combine_all_daughters(dag%node(i_obj(1))%f_node, &
dag%node(i_obj(2))%f_node)
case (DAG_OPTIONS_TK)
call combine_all_daughters(dag%node(i_obj(1))%f_node, &
dag%options(i_obj(2))%f_node_ptr1)
end select
case (DAG_OPTIONS_TK)
select case (obj(2))
case (DAG_NODE_TK)
call combine_all_daughters(dag%options(i_obj(1))%f_node_ptr1, &
dag%node(i_obj(2))%f_node)
case (DAG_OPTIONS_TK)
call combine_all_daughters(dag%options(i_obj(1))%f_node_ptr1, &
dag%options(i_obj(2))%f_node_ptr1)
end select
end select
end if
end if
contains
subroutine combine_all_daughters (daughter1_ptr, daughter2_ptr)
type(f_node_ptr_t), dimension (:), intent(in) :: daughter1_ptr
type(f_node_ptr_t), dimension (:), intent(in) :: daughter2_ptr
integer :: i, j
integer :: pos
new_size = size1*size2
allocate (dag_node%f_node(new_size))
pos = 0
do i = 1, size (daughter1_ptr)
if (daughter1_ptr(i)%node%keep) then
do j = 1, size (daughter2_ptr)
if (daughter2_ptr(j)%node%keep) then
pos = pos + 1
allocate (dag_node%f_node(pos)%node)
dag_node%f_node(pos)%node%particle_label = particle_label
call dag_node%f_node(pos)%node%assign_particle_properties (feyngraph_set)
dag_node%f_node(pos)%node%daughter1 => daughter1_ptr(i)%node
dag_node%f_node(pos)%node%daughter2 => daughter2_ptr(j)%node
dag_node%f_node(pos)%node%n_subtree_nodes = daughter1_ptr(i)%node%n_subtree_nodes &
+ daughter2_ptr(j)%node%n_subtree_nodes + 1
call feyngraph_set%model%match_vertex (daughter1_ptr(i)%node%particle%pdg, &
daughter2_ptr(j)%node%particle%pdg, match)
if (allocated (match)) then
if (any (abs(match) == abs(dag_node%f_node(pos)%node%particle%pdg))) then
dag_node%f_node(pos)%node%keep = .true.
else
dag_node%f_node(pos)%node%keep = .false.
end if
deallocate (match)
else
dag_node%f_node(pos)%node%keep = .false.
end if
end if
end do
end if
end do
end subroutine combine_all_daughters
end subroutine dag_node_make_f_nodes
@ %def dag_node_make_f_nodes
@ In [[dag_options_make_f_nodes_single]]
we obtain all [[f_nodes]] for [[dag_nodes]] which correspond to a
set of rival subtrees or nodes, which is the first possibility for
which [[dag_options]] can appear.
In [[dag_options_make_f_nodes_pair]]
the options are rival pairs ([[daughter1]], [[daughter2]]).
Therefore we have to pass two allocatable arrays of type [[f_node_ptr_t]]
to the subroutine.
<<Cascades2: dag options: TBP>>=
procedure :: make_f_nodes => dag_options_make_f_nodes
<<Cascades2: sub interfaces>>=
module subroutine dag_options_make_f_nodes (dag_options, &
feyngraph_set, dag)
class(dag_options_t), intent(inout) :: dag_options
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(dag_t), intent(inout) :: dag
end subroutine dag_options_make_f_nodes
<<Cascades2: procedures>>=
module subroutine dag_options_make_f_nodes (dag_options, &
feyngraph_set, dag)
class(dag_options_t), intent(inout) :: dag_options
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(dag_t), intent(inout) :: dag
integer, dimension (:), allocatable :: obj, i_obj
integer :: n_obj
integer :: i
integer :: pos
!!! read options
if (allocated (dag_options%f_node_ptr1)) return
n_obj = count ((dag_options%string%t%type == DAG_NODE_TK) .or. &
(dag_options%string%t%type == DAG_OPTIONS_TK) .or. &
(dag_options%string%t%type == DAG_COMBINATION_TK), 1)
allocate (obj(n_obj)); allocate (i_obj(n_obj))
pos = 0
do i = 1, size (dag_options%string%t)
select case (dag_options%string%t(i)%type)
case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
pos = pos + 1
obj(pos) = dag_options%string%t(i)%type
i_obj(pos) = dag_options%string%t(i)%index
end select
end do
if (any (dag_options%string%t%type == DAG_NODE_TK)) then
call dag_options_make_f_nodes_single
else if (any (dag_options%string%t%type == DAG_COMBINATION_TK)) then
call dag_options_make_f_nodes_pair
end if
deallocate (obj, i_obj)
contains
subroutine dag_options_make_f_nodes_single
integer :: i_start, i_end
integer :: n_nodes
n_nodes = 0
do i=1, n_obj
if (allocated (dag%node(i_obj(i))%f_node)) then
n_nodes = n_nodes + size (dag%node(i_obj(i))%f_node)
end if
end do
if (n_nodes /= 0) then
allocate (dag_options%f_node_ptr1 (n_nodes))
i_end = 0
do i = 1, n_obj
if (allocated (dag%node(i_obj(i))%f_node)) then
i_start = i_end + 1
i_end = i_end + size (dag%node(i_obj(i))%f_node)
dag_options%f_node_ptr1(i_start:i_end) = dag%node(i_obj(i))%f_node
end if
end do
end if
end subroutine dag_options_make_f_nodes_single
subroutine dag_options_make_f_nodes_pair
integer :: i_start, i_end
integer :: n_nodes
!!! get f_nodes from each combination
n_nodes = 0
do i=1, n_obj
if (allocated (dag%combination(i_obj(i))%f_node_ptr1)) then
n_nodes = n_nodes + size (dag%combination(i_obj(i))%f_node_ptr1)
end if
end do
if (n_nodes /= 0) then
allocate (dag_options%f_node_ptr1 (n_nodes))
allocate (dag_options%f_node_ptr2 (n_nodes))
i_end = 0
do i=1, n_obj
if (allocated (dag%combination(i_obj(i))%f_node_ptr1)) then
i_start = i_end + 1
i_end = i_end + size (dag%combination(i_obj(i))%f_node_ptr1)
dag_options%f_node_ptr1(i_start:i_end) = dag%combination(i_obj(i))%f_node_ptr1
dag_options%f_node_ptr2(i_start:i_end) = dag%combination(i_obj(i))%f_node_ptr2
end if
end do
end if
end subroutine dag_options_make_f_nodes_pair
end subroutine dag_options_make_f_nodes
@ %def dag_options_make_f_nodes
@ We create all combinations of daughter [[f_nodes]] for a combination.
In the combination each daughter can be either a single [[dag_node]] or
[[dag_options]] which are a set of single [[dag_nodes]]. Therefore, we
first create all possible [[f_nodes]] for daughter1, then all possible
[[f_nodes]] for daughter2. In the end we combine all [[daughter1]] nodes
with all [[daughter2]] nodes.
<<Cascades2: dag combination: TBP>>=
procedure :: make_f_nodes => dag_combination_make_f_nodes
<<Cascades2: sub interfaces>>=
module subroutine dag_combination_make_f_nodes (dag_combination, &
feyngraph_set, dag)
class(dag_combination_t), intent(inout) :: dag_combination
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(dag_t), intent(inout) :: dag
end subroutine dag_combination_make_f_nodes
<<Cascades2: procedures>>=
module subroutine dag_combination_make_f_nodes (dag_combination, &
feyngraph_set, dag)
class(dag_combination_t), intent(inout) :: dag_combination
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(dag_t), intent(inout) :: dag
integer, dimension (2) :: obj, i_obj
integer :: n_obj
integer :: new_size, size1, size2
integer :: i, j, pos
if (allocated (dag_combination%f_node_ptr1)) return
n_obj = 0
do i = 1, size (dag_combination%string%t)
select case (dag_combination%string%t(i)%type)
case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
n_obj = n_obj + 1
if (n_obj > 2) return
obj(n_obj) = dag_combination%string%t(i)%type
i_obj(n_obj) = dag_combination%string%t(i)%index
end select
end do
size1 = 0
size2 = 0
if (obj(1) == DAG_NODE_TK) then
if (allocated (dag%node(i_obj(1))%f_node)) &
size1 = size (dag%node(i_obj(1))%f_node)
else if (obj(1) == DAG_OPTIONS_TK) then
if (allocated (dag%options(i_obj(1))%f_node_ptr1)) &
size1 = size (dag%options(i_obj(1))%f_node_ptr1)
end if
if (obj(2) == DAG_NODE_TK) then
if (allocated (dag%node(i_obj(2))%f_node)) &
size2 = size (dag%node(i_obj(2))%f_node)
else if (obj(2) == DAG_OPTIONS_TK) then
if (allocated (dag%options(i_obj(2))%f_node_ptr1)) &
size2 = size (dag%options(i_obj(2))%f_node_ptr1)
end if
!!! combine the 2 arrays of f_nodes
new_size = size1*size2
if (new_size /= 0) then
allocate (dag_combination%f_node_ptr1 (new_size))
allocate (dag_combination%f_node_ptr2 (new_size))
pos = 0
select case (obj(1))
case (DAG_NODE_TK)
select case (obj(2))
case (DAG_NODE_TK)
do i = 1, size1
do j = 1, size2
pos = pos + 1
dag_combination%f_node_ptr1(pos) = &
dag%node(i_obj(1))%f_node(i)
dag_combination%f_node_ptr2(pos) = &
dag%node(i_obj(2))%f_node(j)
end do
end do
case (DAG_OPTIONS_TK)
do i = 1, size1
do j = 1, size2
pos = pos + 1
dag_combination%f_node_ptr1(pos) = &
dag%node(i_obj(1))%f_node(i)
dag_combination%f_node_ptr2(pos) = &
dag%options(i_obj(2))%f_node_ptr1(j)
end do
end do
end select
case (DAG_OPTIONS_TK)
select case (obj(2))
case (DAG_NODE_TK)
do i = 1, size1
do j = 1, size2
pos = pos + 1
dag_combination%f_node_ptr1(pos) = &
dag%options(i_obj(1))%f_node_ptr1(i)
dag_combination%f_node_ptr2(pos) = &
dag%node(i_obj(2))%f_node(j)
end do
end do
case (DAG_OPTIONS_TK)
do i = 1, size1
do j = 1, size2
pos = pos + 1
dag_combination%f_node_ptr1(pos) = &
dag%options(i_obj(1))%f_node_ptr1(i)
dag_combination%f_node_ptr2(pos) = &
dag%options(i_obj(2))%f_node_ptr1(j)
end do
end do
end select
end select
end if
end subroutine dag_combination_make_f_nodes
@ %def dag_combination_make_f_nodes
@ Here we create the [[feyngraphs]]. After the construction of the
[[dag]] the remaining [[dag_string]] should contain a token for a
single [[dag_node]] which corresponds to the roots of the
[[feyngraphs]]. Therefore we make all [[f_nodes]] for this [[dag_node]]
and create a [[feyngraph]] for each [[f_node]]. Note that only
3-vertices are accepted. All other vertices are rejected. The
starting point is the last dag node which has been added to the list,
since this corresponds to the root of the tree.
Is is important to understand that the structure of feyngraphs is not
the same as the structure of the dag which is read from file, because
for the calculations which are performed in this module we want to
reuse the nodes for the outgoing particles, which means that they
appear only once. In O'Mega's output, it is the first incoming particle
which appears only once and the outgoing particles appear many times. This
transition is incorporated in the subroutines which create [[f_nodes]]
from the different dag objects.
<<Cascades2: dag: TBP>>=
procedure :: make_feyngraphs => dag_make_feyngraphs
<<Cascades2: sub interfaces>>=
module subroutine dag_make_feyngraphs (dag, feyngraph_set)
class(dag_t), intent(inout) :: dag
type(feyngraph_set_t), intent(inout) :: feyngraph_set
end subroutine dag_make_feyngraphs
<<Cascades2: procedures>>=
module subroutine dag_make_feyngraphs (dag, feyngraph_set)
class(dag_t), intent(inout) :: dag
type(feyngraph_set_t), intent(inout) :: feyngraph_set
integer :: i
integer :: max_subtree_size
max_subtree_size = dag%node(dag%n_nodes)%subtree_size
if (allocated (dag%node(dag%n_nodes)%f_node)) then
do i = 1, size (dag%node(dag%n_nodes)%f_node)
if (.not. associated (feyngraph_set%first)) then
allocate (feyngraph_set%last)
feyngraph_set%first => feyngraph_set%last
else
allocate (feyngraph_set%last%next)
feyngraph_set%last => feyngraph_set%last%next
end if
feyngraph_set%last%root => dag%node(dag%n_nodes)%f_node(i)%node
!!! The first particle was correct in the O'Mega parsable DAG output.
!!! It was however changed to its anti-particle in
!!! f_node_assign_particle_properties, which we revert here.
feyngraph_set%last%root%particle => &
feyngraph_set%last%root%particle%anti
feyngraph_set%last%n_nodes = feyngraph_set%last%root%n_subtree_nodes
feyngraph_set%n_graphs = feyngraph_set%n_graphs + 1
end do
feyngraph_set%f_node_list%max_tree_size = feyngraph_set%first%n_nodes
end if
end subroutine dag_make_feyngraphs
@ %def dag_make_feyngraphs
@ A write procedure of the [[dag]] for debugging.
<<Cascades2: dag: TBP>>=
procedure :: write => dag_write
<<Cascades2: sub interfaces>>=
module subroutine dag_write (dag, u)
class(dag_t), intent(in) :: dag
integer, intent(in) :: u
end subroutine dag_write
<<Cascades2: procedures>>=
module subroutine dag_write (dag, u)
class(dag_t), intent(in) :: dag
integer, intent(in) :: u
integer :: i
write (u,fmt='(A)') 'nodes'
do i=1, dag%n_nodes
write (u,fmt='(I5,3X,A)') i, char (dag%node(i)%string)
end do
write (u,fmt='(A)') 'options'
do i=1, dag%n_options
write (u,fmt='(I5,3X,A)') i, char (dag%options(i)%string)
end do
write (u,fmt='(A)') 'combination'
do i=1, dag%n_combinations
write (u,fmt='(I5,3X,A)') i, char (dag%combination(i)%string)
end do
end subroutine dag_write
@ %def dag_write
@ Make a copy of a resonant [[k_node]], where the copy is kept
nonresonant.
<<Cascades2: procedures>>=
subroutine k_node_make_nonresonant_copy (k_node)
type(k_node_t), intent(in) :: k_node
type(k_node_t), pointer :: copy
call k_node%f_node%k_node_list%add_entry (copy, recycle=.true.)
copy%daughter1 => k_node%daughter1
copy%daughter2 => k_node%daughter2
copy = k_node
copy%mapping = NONRESONANT
copy%resonant = .false.
copy%on_shell = .false.
copy%mapping_assigned = .true.
copy%is_nonresonant_copy = .true.
end subroutine k_node_make_nonresonant_copy
@ %def k_node_make_nonresonant_copy
@ For a given [[feyngraph]] we create all possible [[kingraphs]]. Here
we use existing [[k_nodes]] which have already been created when the
mapping calculations of the pure s-channel subgraphs are performed. The
nodes for the incoming particles or the nodes on the t-line will have
to be created in all cases because they are not used in several graphs.
To obtain the existing [[k_nodes]], we use the subroutine
[[k_node_init_from_f_node]] which itself uses [[f_node_list_get_nodes]]
to obtain all active [[k_nodes]] in the [[k_node_list]] of the [[f_node]].
The created [[kingraphs]] are attached to the linked list
of the [[feyngraph]]. For scattering processes we have to split up the
t-line, because since all graphs are represented as a decay, different
nodes can share daughter nodes. This happens also for the t-line or
the incoming particle which appears as an outgoing particle. For the
[[t_line]] or [[incoming]] nodes we do not want to recycle nodes but
rather create a copy of this line for each [[kingraph]].
<<Cascades2: feyngraph: TBP>>=
procedure :: make_kingraphs => feyngraph_make_kingraphs
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_make_kingraphs (feyngraph, feyngraph_set)
class(feyngraph_t), intent(inout) :: feyngraph
type(feyngraph_set_t), intent(in) :: feyngraph_set
end subroutine feyngraph_make_kingraphs
<<Cascades2: procedures>>=
module subroutine feyngraph_make_kingraphs (feyngraph, feyngraph_set)
class(feyngraph_t), intent(inout) :: feyngraph
type(feyngraph_set_t), intent(in) :: feyngraph_set
type(k_node_ptr_t), dimension (:), allocatable :: kingraph_root
integer :: i
if (.not. associated (feyngraph%kin_first)) then
call k_node_init_from_f_node (feyngraph%root, &
kingraph_root, feyngraph_set)
if (.not. feyngraph%root%keep) return
if (feyngraph_set%process_type == SCATTERING) then
call split_up_t_lines (kingraph_root)
end if
do i=1, size (kingraph_root)
if (associated (feyngraph%kin_last)) then
allocate (feyngraph%kin_last%next)
feyngraph%kin_last => feyngraph%kin_last%next
else
allocate (feyngraph%kin_last)
feyngraph%kin_first => feyngraph%kin_last
end if
feyngraph%kin_last%root => kingraph_root(i)%node
feyngraph%kin_last%n_nodes = feyngraph%n_nodes
feyngraph%kin_last%keep = feyngraph%keep
if (feyngraph_set%process_type == SCATTERING) then
feyngraph%kin_last%root%bincode = &
f_node_get_external_bincode (feyngraph_set, feyngraph%root)
end if
end do
deallocate (kingraph_root)
end if
end subroutine feyngraph_make_kingraphs
@ %def feyngraph_make_kingraphs
@ Create all [[k_nodes]] for a given [[f_node]]. We return these nodes
using [[k_node_ptr]]. If the node is external, we assign also the bincode
to the [[k_nodes]] because this is determined from substrings of the
input file which belong to the [[feyngraphs]] and [[f_nodes]].
<<Cascades2: procedures>>=
recursive subroutine k_node_init_from_f_node (f_node, k_node_ptr, feyngraph_set)
type(f_node_t), target, intent(inout) :: f_node
type(k_node_ptr_t), allocatable, dimension (:), intent(out) :: k_node_ptr
type(feyngraph_set_t), intent(in) :: feyngraph_set
type(k_node_ptr_t), allocatable, dimension(:) :: daughter_ptr1, daughter_ptr2
integer :: n_nodes
integer :: i, j
integer :: pos
integer, save :: counter = 0
if (.not. (f_node%incoming .or. f_node%t_line)) then
call f_node%k_node_list%get_nodes (k_node_ptr)
if (.not. allocated (k_node_ptr) .and. f_node%k_node_list%n_entries > 0) then
f_node%keep = .false.
return
end if
end if
if (.not. allocated (k_node_ptr)) then
if (associated (f_node%daughter1) .and. associated (f_node%daughter2)) then
call k_node_init_from_f_node (f_node%daughter1, daughter_ptr1, &
feyngraph_set)
call k_node_init_from_f_node (f_node%daughter2, daughter_ptr2, &
feyngraph_set)
if (.not. (f_node%daughter1%keep .and. f_node%daughter2%keep)) then
f_node%keep = .false.
return
end if
n_nodes = size (daughter_ptr1) * size (daughter_ptr2)
allocate (k_node_ptr (n_nodes))
pos = 1
do i=1, size (daughter_ptr1)
do j=1, size (daughter_ptr2)
if (f_node%incoming .or. f_node%t_line) then
call f_node%k_node_list%add_entry (k_node_ptr(pos)%node, recycle = .false.)
else
call f_node%k_node_list%add_entry (k_node_ptr(pos)%node, recycle = .true.)
end if
k_node_ptr(pos)%node%f_node => f_node
k_node_ptr(pos)%node%daughter1 => daughter_ptr1(i)%node
k_node_ptr(pos)%node%daughter2 => daughter_ptr2(j)%node
k_node_ptr(pos)%node%f_node_index = f_node%index
k_node_ptr(pos)%node%incoming = f_node%incoming
k_node_ptr(pos)%node%t_line = f_node%t_line
k_node_ptr(pos)%node%particle => f_node%particle
pos = pos + 1
end do
end do
deallocate (daughter_ptr1, daughter_ptr2)
else
allocate (k_node_ptr(1))
if (f_node%incoming .or. f_node%t_line) then
call f_node%k_node_list%add_entry (k_node_ptr(1)%node, recycle=.false.)
else
call f_node%k_node_list%add_entry (k_node_ptr(1)%node, recycle=.true.)
end if
k_node_ptr(1)%node%f_node => f_node
k_node_ptr(1)%node%f_node_index = f_node%index
k_node_ptr(1)%node%incoming = f_node%incoming
k_node_ptr(1)%node%t_line = f_node%t_line
k_node_ptr(1)%node%particle => f_node%particle
k_node_ptr(1)%node%bincode = f_node_get_external_bincode (feyngraph_set, &
f_node)
end if
end if
end subroutine k_node_init_from_f_node
@ %def k_node_init_from_f_node
@ The graphs resulting from [[k_node_init_from_f_node]] are fine if they
are used only in one direction. This is however not the case when one
wants to invert the graphs, i.e. take the other incoming particle of a
scattering process as the decaying particle, because the outgoing
[[f_nodes]] (and hence also the [[k_nodes]]) exist only once. This
problem is solved here by creating a distinct t-line for each of the
graphs. The following subroutine disentangles the data structure by
creating new nodes such that the different t-lines are not connected
any more.
<<Cascades2: procedures>>=
recursive subroutine split_up_t_lines (t_node)
type(k_node_ptr_t), dimension(:), intent(inout) :: t_node
type(k_node_t), pointer :: ref_node => null ()
type(k_node_t), pointer :: ref_daughter => null ()
type(k_node_t), pointer :: new_daughter => null ()
type(k_node_ptr_t), dimension(:), allocatable :: t_daughter
integer :: ref_daughter_index
integer :: i, j
allocate (t_daughter (size (t_node)))
do i=1, size (t_node)
ref_node => t_node(i)%node
if (associated (ref_node%daughter1) .and. associated (ref_node%daughter2)) then
ref_daughter => null ()
if (ref_node%daughter1%incoming .or. ref_node%daughter1%t_line) then
ref_daughter => ref_node%daughter1
ref_daughter_index = 1
else if (ref_node%daughter2%incoming .or. ref_node%daughter2%t_line) then
ref_daughter => ref_node%daughter2
ref_daughter_index = 2
end if
do j=1, size (t_daughter)
if (.not. associated (t_daughter(j)%node)) then
t_daughter(j)%node => ref_daughter
exit
else if (t_daughter(j)%node%index == ref_daughter%index) then
new_daughter => null ()
call ref_daughter%f_node%k_node_list%add_entry (new_daughter, recycle=.false.)
new_daughter = ref_daughter
new_daughter%daughter1 => ref_daughter%daughter1
new_daughter%daughter2 => ref_daughter%daughter2
if (ref_daughter_index == 1) then
ref_node%daughter1 => new_daughter
else if (ref_daughter_index == 2) then
ref_node%daughter2 => new_daughter
end if
ref_daughter => new_daughter
end if
end do
else
return
end if
end do
call split_up_t_lines (t_daughter)
deallocate (t_daughter)
end subroutine split_up_t_lines
@ %def split_up_t_lines
@ This subroutine sets the [[inverse_daughters]] of a [[k_node]]. If we
invert a [[kingraph]] such that not the first but the second incoming
particle appears as the root of the tree, the [[incoming]] and [[t_line]]
particles obtain other daughters. These are the former mother node and
the sister node [[s_daughter]]. Here we set only the pointers for
the [[inverse_daughters]]. The inversion happens in [[kingraph_make_inverse_copy]]
and [[node_inverse_deep_copy]].
<<Cascades2: procedures>>=
subroutine kingraph_set_inverse_daughters (kingraph)
type(kingraph_t), intent(inout) :: kingraph
type(k_node_t), pointer :: mother
type(k_node_t), pointer :: t_daughter
type(k_node_t), pointer :: s_daughter
mother => kingraph%root
do while (associated (mother))
if (associated (mother%daughter1) .and. &
associated (mother%daughter2)) then
if (mother%daughter1%t_line .or. mother%daughter1%incoming) then
t_daughter => mother%daughter1; s_daughter => mother%daughter2
else if (mother%daughter2%t_line .or. mother%daughter2%incoming) then
t_daughter => mother%daughter2; s_daughter => mother%daughter1
else
exit
end if
t_daughter%inverse_daughter1 => mother
t_daughter%inverse_daughter2 => s_daughter
mother => t_daughter
else
exit
end if
end do
end subroutine kingraph_set_inverse_daughters
@ %def kingraph_set_inverse_daughters
@ Set the bincode of an [[f_node]] which corresponds to an external
particle. This is done on the basis of the [[particle_label]] which is a
substring of the input file. Here it is not the particle name which is
important, but the number(s) in brackets which in general indicate the
external particles which are connected to the current node. This function
is however only used for external particles, so there can either be
one or [[n_out + 1]] particles in the brackets (in the DAG input file
always one, because also for the root there is only a single number).
In all cases we check the number of particles (in the DAG input the
numbers are separated by a slash).
<<Cascades2: procedures>>=
function f_node_get_external_bincode (feyngraph_set, f_node) result (bincode)
type(feyngraph_set_t), intent(in) :: feyngraph_set
type(f_node_t), intent(in) :: f_node
integer (TC) :: bincode
character(len=LABEL_LEN) :: particle_label
integer :: start_pos, end_pos, n_out_decay
integer :: n_prt ! for DAG
integer :: i
bincode = 0
if (feyngraph_set%process_type == DECAY) then
n_out_decay = feyngraph_set%n_out
else
n_out_decay = feyngraph_set%n_out + 1
end if
particle_label = f_node%particle_label
start_pos = index (particle_label, '[') + 1
end_pos = index (particle_label, ']') - 1
particle_label = particle_label(start_pos:end_pos)
!!! n_out_decay is the number of outgoing particles in the
!!! O'Mega output, which is always represented as a decay
if (feyngraph_set%use_dag) then
n_prt = 1
do i=1, len(particle_label)
if (particle_label(i:i) == '/') n_prt = n_prt + 1
end do
else
n_prt = end_pos - start_pos + 1
end if
if (n_prt == 1) then
bincode = calculate_external_bincode (particle_label, &
feyngraph_set%process_type, n_out_decay)
else if (n_prt == n_out_decay) then
bincode = ibset (0, n_out_decay)
end if
end function f_node_get_external_bincode
@ %def f_node_get_external_bincode
@ Assign a bincode to an internal node, which is calculated from
the bincodes of [[daughter1]] and [[daughter2]].
<<Cascades2: procedures>>=
subroutine node_assign_bincode (node)
type(k_node_t), intent(inout) :: node
if (associated (node%daughter1) .and. associated (node%daughter2) &
.and. .not. node%incoming) then
node%bincode = ior(node%daughter1%bincode, node%daughter2%bincode)
end if
end subroutine node_assign_bincode
@ %def node_assign_bincode
@ Calculate the [[bincode]] from the number in the brackets of the
[[particle_label]], if the node is external. For the root in the
non-factorized output, this is calculated directly in
[[f_node_get_external_bincode]] because in this case all the other
external particle numbers appear between the brackets.
<<Cascades2: procedures>>=
function calculate_external_bincode (label_number_string, process_type, n_out_decay) result (bincode)
character(len=*), intent(in) :: label_number_string
integer, intent(in) :: process_type
integer, intent(in) :: n_out_decay
character :: number_char
integer :: number_int
integer (kind=TC) :: bincode
bincode = 0
read (label_number_string, fmt='(A)') number_char
!!! check if the character is a letter (A,B,C,...) or a number (1...9)
!!! numbers 1 and 2 are special cases
select case (number_char)
case ('1')
if (process_type == SCATTERING) then
number_int = n_out_decay + 3
else
number_int = n_out_decay + 2
end if
case ('2')
if (process_type == SCATTERING) then
number_int = n_out_decay + 2
else
number_int = 2
end if
case ('A')
number_int = 10
case ('B')
number_int = 11
case ('C')
number_int = 12
case ('D')
number_int = 13
case default
read (number_char, fmt='(I1)') number_int
end select
bincode = ibset (bincode, number_int - process_type - 1)
end function calculate_external_bincode
@ %def calculate_external_bincode
@
\subsection{Mapping calculations}
Once a [[k_node]] and its subtree nodes have been created, we can
perform the kinematical calculations and assign mappings, depending on
the particle properties and the results for the subtree nodes. This
could in principle be done recursively, calling the procedure first
for the daughter nodes and then perform the calculations for the actual
node. But for parallization and comparing the nodes, this will be done
simultaneously for all nodes with the same number of subtree nodes, and the number of
subtree nodes increases, starting from one, in steps of two. The
actual mapping calculations are done in complete analogy to cascades.
<<Cascades2: procedures>>=
subroutine node_assign_mapping_s (feyngraph, node, feyngraph_set)
type(feyngraph_t), intent(inout) :: feyngraph
type(k_node_t), intent(inout) :: node
type(feyngraph_set_t), intent(inout) :: feyngraph_set
real(default) :: eff_mass_sum
logical :: keep
if (.not. node%mapping_assigned) then
if (node%particle%mass > feyngraph_set%phs_par%m_threshold_s) then
node%effective_mass = node%particle%mass
end if
if (associated (node%daughter1) .and. associated (node%daughter2)) then
if (.not. (node%daughter1%keep .and. node%daughter2%keep)) then
node%keep = .false.; return
end if
node%ext_mass_sum = node%daughter1%ext_mass_sum &
+ node%daughter2%ext_mass_sum
keep = .false.
!!! Potentially resonant cases [sqrts = m_rea for on-shell decay]
if (node%particle%mass > node%ext_mass_sum &
.and. node%particle%mass <= feyngraph_set%phs_par%sqrts) then
if (node%particle%width /= 0) then
if (node%daughter1%on_shell .or. node%daughter2%on_shell) then
keep = .true.
node%mapping = S_CHANNEL
node%resonant = .true.
end if
else
call warn_decay (node%particle)
end if
!!! Collinear and IR singular cases
else if (node%particle%mass < feyngraph_set%phs_par%sqrts) then
!!! Massless splitting
if (node%daughter1%effective_mass == 0 &
.and. node%daughter2%effective_mass == 0 &
.and. .not. associated (node%daughter1%daughter1) &
.and. .not. associated (node%daughter1%daughter2) &
.and. .not. associated (node%daughter2%daughter1) &
.and. .not. associated (node%daughter2%daughter2)) then
keep = .true.
node%log_enhanced = .true.
if (node%particle%is_vector) then
if (node%daughter1%particle%is_vector &
.and. node%daughter2%particle%is_vector) then
node%mapping = COLLINEAR !!! three-vector-splitting
else
node%mapping = INFRARED !!! vector spliiting into matter
end if
else
if (node%daughter1%particle%is_vector &
.or. node%daughter2%particle%is_vector) then
node%mapping = COLLINEAR !!! vector radiation off matter
else
node%mapping = INFRARED !!! scalar radiation/splitting
end if
end if
!!! IR radiation off massive particle [cascades]
else if (node%effective_mass > 0 .and. &
node%daughter1%effective_mass > 0 .and. &
node%daughter2%effective_mass == 0 .and. &
(node%daughter1%on_shell .or. &
node%daughter1%mapping == RADIATION) .and. &
abs (node%effective_mass - &
node%daughter1%effective_mass) < feyngraph_set%phs_par%m_threshold_s) &
then
keep = .true.
node%log_enhanced = .true.
node%mapping = RADIATION
else if (node%effective_mass > 0 .and. &
node%daughter2%effective_mass > 0 .and. &
node%daughter1%effective_mass == 0 .and. &
(node%daughter2%on_shell .or. &
node%daughter2%mapping == RADIATION) .and. &
abs (node%effective_mass - &
node%daughter2%effective_mass) < feyngraph_set%phs_par%m_threshold_s) &
then
keep = .true.
node%log_enhanced = .true.
node%mapping = RADIATION
end if
end if
!!! Non-singular cases, including failed resonances [from cascades]
if (.not. keep) then
!!! Two on-shell particles from a virtual mother [from cascades, here eventually more than 2]
if (node%daughter1%on_shell .or. node%daughter2%on_shell) then
keep = .true.
eff_mass_sum = node%daughter1%effective_mass &
+ node%daughter2%effective_mass
node%effective_mass = max (node%ext_mass_sum, eff_mass_sum)
if (node%effective_mass < feyngraph_set%phs_par%m_threshold_s) then
node%effective_mass = 0
end if
end if
end if
!!! Complete and register feyngraph (make copy in case of resonance)
if (keep) then
node%on_shell = node%resonant .or. node%log_enhanced
if (node%resonant) then
if (feyngraph_set%phs_par%keep_nonresonant) then
call k_node_make_nonresonant_copy (node)
end if
node%ext_mass_sum = node%particle%mass
end if
end if
node%mapping_assigned = .true.
call node_assign_bincode (node)
call node%subtree%add_entry (node)
else !!! external (outgoing) particle
node%ext_mass_sum = node%particle%mass
node%mapping = EXTERNAL_PRT
node%multiplicity = 1
node%mapping_assigned = .true.
call node%subtree%add_entry (node)
node%on_shell = .true.
if (node%particle%mass >= feyngraph_set%phs_par%m_threshold_s) then
node%effective_mass = node%particle%mass
end if
end if
else if (node%is_nonresonant_copy) then
call node_assign_bincode (node)
call node%subtree%add_entry (node)
node%is_nonresonant_copy = .false.
end if
call node_count_specific_properties (node)
if (node%n_off_shell > feyngraph_set%phs_par%off_shell) then
node%keep = .false.
end if
contains
subroutine warn_decay (particle)
type(part_prop_t), intent(in) :: particle
integer :: i
integer, dimension(MAX_WARN_RESONANCE), save :: warned_code = 0
LOOP_WARNED: do i = 1, MAX_WARN_RESONANCE
if (warned_code(i) == 0) then
warned_code(i) = particle%pdg
write (msg_buffer, "(A)") &
& " Intermediate decay of zero-width particle " &
& // trim(particle%particle_label) &
& // " may be possible."
call msg_warning
exit LOOP_WARNED
else if (warned_code(i) == particle%pdg) then
exit LOOP_WARNED
end if
end do LOOP_WARNED
end subroutine warn_decay
end subroutine node_assign_mapping_s
@ %def node_assign_mapping_s
@ We determine the numbers [[n_resonances]], [[multiplicity]],
[[n_off_shell]] and [[n_log_enhanced]] for a given node.
<<Cascades2: procedures>>=
subroutine node_count_specific_properties (node)
type(k_node_t), intent(inout) :: node
if (associated (node%daughter1) .and. associated(node%daughter2)) then
if (node%resonant) then
node%multiplicity = 1
node%n_resonances &
= node%daughter1%n_resonances &
+ node%daughter2%n_resonances + 1
else
node%multiplicity &
= node%daughter1%multiplicity &
+ node%daughter2%multiplicity
node%n_resonances &
= node%daughter1%n_resonances &
+ node%daughter2%n_resonances
end if
if (node%log_enhanced) then
node%n_log_enhanced &
= node%daughter1%n_log_enhanced &
+ node%daughter2%n_log_enhanced + 1
else
node%n_log_enhanced &
= node%daughter1%n_log_enhanced &
+ node%daughter2%n_log_enhanced
end if
if (node%resonant) then
node%n_off_shell = 0
else if (node%log_enhanced) then
node%n_off_shell &
= node%daughter1%n_off_shell &
+ node%daughter2%n_off_shell
else
node%n_off_shell &
= node%daughter1%n_off_shell &
+ node%daughter2%n_off_shell + 1
end if
if (node%t_line) then
if (node%daughter1%t_line .or. node%daughter1%incoming) then
node%n_t_channel = node%daughter1%n_t_channel + 1
else if (node%daughter2%t_line .or. node%daughter2%incoming) then
node%n_t_channel = node%daughter2%n_t_channel + 1
end if
end if
end if
end subroutine node_count_specific_properties
@ %def node_count_specific_properties
@ The subroutine [[kingraph_assign_mappings_s]] completes kinematical
calculations for a decay process, considering the [[root]] node.
<<Cascades2: procedures>>=
subroutine kingraph_assign_mappings_s (feyngraph, kingraph, feyngraph_set)
type(feyngraph_t), intent(inout) :: feyngraph
type(kingraph_t), pointer, intent(inout) :: kingraph
type(feyngraph_set_t), intent(inout) :: feyngraph_set
if (.not. (kingraph%root%daughter1%keep .and. kingraph%root%daughter2%keep)) then
kingraph%keep = .false.
call kingraph%tree%final ()
end if
if (kingraph%keep) then
kingraph%root%on_shell = .true.
kingraph%root%mapping = EXTERNAL_PRT
kingraph%root%mapping_assigned = .true.
call node_assign_bincode (kingraph%root)
kingraph%root%ext_mass_sum = &
kingraph%root%daughter1%ext_mass_sum + &
kingraph%root%daughter2%ext_mass_sum
if (kingraph%root%ext_mass_sum >= feyngraph_set%phs_par%sqrts) then
kingraph%root%keep = .false.
kingraph%keep = .false.; call kingraph%tree%final (); return
end if
call kingraph%root%subtree%add_entry (kingraph%root)
kingraph%root%multiplicity &
= kingraph%root%daughter1%multiplicity &
+ kingraph%root%daughter2%multiplicity
kingraph%root%n_resonances &
= kingraph%root%daughter1%n_resonances &
+ kingraph%root%daughter2%n_resonances
kingraph%root%n_off_shell &
= kingraph%root%daughter1%n_off_shell &
+ kingraph%root%daughter2%n_off_shell
kingraph%root%n_log_enhanced &
= kingraph%root%daughter1%n_log_enhanced &
+ kingraph%root%daughter2%n_log_enhanced
if (kingraph%root%n_off_shell > feyngraph_set%phs_par%off_shell) then
kingraph%root%keep = .false.
kingraph%keep = .false.; call kingraph%tree%final (); return
else
kingraph%grove_prop%multiplicity = &
kingraph%root%multiplicity
kingraph%grove_prop%n_resonances = &
kingraph%root%n_resonances
kingraph%grove_prop%n_off_shell = &
kingraph%root%n_off_shell
kingraph%grove_prop%n_log_enhanced = &
kingraph%root%n_log_enhanced
end if
kingraph%tree = kingraph%root%subtree
end if
end subroutine kingraph_assign_mappings_s
@ %def kingraph_assign_mappings_s
@ Compute mappings for the [[t_line]] and [[incoming]] nodes. This is
done recursively using [[node_compute_t_line]].
<<Cascades2: procedures>>=
subroutine kingraph_compute_mappings_t_line (feyngraph, kingraph, feyngraph_set)
type(feyngraph_t), intent(inout) :: feyngraph
type(kingraph_t), pointer, intent(inout) :: kingraph
type(feyngraph_set_t), intent(inout) :: feyngraph_set
call node_compute_t_line (feyngraph, kingraph, kingraph%root, feyngraph_set)
if (.not. kingraph%root%keep) then
kingraph%keep = .false.
call kingraph%tree%final ()
end if
if (kingraph%keep) kingraph%tree = kingraph%root%subtree
end subroutine kingraph_compute_mappings_t_line
@ %def kingraph_compute_mappings_t_line
@ Perform the kinematical calculations and mapping assignment for a node
which is either [[incoming]] or [[t_line]]. This is done recursively,
going first to the daughter node which has this property. Therefore we
first set the pointer [[t_node]] to this daughter node and [[s_node]] to
the other one. The mapping determination happens again in the same way as
in [[cascades]].
<<Cascades2: procedures>>=
recursive subroutine node_compute_t_line (feyngraph, kingraph, node, feyngraph_set)
type(feyngraph_t), intent(inout) :: feyngraph
type(kingraph_t), intent(inout) :: kingraph
type(k_node_t), intent(inout) :: node
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(k_node_t), pointer :: s_node
type(k_node_t), pointer :: t_node
type(k_node_t), pointer :: new_s_node
if (.not. (node%daughter1%keep .and. node%daughter2%keep)) then
node%keep = .false.
return
end if
s_node => null ()
t_node => null ()
new_s_node => null ()
if (associated (node%daughter1) .and. associated (node%daughter2)) then
if (node%daughter1%t_line .or. node%daughter1%incoming) then
t_node => node%daughter1; s_node => node%daughter2
else if (node%daughter2%t_line .or. node%daughter2%incoming) then
t_node => node%daughter2; s_node => node%daughter1
end if
if (t_node%t_line) then
call node_compute_t_line (feyngraph, kingraph, t_node, feyngraph_set)
if (.not. t_node%keep) then
node%keep = .false.
return
end if
else if (t_node%incoming) then
t_node%mapping = EXTERNAL_PRT
t_node%on_shell = .true.
t_node%ext_mass_sum = t_node%particle%mass
if (t_node%particle%mass >= feyngraph_set%phs_par%m_threshold_t) then
t_node%effective_mass = t_node%particle%mass
end if
call t_node%subtree%add_entry (t_node)
end if
!!! root:
if (.not. node%incoming) then
if (t_node%incoming) then
node%ext_mass_sum = s_node%ext_mass_sum
else
node%ext_mass_sum &
= node%daughter1%ext_mass_sum &
+ node%daughter2%ext_mass_sum
end if
if (node%particle%mass > feyngraph_set%phs_par%m_threshold_t) then
node%effective_mass = max (node%particle%mass, &
s_node%effective_mass)
else if (s_node%effective_mass > feyngraph_set%phs_par%m_threshold_t) then
node%effective_mass = s_node%effective_mass
else
node%effective_mass = 0
end if
!!! Allowed decay of beam particle
if (t_node%incoming &
.and. t_node%particle%mass > s_node%particle%mass &
+ node%particle%mass) then
call beam_decay (feyngraph_set%fatal_beam_decay)
!!! Massless splitting
else if (t_node%effective_mass == 0 &
.and. s_node%effective_mass < feyngraph_set%phs_par%m_threshold_t &
.and. node%effective_mass == 0) then
node%mapping = U_CHANNEL
node%log_enhanced = .true.
!!! IR radiation off massive particle
else if (t_node%effective_mass /= 0 &
.and. s_node%effective_mass == 0 &
.and. node%effective_mass /= 0 &
.and. (t_node%on_shell &
.or. t_node%mapping == RADIATION) &
.and. abs (t_node%effective_mass - node%effective_mass) &
< feyngraph_set%phs_par%m_threshold_t) then
node%log_enhanced = .true.
node%mapping = RADIATION
end if
node%mapping_assigned = .true.
call node_assign_bincode (node)
call node%subtree%add_entry (node)
call node_count_specific_properties (node)
if (node%n_off_shell > feyngraph_set%phs_par%off_shell) then
node%keep = .false.
kingraph%keep = .false.; call kingraph%tree%final (); return
else if (node%n_t_channel > feyngraph_set%phs_par%t_channel) then
node%keep = .false.;
kingraph%keep = .false.; call kingraph%tree%final (); return
end if
else
node%mapping = EXTERNAL_PRT
node%on_shell = .true.
node%ext_mass_sum &
= t_node%ext_mass_sum &
+ s_node%ext_mass_sum
node%effective_mass = node%particle%mass
if (.not. (node%ext_mass_sum < feyngraph_set%phs_par%sqrts)) then
node%keep = .false.
kingraph%keep = .false.; call kingraph%tree%final (); return
end if
if (kingraph%keep) then
if (t_node%incoming .and. s_node%log_enhanced) then
call s_node%f_node%k_node_list%add_entry (new_s_node, recycle=.false.)
new_s_node = s_node
new_s_node%daughter1 => s_node%daughter1
new_s_node%daughter2 => s_node%daughter2
if (s_node%index == node%daughter1%index) then
node%daughter1 => new_s_node
else if (s_node%index == node%daughter2%index) then
node%daughter2 => new_s_node
end if
new_s_node%subtree = s_node%subtree
new_s_node%mapping = NO_MAPPING
new_s_node%log_enhanced = .false.
new_s_node%n_log_enhanced &
= new_s_node%n_log_enhanced - 1
new_s_node%log_enhanced = .false.
where (new_s_node%subtree%bc == new_s_node%bincode)
new_s_node%subtree%mapping = NO_MAPPING
endwhere
else if ((t_node%t_line .or. t_node%incoming) .and. &
t_node%mapping == U_CHANNEL) then
t_node%mapping = T_CHANNEL
where (t_node%subtree%bc == t_node%bincode)
t_node%subtree%mapping = T_CHANNEL
endwhere
else if (t_node%incoming .and. &
.not. associated (s_node%daughter1) .and. &
.not. associated (s_node%daughter2)) then
call s_node%f_node%k_node_list%add_entry (new_s_node, recycle=.false.)
new_s_node = s_node
new_s_node%mapping = ON_SHELL
new_s_node%daughter1 => s_node%daughter1
new_s_node%daughter2 => s_node%daughter2
new_s_node%subtree = s_node%subtree
if (s_node%index == node%daughter1%index) then
node%daughter1 => new_s_node
else if (s_node%index == node%daughter2%index) then
node%daughter2 => new_s_node
end if
where (new_s_node%subtree%bc == new_s_node%bincode)
new_s_node%subtree%mapping = ON_SHELL
endwhere
end if
end if
call node%subtree%add_entry (node)
node%multiplicity &
= node%daughter1%multiplicity &
+ node%daughter2%multiplicity
node%n_resonances &
= node%daughter1%n_resonances &
+ node%daughter2%n_resonances
node%n_off_shell &
= node%daughter1%n_off_shell &
+ node%daughter2%n_off_shell
node%n_log_enhanced &
= node%daughter1%n_log_enhanced &
+ node%daughter2%n_log_enhanced
node%n_t_channel &
= node%daughter1%n_t_channel &
+ node%daughter2%n_t_channel
if (node%n_off_shell > feyngraph_set%phs_par%off_shell) then
node%keep = .false.
kingraph%keep = .false.; call kingraph%tree%final (); return
else if (node%n_t_channel > feyngraph_set%phs_par%t_channel) then
node%keep = .false.
kingraph%keep = .false.; call kingraph%tree%final (); return
else
kingraph%grove_prop%multiplicity = node%multiplicity
kingraph%grove_prop%n_resonances = node%n_resonances
kingraph%grove_prop%n_off_shell = node%n_off_shell
kingraph%grove_prop%n_log_enhanced = node%n_log_enhanced
kingraph%grove_prop%n_t_channel = node%n_t_channel
end if
end if
end if
contains
subroutine beam_decay (fatal_beam_decay)
logical, intent(in) :: fatal_beam_decay
write (msg_buffer, "(1x,A,1x,'->',1x,A,1x,A)") &
t_node%particle%particle_label, &
node%particle%particle_label, &
s_node%particle%particle_label
call msg_message
write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
t_node%particle%particle_label, t_node%particle%mass
call msg_message
write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
node%particle%particle_label, node%particle%mass
call msg_message
write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
s_node%particle%particle_label, s_node%particle%mass
call msg_message
if (fatal_beam_decay) then
call msg_fatal (" Phase space: Initial beam particle can decay")
else
call msg_warning (" Phase space: Initial beam particle can decay")
end if
end subroutine beam_decay
end subroutine node_compute_t_line
@ %def node_compute_t_line
@ After all pure s-channel subdiagrams have already been created from the
corresponding [[f_nodes]] and mappings have been determined for their
nodes, we complete the calculations here. In a first step, the
[[kingraphs]] have to be created on the basis of the existing
[[k_nodes]], which means in particular that a [[feyngraph]] can give
rise to several [[kingraphs]] which will all be attached to the linked
list of the [[feyngraph]]. The calculations which remain are of different
kinds for decay and scattering processes. In a decay process the
kinematical calculations have to be done for the [[root]] node. In a
scattering process, after the creation of [[kingraphs]] in the first
step, there will be only [[kingraphs]] with the first incoming particle
as the [[root]] of the tree. For these graphs the [[inverse]] variable
has the value [[.false.]]. Before performing any calculations on these
graphs we make a so-called inverse copy of the graph (see below), which
will also be attached to the linked list. Since the s-channel subgraph
calculations have already been completed, only the t-line computations
remain.
<<Cascades2: feyngraph: TBP>>=
procedure :: make_inverse_kingraphs => feyngraph_make_inverse_kingraphs
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_make_inverse_kingraphs (feyngraph)
class(feyngraph_t), intent(inout) :: feyngraph
end subroutine feyngraph_make_inverse_kingraphs
<<Cascades2: procedures>>=
module subroutine feyngraph_make_inverse_kingraphs (feyngraph)
class(feyngraph_t), intent(inout) :: feyngraph
type(kingraph_t), pointer :: current
current => feyngraph%kin_first
do while (associated (current))
if (current%inverse) exit
call current%make_inverse_copy (feyngraph)
current => current%next
end do
end subroutine feyngraph_make_inverse_kingraphs
@ %def feyngraph_make_inverse_kingraphs
<<Cascades2: feyngraph: TBP>>=
procedure :: compute_mappings => feyngraph_compute_mappings
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_compute_mappings (feyngraph, feyngraph_set)
class(feyngraph_t), intent(inout) :: feyngraph
type(feyngraph_set_t), intent(inout) :: feyngraph_set
end subroutine feyngraph_compute_mappings
<<Cascades2: procedures>>=
module subroutine feyngraph_compute_mappings (feyngraph, feyngraph_set)
class(feyngraph_t), intent(inout) :: feyngraph
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(kingraph_t), pointer :: current
current => feyngraph%kin_first
do while (associated (current))
if (feyngraph_set%process_type == DECAY) then
call kingraph_assign_mappings_s (feyngraph, current, feyngraph_set)
else if (feyngraph_set%process_type == SCATTERING) then
call kingraph_compute_mappings_t_line &
(feyngraph, current, feyngraph_set)
end if
current => current%next
end do
end subroutine feyngraph_compute_mappings
@ %def feyngraph_compute_mappings
@ Here we control the mapping calculations for the nodes of s-channel
subgraphs. We start with the nodes with the smallest number of subtree
nodes and always increase this number by two because nodes have exactly
zero or two daughter nodes. We create the [[k_nodes]] using the
[[k_node_list]] of each [[f_node]]. The number of nodes which have to
be created depends of the number of existing daughter nodes, which means
that we have to create a node for each combination of existing and
valid (the ones which we [[keep]]) daughter nodes. If the node
corresponds to an external particle, we create only one node, since
there are no daughter nodes. If the particle is not external and
the daughter [[f_nodes]] do not contain any valid [[k_nodes]], we do
not create a new [[k_nodes]] either. When the calculations for all nodes
with the same number of subtree nodes have been completed, we compare
the valid nodes to eliminate equivalences (see below).
<<Cascades2: procedures>>=
subroutine f_node_list_compute_mappings_s (feyngraph_set)
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(f_node_ptr_t), dimension(:), allocatable :: set
type(k_node_ptr_t), dimension(:), allocatable :: k_set
type(k_node_entry_t), pointer :: k_entry
type(f_node_entry_t), pointer :: current
type(k_node_list_t), allocatable :: compare_list
integer :: n_entries
integer :: pos
integer :: i, j, k
do i = 1, feyngraph_set%f_node_list%max_tree_size - 2, 2
!!! Counter number of f_nodes with subtree size i for s channel calculations
n_entries = 0
if (feyngraph_set%use_dag) then
do j=1, feyngraph_set%dag%n_nodes
if (allocated (feyngraph_set%dag%node(j)%f_node)) then
do k=1, size(feyngraph_set%dag%node(j)%f_node)
if (associated (feyngraph_set%dag%node(j)%f_node(k)%node)) then
if (.not. (feyngraph_set%dag%node(j)%f_node(k)%node%incoming &
.or. feyngraph_set%dag%node(j)%f_node(k)%node%t_line) &
.and. feyngraph_set%dag%node(j)%f_node(k)%node%n_subtree_nodes == i) then
n_entries = n_entries + 1
end if
end if
end do
end if
end do
else
current => feyngraph_set%f_node_list%first
do while (associated (current))
if (.not. (current%node%incoming .or. current%node%t_line) &
.and. current%node%n_subtree_nodes == i) then
n_entries = n_entries + 1
end if
current => current%next
end do
end if
if (n_entries == 0) exit
!!! Create a temporary k node list for comparison
allocate (set(n_entries))
pos = 0
if (feyngraph_set%use_dag) then
do j=1, feyngraph_set%dag%n_nodes
if (allocated (feyngraph_set%dag%node(j)%f_node)) then
do k=1, size(feyngraph_set%dag%node(j)%f_node)
if (associated (feyngraph_set%dag%node(j)%f_node(k)%node)) then
if (.not. (feyngraph_set%dag%node(j)%f_node(k)%node%incoming &
.or. feyngraph_set%dag%node(j)%f_node(k)%node%t_line) &
.and. feyngraph_set%dag%node(j)%f_node(k)%node%n_subtree_nodes == i) then
pos = pos + 1
set(pos)%node => feyngraph_set%dag%node(j)%f_node(k)%node
end if
end if
end do
end if
end do
else
current => feyngraph_set%f_node_list%first
do while (associated (current))
if (.not. (current%node%incoming .or. current%node%t_line) &
.and. current%node%n_subtree_nodes == i) then
pos = pos + 1
set(pos)%node => current%node
end if
current => current%next
end do
end if
allocate (compare_list)
compare_list%observer = .true.
do j = 1, n_entries
call k_node_init_from_f_node (set(j)%node, k_set, &
feyngraph_set)
if (allocated (k_set)) deallocate (k_set)
end do
!$OMP PARALLEL DO PRIVATE (k_entry)
do j = 1, n_entries
k_entry => set(j)%node%k_node_list%first
do while (associated (k_entry))
call node_assign_mapping_s(feyngraph_set%first, k_entry%node, feyngraph_set)
k_entry => k_entry%next
end do
end do
!$OMP END PARALLEL DO
do j = 1, size (set)
k_entry => set(j)%node%k_node_list%first
do while (associated (k_entry))
if (k_entry%node%keep) then
if (k_entry%node%mapping == NO_MAPPING .or. k_entry%node%mapping == NONRESONANT) then
call compare_list%add_pointer (k_entry%node)
end if
end if
k_entry => k_entry%next
end do
end do
deallocate (set)
call compare_list%check_subtree_equivalences(feyngraph_set%model)
call compare_list%final
deallocate (compare_list)
end do
end subroutine f_node_list_compute_mappings_s
@ %def f_node_list_compute_mappings_s
@
\subsection{Fill the grove list}
Find the [[grove]] within the [[grove_list]] for a [[kingraph]] for
which the kinematical calculations and mapping assignments have been completed. The [[groves]]
are defined by the [[grove_prop]] entries and the value of the resonance
hash ([[res_hash]]). Whenever a matching grove does not exist, we
create one. In a first step we consider only part of the grove properties
(see [[grove_prop_match]]) and the resonance hash is ignored, which leads
to a preliminary grove list. In the end all numbers in [[grove_prop]] as
well as the resonance hash are compared, i.e. we create a new
[[grove_list]].
<<Cascades2: grove list: TBP>>=
procedure :: get_grove => grove_list_get_grove
<<Cascades2: sub interfaces>>=
module subroutine grove_list_get_grove (grove_list, kingraph, &
return_grove, preliminary)
class(grove_list_t), intent(inout) :: grove_list
type(kingraph_t), intent(in), pointer :: kingraph
type(grove_t), intent(inout), pointer :: return_grove
logical, intent(in) :: preliminary
end subroutine grove_list_get_grove
<<Cascades2: procedures>>=
module subroutine grove_list_get_grove (grove_list, kingraph, &
return_grove, preliminary)
class(grove_list_t), intent(inout) :: grove_list
type(kingraph_t), intent(in), pointer :: kingraph
type(grove_t), intent(inout), pointer :: return_grove
logical, intent(in) :: preliminary
type(grove_t), pointer :: current_grove
return_grove => null ()
if (.not. associated(grove_list%first)) then
allocate (grove_list%first)
grove_list%first%grove_prop = kingraph%grove_prop
return_grove => grove_list%first
return
end if
current_grove => grove_list%first
do while (associated (current_grove))
if ((preliminary .and. &
(current_grove%grove_prop .match. kingraph%grove_prop)) .or. &
(.not. preliminary .and. &
current_grove%grove_prop == kingraph%grove_prop)) then
return_grove => current_grove
exit
else if (.not. associated (current_grove%next)) then
allocate (current_grove%next)
current_grove%next%grove_prop = kingraph%grove_prop
if (size (kingraph%tree%bc) < 9) &
current_grove%compare_tree%depth = 1
return_grove => current_grove%next
exit
end if
if (associated (current_grove%next)) then
current_grove => current_grove%next
end if
end do
end subroutine grove_list_get_grove
@ %def grove_list_get_grove
@ Add a valid [[kingraph]] to a [[grove_list]]. We first look for the
[[grove]] which has the grove properties of the [[kingraph]]. If no such
[[grove]] exists so far, it is created.
<<Cascades2: grove list: TBP>>=
procedure :: add_kingraph => grove_list_add_kingraph
<<Cascades2: sub interfaces>>=
module subroutine grove_list_add_kingraph (grove_list, kingraph, &
preliminary, check, model)
class(grove_list_t), intent(inout) :: grove_list
type(kingraph_t), pointer, intent(inout) :: kingraph
logical, intent(in) :: preliminary
logical, intent(in) :: check
type(model_data_t), optional, intent(in) :: model
end subroutine grove_list_add_kingraph
<<Cascades2: procedures>>=
module subroutine grove_list_add_kingraph (grove_list, kingraph, &
preliminary, check, model)
class(grove_list_t), intent(inout) :: grove_list
type(kingraph_t), pointer, intent(inout) :: kingraph
logical, intent(in) :: preliminary
logical, intent(in) :: check
type(model_data_t), optional, intent(in) :: model
type(grove_t), pointer :: grove
type(kingraph_t), pointer :: current
integer, save :: index = 0
grove => null ()
current => null ()
if (preliminary) then
if (kingraph%index == 0) then
index = index + 1
kingraph%index = index
end if
end if
call grove_list%get_grove (kingraph, grove, preliminary)
if (check) then
call grove%compare_tree%check_kingraph (kingraph, model, preliminary)
end if
if (kingraph%keep) then
if (associated (grove%first)) then
grove%last%grove_next => kingraph
grove%last => kingraph
else
grove%first => kingraph
grove%last => kingraph
end if
end if
end subroutine grove_list_add_kingraph
@ %ref grove_list_add_kingraph
@ For a given [[feyngraph]] we store all valid [[kingraphs]] in the
[[grove_list]].
<<Cascades2: grove list: TBP>>=
procedure :: add_feyngraph => grove_list_add_feyngraph
<<Cascades2: sub interfaces>>=
module subroutine grove_list_add_feyngraph (grove_list, feyngraph, model)
class(grove_list_t), intent(inout) :: grove_list
type(feyngraph_t), intent(inout) :: feyngraph
type(model_data_t), intent(in) :: model
end subroutine grove_list_add_feyngraph
<<Cascades2: procedures>>=
module subroutine grove_list_add_feyngraph (grove_list, feyngraph, model)
class(grove_list_t), intent(inout) :: grove_list
type(feyngraph_t), intent(inout) :: feyngraph
type(model_data_t), intent(in) :: model
type(kingraph_t), pointer :: current_kingraph, add_kingraph
do while (associated (feyngraph%kin_first))
if (feyngraph%kin_first%keep) then
add_kingraph => feyngraph%kin_first
feyngraph%kin_first => feyngraph%kin_first%next
add_kingraph%next => null ()
call grove_list%add_kingraph (kingraph=add_kingraph, &
preliminary=.true., check=.true., model=model)
else
exit
end if
end do
if (associated (feyngraph%kin_first)) then
current_kingraph => feyngraph%kin_first
do while (associated (current_kingraph%next))
if (current_kingraph%next%keep) then
add_kingraph => current_kingraph%next
current_kingraph%next => current_kingraph%next%next
add_kingraph%next => null ()
call grove_list%add_kingraph (kingraph=add_kingraph, &
preliminary=.true., check=.true., model=model)
else
current_kingraph => current_kingraph%next
end if
end do
end if
end subroutine grove_list_add_feyngraph
@ %def grove_list_add_feyngraph
@ Compare two [[grove_prop]] objects. The [[.match.]] operator is used
for preliminary groves in which the [[kingraphs]] share only the 3
numbers [[n_resonances]], [[n_log_enhanced]] and [[n_t_channel]]. These
groves are only used for comparing the kingraphs, because only graphs
within these preliminary groves can be equivalent (the numbers which are
compared here are unambigously fixed by the combination of mappings in
these channels).
<<Cascades2: interfaces>>=
interface operator (.match.)
module procedure grove_prop_match
end interface operator (.match.)
<<Cascades2: sub interfaces>>=
module function grove_prop_match (grove_prop1, grove_prop2) &
result (gp_match)
type(grove_prop_t), intent(in) :: grove_prop1
type(grove_prop_t), intent(in) :: grove_prop2
logical :: gp_match
end function grove_prop_match
<<Cascades2: procedures>>=
module function grove_prop_match (grove_prop1, grove_prop2) result (gp_match)
type(grove_prop_t), intent(in) :: grove_prop1
type(grove_prop_t), intent(in) :: grove_prop2
logical :: gp_match
gp_match = (grove_prop1%n_resonances == grove_prop2%n_resonances) &
.and. (grove_prop1%n_log_enhanced == grove_prop2%n_log_enhanced) &
.and. (grove_prop1%n_t_channel == grove_prop2%n_t_channel)
end function grove_prop_match
@ %def grove_prop_match
@ The equal operator on the other hand will be used when all valid
[[kingraphs]] have been created and mappings have been determined, to
split up the existing (preliminary) grove list, i.e. to create new
groves which are determined by all entries in [[grove_prop_t]].
<<Cascades2: interfaces>>=
interface operator (==)
module procedure grove_prop_equal
end interface operator (==)
<<Cascades2: sub interfaces>>=
module function grove_prop_equal (grove_prop1, grove_prop2) &
result (gp_equal)
type(grove_prop_t), intent(in) :: grove_prop1
type(grove_prop_t), intent(in) :: grove_prop2
logical :: gp_equal
end function grove_prop_equal
<<Cascades2: procedures>>=
module function grove_prop_equal (grove_prop1, grove_prop2) result (gp_equal)
type(grove_prop_t), intent(in) :: grove_prop1
type(grove_prop_t), intent(in) :: grove_prop2
logical :: gp_equal
gp_equal = (grove_prop1%res_hash == grove_prop2%res_hash) &
.and. (grove_prop1%n_resonances == grove_prop2%n_resonances) &
.and. (grove_prop1%n_log_enhanced == grove_prop2%n_log_enhanced) &
.and. (grove_prop1%n_off_shell == grove_prop2%n_off_shell) &
.and. (grove_prop1%multiplicity == grove_prop2%multiplicity) &
.and. (grove_prop1%n_t_channel == grove_prop2%n_t_channel)
end function grove_prop_equal
@ %def grove_prop_equal
@
\subsection{Remove equivalent channels}
Here we define the equivalence condition for completed [[kingraphs]].
The aim is to keep those [[kingraphs]] which describe the strongest
peaks of the amplitude. The [[bincodes]] and [[mappings]] have to be
the same for an equivalence, but the [[pdgs]] can be different. At
the same time we check if the trees are exacly the same (up to the
sign of pdg codes) in which case we do not keep both of them. This
can be the case when the incoming particles are the same or their
mutual anti-particles and there are no t-channel lines in the
Feynman diagram to which the kingraph belongs.
<<Cascades2: parameters>>=
integer, parameter :: EMPTY = -999
<<Cascades2: procedures>>=
function kingraph_eqv (kingraph1, kingraph2) result (eqv)
type(kingraph_t), intent(in) :: kingraph1
type(kingraph_t), intent(inout) :: kingraph2
logical :: eqv
integer :: i
logical :: equal
eqv = .false.
do i = kingraph1%tree%n_entries, 1, -1
if (kingraph1%tree%bc(i) /= kingraph2%tree%bc(i)) return
end do
do i = kingraph1%tree%n_entries, 1, -1
if ( .not. (kingraph1%tree%mapping(i) == kingraph2%tree%mapping(i) &
.or. ((kingraph1%tree%mapping(i) == NO_MAPPING .or. &
kingraph1%tree%mapping(i) == NONRESONANT) .and. &
(kingraph2%tree%mapping(i) == NO_MAPPING .or. &
kingraph2%tree%mapping(i) == NONRESONANT)))) return
end do
equal = .true.
do i = kingraph1%tree%n_entries, 1, -1
if (abs(kingraph1%tree%pdg(i)) /= abs(kingraph2%tree%pdg(i))) then
equal = .false.;
select case (kingraph1%tree%mapping(i))
case (S_CHANNEL, RADIATION)
select case (kingraph2%tree%mapping(i))
case (S_CHANNEL, RADIATION)
return
end select
end select
end if
end do
if (equal) then
kingraph2%keep = .false.
call kingraph2%tree%final ()
else
eqv = .true.
end if
end function kingraph_eqv
@ %def kingraph_eqv
@ Select between two [[kingraphs]] which fulfill the equivalence
condition above. This is done by comparing the [[pdg]] values of the
[[tree]] for increasing bincode. If the particles are different at
some place, we usually choose the one which would be returned first by the
subroutine [[match_vertex]] of the model for the daughter [[pdg]] codes.
Since we work here only on the basis of the the [[trees]] of the
completed [[kingraphs]], we have to use the [[bc]] array to determine
the positions of the daughter nodes' entries in the array. The graph
which has to be kept should correspond to the stronger peak at the place
which is compared.
<<Cascades2: procedures>>=
subroutine kingraph_select (kingraph1, kingraph2, model, preliminary)
type(kingraph_t), intent(inout) :: kingraph1
type(kingraph_t), intent(inout) :: kingraph2
type(model_data_t), intent(in) :: model
logical, intent(in) :: preliminary
integer(TC), dimension(:), allocatable :: tmp_bc, daughter_bc
integer, dimension(:), allocatable :: tmp_pdg, daughter_pdg
integer, dimension (:), allocatable :: pdg_match
integer :: i, j
integer :: n_ext1, n_ext2
if (kingraph_eqv (kingraph1, kingraph2)) then
if (.not. preliminary) then
kingraph2%keep = .false.; call kingraph2%tree%final ()
return
end if
do i=1, size (kingraph1%tree%bc)
if (abs(kingraph1%tree%pdg(i)) /= abs(kingraph2%tree%pdg(i))) then
if (kingraph1%tree%mapping(i) /= EXTERNAL_PRT) then
n_ext1 = popcnt (kingraph1%tree%bc(i))
n_ext2 = n_ext1
do j=i+1, size (kingraph1%tree%bc)
if (abs(kingraph1%tree%pdg(j)) /= abs(kingraph2%tree%pdg(j))) then
n_ext2 = popcnt (kingraph1%tree%bc(j))
if (n_ext2 < n_ext1) exit
end if
end do
if (n_ext2 < n_ext1) cycle
allocate (tmp_bc(i-1))
tmp_bc = kingraph1%tree%bc(:i-1)
allocate (tmp_pdg(i-1))
tmp_pdg = kingraph1%tree%pdg(:i-1)
do j=i-1, 1, - 1
where (iand (tmp_bc(:j-1),tmp_bc(j)) /= 0 &
.or. iand(tmp_bc(:j-1),kingraph1%tree%bc(i)) == 0)
tmp_bc(:j-1) = 0
tmp_pdg(:j-1) = 0
endwhere
end do
allocate (daughter_bc(size(pack(tmp_bc, tmp_bc /= 0))))
daughter_bc = pack (tmp_bc, tmp_bc /= 0)
allocate (daughter_pdg(size(pack(tmp_pdg, tmp_pdg /= 0))))
daughter_pdg = pack (tmp_pdg, tmp_pdg /= 0)
if (size (daughter_pdg) == 2) then
call model%match_vertex(daughter_pdg(1), daughter_pdg(2), pdg_match)
end if
do j=1, size (pdg_match)
if (abs(pdg_match(j)) == abs(kingraph1%tree%pdg(i))) then
kingraph2%keep = .false.; call kingraph2%tree%final ()
exit
else if (abs(pdg_match(j)) == abs(kingraph2%tree%pdg(i))) then
kingraph1%keep = .false.; call kingraph1%tree%final ()
exit
end if
end do
deallocate (tmp_bc, tmp_pdg, daughter_bc, daughter_pdg, pdg_match)
if (.not. (kingraph1%keep .and. kingraph2%keep)) exit
end if
end if
end do
end if
end subroutine kingraph_select
@ %def kingraph_select
@ At the beginning we do not care about the resonance hash, but only
about part of the grove properties, which is defined in
[[grove_prop_match]]. In these resulting preliminary groves the kingraphs
can be equivalent, i.e. we do not have to compare all graphs with each
other but only all graphs within each of these preliminary groves. In the
end we create a new grove list where the grove properties of the
[[kingraphs]] within a [[grove]] have to be exactly the same and in
addition the groves are distinguished by the resonance hash values. Here
the kingraphs are not compared any more, which means that the number of
channels is not reduced any more.
<<Cascades2: grove list: TBP>>=
procedure :: merge => grove_list_merge
<<Cascades2: sub interfaces>>=
module subroutine grove_list_merge (target_list, grove_list, model, &
prc_component)
class(grove_list_t), intent(inout) :: target_list
type(grove_list_t), intent(inout) :: grove_list
type(model_data_t), intent(in) :: model
integer, intent(in) :: prc_component
end subroutine grove_list_merge
<<Cascades2: procedures>>=
module subroutine grove_list_merge (target_list, grove_list, model, &
prc_component)
class(grove_list_t), intent(inout) :: target_list
type(grove_list_t), intent(inout) :: grove_list
type(model_data_t), intent(in) :: model
integer, intent(in) :: prc_component
type(grove_t), pointer :: current_grove
type(kingraph_t), pointer :: current_graph
current_grove => grove_list%first
do while (associated (current_grove))
do while (associated (current_grove%first))
current_graph => current_grove%first
current_grove%first => current_grove%first%grove_next
current_graph%grove_next => null ()
if (current_graph%keep) then
current_graph%prc_component = prc_component
call target_list%add_kingraph(kingraph=current_graph, &
preliminary=.false., check=.true., model=model)
else
call current_graph%final ()
deallocate (current_graph)
end if
end do
current_grove => current_grove%next
end do
end subroutine grove_list_merge
@ %def grove_list_merge
@ Recreate a grove list where we have different groves for different
resonance hashes.
<<Cascades2: grove list: TBP>>=
procedure :: rebuild => grove_list_rebuild
<<Cascades2: sub interfaces>>=
module subroutine grove_list_rebuild (grove_list)
class(grove_list_t), intent(inout) :: grove_list
end subroutine grove_list_rebuild
<<Cascades2: procedures>>=
module subroutine grove_list_rebuild (grove_list)
class(grove_list_t), intent(inout) :: grove_list
type(grove_list_t) :: tmp_list
type(grove_t), pointer :: current_grove
type(grove_t), pointer :: remove_grove
type(kingraph_t), pointer :: current_graph
type(kingraph_t), pointer :: next_graph
tmp_list%first => grove_list%first
grove_list%first => null ()
current_grove => tmp_list%first
do while (associated (current_grove))
current_graph => current_grove%first
do while (associated (current_graph))
call current_graph%assign_resonance_hash ()
next_graph => current_graph%grove_next
current_graph%grove_next => null ()
if (current_graph%keep) then
call grove_list%add_kingraph (kingraph=current_graph, &
preliminary=.false., check=.false.)
end if
current_graph => next_graph
end do
current_grove => current_grove%next
end do
call tmp_list%final
end subroutine grove_list_rebuild
@ %def grove_list_rebuild
@
\subsection{Write the phase-space file}
The phase-space file is written from the graphs which survive the
calculations and equivalence checks and are in the grove list. It is
written grove by grove. The output should be the same as in the
corresponding procedure [[cascade_set_write_file_format]] of
[[cascades]], up to the order of groves and channels.
<<Cascades2: public>>=
public :: feyngraph_set_write_file_format
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_set_write_file_format (feyngraph_set, u)
type(feyngraph_set_t), intent(in) :: feyngraph_set
integer, intent(in) :: u
end subroutine feyngraph_set_write_file_format
<<Cascades2: procedures>>=
module subroutine feyngraph_set_write_file_format (feyngraph_set, u)
type(feyngraph_set_t), intent(in) :: feyngraph_set
integer, intent(in) :: u
type(grove_t), pointer :: grove
integer :: channel_number
integer :: grove_number
channel_number = 0
grove_number = 0
grove => feyngraph_set%grove_list%first
do while (associated (grove))
grove_number = grove_number + 1
call grove%write_file_format &
(feyngraph_set, grove_number, channel_number, u)
grove => grove%next
end do
end subroutine feyngraph_set_write_file_format
@ %def feyngraph_set_write_file_format
@ Write the relevant information of the [[kingraphs]] of a [[grove]] and
the grove properties in the file format.
<<Cascades2: grove: TBP>>=
procedure :: write_file_format => grove_write_file_format
<<Cascades2: sub interfaces>>=
recursive module subroutine grove_write_file_format &
(grove, feyngraph_set, gr_number, ch_number, u)
class(grove_t), intent(in) :: grove
type(feyngraph_set_t), intent(in) :: feyngraph_set
integer, intent(in) :: u
integer, intent(inout) :: gr_number
integer, intent(inout) :: ch_number
end subroutine grove_write_file_format
<<Cascades2: procedures>>=
recursive module subroutine grove_write_file_format &
(grove, feyngraph_set, gr_number, ch_number, u)
class(grove_t), intent(in) :: grove
type(feyngraph_set_t), intent(in) :: feyngraph_set
integer, intent(in) :: u
integer, intent(inout) :: gr_number
integer, intent(inout) :: ch_number
type(kingraph_t), pointer :: current
1 format(3x,A,1x,40(1x,I4))
write (u, "(A)")
write (u, "(1x,'!',1x,A,1x,I0,A)", advance='no') &
'Multiplicity =', grove%grove_prop%multiplicity, ","
select case (grove%grove_prop%n_resonances)
case (0)
write (u, '(1x,A)', advance='no') 'no resonances, '
case (1)
write (u, '(1x,A)', advance='no') '1 resonance, '
case default
write (u, '(1x,I0,1x,A)', advance='no') &
grove%grove_prop%n_resonances, 'resonances, '
end select
write (u, '(1x,I0,1x,A)', advance='no') &
grove%grove_prop%n_log_enhanced, 'logs, '
write (u, '(1x,I0,1x,A)', advance='no') &
grove%grove_prop%n_off_shell, 'off-shell, '
select case (grove%grove_prop%n_t_channel)
case (0); write (u, '(1x,A)') 's-channel graph'
case (1); write (u, '(1x,A)') '1 t-channel line'
case default
write(u,'(1x,I0,1x,A)') &
grove%grove_prop%n_t_channel, 't-channel lines'
end select
write (u, '(1x,A,I0)') 'grove #', gr_number
current => grove%first
do while (associated (current))
if (current%keep) then
ch_number = ch_number + 1
call current%write_file_format (feyngraph_set, ch_number, u)
end if
current => current%grove_next
end do
end subroutine grove_write_file_format
@ %def grove_write_file_format
@ Write the relevant information of a valid [[kingraph]] in the file
format. The information is extracted from the [[tree]].
<<Cascades2: kingraph: TBP>>=
procedure :: write_file_format => kingraph_write_file_format
<<Cascades2: sub interfaces>>=
module subroutine kingraph_write_file_format &
(kingraph, feyngraph_set, ch_number, u)
class(kingraph_t), intent(in) :: kingraph
type(feyngraph_set_t), intent(in) :: feyngraph_set
integer, intent(in) :: ch_number
integer, intent(in) :: u
end subroutine kingraph_write_file_format
<<Cascades2: procedures>>=
module subroutine kingraph_write_file_format &
(kingraph, feyngraph_set, ch_number, u)
class(kingraph_t), intent(in) :: kingraph
type(feyngraph_set_t), intent(in) :: feyngraph_set
integer, intent(in) :: ch_number
integer, intent(in) :: u
integer :: i
integer(TC) :: bincode_incoming
2 format(3X,'map',1X,I3,1X,A,1X,I9,1X,'!',1X,A)
!!! determine bincode of incoming particle from tree
bincode_incoming = maxval (kingraph%tree%bc)
write (unit=u, fmt='(1X,A,I0)') '! Channel #', ch_number
write (unit=u, fmt='(3X,A,1X)', advance='no') 'tree'
do i=1, size (kingraph%tree%bc)
if (kingraph%tree%mapping(i) >=0 &
.or. kingraph%tree%mapping(i) == NONRESONANT &
.or. (kingraph%tree%bc(i) == bincode_incoming &
.and. feyngraph_set%process_type == DECAY)) then
write (unit=u, fmt='(1X,I0)', advance='no') kingraph%tree%bc(i)
end if
end do
write (unit=u, fmt='(A)', advance='yes')
do i=1, size(kingraph%tree%bc)
select case (kingraph%tree%mapping(i))
case (NO_MAPPING, NONRESONANT, EXTERNAL_PRT)
case (S_CHANNEL)
write (unit=u, fmt=2) kingraph%tree%bc(i), 's_channel', &
kingraph%tree%pdg(i), &
trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
case (T_CHANNEL)
write (unit=u, fmt=2) kingraph%tree%bc(i), 't_channel', &
abs (kingraph%tree%pdg(i)), &
trim(get_particle_name (feyngraph_set, abs(kingraph%tree%pdg(i))))
case (U_CHANNEL)
write (unit=u, fmt=2) kingraph%tree%bc(i), 'u_channel', &
abs (kingraph%tree%pdg(i)), &
trim(get_particle_name (feyngraph_set, abs(kingraph%tree%pdg(i))))
case (RADIATION)
write (unit=u, fmt=2) kingraph%tree%bc(i), 'radiation', &
kingraph%tree%pdg(i), &
trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
case (COLLINEAR)
write (unit=u, fmt=2) kingraph%tree%bc(i), 'collinear', &
kingraph%tree%pdg(i), &
trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
case (INFRARED)
write (unit=u, fmt=2) kingraph%tree%bc(i), 'infrared ', &
kingraph%tree%pdg(i), &
trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
case (ON_SHELL)
write (unit=u, fmt=2) kingraph%tree%bc(i), 'on_shell ', &
kingraph%tree%pdg(i), &
trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
case default
call msg_bug (" Impossible mapping mode encountered")
end select
end do
end subroutine kingraph_write_file_format
@ %def kingraph_write_file_format
@ Get the particle name from the [[particle]] array of the
[[feyngraph_set]]. This is needed for the phs file creation.
<<Cascades2: procedures>>=
function get_particle_name (feyngraph_set, pdg) result (particle_name)
type(feyngraph_set_t), intent(in) :: feyngraph_set
integer, intent(in) :: pdg
character(len=LABEL_LEN) :: particle_name
integer :: i
do i=1, size (feyngraph_set%particle)
if (feyngraph_set%particle(i)%pdg == pdg) then
particle_name = feyngraph_set%particle(i)%particle_label
exit
end if
end do
end function get_particle_name
@ %def get_particle_name
@
\subsection{Invert a graph}
All Feynman diagrams given by O'Mega look like a decay. The [[feyngraph]]
which is constructed from this output also looks like a decay, where one
of the incoming particles is the decaying particle (or the root of the
tree). The calculations can in principle be done on this data structure.
However, it is also performed with the other incoming particle as
the root. The first part of the calculation is the same for both cases.
For the second part we need to transform/turn the graphs such that the
other incoming particle becomes the root. This is done by identifying
the incoming particles from the O'Mega output (the first one is simply
the root of the existing tree, the second contains [2] in the
[[particle_label]]) and the nodes/particles which connect both incoming
particles (here we set [[t_line = .true.]]). At the same time we set the
pointers [[inverse_daughter1]] and [[inverse_daughter2]] for the
corresponding node, which point to the mother node and the other daughter
of the mother node; these will be the daughters of the node in the
inverted [[feyngraph]].
<<Cascades2: feyngraph: TBP>>=
procedure :: make_invertible => feyngraph_make_invertible
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_make_invertible (feyngraph)
class(feyngraph_t), intent(inout) :: feyngraph
end subroutine feyngraph_make_invertible
<<Cascades2: procedures>>=
module subroutine feyngraph_make_invertible (feyngraph)
class(feyngraph_t), intent(inout) :: feyngraph
logical :: t_line_found
feyngraph%root%incoming = .true.
t_line_found = .false.
if (associated (feyngraph%root%daughter1)) then
call f_node_t_line_check (feyngraph%root%daughter1, t_line_found)
if (.not. t_line_found) then
if (associated (feyngraph%root%daughter2)) then
call f_node_t_line_check (feyngraph%root%daughter2, t_line_found)
end if
end if
end if
contains
<<k node t line check>>
end subroutine feyngraph_make_invertible
@ %def feyngraph_make_invertible
@ Check if a node has to be [[t_line]] or [[incoming]] and assign
inverse daughter pointers.
<<k node t line check>>=
recursive subroutine f_node_t_line_check (node, t_line_found)
type(f_node_t), target, intent(inout) :: node
integer :: pos
logical, intent(inout) :: t_line_found
if (associated (node%daughter1)) then
call f_node_t_line_check (node%daughter1, t_line_found)
if (node%daughter1%incoming .or. node%daughter1%t_line) then
node%t_line = .true.
else if (associated (node%daughter2)) then
call f_node_t_line_check (node%daughter2, t_line_found)
if (node%daughter2%incoming .or. node%daughter2%t_line) then
node%t_line = .true.
end if
end if
else
pos = index (node%particle_label, '[') + 1
if (node%particle_label(pos:pos) == '2') then
node%incoming = .true.
t_line_found = .true.
end if
end if
end subroutine f_node_t_line_check
@ %def k_node_t_line_check
@ Make an inverted copy of a [[kingraph]] using the inverse daughter
pointers.
<<Cascades2: kingraph: TBP>>=
procedure :: make_inverse_copy => kingraph_make_inverse_copy
<<Cascades2: sub interfaces>>=
module subroutine kingraph_make_inverse_copy (original_kingraph, feyngraph)
class(kingraph_t), intent(inout) :: original_kingraph
type(feyngraph_t), intent(inout) :: feyngraph
end subroutine kingraph_make_inverse_copy
<<Cascades2: procedures>>=
module subroutine kingraph_make_inverse_copy (original_kingraph, feyngraph)
class(kingraph_t), intent(inout) :: original_kingraph
type(feyngraph_t), intent(inout) :: feyngraph
type(kingraph_t), pointer :: kingraph_copy
type(k_node_t), pointer :: potential_root
allocate (kingraph_copy)
if (associated (feyngraph%kin_last)) then
allocate (feyngraph%kin_last%next)
feyngraph%kin_last => feyngraph%kin_last%next
else
allocate(feyngraph%kin_first)
feyngraph%kin_last => feyngraph%kin_first
end if
kingraph_copy => feyngraph%kin_last
call kingraph_set_inverse_daughters (original_kingraph)
kingraph_copy%inverse = .true.
kingraph_copy%n_nodes = original_kingraph%n_nodes
kingraph_copy%keep = original_kingraph%keep
potential_root => original_kingraph%root
do while (.not. potential_root%incoming .or. &
(associated (potential_root%daughter1) .and. &
associated (potential_root%daughter2)))
if (potential_root%daughter1%incoming .or. &
potential_root%daughter1%t_line) then
potential_root => potential_root%daughter1
else if (potential_root%daughter2%incoming .or. &
potential_root%daughter2%t_line) then
potential_root => potential_root%daughter2
end if
end do
call node_inverse_deep_copy (potential_root, kingraph_copy%root)
end subroutine kingraph_make_inverse_copy
@ %def kingraph_make_inverse_copy
@ Recursively deep-copy nodes, but along the t-line the inverse daughters
become the new daughters. We need a deep copy only for the [[incoming]]
or [[t_line]] nodes. For the other nodes (of s-channel subgraphs) we set
only pointers to the existing nodes of the non-inverted graph.
<<Cascades2: procedures>>=
recursive subroutine node_inverse_deep_copy (original_node, node_copy)
type(k_node_t), intent(in) :: original_node
type(k_node_t), pointer, intent(out) :: node_copy
call original_node%f_node%k_node_list%add_entry(node_copy, recycle=.false.)
node_copy = original_node
if (node_copy%t_line .or. node_copy%incoming) then
node_copy%particle => original_node%particle%anti
else
node_copy%particle => original_node%particle
end if
if (associated (original_node%inverse_daughter1) .and. associated (original_node%inverse_daughter2)) then
if (original_node%inverse_daughter1%incoming .or. original_node%inverse_daughter1%t_line) then
node_copy%daughter2 => original_node%inverse_daughter2
call node_inverse_deep_copy (original_node%inverse_daughter1, &
node_copy%daughter1)
else if (original_node%inverse_daughter2%incoming .or. original_node%inverse_daughter2%t_line) then
node_copy%daughter1 => original_node%inverse_daughter1
call node_inverse_deep_copy (original_node%inverse_daughter2, &
node_copy%daughter2)
end if
end if
end subroutine node_inverse_deep_copy
@ %def node_inverse_deep_copy
@
\subsection{Find phase-space parametrizations}
Perform all mapping calculations for a single process and store valid
[[kingraphs]] (channels) into the grove list, without caring for instance
about the resonance hash values.
<<Cascades2: public>>=
public :: feyngraph_set_generate_single
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_set_generate_single (feyngraph_set, model, &
n_in, n_out, phs_par, fatal_beam_decay, u_in)
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(model_data_t), target, intent(in) :: model
integer, intent(in) :: n_in, n_out
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
integer, intent(in) :: u_in
end subroutine feyngraph_set_generate_single
<<Cascades2: procedures>>=
module subroutine feyngraph_set_generate_single (feyngraph_set, model, &
n_in, n_out, phs_par, fatal_beam_decay, u_in)
type(feyngraph_set_t), intent(inout) :: feyngraph_set
type(model_data_t), target, intent(in) :: model
integer, intent(in) :: n_in, n_out
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
integer, intent(in) :: u_in
feyngraph_set%n_in = n_in
feyngraph_set%n_out = n_out
feyngraph_set%process_type = n_in
feyngraph_set%phs_par = phs_par
feyngraph_set%model => model
if (debug_on) call msg_debug &
(D_PHASESPACE, "Construct relevant Feynman diagrams from Omega output")
call feyngraph_set%build (u_in)
if (debug_on) call msg_debug &
(D_PHASESPACE, "Find phase-space parametrizations")
call feyngraph_set_find_phs_parametrizations(feyngraph_set)
end subroutine feyngraph_set_generate_single
@ %def feyngraph_set_generate_single
@ Find the phase space parametrizations. We start with the computation
of pure s-channel subtrees, i.e. we determine mappings and compare
subtrees in order to reduce the number of channels. This can be
parallelized easily. When all s-channel [[k_nodes]] exist, the possible
[[kingraphs]] are created using these nodes and we determine mappings for
t-channel nodes.
<<Cascades2: procedures>>=
subroutine feyngraph_set_find_phs_parametrizations (feyngraph_set)
class(feyngraph_set_t), intent(inout) :: feyngraph_set
type(feyngraph_t), pointer :: current => null ()
type(feyngraph_ptr_t), dimension (:), allocatable :: set
integer :: pos
integer :: i
allocate (set (feyngraph_set%n_graphs))
pos = 0
current => feyngraph_set%first
do while (associated (current))
pos = pos + 1
set(pos)%graph => current
current => current%next
end do
if (feyngraph_set%process_type == SCATTERING) then
!$OMP PARALLEL DO
do i=1, feyngraph_set%n_graphs
if (set(i)%graph%keep) then
call set(i)%graph%make_invertible ()
end if
end do
!$OMP END PARALLEL DO
end if
call f_node_list_compute_mappings_s (feyngraph_set)
do i=1, feyngraph_set%n_graphs
if (set(i)%graph%keep) then
call set(i)%graph%make_kingraphs (feyngraph_set)
end if
end do
if (feyngraph_set%process_type == SCATTERING) then
do i=1, feyngraph_set%n_graphs
if (set(i)%graph%keep) then
call set(i)%graph%make_inverse_kingraphs ()
end if
end do
end if
do i=1, feyngraph_set%n_graphs
if (set(i)%graph%keep) then
call set(i)%graph%compute_mappings (feyngraph_set)
end if
end do
do i=1, feyngraph_set%n_graphs
if (set(i)%graph%keep) then
call feyngraph_set%grove_list%add_feyngraph (set(i)%graph, &
feyngraph_set%model)
end if
end do
end subroutine feyngraph_set_find_phs_parametrizations
@ %def feyngraph_set_find_phs_parametrizations
@ Compare objects of type [[tree_t]].
<<Cascades2: interfaces>>=
interface operator (==)
module procedure tree_equal
end interface operator (==)
<<Cascades2: sub interfaces>>=
elemental module function tree_equal (tree1, tree2) result (flag)
type(tree_t), intent(in) :: tree1, tree2
logical :: flag
end function tree_equal
<<Cascades2: procedures>>=
elemental module function tree_equal (tree1, tree2) result (flag)
type(tree_t), intent(in) :: tree1, tree2
logical :: flag
if (tree1%n_entries == tree2%n_entries) then
if (tree1%bc(size(tree1%bc)) == tree2%bc(size(tree2%bc))) then
flag = all (tree1%mapping == tree2%mapping) .and. &
all (tree1%bc == tree2%bc) .and. &
all (abs(tree1%pdg) == abs(tree2%pdg))
else
flag = .false.
end if
else
flag = .false.
end if
end function tree_equal
@ %def tree_equal
@ Select between equivalent subtrees (type [[tree_t]]). This is similar
to [[kingraph_select]], but we compare only positions with mappings
[[NONRESONANT]] and [[NO_MAPPING]].
<<Cascades2: interfaces>>=
interface operator (.eqv.)
module procedure subtree_eqv
end interface operator (.eqv.)
<<Cascades2: sub interfaces>>=
pure module function subtree_eqv (subtree1, subtree2) result (eqv)
type(tree_t), intent(in) :: subtree1, subtree2
logical :: eqv
end function subtree_eqv
<<Cascades2: procedures>>=
pure module function subtree_eqv (subtree1, subtree2) result (eqv)
type(tree_t), intent(in) :: subtree1, subtree2
logical :: eqv
integer :: root_pos
integer :: i
logical :: equal
eqv = .false.
if (subtree1%n_entries /= subtree2%n_entries) return
root_pos = subtree1%n_entries
if (subtree1%mapping(root_pos) == NONRESONANT .or. &
subtree2%mapping(root_pos) == NONRESONANT .or. &
(subtree1%mapping(root_pos) == NO_MAPPING .and. &
subtree2%mapping(root_pos) == NO_MAPPING .and. &
abs(subtree1%pdg(root_pos)) == abs(subtree2%pdg(root_pos)))) then
do i = subtree1%n_entries, 1, -1
if (subtree1%bc(i) /= subtree2%bc(i)) return
end do
equal = .true.
do i = subtree1%n_entries, 1, -1
if (abs(subtree1%pdg(i)) /= abs (subtree2%pdg(i))) then
select case (subtree1%mapping(i))
case (NO_MAPPING, NONRESONANT)
select case (subtree2%mapping(i))
case (NO_MAPPING, NONRESONANT)
equal = .false.
case default
return
end select
case default
return
end select
end if
end do
do i = subtree1%n_entries, 1, -1
if (subtree1%mapping(i) /= subtree2%mapping(i)) then
select case (subtree1%mapping(i))
case (NO_MAPPING, NONRESONANT)
select case (subtree2%mapping(i))
case (NO_MAPPING, NONRESONANT)
case default
return
end select
case default
return
end select
end if
end do
if (.not. equal) eqv = .true.
end if
end function subtree_eqv
@ %def subtree_eqv
<<Cascades2: procedures>>=
subroutine subtree_select (subtree1, subtree2, model)
type(tree_t), intent(inout) :: subtree1, subtree2
type(model_data_t), intent(in) :: model
integer :: j, k
integer(TC), dimension(:), allocatable :: tmp_bc, daughter_bc
integer, dimension(:), allocatable :: tmp_pdg, daughter_pdg
integer, dimension (:), allocatable :: pdg_match
if (subtree1 .eqv. subtree2) then
do j=1, subtree1%n_entries
if (abs(subtree1%pdg(j)) /= abs(subtree2%pdg(j))) then
tmp_bc = subtree1%bc(:j-1); tmp_pdg = subtree1%pdg(:j-1)
do k=j-1, 1, - 1
where (iand (tmp_bc(:k-1),tmp_bc(k)) /= 0 &
.or. iand(tmp_bc(:k-1),subtree1%bc(j)) == 0)
tmp_bc(:k-1) = 0
tmp_pdg(:k-1) = 0
endwhere
end do
daughter_bc = pack (tmp_bc, tmp_bc /= 0)
daughter_pdg = pack (tmp_pdg, tmp_pdg /= 0)
if (size (daughter_pdg) == 2) then
call model%match_vertex(daughter_pdg(1), daughter_pdg(2), pdg_match)
if (.not. allocated (pdg_match)) then
!!! Relevant if tree contains only abs (pdg). In this case, changing the
!!! sign of one of the pdg codes should give a result.
call model%match_vertex(-daughter_pdg(1), daughter_pdg(2), pdg_match)
end if
end if
do k=1, size (pdg_match)
if (abs(pdg_match(k)) == abs(subtree1%pdg(j))) then
if (subtree1%keep) subtree2%keep = .false.
exit
else if (abs(pdg_match(k)) == abs(subtree2%pdg(j))) then
if (subtree2%keep) subtree1%keep = .false.
exit
end if
end do
deallocate (tmp_bc, tmp_pdg, daughter_bc, daughter_pdg, pdg_match)
if (.not. (subtree1%keep .and. subtree2%keep)) exit
end if
end do
end if
end subroutine subtree_select
@ %def subtree_select
@ Assign a resonance hash value to a [[kingraph]], like in [[cascades]],
but here without the array [[tree_resonant]].
<<Cascades2: kingraph: TBP>>=
procedure :: assign_resonance_hash => kingraph_assign_resonance_hash
<<Cascades2: sub interfaces>>=
module subroutine kingraph_assign_resonance_hash (kingraph)
class(kingraph_t), intent(inout) :: kingraph
end subroutine kingraph_assign_resonance_hash
<<Cascades2: procedures>>=
module subroutine kingraph_assign_resonance_hash (kingraph)
class(kingraph_t), intent(inout) :: kingraph
logical, dimension (:), allocatable :: tree_resonant
integer(i8), dimension(1) :: mold
allocate (tree_resonant (kingraph%tree%n_entries))
tree_resonant = (kingraph%tree%mapping == S_CHANNEL)
kingraph%grove_prop%res_hash = hash (transfer &
([sort (pack (kingraph%tree%pdg, tree_resonant)), &
sort (pack (abs (kingraph%tree%pdg), &
kingraph%tree%mapping == T_CHANNEL .or. &
kingraph%tree%mapping == U_CHANNEL))], mold))
deallocate (tree_resonant)
end subroutine kingraph_assign_resonance_hash
@ %def kingraph_assign_resonance_hash
@ Write the process in the bincode format. This is again a copy of the
corresponding procedure in [[cascades]], using [[feyngraph_set]] instead
of [[cascade_set]] as an argument.
<<Cascades2: public>>=
public :: feyngraph_set_write_process_bincode_format
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_set_write_process_bincode_format &
(feyngraph_set, unit)
type(feyngraph_set_t), intent(in), target :: feyngraph_set
integer, intent(in), optional :: unit
end subroutine feyngraph_set_write_process_bincode_format
<<Cascades2: procedures>>=
module subroutine feyngraph_set_write_process_bincode_format &
(feyngraph_set, unit)
type(feyngraph_set_t), intent(in), target :: feyngraph_set
integer, intent(in), optional :: unit
integer, dimension(:), allocatable :: bincode, field_width
integer :: n_in, n_out, n_tot, n_flv
integer :: u, f, i, bc
character(20) :: str
type(string_t) :: fmt_head
type(string_t), dimension(:), allocatable :: fmt_proc
u = given_output_unit (unit); if (u < 0) return
if (.not. allocated (feyngraph_set%flv)) return
write (u, "('!',1x,A)") "List of subprocesses with particle bincodes:"
n_in = feyngraph_set%n_in
n_out = feyngraph_set%n_out
n_tot = n_in + n_out
n_flv = size (feyngraph_set%flv, 2)
allocate (bincode (n_tot), field_width (n_tot), fmt_proc (n_tot))
bc = 1
do i = 1, n_out
bincode(n_in + i) = bc
bc = 2 * bc
end do
do i = n_in, 1, -1
bincode(i) = bc
bc = 2 * bc
end do
do i = 1, n_tot
write (str, "(I0)") bincode(i)
field_width(i) = len_trim (str)
do f = 1, n_flv
field_width(i) = max (field_width(i), &
len (feyngraph_set%flv(i,f)%get_name ()))
end do
end do
fmt_head = "('!'"
do i = 1, n_tot
fmt_head = fmt_head // ",1x,"
fmt_proc(i) = "(1x,"
write (str, "(I0)") field_width(i)
fmt_head = fmt_head // "I" // trim(str)
fmt_proc(i) = fmt_proc(i) // "A" // trim(str)
if (i == n_in) then
fmt_head = fmt_head // ",1x,' '"
end if
end do
do i = 1, n_tot
fmt_proc(i) = fmt_proc(i) // ")"
end do
fmt_head = fmt_head // ")"
write (u, char (fmt_head)) bincode
do f = 1, n_flv
write (u, "('!')", advance="no")
do i = 1, n_tot
write (u, char (fmt_proc(i)), advance="no") &
char (feyngraph_set%flv(i,f)%get_name ())
if (i == n_in) write (u, "(1x,'=>')", advance="no")
end do
write (u, *)
end do
write (u, char (fmt_head)) bincode
end subroutine feyngraph_set_write_process_bincode_format
@ %def feyngraph_set_write_process_bincode_format
@ Write tex file for graphical display of channels.
<<Cascades2: public>>=
public :: feyngraph_set_write_graph_format
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_set_write_graph_format &
(feyngraph_set, filename, process_id, unit)
type(feyngraph_set_t), intent(in), target :: feyngraph_set
type(string_t), intent(in) :: filename, process_id
integer, intent(in), optional :: unit
end subroutine feyngraph_set_write_graph_format
<<Cascades2: procedures>>=
module subroutine feyngraph_set_write_graph_format &
(feyngraph_set, filename, process_id, unit)
type(feyngraph_set_t), intent(in), target :: feyngraph_set
type(string_t), intent(in) :: filename, process_id
integer, intent(in), optional :: unit
type(kingraph_t), pointer :: kingraph
type(grove_t), pointer :: grove
integer :: u, n_grove, count, pgcount
logical :: first_in_grove
u = given_output_unit (unit); if (u < 0) return
write (u, '(A)') "\documentclass[10pt]{article}"
write (u, '(A)') "\usepackage{amsmath}"
write (u, '(A)') "\usepackage{feynmp}"
write (u, '(A)') "\usepackage{url}"
write (u, '(A)') "\usepackage{color}"
write (u, *)
write (u, '(A)') "\textwidth 18.5cm"
write (u, '(A)') "\evensidemargin -1.5cm"
write (u, '(A)') "\oddsidemargin -1.5cm"
write (u, *)
write (u, '(A)') "\newcommand{\blue}{\color{blue}}"
write (u, '(A)') "\newcommand{\green}{\color{green}}"
write (u, '(A)') "\newcommand{\red}{\color{red}}"
write (u, '(A)') "\newcommand{\magenta}{\color{magenta}}"
write (u, '(A)') "\newcommand{\cyan}{\color{cyan}}"
write (u, '(A)') "\newcommand{\sm}{\footnotesize}"
write (u, '(A)') "\setlength{\parindent}{0pt}"
write (u, '(A)') "\setlength{\parsep}{20pt}"
write (u, *)
write (u, '(A)') "\begin{document}"
write (u, '(A)') "\begin{fmffile}{" // char (filename) // "}"
write (u, '(A)') "\fmfcmd{color magenta; magenta = red + blue;}"
write (u, '(A)') "\fmfcmd{color cyan; cyan = green + blue;}"
write (u, '(A)') "\begin{fmfshrink}{0.5}"
write (u, '(A)') "\begin{flushleft}"
write (u, *)
write (u, '(A)') "\noindent" // &
& "\textbf{\large\texttt{WHIZARD} phase space channels}" // &
& "\hfill\today"
write (u, *)
write (u, '(A)') "\vspace{10pt}"
write (u, '(A)') "\noindent" // &
& "\textbf{Process:} \url{" // char (process_id) // "}"
call feyngraph_set_write_process_tex_format (feyngraph_set, u)
write (u, *)
write (u, '(A)') "\noindent" // &
& "\textbf{Note:} These are pseudo Feynman graphs that "
write (u, '(A)') "visualize phase-space parameterizations " // &
& "(``integration channels''). "
write (u, '(A)') "They do \emph{not} indicate Feynman graphs used for the " // &
& "matrix element."
write (u, *)
write (u, '(A)') "\textbf{Color code:} " // &
& "{\blue resonance,} " // &
& "{\cyan t-channel,} " // &
& "{\green radiation,} "
write (u, '(A)') "{\red infrared,} " // &
& "{\magenta collinear,} " // &
& "external/off-shell"
write (u, *)
write (u, '(A)') "\noindent" // &
& "\textbf{Black square:} Keystone, indicates ordering of " // &
& "phase space parameters."
write (u, *)
write (u, '(A)') "\vspace{-20pt}"
count = 0
pgcount = 0
n_grove = 0
grove => feyngraph_set%grove_list%first
do while (associated (grove))
n_grove = n_grove + 1
write (u, *)
write (u, '(A)') "\vspace{20pt}"
write (u, '(A)') "\begin{tabular}{l}"
write (u, '(A,I5,A)') &
& "\fbox{\bf Grove \boldmath$", n_grove, "$} \\[10pt]"
write (u, '(A,I1,A)') "Multiplicity: ", &
grove%grove_prop%multiplicity, "\\"
write (u, '(A,I1,A)') "Resonances: ", &
grove%grove_prop%n_resonances, "\\"
write (u, '(A,I1,A)') "Log-enhanced: ", &
grove%grove_prop%n_log_enhanced, "\\"
write (u, '(A,I1,A)') "Off-shell: ", &
grove%grove_prop%n_off_shell, "\\"
write (u, '(A,I1,A)') "t-channel: ", &
grove%grove_prop%n_t_channel, ""
write (u, '(A)') "\end{tabular}"
kingraph => grove%first
do while (associated (kingraph))
count = count + 1
call kingraph_write_graph_format (kingraph, count, unit)
kingraph => kingraph%grove_next
end do
grove => grove%next
end do
write (u, '(A)') "\end{flushleft}"
write (u, '(A)') "\end{fmfshrink}"
write (u, '(A)') "\end{fmffile}"
write (u, '(A)') "\end{document}"
end subroutine feyngraph_set_write_graph_format
@ %def feyngraph_set_write_graph_format
@ Write the process as a \LaTeX\ expression. This is a slightly modified
copy of [[cascade_set_write_process_tex_format]] which has only been
adapted to the types which are used here.
<<Cascades2: procedures>>=
subroutine feyngraph_set_write_process_tex_format (feyngraph_set, unit)
type(feyngraph_set_t), intent(in), target :: feyngraph_set
integer, intent(in), optional :: unit
integer :: n_tot
integer :: u, f, i
n_tot = feyngraph_set%n_in + feyngraph_set%n_out
u = given_output_unit (unit); if (u < 0) return
if (.not. allocated (feyngraph_set%flv)) return
write (u, "(A)") "\begin{align*}"
do f = 1, size (feyngraph_set%flv, 2)
do i = 1, feyngraph_set%n_in
if (i > 1) write (u, "(A)", advance="no") "\quad "
write (u, "(A)", advance="no") &
char (feyngraph_set%flv(i,f)%get_tex_name ())
end do
write (u, "(A)", advance="no") "\quad &\to\quad "
do i = feyngraph_set%n_in + 1, n_tot
if (i > feyngraph_set%n_in + 1) write (u, "(A)", advance="no") "\quad "
write (u, "(A)", advance="no") &
char (feyngraph_set%flv(i,f)%get_tex_name ())
end do
if (f < size (feyngraph_set%flv, 2)) then
write (u, "(A)") "\\"
else
write (u, "(A)") ""
end if
end do
write (u, "(A)") "\end{align*}"
end subroutine feyngraph_set_write_process_tex_format
@ %def feyngraph_set_write_process_tex_format
@ This creates metapost source for graphical display for a given [[kingraph]].
It is the analogon to [[cascade_write_graph_format]] (a modified copy).
<<Cascades2: procedures>>=
subroutine kingraph_write_graph_format (kingraph, count, unit)
type(kingraph_t), intent(in) :: kingraph
integer, intent(in) :: count
integer, intent(in), optional :: unit
integer :: u
type(string_t) :: left_str, right_str
u = given_output_unit (unit); if (u < 0) return
left_str = ""
right_str = ""
write (u, '(A)') "\begin{minipage}{105pt}"
write (u, '(A)') "\vspace{30pt}"
write (u, '(A)') "\begin{center}"
write (u, '(A)') "\begin{fmfgraph*}(55,55)"
call graph_write_node (kingraph%root)
write (u, '(A)') "\fmfleft{" // char (extract (left_str, 2)) // "}"
write (u, '(A)') "\fmfright{" // char (extract (right_str, 2)) // "}"
write (u, '(A)') "\end{fmfgraph*}\\"
write (u, '(A,I5,A)') "\fbox{$", count, "$}"
write (u, '(A)') "\end{center}"
write (u, '(A)') "\end{minipage}"
write (u, '(A)') "%"
contains
recursive subroutine graph_write_node (node)
type(k_node_t), intent(in) :: node
if (associated (node%daughter1) .or. associated (node%daughter2)) then
if (node%daughter2%t_line .or. node%daughter2%incoming) then
call vertex_write (node, node%daughter2)
call vertex_write (node, node%daughter1)
else
call vertex_write (node, node%daughter1)
call vertex_write (node, node%daughter2)
end if
if (node%mapping == EXTERNAL_PRT) then
call line_write (node%bincode, 0, node%particle)
call external_write (node%bincode, node%particle%tex_name, &
left_str)
write (u, '(A,I0,A)') "\fmfv{d.shape=square}{v0}"
end if
else
if (node%incoming) then
call external_write (node%bincode, node%particle%anti%tex_name, &
left_str)
else
call external_write (node%bincode, node%particle%tex_name, &
right_str)
end if
end if
end subroutine graph_write_node
recursive subroutine vertex_write (node, daughter)
type(k_node_t), intent(in) :: node, daughter
integer :: bincode
if (associated (node%daughter1) .and. associated (node%daughter2) &
.and. node%mapping == EXTERNAL_PRT) then
bincode = 0
else
bincode = node%bincode
end if
call graph_write_node (daughter)
if (associated (node%daughter1) .or. associated (node%daughter2)) then
call line_write (bincode, daughter%bincode, daughter%particle, &
mapping=daughter%mapping)
else
call line_write (bincode, daughter%bincode, daughter%particle)
end if
end subroutine vertex_write
subroutine line_write (i1, i2, particle, mapping)
integer(TC), intent(in) :: i1, i2
type(part_prop_t), intent(in) :: particle
integer, intent(in), optional :: mapping
integer :: k1, k2
type(string_t) :: prt_type
select case (particle%spin_type)
case (SCALAR); prt_type = "plain"
case (SPINOR); prt_type = "fermion"
case (VECTOR); prt_type = "boson"
case (VECTORSPINOR); prt_type = "fermion"
case (TENSOR); prt_type = "dbl_wiggly"
case default; prt_type = "dashes"
end select
if (particle%pdg < 0) then
!!! anti-particle
k1 = i2; k2 = i1
else
k1 = i1; k2 = i2
end if
if (present (mapping)) then
select case (mapping)
case (S_CHANNEL)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=blue,lab=\sm\blue$" // &
& char (particle%tex_name) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (T_CHANNEL, U_CHANNEL)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=cyan,lab=\sm\cyan$" // &
& char (particle%tex_name) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (RADIATION)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=green,lab=\sm\green$" // &
& char (particle%tex_name) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (COLLINEAR)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=magenta,lab=\sm\magenta$" // &
& char (particle%tex_name) // "$}" // &
& "{v", k1, ",v", k2, "}"
case (INFRARED)
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=red,lab=\sm\red$" // &
& char (particle%tex_name) // "$}" // &
& "{v", k1, ",v", k2, "}"
case default
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& ",f=black}" // &
& "{v", k1, ",v", k2, "}"
end select
else
write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
& "}" // &
& "{v", k1, ",v", k2, "}"
end if
end subroutine line_write
subroutine external_write (bincode, name, ext_str)
integer(TC), intent(in) :: bincode
type(string_t), intent(in) :: name
type(string_t), intent(inout) :: ext_str
character(len=20) :: str
write (str, '(A2,I0)') ",v", bincode
ext_str = ext_str // trim (str)
write (u, '(A,I0,A,I0,A)') "\fmflabel{\sm$" &
// char (name) &
// "\,(", bincode, ")" &
// "$}{v", bincode, "}"
end subroutine external_write
end subroutine kingraph_write_graph_format
@ %def kingraph_write_graph_format
@ Generate a [[feyngraph_set]] for several subprocesses. Mapping
calculations are performed separately, but the final grove list is shared
between the subsets [[fset]] of the [[feyngraph_set]].
<<Cascades2: public>>=
public :: feyngraph_set_generate
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_set_generate &
(feyngraph_set, model, n_in, n_out, flv, phs_par, fatal_beam_decay, &
u_in, vis_channels, use_dag)
type(feyngraph_set_t), intent(out) :: feyngraph_set
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_in, n_out
type(flavor_t), dimension(:,:), intent(in) :: flv
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
integer, intent(in) :: u_in
logical, intent(in) :: vis_channels
logical, optional, intent(in) :: use_dag
end subroutine feyngraph_set_generate
<<Cascades2: procedures>>=
module subroutine feyngraph_set_generate &
(feyngraph_set, model, n_in, n_out, flv, phs_par, fatal_beam_decay, &
u_in, vis_channels, use_dag)
type(feyngraph_set_t), intent(out) :: feyngraph_set
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_in, n_out
type(flavor_t), dimension(:,:), intent(in) :: flv
type(phs_parameters_t), intent(in) :: phs_par
logical, intent(in) :: fatal_beam_decay
integer, intent(in) :: u_in
logical, intent(in) :: vis_channels
logical, optional, intent(in) :: use_dag
type(grove_t), pointer :: grove
integer :: i, j
type(kingraph_t), pointer :: kingraph
if (phase_space_vanishes (phs_par%sqrts, n_in, flv)) return
if (present (use_dag)) feyngraph_set%use_dag = use_dag
feyngraph_set%process_type = n_in
feyngraph_set%n_in = n_in
feyngraph_set%n_out = n_out
allocate (feyngraph_set%flv (size (flv, 1), size (flv, 2)))
do i = 1, size (flv, 2)
do j = 1, size (flv, 1)
call feyngraph_set%flv(j,i)%init (flv(j,i)%get_pdg (), model)
end do
end do
allocate (feyngraph_set%particle (PRT_ARRAY_SIZE))
allocate (feyngraph_set%grove_list)
allocate (feyngraph_set%fset (size (flv, 2)))
do i = 1, size (feyngraph_set%fset)
feyngraph_set%fset(i)%use_dag = feyngraph_set%use_dag
allocate (feyngraph_set%fset(i)%flv(size (flv,1),1))
feyngraph_set%fset(i)%flv(:,1) = flv(:,i)
feyngraph_set%fset(i)%particle => feyngraph_set%particle
allocate (feyngraph_set%fset(i)%grove_list)
call feyngraph_set_generate_single (feyngraph_set%fset(i), &
model, n_in, n_out, phs_par, fatal_beam_decay, u_in)
call feyngraph_set%grove_list%merge &
(feyngraph_set%fset(i)%grove_list, model, i)
if (.not. vis_channels) call feyngraph_set%fset(i)%final()
end do
call feyngraph_set%grove_list%rebuild ()
end subroutine feyngraph_set_generate
@ %def feyngraph_set_generate
@ Check whether the [[grove_list]] of the [[feyngraph_set]] contains any
[[kingraphs]] which are valid, i.e. where the [[keep]] variable has the
value [[.true.]]. This is necessary to write a non-empty phase-space
file. The function is the pendant to [[cascade_set_is_valid]].
<<Cascades2: public>>=
public :: feyngraph_set_is_valid
<<Cascades2: sub interfaces>>=
module function feyngraph_set_is_valid (feyngraph_set) result (flag)
class(feyngraph_set_t), intent(in) :: feyngraph_set
logical :: flag
end function feyngraph_set_is_valid
<<Cascades2: procedures>>=
module function feyngraph_set_is_valid (feyngraph_set) result (flag)
class(feyngraph_set_t), intent(in) :: feyngraph_set
type(kingraph_t), pointer :: kingraph
type(grove_t), pointer :: grove
logical :: flag
flag = .false.
if (associated (feyngraph_set%grove_list)) then
grove => feyngraph_set%grove_list%first
do while (associated (grove))
kingraph => grove%first
do while (associated (kingraph))
if (kingraph%keep) then
flag = .true.
return
end if
kingraph => kingraph%next
end do
grove => grove%next
end do
end if
end function feyngraph_set_is_valid
@ %def feyngraph_set_is_valid
@
\subsection{Return the resonance histories for subtraction}
The following procedures are copies of corresponding procedures in
[[cascades]], which only have been adapted to the new types used in
this module.
Extract the resonance set from a valid [[kingraph]] which is kept in the
final grove list.
<<Cascades2: kingraph: TBP>>=
procedure :: extract_resonance_history => kingraph_extract_resonance_history
<<Cascades2: sub interfaces>>=
module subroutine kingraph_extract_resonance_history &
(kingraph, res_hist, model, n_out)
class(kingraph_t), intent(in), target :: kingraph
type(resonance_history_t), intent(out) :: res_hist
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_out
end subroutine kingraph_extract_resonance_history
<<Cascades2: procedures>>=
module subroutine kingraph_extract_resonance_history &
(kingraph, res_hist, model, n_out)
class(kingraph_t), intent(in), target :: kingraph
type(resonance_history_t), intent(out) :: res_hist
class(model_data_t), intent(in), target :: model
integer, intent(in) :: n_out
type(resonance_info_t) :: resonance
integer :: i, mom_id, pdg
if (debug_on) call msg_debug2 &
(D_PHASESPACE, "kingraph_extract_resonance_history")
if (kingraph%grove_prop%n_resonances > 0) then
if (associated (kingraph%root%daughter1) .or. &
associated (kingraph%root%daughter2)) then
if (debug_on) call msg_debug2 &
(D_PHASESPACE, "kingraph has resonances, root has children")
do i = 1, kingraph%tree%n_entries
if (kingraph%tree%mapping(i) == S_CHANNEL) then
mom_id = kingraph%tree%bc (i)
pdg = kingraph%tree%pdg (i)
call resonance%init (mom_id, pdg, model, n_out)
if (debug2_active (D_PHASESPACE)) then
print *, 'D: Adding resonance'
call resonance%write ()
end if
call res_hist%add_resonance (resonance)
end if
end do
end if
end if
end subroutine kingraph_extract_resonance_history
@ %def kingraph_extract_resonance_history
@ Determine the number of valid [[kingraphs]] in [[grove_list]].
<<Cascades2: public>>=
public :: grove_list_get_n_trees
<<Cascades2: sub interfaces>>=
module function grove_list_get_n_trees (grove_list) result (n)
class(grove_list_t), intent(in) :: grove_list
integer :: n
end function grove_list_get_n_trees
<<Cascades2: procedures>>=
module function grove_list_get_n_trees (grove_list) result (n)
class(grove_list_t), intent(in) :: grove_list
integer :: n
type(kingraph_t), pointer :: kingraph
type(grove_t), pointer :: grove
if (debug_on) call msg_debug (D_PHASESPACE, "grove_list_get_n_trees")
n = 0
grove => grove_list%first
do while (associated (grove))
kingraph => grove%first
do while (associated (kingraph))
if (kingraph%keep) n = n + 1
kingraph => kingraph%grove_next
end do
grove => grove%next
end do
if (debug_on) call msg_debug (D_PHASESPACE, "n", n)
end function grove_list_get_n_trees
@ %def grove_list_get_n_trees
@ Extract the resonance histories from the [[feyngraph_set]], in complete
analogy to [[cascade_set_get_resonance_histories]]
<<Cascades2: public>>=
public :: feyngraph_set_get_resonance_histories
<<Cascades2: sub interfaces>>=
module subroutine feyngraph_set_get_resonance_histories &
(feyngraph_set, n_filter, res_hists)
type(feyngraph_set_t), intent(in), target :: feyngraph_set
integer, intent(in), optional :: n_filter
type(resonance_history_t), dimension(:), allocatable, intent(out) :: &
res_hists
end subroutine feyngraph_set_get_resonance_histories
<<Cascades2: procedures>>=
module subroutine feyngraph_set_get_resonance_histories &
(feyngraph_set, n_filter, res_hists)
type(feyngraph_set_t), intent(in), target :: feyngraph_set
integer, intent(in), optional :: n_filter
type(resonance_history_t), dimension(:), allocatable, intent(out) :: &
res_hists
type(kingraph_t), pointer :: kingraph
type(grove_t), pointer :: grove
type(resonance_history_t) :: res_hist
type(resonance_history_set_t) :: res_hist_set
integer :: i_grove
if (debug_on) call msg_debug &
(D_PHASESPACE, "grove_list_get_resonance_histories")
call res_hist_set%init (n_filter = n_filter)
grove => feyngraph_set%grove_list%first
i_grove = 0
do while (associated (grove))
i_grove = i_grove + 1
kingraph => grove%first
do while (associated (kingraph))
if (kingraph%keep) then
if (debug_on) call msg_debug2 (D_PHASESPACE, "grove", i_grove)
call kingraph%extract_resonance_history &
(res_hist, feyngraph_set%model, feyngraph_set%n_out)
call res_hist_set%enter (res_hist)
end if
kingraph => kingraph%grove_next
end do
end do
call res_hist_set%freeze ()
call res_hist_set%to_array (res_hists)
end subroutine feyngraph_set_get_resonance_histories
@ %def feyngraph_set_get_resonance_histories
@
<<[[cascades2_ut.f90]]>>=
<<File header>>
module cascades2_ut
use unit_tests
use cascades2_uti
<<Standard module head>>
<<Cascades2: public test>>
contains
<<Cascades2: test driver>>
end module cascades2_ut
@ %def cascades2_ut
@
<<[[cascades2_uti.f90]]>>=
<<File header>>
module cascades2_uti
<<Use kinds>>
<<Use strings>>
use numeric_utils
use cascades2
use flavors
use phs_forests, only: phs_parameters_t
use model_data
<<Standard module head>>
<<Cascades2: test declarations>>
contains
<<Cascades2: tests>>
end module cascades2_uti
@ %def cascades2_uti
@ API: driver for the unit tests below.
<<Cascades2: public test>>=
public :: cascades2_test
<<Cascades2: test driver>>=
subroutine cascades2_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Cascades2: execute tests>>
end subroutine cascades2_test
@ %def cascades2_test
@
<<Cascades2: execute tests>>=
call test (cascades2_1, "cascades2_1", &
"make phase-space", u, results)
call test (cascades2_2, "cascades2_2", &
"make phase-space (scattering)", u, results)
<<Cascades2: test declarations>>=
public :: cascades2_1
<<Cascades2: tests>>=
subroutine cascades2_1 (u)
integer, intent(in) :: u
type(feyngraph_set_t) :: feyngraph_set
type(model_data_t) :: model
integer :: n_in = 1
integer :: n_out = 6
type(flavor_t), dimension(7,1) :: flv
type(phs_parameters_t) :: phs_par
logical :: fatal_beam_decay = .true.
integer :: u_in = 8
write (u, "(A)") "* Test output: cascades2_1"
write (u, "(A)") "* Purpose: create a test phs file (decay) with the forest"
write (u, "(A)") "* output of O'Mega"
write (u, "(A)")
write (u, "(A)") "* Initializing"
write (u, "(A)")
call init_sm_full_test (model)
call flv(1,1)%init (6, model)
call flv(2,1)%init (5, model)
call flv(3,1)%init (-11, model)
call flv(4,1)%init (12, model)
call flv(5,1)%init (21, model)
call flv(6,1)%init (22, model)
call flv(7,1)%init (21, model)
phs_par%sqrts = 173.1_default
phs_par%m_threshold_s = 50._default
phs_par%m_threshold_t = 100._default
phs_par%keep_nonresonant = .true.
phs_par%off_shell = 2
open (unit=u_in, file="cascades2_1.fds", status='old', action='read')
write (u, "(A)")
write (u, "(A)") "* Generating phase-space parametrizations"
write (u, "(A)")
call feyngraph_set_generate (feyngraph_set, model, n_in, n_out, &
flv, phs_par, fatal_beam_decay, u_in, use_dag = .false., &
vis_channels = .false.)
call feyngraph_set_write_process_bincode_format (feyngraph_set, u)
call feyngraph_set_write_file_format (feyngraph_set, u)
write (u, "(A)") "* Cleanup"
write (u, "(A)")
close (u_in)
call feyngraph_set%final ()
call model%final ()
write (u, *)
write (u, "(A)") "* Test output end: cascades2_1"
end subroutine cascades2_1
@ %def cascades2_1
@
<<Cascades2: test declarations>>=
public :: cascades2_2
<<Cascades2: tests>>=
subroutine cascades2_2 (u)
integer, intent(in) :: u
type(feyngraph_set_t) :: feyngraph_set
type(model_data_t) :: model
integer :: n_in = 2
integer :: n_out = 5
type(flavor_t), dimension(7,1) :: flv
type(phs_parameters_t) :: phs_par
logical :: fatal_beam_decay = .true.
integer :: u_in = 8
write (u, "(A)") "* Test output: cascades2_2"
write (u, "(A)") "* Purpose: create a test phs file (scattering) with the"
write (u, "(A)") "* parsable DAG output of O'Mega"
write (u, "(A)")
write (u, "(A)") "* Initializing"
write (u, "(A)")
call init_sm_full_test (model)
call flv(1,1)%init (-11, model)
call flv(2,1)%init (11, model)
call flv(3,1)%init (-11, model)
call flv(4,1)%init (12, model)
call flv(5,1)%init (1, model)
call flv(6,1)%init (-2, model)
call flv(7,1)%init (22, model)
phs_par%sqrts = 500._default
phs_par%m_threshold_s = 50._default
phs_par%m_threshold_t = 100._default
phs_par%keep_nonresonant = .true.
phs_par%off_shell = 2
phs_par%t_channel = 6
open (unit=u_in, file="cascades2_2.fds", &
status='old', action='read')
write (u, "(A)")
write (u, "(A)") "* Generating phase-space parametrizations"
write (u, "(A)")
call feyngraph_set_generate (feyngraph_set, model, n_in, n_out, &
flv, phs_par, fatal_beam_decay, u_in, use_dag = .true., &
vis_channels = .false.)
call feyngraph_set_write_process_bincode_format (feyngraph_set, u)
call feyngraph_set_write_file_format (feyngraph_set, u)
write (u, "(A)") "* Cleanup"
write (u, "(A)")
close (u_in)
call feyngraph_set%final ()
call model%final ()
write (u, *)
write (u, "(A)") "* Test output end: cascades2_2"
end subroutine cascades2_2
@ %def cascades2_2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{WOOD phase space}
This is the module that interfaces the [[phs_forests]] phase-space
treatment and the [[cascades]] module for generating phase-space
channels. As an extension of the [[phs_base]] abstract type,
the phase-space configuration and instance implement the standard API.
(Currently, this is the only generic phase-space implementation of
\whizard. For trivial two-particle phase space, there is
[[phs_wood]] as an alternative.)
<<[[phs_wood.f90]]>>=
<<File header>>
module phs_wood
<<Use kinds>>
<<Use strings>>
use os_interface
use lorentz
use model_data
use flavors
use phs_base
use mappings
use resonances, only: resonance_history_set_t
use phs_forests
use cascades
use cascades2
<<Standard module head>>
<<PHS wood: public>>
<<PHS wood: types>>
interface
<<PHS wood: sub interfaces>>
end interface
contains
<<PHS wood: main procedures>>
end module phs_wood
@ %def phs_wood
@
<<[[phs_wood_sub.f90]]>>=
<<File header>>
submodule (phs_wood) phs_wood_s
use io_units
use constants
use numeric_utils
use diagnostics
use physics_defs
use md5
use process_constants
use sf_mappings
use sf_base
implicit none
contains
<<PHS wood: procedures>>
end submodule phs_wood_s
@ %def phs_wood_s
@
\subsection{Configuration}
<<PHS wood: public>>=
public :: phs_wood_config_t
<<PHS wood: types>>=
type, extends (phs_config_t) :: phs_wood_config_t
character(32) :: md5sum_forest = ""
type(string_t) :: phs_path
integer :: io_unit = 0
logical :: io_unit_keep_open = .false.
logical :: use_equivalences = .false.
logical :: fatal_beam_decay = .true.
type(mapping_defaults_t) :: mapping_defaults
type(phs_parameters_t) :: par
type(string_t) :: run_id
type(cascade_set_t), allocatable :: cascade_set
logical :: use_cascades2 = .false.
type(feyngraph_set_t), allocatable :: feyngraph_set
type(phs_forest_t) :: forest
type(os_data_t) :: os_data
logical :: is_combined_integration = .false.
contains
<<PHS wood: phs wood config: TBP>>
end type phs_wood_config_t
@ %def phs_wood_config_t
@ Finalizer. We should delete the cascade set and the forest subobject.
Also close the I/O unit, just in case. (We assume that [[io_unit]] is
not standard input/output.)
<<PHS wood: phs wood config: TBP>>=
procedure :: final => phs_wood_config_final
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_final (object)
class(phs_wood_config_t), intent(inout) :: object
end subroutine phs_wood_config_final
<<PHS wood: procedures>>=
module subroutine phs_wood_config_final (object)
class(phs_wood_config_t), intent(inout) :: object
logical :: opened
if (object%io_unit /= 0) then
inquire (unit = object%io_unit, opened = opened)
if (opened) close (object%io_unit)
end if
call object%clear_phase_space ()
call object%forest%final ()
end subroutine phs_wood_config_final
@ %def phs_wood_config_final
@
<<PHS wood: phs wood config: TBP>>=
procedure :: increase_n_par => phs_wood_config_increase_n_par
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_increase_n_par (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
end subroutine phs_wood_config_increase_n_par
<<PHS wood: procedures>>=
module subroutine phs_wood_config_increase_n_par (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
if (phs_config%is_combined_integration) then
phs_config%n_par = phs_config%n_par + 3
end if
end subroutine phs_wood_config_increase_n_par
@ %def phs_wood_config_increase_n_par
@ Output. The contents of the PHS forest are not printed explicitly.
<<PHS wood: phs wood config: TBP>>=
procedure :: write => phs_wood_config_write
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_write (object, unit, include_id)
class(phs_wood_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
end subroutine phs_wood_config_write
<<PHS wood: procedures>>=
module subroutine phs_wood_config_write (object, unit, include_id)
class(phs_wood_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") &
"Partonic phase-space configuration (phase-space forest):"
call object%base_write (unit)
write (u, "(1x,A)") "Phase-space configuration parameters:"
call object%par%write (u)
call object%mapping_defaults%write (u)
write (u, "(3x,A,A,A)") "Run ID: '", char (object%run_id), "'"
end subroutine phs_wood_config_write
@ %def phs_wood_config_write
@ Print the PHS forest contents.
<<PHS wood: phs wood config: TBP>>=
procedure :: write_forest => phs_wood_config_write_forest
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_write_forest (object, unit)
class(phs_wood_config_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine phs_wood_config_write_forest
<<PHS wood: procedures>>=
module subroutine phs_wood_config_write_forest (object, unit)
class(phs_wood_config_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
call object%forest%write (u)
end subroutine phs_wood_config_write_forest
@ %def phs_wood_config_write_forest
@ Set the phase-space parameters that the configuration generator requests.
<<PHS wood: phs wood config: TBP>>=
procedure :: set_parameters => phs_wood_config_set_parameters
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_set_parameters (phs_config, par)
class(phs_wood_config_t), intent(inout) :: phs_config
type(phs_parameters_t), intent(in) :: par
end subroutine phs_wood_config_set_parameters
<<PHS wood: procedures>>=
module subroutine phs_wood_config_set_parameters (phs_config, par)
class(phs_wood_config_t), intent(inout) :: phs_config
type(phs_parameters_t), intent(in) :: par
phs_config%par = par
end subroutine phs_wood_config_set_parameters
@ %def phs_wood_config_set_parameters
@ Enable the generation of channel equivalences (when calling [[configure]]).
<<PHS wood: phs wood config: TBP>>=
procedure :: enable_equivalences => phs_wood_config_enable_equivalences
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_enable_equivalences (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
end subroutine phs_wood_config_enable_equivalences
<<PHS wood: procedures>>=
module subroutine phs_wood_config_enable_equivalences (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
phs_config%use_equivalences = .true.
end subroutine phs_wood_config_enable_equivalences
@ %def phs_wood_config_enable_equivalences
@ Set the phase-space mapping parameters that the configuration generator
requests.g
<<PHS wood: phs wood config: TBP>>=
procedure :: set_mapping_defaults => phs_wood_config_set_mapping_defaults
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_set_mapping_defaults &
(phs_config, mapping_defaults)
class(phs_wood_config_t), intent(inout) :: phs_config
type(mapping_defaults_t), intent(in) :: mapping_defaults
end subroutine phs_wood_config_set_mapping_defaults
<<PHS wood: procedures>>=
module subroutine phs_wood_config_set_mapping_defaults &
(phs_config, mapping_defaults)
class(phs_wood_config_t), intent(inout) :: phs_config
type(mapping_defaults_t), intent(in) :: mapping_defaults
phs_config%mapping_defaults = mapping_defaults
end subroutine phs_wood_config_set_mapping_defaults
@ %def phs_wood_config_set_mapping_defaults
@ Define the input stream for the phase-space file as an open logical unit.
The unit must be connected.
<<PHS wood: phs wood config: TBP>>=
procedure :: set_input => phs_wood_config_set_input
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_set_input (phs_config, unit)
class(phs_wood_config_t), intent(inout) :: phs_config
integer, intent(in) :: unit
end subroutine phs_wood_config_set_input
<<PHS wood: procedures>>=
module subroutine phs_wood_config_set_input (phs_config, unit)
class(phs_wood_config_t), intent(inout) :: phs_config
integer, intent(in) :: unit
phs_config%io_unit = unit
rewind (unit)
end subroutine phs_wood_config_set_input
@ %def phs_wood_config_set_input
@
\subsection{Phase-space generation}
This subroutine generates a phase space configuration using the
[[cascades]] module. Note that this may take time, and the
[[cascade_set]] subobject may consume a large amount of memory.
<<PHS wood: phs wood config: TBP>>=
procedure :: generate_phase_space => phs_wood_config_generate_phase_space
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_generate_phase_space (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
end subroutine phs_wood_config_generate_phase_space
<<PHS wood: procedures>>=
module subroutine phs_wood_config_generate_phase_space (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
integer :: off_shell, extra_off_shell
logical :: valid
integer :: unit_fds
type(string_t) :: file_name
logical :: file_exists
call msg_message ("Phase space: generating configuration ...")
off_shell = phs_config%par%off_shell
if (phs_config%use_cascades2) then
file_name = char (phs_config%id) // ".fds"
inquire (file=char (file_name), exist=file_exists)
if (.not. file_exists) call msg_fatal &
("The O'Mega input file " // char (file_name) // &
" does not exist. " // "Please make sure that the " // &
"variable ?omega_write_phs_output has been set correctly.")
unit_fds = free_unit ()
open (unit=unit_fds, file=char(file_name), status='old', action='read')
do extra_off_shell = 0, max (phs_config%n_tot - 3, 0)
phs_config%par%off_shell = off_shell + extra_off_shell
allocate (phs_config%feyngraph_set)
call feyngraph_set_generate (phs_config%feyngraph_set, &
phs_config%model, phs_config%n_in, phs_config%n_out, &
phs_config%flv, &
phs_config%par, phs_config%fatal_beam_decay, unit_fds, &
phs_config%vis_channels)
if (feyngraph_set_is_valid (phs_config%feyngraph_set)) then
exit
else
call msg_message ("Phase space: ... failed. &
&Increasing phs_off_shell ...")
call phs_config%feyngraph_set%final ()
deallocate (phs_config%feyngraph_set)
end if
end do
close (unit_fds)
else
allocate (phs_config%cascade_set)
do extra_off_shell = 0, max (phs_config%n_tot - 3, 0)
phs_config%par%off_shell = off_shell + extra_off_shell
call cascade_set_generate (phs_config%cascade_set, &
phs_config%model, phs_config%n_in, phs_config%n_out, &
phs_config%flv, &
phs_config%par, phs_config%fatal_beam_decay)
if (cascade_set_is_valid (phs_config%cascade_set)) then
exit
else
call msg_message ("Phase space: ... failed. &
&Increasing phs_off_shell ...")
end if
end do
end if
if (phs_config%use_cascades2) then
valid = feyngraph_set_is_valid (phs_config%feyngraph_set)
else
valid = cascade_set_is_valid (phs_config%cascade_set)
end if
if (valid) then
call msg_message ("Phase space: ... success.")
else
call msg_fatal ("Phase-space: generation failed")
end if
end subroutine phs_wood_config_generate_phase_space
@ %def phs_wood_config_generate_phase_space
@ Using the generated phase-space configuration, write an appropriate
phase-space file to the stored (or explicitly specified) I/O unit.
<<PHS wood: phs wood config: TBP>>=
procedure :: write_phase_space => phs_wood_config_write_phase_space
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_write_phase_space (phs_config, &
filename_vis, unit)
class(phs_wood_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
type(string_t), intent(in), optional :: filename_vis
end subroutine phs_wood_config_write_phase_space
<<PHS wood: procedures>>=
module subroutine phs_wood_config_write_phase_space (phs_config, &
filename_vis, unit)
class(phs_wood_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
type(string_t), intent(in), optional :: filename_vis
type(string_t) :: setenv_tex, setenv_mp, pipe, pipe_dvi
integer :: u, unit_tex, unit_dev, status
if (allocated (phs_config%cascade_set) .or. &
allocated (phs_config%feyngraph_set)) then
if (present (unit)) then
u = unit
else
u = phs_config%io_unit
end if
write (u, "(1x,A,A)") "process ", char (phs_config%id)
write (u, "(A)")
if (phs_config%use_cascades2) then
call feyngraph_set_write_process_bincode_format (phs_config%feyngraph_set, u)
else
call cascade_set_write_process_bincode_format (phs_config%cascade_set, u)
end if
write (u, "(A)")
write (u, "(3x,A,A,A32,A)") "md5sum_process = ", &
'"', phs_config%md5sum_process, '"'
write (u, "(3x,A,A,A32,A)") "md5sum_model_par = ", &
'"', phs_config%md5sum_model_par, '"'
write (u, "(3x,A,A,A32,A)") "md5sum_phs_config = ", &
'"', phs_config%md5sum_phs_config, '"'
call phs_config%par%write (u)
if (phs_config%use_cascades2) then
call feyngraph_set_write_file_format (phs_config%feyngraph_set, u)
else
call cascade_set_write_file_format (phs_config%cascade_set, u)
end if
if (phs_config%vis_channels) then
unit_tex = free_unit ()
open (unit=unit_tex, file=char(filename_vis // ".tex"), &
action="write", status="replace")
if (phs_config%use_cascades2) then
call feyngraph_set_write_graph_format (phs_config%feyngraph_set, &
filename_vis // "-graphs", phs_config%id, unit_tex)
else
call cascade_set_write_graph_format (phs_config%cascade_set, &
filename_vis // "-graphs", phs_config%id, unit_tex)
end if
close (unit_tex)
call msg_message ("Phase space: visualizing channels in file " &
// char(trim(filename_vis)) // "...")
if (phs_config%os_data%event_analysis_ps) then
BLOCK: do
unit_dev = free_unit ()
open (file = "/dev/null", unit = unit_dev, &
action = "write", iostat = status)
if (status /= 0) then
pipe = ""
pipe_dvi = ""
else
pipe = " > /dev/null"
pipe_dvi = " 2>/dev/null 1>/dev/null"
end if
close (unit_dev)
if (phs_config%os_data%whizard_texpath /= "") then
setenv_tex = "TEXINPUTS=" // &
phs_config%os_data%whizard_texpath // ":$TEXINPUTS "
setenv_mp = "MPINPUTS=" // &
phs_config%os_data%whizard_texpath // ":$MPINPUTS "
else
setenv_tex = ""
setenv_mp = ""
end if
call os_system_call (setenv_tex // &
phs_config%os_data%latex // " " // &
filename_vis // ".tex " // pipe, status)
if (status /= 0) exit BLOCK
if (phs_config%os_data%mpost /= "") then
call os_system_call (setenv_mp // &
phs_config%os_data%mpost // " " // &
filename_vis // "-graphs.mp" // pipe, status)
else
call msg_fatal ("Could not use MetaPOST.")
end if
if (status /= 0) exit BLOCK
call os_system_call (setenv_tex // &
phs_config%os_data%latex // " " // &
filename_vis // ".tex" // pipe, status)
if (status /= 0) exit BLOCK
call os_system_call &
(phs_config%os_data%dvips // " -o " // filename_vis &
// ".ps " // filename_vis // ".dvi" // pipe_dvi, status)
if (status /= 0) exit BLOCK
if (phs_config%os_data%event_analysis_pdf) then
call os_system_call (phs_config%os_data%ps2pdf // " " // &
filename_vis // ".ps", status)
if (status /= 0) exit BLOCK
end if
exit BLOCK
end do BLOCK
if (status /= 0) then
call msg_error ("Unable to compile analysis output file")
end if
end if
end if
else
call msg_fatal ("Phase-space configuration: &
&no phase space object generated")
end if
end subroutine phs_wood_config_write_phase_space
@ %def phs_config_write_phase_space
@ Clear the phase-space configuration. This is useful since the
object may become \emph{really} large.
<<PHS wood: phs wood config: TBP>>=
procedure :: clear_phase_space => phs_wood_config_clear_phase_space
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_clear_phase_space (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
end subroutine phs_wood_config_clear_phase_space
<<PHS wood: procedures>>=
module subroutine phs_wood_config_clear_phase_space (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
if (allocated (phs_config%cascade_set)) then
call cascade_set_final (phs_config%cascade_set)
deallocate (phs_config%cascade_set)
end if
if (allocated (phs_config%feyngraph_set)) then
call phs_config%feyngraph_set%final ()
deallocate (phs_config%feyngraph_set)
end if
end subroutine phs_wood_config_clear_phase_space
@ %def phs_wood_config_clear_phase_space
@
Extract the set of resonance histories
<<PHS wood: phs wood config: TBP>>=
procedure :: extract_resonance_history_set &
=> phs_wood_config_extract_resonance_history_set
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_extract_resonance_history_set &
(phs_config, res_set, include_trivial)
class(phs_wood_config_t), intent(in) :: phs_config
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
end subroutine phs_wood_config_extract_resonance_history_set
<<PHS wood: procedures>>=
module subroutine phs_wood_config_extract_resonance_history_set &
(phs_config, res_set, include_trivial)
class(phs_wood_config_t), intent(in) :: phs_config
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
call phs_config%forest%extract_resonance_history_set &
(res_set, include_trivial)
end subroutine phs_wood_config_extract_resonance_history_set
@ %def phs_wood_config_extract_resonance_history_set
@
\subsection{Phase-space configuration}
We read the phase-space configuration from the stored I/O unit. If
this is not set, we assume that we have to generate a phase space
configuration. When done, we open a scratch file and write the
configuration.
If [[rebuild]] is set, we should trash any existing phase space file
and build a new one. Otherwise, we try to use an old one, which we
check for existence and integrity. If [[ignore_mismatch]] is set, we
reuse an existing file even if it does not match the current setup.
<<PHS wood: phs wood config: TBP>>=
procedure :: configure => phs_wood_config_configure
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_wood_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
end subroutine phs_wood_config_configure
<<PHS wood: procedures>>=
module subroutine phs_wood_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_wood_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
type(string_t) :: filename, filename_vis
logical :: variable_limits
logical :: ok, exist, found, check, match, rebuild_phs
integer :: g, c0, c1, n
if (present (nlo_type)) then
phs_config%nlo_type = nlo_type
else
phs_config%nlo_type = BORN
end if
phs_config%sqrts = sqrts
phs_config%par%sqrts = sqrts
if (present (sqrts_fixed)) &
phs_config%sqrts_fixed = sqrts_fixed
if (present (lab_is_cm)) &
phs_config%lab_is_cm = lab_is_cm
if (present (azimuthal_dependence)) &
phs_config%azimuthal_dependence = azimuthal_dependence
if (present (rebuild)) then
rebuild_phs = rebuild
else
rebuild_phs = .true.
end if
if (present (ignore_mismatch)) then
check = .not. ignore_mismatch
if (ignore_mismatch) &
call msg_warning ("Reading phs file: MD5 sum check disabled")
else
check = .true.
end if
phs_config%md5sum_forest = ""
call phs_config%compute_md5sum (include_id = .false.)
if (phs_config%io_unit == 0) then
filename = phs_config%make_phs_filename (subdir)
filename_vis = phs_config%make_phs_filename (subdir) // "-vis"
if (.not. rebuild_phs) then
if (check) then
call phs_config%read_phs_file (exist, found, match, subdir=subdir)
rebuild_phs = .not. (exist .and. found .and. match)
else
call phs_config%read_phs_file (exist, found, subdir=subdir)
rebuild_phs = .not. (exist .and. found)
end if
end if
if (.not. mpi_is_comm_master ()) then
rebuild_phs = .false.
call msg_message ("MPI: Workers do not build phase space configuration.")
end if
if (rebuild_phs) then
call phs_config%generate_phase_space ()
phs_config%io_unit = free_unit ()
if (phs_config%id /= "") then
call msg_message ("Phase space: writing configuration file '" &
// char (filename) // "'")
open (phs_config%io_unit, file = char (filename), &
status = "replace", action = "readwrite")
else
open (phs_config%io_unit, status = "scratch", action = "readwrite")
end if
call phs_config%write_phase_space (filename_vis)
rewind (phs_config%io_unit)
else
call msg_message ("Phase space: keeping configuration file '" &
// char (filename) // "'")
end if
end if
if (phs_config%io_unit == 0) then
ok = .true.
else
call phs_config%forest%read (phs_config%io_unit, phs_config%id, &
phs_config%n_in, phs_config%n_out, phs_config%model, ok)
if (.not. phs_config%io_unit_keep_open) then
close (phs_config%io_unit)
phs_config%io_unit = 0
end if
end if
if (ok) then
call phs_config%forest%set_flavors (phs_config%flv(:,1))
variable_limits = .not. phs_config%lab_is_cm
call phs_config%forest%set_parameters (phs_config%mapping_defaults, &
variable_limits)
call phs_config%forest%setup_prt_combinations ()
phs_config%n_channel = phs_config%forest%get_n_channels ()
phs_config%n_par = phs_config%forest%get_n_parameters ()
allocate (phs_config%channel (phs_config%n_channel))
if (phs_config%use_equivalences) then
call phs_config%forest%set_equivalences ()
call phs_config%forest%get_equivalences (phs_config%channel, &
phs_config%azimuthal_dependence)
phs_config%provides_equivalences = .true.
end if
call phs_config%forest%set_s_mappings ()
call phs_config%record_on_shell ()
if (phs_config%mapping_defaults%enable_s_mapping) then
call phs_config%record_s_mappings ()
end if
allocate (phs_config%chain (phs_config%n_channel), source = 0)
do g = 1, phs_config%forest%get_n_groves ()
call phs_config%forest%get_grove_bounds (g, c0, c1, n)
phs_config%chain (c0:c1) = g
end do
phs_config%provides_chains = .true.
call phs_config%compute_md5sum_forest ()
else
write (msg_buffer, "(A,A,A)") &
"Phase space: process '", &
char (phs_config%id), "' not found in configuration file"
call msg_fatal ()
end if
end subroutine phs_wood_config_configure
@ %def phs_wood_config_configure
@ The MD5 sum of the forest is computed in addition to the MD5 sum of
the configuration. The reason is that the forest may depend on a
user-provided external file. On the other hand, this MD5 sum encodes
all information that is relevant for further processing. Therefore,
the [[get_md5sum]] method returns this result, once it is available.
<<PHS wood: phs wood config: TBP>>=
procedure :: compute_md5sum_forest => phs_wood_config_compute_md5sum_forest
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_compute_md5sum_forest (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
end subroutine phs_wood_config_compute_md5sum_forest
<<PHS wood: procedures>>=
module subroutine phs_wood_config_compute_md5sum_forest (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
integer :: u
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call phs_config%write_forest (u)
rewind (u)
phs_config%md5sum_forest = md5sum (u)
close (u)
end subroutine phs_wood_config_compute_md5sum_forest
@ %def phs_wood_config_compute_md5sum_forest
@ Create filenames according to standard conventions. The [[id]] is the
process name including the suffix [[_iX]] where [[X]] stands for the component
identifier (an integer). The [[run_id]] may be set or unset.
The convention for file names that include the run ID is to separate prefix, run
ID, and any extensions by dots. We construct the file name by concatenating
the individual elements accordingly. If there is no run ID, we nevertheless
replace [[_iX]] by [[.iX]].
<<PHS wood: phs wood config: TBP>>=
procedure :: make_phs_filename => phs_wood_make_phs_filename
<<PHS wood: sub interfaces>>=
module function phs_wood_make_phs_filename &
(phs_config, subdir) result (filename)
class(phs_wood_config_t), intent(in) :: phs_config
type(string_t), intent(in), optional :: subdir
type(string_t) :: filename
end function phs_wood_make_phs_filename
<<PHS wood: procedures>>=
module function phs_wood_make_phs_filename &
(phs_config, subdir) result (filename)
class(phs_wood_config_t), intent(in) :: phs_config
type(string_t), intent(in), optional :: subdir
type(string_t) :: filename
type(string_t) :: basename, suffix, comp_code, comp_index
basename = phs_config%id
call split (basename, suffix, "_", back=.true.)
comp_code = extract (suffix, 1, 1)
comp_index = extract (suffix, 2)
if (comp_code == "i" .and. verify (comp_index, "1234567890") == 0) then
suffix = "." // comp_code // comp_index
else
basename = phs_config%id
suffix = ""
end if
if (phs_config%run_id /= "") then
filename = basename // "." // phs_config%run_id // suffix // ".phs"
else
filename = basename // suffix // ".phs"
end if
if (present (subdir)) then
filename = subdir // "/" // filename
end if
end function phs_wood_make_phs_filename
@ %def phs_wood_make_phs_filename
@
<<PHS wood: phs wood config: TBP>>=
procedure :: reshuffle_flavors => phs_wood_config_reshuffle_flavors
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_reshuffle_flavors &
(phs_config, reshuffle, flv_extra)
class(phs_wood_config_t), intent(inout) :: phs_config
integer, intent(in), dimension(:), allocatable :: reshuffle
type(flavor_t), intent(in) :: flv_extra
end subroutine phs_wood_config_reshuffle_flavors
<<PHS wood: procedures>>=
module subroutine phs_wood_config_reshuffle_flavors &
(phs_config, reshuffle, flv_extra)
class(phs_wood_config_t), intent(inout) :: phs_config
integer, intent(in), dimension(:), allocatable :: reshuffle
type(flavor_t), intent(in) :: flv_extra
call phs_config%forest%set_flavors (phs_config%flv(:,1), reshuffle, &
flv_extra)
end subroutine phs_wood_config_reshuffle_flavors
@ %def phs_wood_config_reshuffle_flavors
@
<<PHS wood: phs wood config: TBP>>=
procedure :: set_momentum_links => phs_wood_config_set_momentum_links
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_set_momentum_links (phs_config, reshuffle)
class(phs_wood_config_t), intent(inout) :: phs_config
integer, intent(in), dimension(:), allocatable :: reshuffle
end subroutine phs_wood_config_set_momentum_links
<<PHS wood: procedures>>=
module subroutine phs_wood_config_set_momentum_links (phs_config, reshuffle)
class(phs_wood_config_t), intent(inout) :: phs_config
integer, intent(in), dimension(:), allocatable :: reshuffle
call phs_config%forest%set_momentum_links (reshuffle)
end subroutine phs_wood_config_set_momentum_links
@ %def phs_wood_config_set_momentum_links
@ Identify resonances which are marked by s-channel mappings for the
whole phase space and report them to the channel array.
<<PHS wood: phs wood config: TBP>>=
procedure :: record_s_mappings => phs_wood_config_record_s_mappings
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_record_s_mappings (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
end subroutine phs_wood_config_record_s_mappings
<<PHS wood: procedures>>=
module subroutine phs_wood_config_record_s_mappings (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
logical :: flag
real(default) :: mass, width
integer :: c
do c = 1, phs_config%n_channel
call phs_config%forest%get_s_mapping (c, flag, mass, width)
if (flag) then
if (mass == 0) then
call msg_fatal ("Phase space: s-channel resonance " &
// " has zero mass")
end if
if (width == 0) then
call msg_fatal ("Phase space: s-channel resonance " &
// " has zero width")
end if
call phs_config%channel(c)%set_resonant (mass, width)
end if
end do
end subroutine phs_wood_config_record_s_mappings
@ %def phs_wood_config_record_s_mappings
@ Identify on-shell mappings for the whole phase space and report them
to the channel array.
<<PHS wood: phs wood config: TBP>>=
procedure :: record_on_shell => phs_wood_config_record_on_shell
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_record_on_shell (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
end subroutine phs_wood_config_record_on_shell
<<PHS wood: procedures>>=
module subroutine phs_wood_config_record_on_shell (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
logical :: flag
real(default) :: mass
integer :: c
do c = 1, phs_config%n_channel
call phs_config%forest%get_on_shell (c, flag, mass)
if (flag) then
call phs_config%channel(c)%set_on_shell (mass)
end if
end do
end subroutine phs_wood_config_record_on_shell
@ %def phs_wood_config_record_on_shell
@ Return the most relevant MD5 sum. This overrides the method of the
base type.
<<PHS wood: phs wood config: TBP>>=
procedure :: get_md5sum => phs_wood_config_get_md5sum
<<PHS wood: sub interfaces>>=
module function phs_wood_config_get_md5sum (phs_config) result (md5sum)
class(phs_wood_config_t), intent(in) :: phs_config
character(32) :: md5sum
end function phs_wood_config_get_md5sum
<<PHS wood: procedures>>=
module function phs_wood_config_get_md5sum (phs_config) result (md5sum)
class(phs_wood_config_t), intent(in) :: phs_config
character(32) :: md5sum
if (phs_config%md5sum_forest /= "") then
md5sum = phs_config%md5sum_forest
else
md5sum = phs_config%md5sum_phs_config
end if
end function phs_wood_config_get_md5sum
@ %def phs_wood_config_get_md5sum
@ Check whether a phase-space configuration for the current process exists.
We look for the phase-space file that should correspond to the current
process. If we find it, we check the MD5 sums stored in the file against the
MD5 sums in the current configuration (if required).
If successful, read the PHS file.
<<PHS wood: phs wood config: TBP>>=
procedure :: read_phs_file => phs_wood_read_phs_file
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_read_phs_file &
(phs_config, exist, found, match, subdir)
class(phs_wood_config_t), intent(inout) :: phs_config
logical, intent(out) :: exist
logical, intent(out) :: found
logical, intent(out), optional :: match
type(string_t), intent(in), optional :: subdir
end subroutine phs_wood_read_phs_file
<<PHS wood: procedures>>=
module subroutine phs_wood_read_phs_file &
(phs_config, exist, found, match, subdir)
class(phs_wood_config_t), intent(inout) :: phs_config
logical, intent(out) :: exist
logical, intent(out) :: found
logical, intent(out), optional :: match
type(string_t), intent(in), optional :: subdir
type(string_t) :: filename
integer :: u
filename = phs_config%make_phs_filename (subdir)
inquire (file = char (filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (filename), action = "read", status = "old")
call phs_config%forest%read (u, phs_config%id, phs_config%n_in, &
phs_config%n_out, phs_config%model, found, &
phs_config%md5sum_process, phs_config%md5sum_model_par, &
phs_config%md5sum_phs_config, match = match)
close (u)
else
found = .false.
if (present (match)) match = .false.
end if
end subroutine phs_wood_read_phs_file
@ %def phs_wood_read_phs_file
@ Startup message, after configuration is complete.
<<PHS wood: phs wood config: TBP>>=
procedure :: startup_message => phs_wood_config_startup_message
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_config_startup_message (phs_config, unit)
class(phs_wood_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
end subroutine phs_wood_config_startup_message
<<PHS wood: procedures>>=
module subroutine phs_wood_config_startup_message (phs_config, unit)
class(phs_wood_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
integer :: n_groves, n_eq
n_groves = phs_config%forest%get_n_groves ()
n_eq = phs_config%forest%get_n_equivalences ()
call phs_config%base_startup_message (unit)
if (phs_config%n_channel == 1) then
write (msg_buffer, "(A,2(I0,A))") &
"Phase space: found ", phs_config%n_channel, &
" channel, collected in ", n_groves, &
" grove."
else if (n_groves == 1) then
write (msg_buffer, "(A,2(I0,A))") &
"Phase space: found ", phs_config%n_channel, &
" channels, collected in ", n_groves, &
" grove."
else
write (msg_buffer, "(A,2(I0,A))") &
"Phase space: found ", phs_config%n_channel, &
" channels, collected in ", n_groves, &
" groves."
end if
call msg_message (unit = unit)
if (phs_config%use_equivalences) then
if (n_eq == 1) then
write (msg_buffer, "(A,I0,A)") &
"Phase space: Using ", n_eq, &
" equivalence between channels."
else
write (msg_buffer, "(A,I0,A)") &
"Phase space: Using ", n_eq, &
" equivalences between channels."
end if
else
write (msg_buffer, "(A)") &
"Phase space: no equivalences between channels used."
end if
call msg_message (unit = unit)
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Phase space: wood"
call msg_message (unit = unit)
end subroutine phs_wood_config_startup_message
@ %def phs_wood_config_startup_message
@ Allocate an instance: the actual phase-space object.
Gfortran 7/8/9 bug, has to remain in the main module.
<<PHS wood: phs wood config: TBP>>=
procedure, nopass :: allocate_instance => phs_wood_config_allocate_instance
<<PHS wood: main procedures>>=
subroutine phs_wood_config_allocate_instance (phs)
class(phs_t), intent(inout), pointer :: phs
allocate (phs_wood_t :: phs)
end subroutine phs_wood_config_allocate_instance
@ %def phs_wood_config_allocate_instance
@
\subsection{Kinematics implementation}
We generate $\cos\theta$ and $\phi$ uniformly, covering the solid angle.
<<PHS wood: public>>=
public :: phs_wood_t
<<PHS wood: types>>=
type, extends (phs_t) :: phs_wood_t
real(default) :: sqrts = 0
type(phs_forest_t) :: forest
real(default), dimension(3) :: r_real
integer :: n_r_born = 0
contains
<<PHS wood: phs wood: TBP>>
end type phs_wood_t
@ %def phs_wood_t
@ Output. The [[verbose]] setting is irrelevant, we just display the contents
of the base object.
<<PHS wood: phs wood: TBP>>=
procedure :: write => phs_wood_write
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_write (object, unit, verbose)
class(phs_wood_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine phs_wood_write
<<PHS wood: procedures>>=
module subroutine phs_wood_write (object, unit, verbose)
class(phs_wood_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
call object%base_write (u)
end subroutine phs_wood_write
@ %def phs_wood_write
@ Write the forest separately.
<<PHS wood: phs wood: TBP>>=
procedure :: write_forest => phs_wood_write_forest
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_write_forest (object, unit)
class(phs_wood_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine phs_wood_write_forest
<<PHS wood: procedures>>=
module subroutine phs_wood_write_forest (object, unit)
class(phs_wood_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
call object%forest%write (u)
end subroutine phs_wood_write_forest
@ %def phs_wood_write_forest
@ Finalizer.
<<PHS wood: phs wood: TBP>>=
procedure :: final => phs_wood_final
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_final (object)
class(phs_wood_t), intent(inout) :: object
end subroutine phs_wood_final
<<PHS wood: procedures>>=
module subroutine phs_wood_final (object)
class(phs_wood_t), intent(inout) :: object
call object%forest%final ()
end subroutine phs_wood_final
@ %def phs_wood_final
@ Initialization. We allocate arrays ([[base_init]]) and adjust the
phase-space volume. The two-particle phase space volume is
\begin{equation}
\Phi_2 = \frac{1}{4(2\pi)^5} = 2.55294034614 \times 10^{-5}
\end{equation}
independent of the particle masses.
<<PHS wood: phs wood: TBP>>=
procedure :: init => phs_wood_init
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_init (phs, phs_config)
class(phs_wood_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
end subroutine phs_wood_init
<<PHS wood: procedures>>=
module subroutine phs_wood_init (phs, phs_config)
class(phs_wood_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
call phs%base_init (phs_config)
select type(phs_config)
type is (phs_wood_config_t)
phs%forest = phs_config%forest
if (phs_config%is_combined_integration) then
phs%n_r_born = phs_config%n_par - 3
end if
end select
end subroutine phs_wood_init
@ %def phs_wood_init
@
\subsection{Evaluation}
We compute the outgoing momenta from the incoming momenta and
the input parameter set [[r_in]] in channel [[r_in]]. We also compute the
[[r]] parameters and Jacobians [[f]] for all other channels.
We do \emph{not} need to a apply a transformation from/to the c.m.\ frame,
because in [[phs_base]] the momenta are already boosted to the c.m.\ frame
before assigning them in the [[phs]] object, and inversely boosted when
extracting them.
<<PHS wood: phs wood: TBP>>=
procedure :: evaluate_selected_channel => phs_wood_evaluate_selected_channel
procedure :: evaluate_other_channels => phs_wood_evaluate_other_channels
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_evaluate_selected_channel (phs, c_in, r_in)
class(phs_wood_t), intent(inout) :: phs
real(default), intent(in), dimension(:) :: r_in
integer, intent(in) :: c_in
end subroutine phs_wood_evaluate_selected_channel
module subroutine phs_wood_evaluate_other_channels (phs, c_in)
class(phs_wood_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_wood_evaluate_other_channels
<<PHS wood: procedures>>=
module subroutine phs_wood_evaluate_selected_channel (phs, c_in, r_in)
class(phs_wood_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
logical :: ok
phs%q_defined = .false.
if (phs%p_defined) then
call phs%forest%set_prt_in (phs%p)
phs%r(:,c_in) = r_in
call phs%forest%evaluate_selected_channel (c_in, phs%active_channel, &
phs%sqrts_hat, phs%r, phs%f, phs%volume, ok)
select type (config => phs%config)
type is (phs_wood_config_t)
if (config%is_combined_integration) then
if (phs%n_r_born >= 0) then
phs%r_real = r_in (phs%n_r_born + 1 : phs%n_r_born + 3)
else
call msg_fatal ("n_r_born should be larger than 0!")
end if
end if
end select
if (ok) then
phs%q = phs%forest%get_momenta_out ()
phs%q_defined = .true.
end if
end if
end subroutine phs_wood_evaluate_selected_channel
module subroutine phs_wood_evaluate_other_channels (phs, c_in)
class(phs_wood_t), intent(inout) :: phs
integer, intent(in) :: c_in
integer :: c
if (phs%q_defined) then
call phs%forest%evaluate_other_channels (c_in, phs%active_channel, &
phs%sqrts_hat, phs%r, phs%f, combine=.true.)
select type (config => phs%config)
type is (phs_wood_config_t)
if (config%is_combined_integration) then
if (phs%n_r_born >= 0) then
do c = 1, size (phs%r, 2)
phs%r(phs%n_r_born + 1 : phs%n_r_born + 3, c) = phs%r_real
end do
else
phs%r_defined = .false.
end if
end if
end select
phs%r_defined = .true.
end if
end subroutine phs_wood_evaluate_other_channels
@ %def phs_wood_evaluate_selected_channel
@ %def phs_wood_evaluate_other_channels
@ Inverse evaluation.
<<PHS wood: phs wood: TBP>>=
procedure :: inverse => phs_wood_inverse
<<PHS wood: sub interfaces>>=
module subroutine phs_wood_inverse (phs)
class(phs_wood_t), intent(inout) :: phs
end subroutine phs_wood_inverse
<<PHS wood: procedures>>=
module subroutine phs_wood_inverse (phs)
class(phs_wood_t), intent(inout) :: phs
if (phs%p_defined .and. phs%q_defined) then
call phs%forest%set_prt_in (phs%p)
call phs%forest%set_prt_out (phs%q)
call phs%forest%recover_channel (1, phs%sqrts_hat, phs%r, &
phs%f, phs%volume)
call phs%forest%evaluate_other_channels (1, phs%active_channel, &
phs%sqrts_hat, phs%r, phs%f, combine=.false.)
phs%r_defined = .true.
end if
end subroutine phs_wood_inverse
@ %def phs_wood_inverse
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[phs_wood_ut.f90]]>>=
<<File header>>
module phs_wood_ut
use unit_tests
use phs_wood_uti
<<Standard module head>>
<<PHS wood: public test>>
<<PHS wood: public test auxiliary>>
contains
<<PHS wood: test driver>>
end module phs_wood_ut
@ %def phs_wood_ut
@
<<[[phs_wood_uti.f90]]>>=
<<File header>>
module phs_wood_uti
<<Use kinds>>
<<Use strings>>
use io_units
use os_interface
use lorentz
use flavors
use model_data
use process_constants
use mappings
use phs_base
use phs_forests
use phs_wood
use phs_base_ut, only: init_test_process_data, init_test_decay_data
<<Standard module head>>
<<PHS wood: public test auxiliary>>
<<PHS wood: test declarations>>
contains
<<PHS wood: tests>>
<<PHS wood: test auxiliary>>
end module phs_wood_uti
@ %def phs_wood_ut
@ API: driver for the unit tests below.
<<PHS wood: public test>>=
public :: phs_wood_test
<<PHS wood: test driver>>=
subroutine phs_wood_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS wood: execute tests>>
end subroutine phs_wood_test
@ %def phs_wood_test
<<PHS wood: public test>>=
public :: phs_wood_vis_test
<<PHS wood: test driver>>=
subroutine phs_wood_vis_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS wood: execute vis tests>>
end subroutine phs_wood_vis_test
@ %def phs_wood_vis_test
@
\subsubsection{Phase-space configuration data}
Construct and display a test phase-space configuration object. Also
check the [[azimuthal_dependence]] flag.
This auxiliary routine writes a phase-space configuration file to unit
[[u_phs]].
<<PHS wood: public test auxiliary>>=
public :: write_test_phs_file
<<PHS wood: test auxiliary>>=
subroutine write_test_phs_file (u_phs, procname)
integer, intent(in) :: u_phs
type(string_t), intent(in), optional :: procname
if (present (procname)) then
write (u_phs, "(A,A)") "process ", char (procname)
else
write (u_phs, "(A)") "process testproc"
end if
write (u_phs, "(A,A)") " md5sum_process = ", '""'
write (u_phs, "(A,A)") " md5sum_model_par = ", '""'
write (u_phs, "(A,A)") " md5sum_phs_config = ", '""'
write (u_phs, "(A)") " sqrts = 1000"
write (u_phs, "(A)") " m_threshold_s = 50"
write (u_phs, "(A)") " m_threshold_t = 100"
write (u_phs, "(A)") " off_shell = 2"
write (u_phs, "(A)") " t_channel = 6"
write (u_phs, "(A)") " keep_nonresonant = T"
write (u_phs, "(A)") " grove #1"
write (u_phs, "(A)") " tree 3"
end subroutine write_test_phs_file
@ %def write_test_phs_file
@
<<PHS wood: execute tests>>=
call test (phs_wood_1, "phs_wood_1", &
"phase-space configuration", &
u, results)
<<PHS wood: test declarations>>=
public :: phs_wood_1
<<PHS wood: tests>>=
subroutine phs_wood_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
type(mapping_defaults_t) :: mapping_defaults
real(default) :: sqrts
integer :: u_phs, iostat
character(32) :: buffer
write (u, "(A)") "* Test output: phs_wood_1"
write (u, "(A)") "* Purpose: initialize and display &
&phase-space configuration data"
write (u, "(A)")
call model%init_test ()
call syntax_phs_forest_init ()
write (u, "(A)") "* Initialize a process"
write (u, "(A)")
call init_test_process_data (var_str ("phs_wood_1"), process_data)
write (u, "(A)") "* Create a scratch phase-space file"
write (u, "(A)")
u_phs = free_unit ()
open (u_phs, status = "scratch", action = "readwrite")
call write_test_phs_file (u_phs, var_str ("phs_wood_1"))
rewind (u_phs)
do
read (u_phs, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
write (u, "(A)")
write (u, "(A)") "* Setup phase-space configuration object"
write (u, "(A)")
mapping_defaults%step_mapping = .false.
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_input (u_phs)
call phs_data%set_mapping_defaults (mapping_defaults)
end select
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs_data%write (u)
write (u, "(A)")
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%write_forest (u)
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
close (u_phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_wood_1"
end subroutine phs_wood_1
@ %def phs_wood_1
@
\subsubsection{Phase space evaluation}
Compute kinematics for given parameters, also invert the calculation.
<<PHS wood: execute tests>>=
call test (phs_wood_2, "phs_wood_2", &
"phase-space evaluation", &
u, results)
<<PHS wood: test declarations>>=
public :: phs_wood_2
<<PHS wood: tests>>=
subroutine phs_wood_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(process_constants_t) :: process_data
real(default) :: sqrts, E
class(phs_config_t), allocatable, target :: phs_data
class(phs_t), pointer :: phs => null ()
type(vector4_t), dimension(2) :: p, q
integer :: u_phs
write (u, "(A)") "* Test output: phs_wood_2"
write (u, "(A)") "* Purpose: test simple single-channel phase space"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
write (u, "(A)") "* Initialize a process and a matching &
&phase-space configuration"
write (u, "(A)")
call init_test_process_data (var_str ("phs_wood_2"), process_data)
u_phs = free_unit ()
open (u_phs, status = "scratch", action = "readwrite")
call write_test_phs_file (u_phs, var_str ("phs_wood_2"))
rewind (u_phs)
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_input (u_phs)
end select
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs_data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Set incoming momenta"
write (u, "(A)")
E = sqrts / 2
p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute phase-space point &
&for x = 0.125, 0.5"
write (u, "(A)")
call phs%evaluate_selected_channel (1, [0.125_default, 0.5_default])
call phs%evaluate_other_channels (1)
call phs%write (u)
write (u, "(A)")
select type (phs)
type is (phs_wood_t)
call phs%write_forest (u)
end select
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
call phs%final ()
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call phs%write (u)
write (u, "(A)")
select type (phs)
type is (phs_wood_t)
call phs%write_forest (u)
end select
call phs%final ()
deallocate (phs)
close (u_phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_wood_2"
end subroutine phs_wood_2
@ %def phs_wood_2
@
\subsubsection{Phase-space generation}
Generate phase space for a simple process.
<<PHS wood: execute tests>>=
call test (phs_wood_3, "phs_wood_3", &
"phase-space generation", &
u, results)
<<PHS wood: test declarations>>=
public :: phs_wood_3
<<PHS wood: tests>>=
subroutine phs_wood_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
type(phs_parameters_t) :: phs_par
class(phs_config_t), allocatable :: phs_data
integer :: iostat
character(80) :: buffer
write (u, "(A)") "* Test output: phs_wood_3"
write (u, "(A)") "* Purpose: generate a phase-space configuration"
write (u, "(A)")
call model%init_test ()
call syntax_phs_forest_init ()
write (u, "(A)") "* Initialize a process and phase-space parameters"
write (u, "(A)")
call init_test_process_data (var_str ("phs_wood_3"), process_data)
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
phs_data%io_unit_keep_open = .true.
end select
write (u, "(A)")
write (u, "(A)") "* Generate a scratch phase-space file"
write (u, "(A)")
call phs_data%configure (phs_par%sqrts)
select type (phs_data)
type is (phs_wood_config_t)
rewind (phs_data%io_unit)
do
read (phs_data%io_unit, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_wood_3"
end subroutine phs_wood_3
@ %def phs_wood_3
@
\subsubsection{Nontrivial process}
Generate phase space for a $2\to 3$ process.
<<PHS wood: execute tests>>=
call test (phs_wood_4, "phs_wood_4", &
"nontrivial process", &
u, results)
<<PHS wood: test declarations>>=
public :: phs_wood_4
<<PHS wood: tests>>=
subroutine phs_wood_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
type(phs_parameters_t) :: phs_par
class(phs_config_t), allocatable, target :: phs_data
integer :: iostat
character(80) :: buffer
class(phs_t), pointer :: phs => null ()
real(default) :: E, pL
type(vector4_t), dimension(2) :: p
type(vector4_t), dimension(3) :: q
write (u, "(A)") "* Test output: phs_wood_4"
write (u, "(A)") "* Purpose: generate a phase-space configuration"
write (u, "(A)")
call model%init_test ()
call syntax_phs_forest_init ()
write (u, "(A)") "* Initialize a process and phase-space parameters"
write (u, "(A)")
process_data%id = "phs_wood_4"
process_data%model_name = "Test"
process_data%n_in = 2
process_data%n_out = 3
process_data%n_flv = 1
allocate (process_data%flv_state (process_data%n_in + process_data%n_out, &
process_data%n_flv))
process_data%flv_state(:,1) = [25, 25, 25, 6, -6]
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
phs_data%io_unit_keep_open = .true.
end select
write (u, "(A)")
write (u, "(A)") "* Generate a scratch phase-space file"
write (u, "(A)")
call phs_data%configure (phs_par%sqrts)
select type (phs_data)
type is (phs_wood_config_t)
rewind (phs_data%io_unit)
do
read (phs_data%io_unit, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
end select
write (u, "(A)")
write (u, "(A)") "* Initialize the phase-space instance"
write (u, "(A)")
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
write (u, "(A)") "* Set incoming momenta"
write (u, "(A)")
select type (phs_data)
type is (phs_wood_config_t)
E = phs_data%sqrts / 2
pL = sqrt (E**2 - phs_data%flv(1,1)%get_mass ()**2)
end select
p(1) = vector4_moving (E, pL, 3)
p(2) = vector4_moving (E, -pL, 3)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
write (u, "(A)") "* Compute phase-space point &
&for x = 0.1, 0.2, 0.3, 0.4, 0.5"
write (u, "(A)")
call phs%evaluate_selected_channel (1, &
[0.1_default, 0.2_default, 0.3_default, 0.4_default, 0.5_default])
call phs%evaluate_other_channels (1)
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call phs%get_outgoing_momenta (q)
call phs%final ()
deallocate (phs)
call phs_data%allocate_instance (phs)
call phs%init (phs_data)
call phs%set_incoming_momenta (p)
call phs%compute_flux ()
call phs%set_outgoing_momenta (q)
call phs%inverse ()
call phs%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call phs%final ()
deallocate (phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_wood_4"
end subroutine phs_wood_4
@ %def phs_wood_4
@
\subsubsection{Equivalences}
Generate phase space for a simple process, including channel equivalences.
<<PHS wood: execute tests>>=
call test (phs_wood_5, "phs_wood_5", &
"equivalences", &
u, results)
<<PHS wood: test declarations>>=
public :: phs_wood_5
<<PHS wood: tests>>=
subroutine phs_wood_5 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
type(phs_parameters_t) :: phs_par
class(phs_config_t), allocatable :: phs_data
write (u, "(A)") "* Test output: phs_wood_5"
write (u, "(A)") "* Purpose: generate a phase-space configuration"
write (u, "(A)")
call model%init_test ()
call syntax_phs_forest_init ()
write (u, "(A)") "* Initialize a process and phase-space parameters"
write (u, "(A)")
call init_test_process_data (var_str ("phs_wood_5"), process_data)
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
call phs_data%enable_equivalences ()
end select
write (u, "(A)")
write (u, "(A)") "* Generate a scratch phase-space file"
write (u, "(A)")
call phs_data%configure (phs_par%sqrts)
call phs_data%write (u)
write (u, "(A)")
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%write_forest (u)
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_wood_5"
end subroutine phs_wood_5
@ %def phs_wood_5
@
\subsubsection{MD5 sum checks}
Generate phase space for a simple process. Repeat this with and without
parameter change.
<<PHS wood: execute tests>>=
call test (phs_wood_6, "phs_wood_6", &
"phase-space generation", &
u, results)
<<PHS wood: test declarations>>=
public :: phs_wood_6
<<PHS wood: tests>>=
subroutine phs_wood_6 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(process_constants_t) :: process_data
type(phs_parameters_t) :: phs_par
class(phs_config_t), allocatable :: phs_data
logical :: exist, found, match
integer :: u_phs
character(*), parameter :: filename = "phs_wood_6_p.phs"
write (u, "(A)") "* Test output: phs_wood_6"
write (u, "(A)") "* Purpose: generate and check phase-space file"
write (u, "(A)")
call model%init_test ()
call syntax_phs_forest_init ()
write (u, "(A)") "* Initialize a process and phase-space parameters"
write (u, "(A)")
call init_test_process_data (var_str ("phs_wood_6"), process_data)
process_data%id = "phs_wood_6_p"
process_data%md5sum = "1234567890abcdef1234567890abcdef"
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
end select
write (u, "(A)") "* Remove previous phs file, if any"
write (u, "(A)")
inquire (file = filename, exist = exist)
if (exist) then
u_phs = free_unit ()
open (u_phs, file = filename, action = "write")
close (u_phs, status = "delete")
end if
write (u, "(A)") "* Check phase-space file (should fail)"
write (u, "(A)")
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%read_phs_file (exist, found, match)
write (u, "(1x,A,L1)") "exist = ", exist
write (u, "(1x,A,L1)") "found = ", found
write (u, "(1x,A,L1)") "match = ", match
end select
write (u, "(A)")
write (u, "(A)") "* Generate a phase-space file"
write (u, "(A)")
call phs_data%configure (phs_par%sqrts)
write (u, "(1x,A,A,A)") "MD5 sum (process) = '", &
phs_data%md5sum_process, "'"
write (u, "(1x,A,A,A)") "MD5 sum (model par) = '", &
phs_data%md5sum_model_par, "'"
write (u, "(1x,A,A,A)") "MD5 sum (phs config) = '", &
phs_data%md5sum_phs_config, "'"
write (u, "(A)")
write (u, "(A)") "* Check MD5 sum"
write (u, "(A)")
call phs_data%final ()
deallocate (phs_data)
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
phs_data%sqrts = phs_par%sqrts
phs_data%par%sqrts = phs_par%sqrts
end select
call phs_data%compute_md5sum ()
write (u, "(1x,A,A,A)") "MD5 sum (process) = '", &
phs_data%md5sum_process, "'"
write (u, "(1x,A,A,A)") "MD5 sum (model par) = '", &
phs_data%md5sum_model_par, "'"
write (u, "(1x,A,A,A)") "MD5 sum (phs config) = '", &
phs_data%md5sum_phs_config, "'"
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%read_phs_file (exist, found, match)
write (u, "(1x,A,L1)") "exist = ", exist
write (u, "(1x,A,L1)") "found = ", found
write (u, "(1x,A,L1)") "match = ", match
end select
write (u, "(A)")
write (u, "(A)") "* Modify sqrts and check MD5 sum"
write (u, "(A)")
call phs_data%final ()
deallocate (phs_data)
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
phs_par%sqrts = 500
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
phs_data%sqrts = phs_par%sqrts
phs_data%par%sqrts = phs_par%sqrts
end select
call phs_data%compute_md5sum ()
write (u, "(1x,A,A,A)") "MD5 sum (process) = '", &
phs_data%md5sum_process, "'"
write (u, "(1x,A,A,A)") "MD5 sum (model par) = '", &
phs_data%md5sum_model_par, "'"
write (u, "(1x,A,A,A)") "MD5 sum (phs config) = '", &
phs_data%md5sum_phs_config, "'"
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%read_phs_file (exist, found, match)
write (u, "(1x,A,L1)") "exist = ", exist
write (u, "(1x,A,L1)") "found = ", found
write (u, "(1x,A,L1)") "match = ", match
end select
write (u, "(A)")
write (u, "(A)") "* Modify process and check MD5 sum"
write (u, "(A)")
call phs_data%final ()
deallocate (phs_data)
process_data%md5sum = "77777777777777777777777777777777"
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
phs_data%sqrts = phs_par%sqrts
phs_data%par%sqrts = phs_par%sqrts
end select
call phs_data%compute_md5sum ()
write (u, "(1x,A,A,A)") "MD5 sum (process) = '", &
phs_data%md5sum_process, "'"
write (u, "(1x,A,A,A)") "MD5 sum (model par) = '", &
phs_data%md5sum_model_par, "'"
write (u, "(1x,A,A,A)") "MD5 sum (phs config) = '", &
phs_data%md5sum_phs_config, "'"
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%read_phs_file (exist, found, match)
write (u, "(1x,A,L1)") "exist = ", exist
write (u, "(1x,A,L1)") "found = ", found
write (u, "(1x,A,L1)") "match = ", match
end select
write (u, "(A)")
write (u, "(A)") "* Modify phs parameter and check MD5 sum"
write (u, "(A)")
call phs_data%final ()
deallocate (phs_data)
allocate (phs_wood_config_t :: phs_data)
process_data%md5sum = "1234567890abcdef1234567890abcdef"
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
phs_par%off_shell = 17
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
phs_data%sqrts = phs_par%sqrts
phs_data%par%sqrts = phs_par%sqrts
end select
call phs_data%compute_md5sum ()
write (u, "(1x,A,A,A)") "MD5 sum (process) = '", &
phs_data%md5sum_process, "'"
write (u, "(1x,A,A,A)") "MD5 sum (model par) = '", &
phs_data%md5sum_model_par, "'"
write (u, "(1x,A,A,A)") "MD5 sum (phs config) = '", &
phs_data%md5sum_phs_config, "'"
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%read_phs_file (exist, found, match)
write (u, "(1x,A,L1)") "exist = ", exist
write (u, "(1x,A,L1)") "found = ", found
write (u, "(1x,A,L1)") "match = ", match
end select
write (u, "(A)")
write (u, "(A)") "* Modify model parameter and check MD5 sum"
write (u, "(A)")
call phs_data%final ()
deallocate (phs_data)
allocate (phs_wood_config_t :: phs_data)
call model%set_par (var_str ("ms"), 100._default)
call phs_data%init (process_data, model)
phs_par%sqrts = 1000
phs_par%off_shell = 1
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_parameters (phs_par)
phs_data%sqrts = phs_par%sqrts
phs_data%par%sqrts = phs_par%sqrts
end select
call phs_data%compute_md5sum ()
write (u, "(1x,A,A,A)") "MD5 sum (process) = '", &
phs_data%md5sum_process, "'"
write (u, "(1x,A,A,A)") "MD5 sum (model par) = '", &
phs_data%md5sum_model_par, "'"
write (u, "(1x,A,A,A)") "MD5 sum (phs config) = '", &
phs_data%md5sum_phs_config, "'"
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%read_phs_file (exist, found, match)
write (u, "(1x,A,L1)") "exist = ", exist
write (u, "(1x,A,L1)") "found = ", found
write (u, "(1x,A,L1)") "match = ", match
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_wood_6"
end subroutine phs_wood_6
@ %def phs_wood_6
@
<<PHS wood: execute vis tests>>=
call test (phs_wood_vis_1, "phs_wood_vis_1", &
"visualizing phase space channels", &
u, results)
<<PHS wood: test declarations>>=
public :: phs_wood_vis_1
<<PHS wood: tests>>=
subroutine phs_wood_vis_1 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(process_constants_t) :: process_data
class(phs_config_t), allocatable :: phs_data
type(mapping_defaults_t) :: mapping_defaults
type(string_t) :: vis_file, pdf_file, ps_file
real(default) :: sqrts
logical :: exist, exist_pdf, exist_ps
integer :: u_phs, iostat, u_vis
character(95) :: buffer
write (u, "(A)") "* Test output: phs_wood_vis_1"
write (u, "(A)") "* Purpose: visualizing the &
&phase-space configuration"
write (u, "(A)")
call os_data%init ()
call model%init_test ()
call syntax_phs_forest_init ()
write (u, "(A)") "* Initialize a process"
write (u, "(A)")
call init_test_process_data (var_str ("phs_wood_vis_1"), process_data)
write (u, "(A)") "* Create a scratch phase-space file"
write (u, "(A)")
u_phs = free_unit ()
open (u_phs, status = "scratch", action = "readwrite")
call write_test_phs_file (u_phs, var_str ("phs_wood_vis_1"))
rewind (u_phs)
do
read (u_phs, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
write (u, "(A)") trim (buffer)
end do
write (u, "(A)")
write (u, "(A)") "* Setup phase-space configuration object"
write (u, "(A)")
mapping_defaults%step_mapping = .false.
allocate (phs_wood_config_t :: phs_data)
call phs_data%init (process_data, model)
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%set_input (u_phs)
call phs_data%set_mapping_defaults (mapping_defaults)
phs_data%os_data = os_data
phs_data%io_unit = 0
phs_data%io_unit_keep_open = .true.
phs_data%vis_channels = .true.
end select
sqrts = 1000._default
call phs_data%configure (sqrts)
call phs_data%write (u)
write (u, "(A)")
select type (phs_data)
type is (phs_wood_config_t)
call phs_data%write_forest (u)
end select
vis_file = "phs_wood_vis_1.phs-vis.tex"
ps_file = "phs_wood_vis_1.phs-vis.ps"
pdf_file = "phs_wood_vis_1.phs-vis.pdf"
inquire (file = char (vis_file), exist = exist)
if (exist) then
u_vis = free_unit ()
open (u_vis, file = char (vis_file), action = "read", status = "old")
iostat = 0
do while (iostat == 0)
read (u_vis, "(A)", iostat = iostat) buffer
if (iostat == 0) write (u, "(A)") trim (buffer)
end do
close (u_vis)
else
write (u, "(A)") "[Visualize LaTeX file is missing]"
end if
inquire (file = char (ps_file), exist = exist_ps)
if (exist_ps) then
write (u, "(A)") "[Visualize Postscript file exists and is nonempty]"
else
write (u, "(A)") "[Visualize Postscript file is missing/non-regular]"
end if
inquire (file = char (pdf_file), exist = exist_pdf)
if (exist_pdf) then
write (u, "(A)") "[Visualize PDF file exists and is nonempty]"
else
write (u, "(A)") "[Visualize PDF file is missing/non-regular]"
end if
write (u, "(A)")
write (u, "(A)") "* Cleanup"
close (u_phs)
call phs_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_wood_vis_1"
end subroutine phs_wood_vis_1
@ %def phs_wood_vis_1
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{The FKS phase space}
<<[[phs_fks.f90]]>>=
<<File header>>
module phs_fks
<<Use kinds>>
<<Use strings>>
use constants
use lorentz
use phs_points
use models, only: model_t
use phs_base
use resonances, only: resonance_contributors_t, resonance_history_t
use phs_wood
<<Standard module head>>
<<PHS fks: public>>
<<PHS fks: parameters>>
<<PHS fks: types>>
interface
<<PHS fks: sub interfaces>>
end interface
contains
<<PHS fks: main procedures>>
end module phs_fks
@ %def phs_fks
@
<<[[phs_fks_sub.f90]]>>=
<<File header>>
submodule (phs_fks) phs_fks_s
<<Use debug>>
use diagnostics
use io_units, only: given_output_unit, free_unit
use format_defs, only: FMT_17
use format_utils, only: write_separator
use physics_defs
use flavors
use pdg_arrays, only: is_colored
use cascades
use cascades2
use ttv_formfactors, only: generate_on_shell_decay_threshold, m1s_to_mpole
implicit none
<<PHS fks: interfaces>>
contains
<<PHS fks: procedures>>
end submodule phs_fks_s
@ %def phs_fks_s
@ A container for the $x_\oplus$- and $x_\ominus$-values for initial-state
phase spaces.
<<PHS fks: public>>=
public :: isr_kinematics_t
<<PHS fks: types>>=
type :: isr_kinematics_t
integer :: n_in
real(default), dimension(2) :: x = one
real(default), dimension(2) :: z = zero
real(default) :: sqrts_born = zero
real(default), dimension(:), allocatable :: beam_energy
real(default) :: fac_scale = zero
real(default), dimension(2) :: jacobian = one
integer :: isr_mode = SQRTS_FIXED
contains
<<PHS fks: isr kinematics: TBP>>
end type isr_kinematics_t
@ %def type isr_kinematics_t
@
<<PHS fks: isr kinematics: TBP>>=
procedure :: write => isr_kinematics_write
<<PHS fks: sub interfaces>>=
module subroutine isr_kinematics_write (isr, unit)
class(isr_kinematics_t), intent(in) :: isr
integer, intent(in), optional :: unit
end subroutine isr_kinematics_write
<<PHS fks: procedures>>=
module subroutine isr_kinematics_write (isr, unit)
class(isr_kinematics_t), intent(in) :: isr
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u,"(A)") "ISR kinematics: "
write (u,"(A," // FMT_17 // ",1X)") "x(+): ", isr%x(1)
write (u,"(A," // FMT_17 // ",1X)") "x(-): ", isr%x(2)
write (u,"(A," // FMT_17 // ",1X)") "z(+): ", isr%z(1)
write (u,"(A," // FMT_17 // ",1X)") "z(-): ", isr%z(2)
write (u,"(A," // FMT_17 // ",1X)") "sqrts (Born): ", isr%sqrts_born
if (allocated (isr%beam_energy)) then
do i = 1, size (isr%beam_energy)
write (u,"(A," // FMT_17 // ",1X)") "Beam energy: ", &
isr%beam_energy(i)
end do
end if
write (u,"(A," // FMT_17 // ",1X)") "Fac. scale: ", isr%fac_scale
do i = 1, 2
write (u,"(A," // FMT_17 // ",1X)") "Jacobian: ", isr%jacobian(i)
end do
write (u,"(A,I0,1X)") "ISR mode: ", isr%isr_mode
end subroutine isr_kinematics_write
@ %def isr_kinematics_write
@
<<PHS fks: public>>=
public :: phs_point_set_t
<<PHS fks: types>>=
type :: phs_point_set_t
type(phs_point_t), dimension(:), allocatable :: phs_point
logical :: initialized = .false.
contains
<<PHS fks: phs point set: TBP>>
end type phs_point_set_t
@ %def phs_point_set_t
@
<<PHS fks: phs point set: TBP>>=
procedure :: init => phs_point_set_init
<<PHS fks: sub interfaces>>=
module subroutine phs_point_set_init (phs_point_set, n_particles, n_phs)
class(phs_point_set_t), intent(out) :: phs_point_set
integer, intent(in) :: n_particles, n_phs
end subroutine phs_point_set_init
<<PHS fks: procedures>>=
module subroutine phs_point_set_init (phs_point_set, n_particles, n_phs)
class(phs_point_set_t), intent(out) :: phs_point_set
integer, intent(in) :: n_particles, n_phs
integer :: i_phs
allocate (phs_point_set%phs_point (n_phs))
do i_phs = 1, n_phs
phs_point_set%phs_point(i_phs) = n_particles
end do
phs_point_set%initialized = .true.
end subroutine phs_point_set_init
@ %def phs_point_set_init
@
<<PHS fks: phs point set: TBP>>=
procedure :: write => phs_point_set_write
<<PHS fks: sub interfaces>>=
module subroutine phs_point_set_write (phs_point_set, i_phs, contributors, &
unit, show_mass, testflag, check_conservation, ultra, n_in)
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in), optional :: i_phs
integer, intent(in), dimension(:), optional :: contributors
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_set_write
<<PHS fks: procedures>>=
module subroutine phs_point_set_write (phs_point_set, i_phs, contributors, &
unit, show_mass, testflag, check_conservation, ultra, n_in)
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in), optional :: i_phs
integer, intent(in), dimension(:), optional :: contributors
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
integer :: i, u
type(vector4_t) :: p_sum
u = given_output_unit (unit); if (u < 0) return
if (present (i_phs)) then
call phs_point_set%phs_point(i_phs)%write &
(unit = u, show_mass = show_mass, testflag = testflag, &
check_conservation = check_conservation, ultra = ultra, n_in = n_in)
else
do i = 1, size(phs_point_set%phs_point)
call phs_point_set%phs_point(i)%write &
(unit = u, show_mass = show_mass, testflag = testflag, &
check_conservation = check_conservation, ultra = ultra,&
n_in = n_in)
end do
end if
if (present (contributors)) then
if (debug_on) call msg_debug &
(D_SUBTRACTION, "Invariant masses for real emission: ")
associate (pp => phs_point_set%phs_point(i_phs))
p_sum = sum (pp, [contributors, size (pp)])
end associate
if (debug_active (D_SUBTRACTION)) &
call vector4_write (p_sum, unit = unit, show_mass = show_mass, &
testflag = testflag, ultra = ultra)
end if
end subroutine phs_point_set_write
@ %def phs_point_set_write
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_n_momenta => phs_point_set_get_n_momenta
<<PHS fks: sub interfaces>>=
elemental module function phs_point_set_get_n_momenta &
(phs_point_set, i_res) result (n)
integer :: n
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_res
end function phs_point_set_get_n_momenta
<<PHS fks: procedures>>=
elemental module function phs_point_set_get_n_momenta &
(phs_point_set, i_res) result (n)
integer :: n
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_res
n = size (phs_point_set%phs_point(i_res))
end function phs_point_set_get_n_momenta
@ %def phs_point_set_get_n_momenta
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_momenta => phs_point_set_get_momenta
<<PHS fks: sub interfaces>>=
pure module function phs_point_set_get_momenta &
(phs_point_set, i_phs, n_in) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
integer, intent(in), optional :: n_in
end function phs_point_set_get_momenta
<<PHS fks: procedures>>=
pure module function phs_point_set_get_momenta &
(phs_point_set, i_phs, n_in) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
integer, intent(in), optional :: n_in
integer :: i
if (present (n_in)) then
p = phs_point_set%phs_point(i_phs)%select ([(i, i=1, n_in)])
else
p = phs_point_set%phs_point(i_phs)
end if
end function phs_point_set_get_momenta
@ %def phs_point_set_get_momenta
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_momentum => phs_point_set_get_momentum
<<PHS fks: sub interfaces>>=
pure module function phs_point_set_get_momentum &
(phs_point_set, i_phs, i_mom) result (p)
type(vector4_t) :: p
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs, i_mom
end function phs_point_set_get_momentum
<<PHS fks: procedures>>=
pure module function phs_point_set_get_momentum &
(phs_point_set, i_phs, i_mom) result (p)
type(vector4_t) :: p
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs, i_mom
p = phs_point_set%phs_point(i_phs)%select (i_mom)
end function phs_point_set_get_momentum
@ %def phs_point_set_get_momentum
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_energy => phs_point_set_get_energy
<<PHS fks: sub interfaces>>=
pure module function phs_point_set_get_energy &
(phs_point_set, i_phs, i_mom) result (E)
real(default) :: E
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs, i_mom
end function phs_point_set_get_energy
<<PHS fks: procedures>>=
pure module function phs_point_set_get_energy &
(phs_point_set, i_phs, i_mom) result (E)
real(default) :: E
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs, i_mom
E = energy (phs_point_set%phs_point(i_phs)%select (i_mom))
end function phs_point_set_get_energy
@ %def phs_point_set_get_energy
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_sqrts => phs_point_set_get_sqrts
<<PHS fks: sub interfaces>>=
module function phs_point_set_get_sqrts &
(phs_point_set, i_phs) result (sqrts)
real(default) :: sqrts
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
end function phs_point_set_get_sqrts
<<PHS fks: procedures>>=
module function phs_point_set_get_sqrts &
(phs_point_set, i_phs) result (sqrts)
real(default) :: sqrts
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
sqrts = sqrt (phs_point_set%phs_point(i_phs)%get_msq ([1,2]))
end function phs_point_set_get_sqrts
@ %def phs_point_set_get_sqrts
@
<<PHS fks: phs point set: TBP>>=
generic :: set_momenta => set_momenta_p, set_momenta_phs_point
procedure :: set_momenta_p => phs_point_set_set_momenta_p
<<PHS fks: sub interfaces>>=
module subroutine phs_point_set_set_momenta_p (phs_point_set, i_phs, p)
class(phs_point_set_t), intent(inout) :: phs_point_set
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p
end subroutine phs_point_set_set_momenta_p
<<PHS fks: procedures>>=
module subroutine phs_point_set_set_momenta_p (phs_point_set, i_phs, p)
class(phs_point_set_t), intent(inout) :: phs_point_set
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p
phs_point_set%phs_point(i_phs) = p
end subroutine phs_point_set_set_momenta_p
@ %def phs_point_set_set_momenta_p
@
<<PHS fks: phs point set: TBP>>=
procedure :: set_momenta_phs_point => phs_point_set_set_momenta_phs_point
<<PHS fks: sub interfaces>>=
module subroutine phs_point_set_set_momenta_phs_point &
(phs_point_set, i_phs, p)
class(phs_point_set_t), intent(inout) :: phs_point_set
integer, intent(in) :: i_phs
type(phs_point_t), intent(in) :: p
end subroutine phs_point_set_set_momenta_phs_point
<<PHS fks: procedures>>=
module subroutine phs_point_set_set_momenta_phs_point &
(phs_point_set, i_phs, p)
class(phs_point_set_t), intent(inout) :: phs_point_set
integer, intent(in) :: i_phs
type(phs_point_t), intent(in) :: p
phs_point_set%phs_point(i_phs) = p
end subroutine phs_point_set_set_momenta_phs_point
@ %def phs_point_set_set_momenta_phs_point
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_n_particles => phs_point_set_get_n_particles
<<PHS fks: sub interfaces>>=
module function phs_point_set_get_n_particles &
(phs_point_set, i) result (n_particles)
integer :: n_particles
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in), optional :: i
end function phs_point_set_get_n_particles
<<PHS fks: procedures>>=
module function phs_point_set_get_n_particles &
(phs_point_set, i) result (n_particles)
integer :: n_particles
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in), optional :: i
integer :: j
j = 1; if (present (i)) j = i
n_particles = size (phs_point_set%phs_point(j))
end function phs_point_set_get_n_particles
@ %def phs_point_set_get_n_particles
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_n_phs => phs_point_set_get_n_phs
<<PHS fks: sub interfaces>>=
module function phs_point_set_get_n_phs (phs_point_set) result (n_phs)
integer :: n_phs
class(phs_point_set_t), intent(in) :: phs_point_set
end function phs_point_set_get_n_phs
<<PHS fks: procedures>>=
module function phs_point_set_get_n_phs (phs_point_set) result (n_phs)
integer :: n_phs
class(phs_point_set_t), intent(in) :: phs_point_set
n_phs = size (phs_point_set%phs_point)
end function phs_point_set_get_n_phs
@ %def phs_point_set_get_n_phs
@
<<PHS fks: phs point set: TBP>>=
procedure :: get_invariant_mass => phs_point_set_get_invariant_mass
<<PHS fks: sub interfaces>>=
module function phs_point_set_get_invariant_mass &
(phs_point_set, i_phs, i_part) result (m2)
real(default) :: m2
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
integer, intent(in), dimension(:) :: i_part
end function phs_point_set_get_invariant_mass
<<PHS fks: procedures>>=
module function phs_point_set_get_invariant_mass &
(phs_point_set, i_phs, i_part) result (m2)
real(default) :: m2
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
integer, intent(in), dimension(:) :: i_part
m2 = phs_point_set%phs_point(i_phs)%get_msq (i_part)
end function phs_point_set_get_invariant_mass
@ %def phs_point_set_get_invariant_mass
@
<<PHS fks: phs point set: TBP>>=
procedure :: write_phs_point => phs_point_set_write_phs_point
<<PHS fks: sub interfaces>>=
module subroutine phs_point_set_write_phs_point (phs_point_set, i_phs, &
unit, show_mass, testflag, check_conservation, ultra, n_in)
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
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_set_write_phs_point
<<PHS fks: procedures>>=
module subroutine phs_point_set_write_phs_point (phs_point_set, i_phs, &
unit, show_mass, testflag, check_conservation, ultra, n_in)
class(phs_point_set_t), intent(in) :: phs_point_set
integer, intent(in) :: i_phs
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
call phs_point_set%phs_point(i_phs)%write (unit, show_mass, testflag, &
check_conservation, ultra, n_in)
end subroutine phs_point_set_write_phs_point
@ %def phs_point_set_write_phs_point
@
<<PHS fks: phs point set: TBP>>=
procedure :: final => phs_point_set_final
<<PHS fks: sub interfaces>>=
module subroutine phs_point_set_final (phs_point_set)
class(phs_point_set_t), intent(inout) :: phs_point_set
end subroutine phs_point_set_final
<<PHS fks: procedures>>=
module subroutine phs_point_set_final (phs_point_set)
class(phs_point_set_t), intent(inout) :: phs_point_set
integer :: i
deallocate (phs_point_set%phs_point)
phs_point_set%initialized = .false.
end subroutine phs_point_set_final
@ %def phs_point_set_final
@
<<PHS fks: public>>=
public :: real_jacobian_t
<<PHS fks: types>>=
type :: real_jacobian_t
real(default), dimension(4) :: jac = 1._default
end type real_jacobian_t
@ %def real_jacobian_t
@
<<PHS fks: public>>=
public :: real_kinematics_t
<<PHS fks: types>>=
type :: real_kinematics_t
logical :: supply_xi_max = .true.
real(default) :: xi_tilde
real(default) :: phi
real(default), dimension(:), allocatable :: xi_max, y
real(default) :: xi_mismatch, y_mismatch
type(real_jacobian_t), dimension(:), allocatable :: jac
real(default) :: jac_mismatch
type(phs_point_set_t) :: p_born_cms
type(phs_point_set_t) :: p_born_lab
type(phs_point_set_t) :: p_real_cms
type(phs_point_set_t) :: p_real_lab
type(phs_point_set_t) :: p_born_onshell
type(phs_point_set_t), dimension(2) :: p_real_onshell
integer, dimension(:), allocatable :: alr_to_i_phs
real(default), dimension(3) :: x_rad
real(default), dimension(:), allocatable :: jac_rand
real(default), dimension(:), allocatable :: y_soft
real(default) :: cms_energy2
type(vector4_t), dimension(:), allocatable :: xi_ref_momenta
contains
<<PHS fks: real kinematics: TBP>>
end type real_kinematics_t
@ %def real_kinematics_t
@
<<PHS fks: real kinematics: TBP>>=
procedure :: init => real_kinematics_init
<<PHS fks: sub interfaces>>=
module subroutine real_kinematics_init (r, n_tot, n_phs, n_alr, n_contr)
class(real_kinematics_t), intent(inout) :: r
integer, intent(in) :: n_tot, n_phs, n_alr, n_contr
end subroutine real_kinematics_init
<<PHS fks: procedures>>=
module subroutine real_kinematics_init (r, n_tot, n_phs, n_alr, n_contr)
class(real_kinematics_t), intent(inout) :: r
integer, intent(in) :: n_tot, n_phs, n_alr, n_contr
allocate (r%xi_max (n_phs))
allocate (r%y (n_phs))
allocate (r%y_soft (n_phs))
call r%p_born_cms%init (n_tot - 1, 1)
call r%p_born_lab%init (n_tot - 1, 1)
call r%p_real_cms%init (n_tot, n_phs)
call r%p_real_lab%init (n_tot, n_phs)
allocate (r%jac (n_phs), r%jac_rand (n_phs))
allocate (r%alr_to_i_phs (n_alr))
allocate (r%xi_ref_momenta (n_contr))
r%alr_to_i_phs = 0
r%xi_tilde = zero; r%xi_mismatch = zero
r%xi_max = zero
r%y = zero; r%y_mismatch = zero
r%y_soft = zero
r%phi = zero
r%cms_energy2 = zero
r%xi_ref_momenta = vector4_null
r%jac_mismatch = one
r%jac_rand = one
end subroutine real_kinematics_init
@ %def real_kinematics_init
@
<<PHS fks: real kinematics: TBP>>=
procedure :: init_onshell => real_kinematics_init_onshell
<<PHS fks: sub interfaces>>=
module subroutine real_kinematics_init_onshell (r, n_tot, n_phs)
class(real_kinematics_t), intent(inout) :: r
integer, intent(in) :: n_tot, n_phs
end subroutine real_kinematics_init_onshell
<<PHS fks: procedures>>=
module subroutine real_kinematics_init_onshell (r, n_tot, n_phs)
class(real_kinematics_t), intent(inout) :: r
integer, intent(in) :: n_tot, n_phs
call r%p_born_onshell%init (n_tot - 1, 1)
call r%p_real_onshell(1)%init (n_tot, n_phs)
call r%p_real_onshell(2)%init (n_tot, n_phs)
end subroutine real_kinematics_init_onshell
@ %def real_kinematics_init_onshell
@
<<PHS fks: real kinematics: TBP>>=
procedure :: write => real_kinematics_write
<<PHS fks: sub interfaces>>=
module subroutine real_kinematics_write (r, unit)
class(real_kinematics_t), intent(in) :: r
integer, intent(in), optional :: unit
end subroutine real_kinematics_write
<<PHS fks: procedures>>=
module subroutine real_kinematics_write (r, unit)
class(real_kinematics_t), intent(in) :: r
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u,"(A)") "Real kinematics: "
write (u,"(A," // FMT_17 // ",1X)") "xi_tilde: ", r%xi_tilde
write (u,"(A," // FMT_17 // ",1X)") "phi: ", r%phi
do i = 1, size (r%xi_max)
write (u,"(A,I1,1X)") "i_phs: ", i
write (u,"(A," // FMT_17 // ",1X)") "xi_max: ", r%xi_max(i)
write (u,"(A," // FMT_17 // ",1X)") "y: ", r%y(i)
write (u,"(A," // FMT_17 // ",1X)") "jac_rand: ", r%jac_rand(i)
write (u,"(A," // FMT_17 // ",1X)") "y_soft: ", r%y_soft(i)
end do
write (u, "(A)") "Born Momenta: "
write (u, "(A)") "CMS: "
call r%p_born_cms%write (unit = u)
write (u, "(A)") "Lab: "
call r%p_born_lab%write (unit = u)
write (u, "(A)") "Real Momenta: "
write (u, "(A)") "CMS: "
call r%p_real_cms%write (unit = u)
write (u, "(A)") "Lab: "
call r%p_real_lab%write (unit = u)
end subroutine real_kinematics_write
@ %def real_kinematics_write
@ The boost to the center-of-mass system only has a reasonable meaning
above the threshold. Below the threshold, we do not apply boost at all, so
that the top quarks stay in the rest frame. However, with top quarks exactly
at rest, problems arise in the matrix elements (e.g. in the computation
of angles). Therefore, we apply a boost which is not exactly 1, but has a
tiny value differing from that.
<<PHS fks: public>>=
public :: get_boost_for_threshold_projection
<<PHS fks: sub interfaces>>=
module function get_boost_for_threshold_projection &
(p, sqrts, mtop) result (L)
type(lorentz_transformation_t) :: L
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: sqrts, mtop
end function get_boost_for_threshold_projection
<<PHS fks: procedures>>=
module function get_boost_for_threshold_projection &
(p, sqrts, mtop) result (L)
type(lorentz_transformation_t) :: L
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: sqrts, mtop
type(vector4_t) :: p_tmp
type(vector3_t) :: dir
real(default) :: scale_factor, arg
p_tmp = p(THR_POS_WP) + p(THR_POS_B)
arg = sqrts**2 - four * mtop**2
if (arg > zero) then
scale_factor = sqrt (arg) / two
else
scale_factor = tiny_07*1000
end if
dir = scale_factor * create_unit_vector (p_tmp)
p_tmp = [sqrts / two, dir%p]
L = boost (p_tmp, mtop)
end function get_boost_for_threshold_projection
@ %def get_boost_for_threshold_projection
@ This routine recomputes the value of $\phi$ used to generate the real phase space.
<<PHS fks: procedures>>=
function get_generation_phi (p_born, p_real, emitter, i_gluon) result (phi)
real(default) :: phi
type(vector4_t), intent(in), dimension(:) :: p_born, p_real
integer, intent(in) :: emitter, i_gluon
type(vector4_t) :: p1, p2, pp
type(lorentz_transformation_t) :: rot_to_gluon, rot_to_z
type(vector3_t) :: dir, z
real(default) :: cpsi
pp = p_real(emitter) + p_real(i_gluon)
cpsi = (space_part_norm (pp)**2 - space_part_norm (p_real(emitter))**2 &
+ space_part_norm (p_real(i_gluon))**2) / &
(two * space_part_norm (pp) * space_part_norm (p_real(i_gluon)))
dir = create_orthogonal (space_part (p_born(emitter)))
rot_to_gluon = rotation (cpsi, sqrt (one - cpsi**2), dir)
pp = rot_to_gluon * p_born(emitter)
z%p = [0._default, 0._default, 1._default]
rot_to_z = rotation_to_2nd &
(space_part (p_born(emitter)) / space_part_norm (p_born(emitter)), z)
p1 = rot_to_z * pp / space_part_norm (pp)
p2 = rot_to_z * p_real(i_gluon)
phi = azimuthal_distance (p1, p2)
if (phi < zero) phi = twopi - abs(phi)
end function get_generation_phi
@ %def get_generation_phi
@
<<PHS fks: real kinematics: TBP>>=
procedure :: apply_threshold_projection_real => &
real_kinematics_apply_threshold_projection_real
<<PHS fks: sub interfaces>>=
module subroutine real_kinematics_apply_threshold_projection_real &
(r, i_phs, mtop, L_to_cms, invert)
class(real_kinematics_t), intent(inout) :: r
integer, intent(in) :: i_phs
real(default), intent(in) :: mtop
type(lorentz_transformation_t), intent(in), dimension(:) :: L_to_cms
logical, intent(in) :: invert
end subroutine real_kinematics_apply_threshold_projection_real
<<PHS fks: procedures>>=
module subroutine real_kinematics_apply_threshold_projection_real &
(r, i_phs, mtop, L_to_cms, invert)
class(real_kinematics_t), intent(inout) :: r
integer, intent(in) :: i_phs
real(default), intent(in) :: mtop
type(lorentz_transformation_t), intent(in), dimension(:) :: L_to_cms
logical, intent(in) :: invert
integer :: leg, other_leg
type(vector4_t), dimension(:), allocatable :: p_real
type(vector4_t), dimension(:), allocatable :: p_real_onshell
type(vector4_t), dimension(4) :: k_tmp
type(vector4_t), dimension(4) :: k_decay_onshell_real
type(vector4_t), dimension(3) :: k_decay_onshell_born
do leg = 1, 2
other_leg = 3 - leg
p_real = r%p_real_cms%phs_point(i_phs)
allocate (p_real_onshell (size (p_real)))
p_real_onshell(1:2) = p_real(1:2)
k_tmp(1) = p_real(7)
k_tmp(2) = p_real(ass_quark(leg))
k_tmp(3) = p_real(ass_boson(leg))
k_tmp(4) = [mtop, zero, zero, zero]
call generate_on_shell_decay_threshold (k_tmp(1:3), &
k_tmp(4), k_decay_onshell_real (2:4))
k_decay_onshell_real (1) = k_tmp(4)
k_tmp(1) = p_real(ass_quark(other_leg))
k_tmp(2) = p_real(ass_boson(other_leg))
k_decay_onshell_born = create_two_particle_decay (mtop**2, k_tmp(1), k_tmp(2))
p_real_onshell(THR_POS_GLUON) = L_to_cms(leg) * k_decay_onshell_real (2)
p_real_onshell(ass_quark(leg)) = L_to_cms(leg) * k_decay_onshell_real(3)
p_real_onshell(ass_boson(leg)) = L_to_cms(leg) * k_decay_onshell_real(4)
p_real_onshell(ass_quark(other_leg)) = L_to_cms(leg) * k_decay_onshell_born (2)
p_real_onshell(ass_boson(other_leg)) = L_to_cms(leg) * k_decay_onshell_born (3)
if (invert) then
call vector4_invert_direction (p_real_onshell (ass_quark(other_leg)))
call vector4_invert_direction (p_real_onshell (ass_boson(other_leg)))
end if
r%p_real_onshell(leg)%phs_point(i_phs) = p_real_onshell
deallocate (p_real_onshell)
end do
end subroutine real_kinematics_apply_threshold_projection_real
@ %def real_kinematics_apply_threshold_projection_real
@
<<PHS fks: public>>=
public :: threshold_projection_born
<<PHS fks: sub interfaces>>=
module subroutine threshold_projection_born &
(mtop, L_to_cms, p_in, p_onshell)
real(default), intent(in) :: mtop
type(lorentz_transformation_t), intent(in) :: L_to_cms
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:) :: p_onshell
end subroutine threshold_projection_born
<<PHS fks: procedures>>=
module subroutine threshold_projection_born &
(mtop, L_to_cms, p_in, p_onshell)
real(default), intent(in) :: mtop
type(lorentz_transformation_t), intent(in) :: L_to_cms
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:) :: p_onshell
type(vector4_t), dimension(3) :: k_decay_onshell
type(vector4_t) :: p_tmp_1, p_tmp_2
type(lorentz_transformation_t) :: L_to_cms_inv
p_onshell(1:2) = p_in(1:2)
L_to_cms_inv = inverse (L_to_cms)
p_tmp_1 = L_to_cms_inv * p_in(THR_POS_B)
p_tmp_2 = L_to_cms_inv * p_in(THR_POS_WP)
k_decay_onshell = create_two_particle_decay (mtop**2, &
p_tmp_1, p_tmp_2)
p_onshell([THR_POS_B, THR_POS_WP]) = k_decay_onshell([2, 3])
p_tmp_1 = L_to_cms * p_in(THR_POS_BBAR)
p_tmp_2 = L_to_cms * p_in(THR_POS_WM)
k_decay_onshell = create_two_particle_decay (mtop**2, &
p_tmp_1, p_tmp_2)
p_onshell([THR_POS_BBAR, THR_POS_WM]) = k_decay_onshell([2, 3])
p_onshell([THR_POS_WP, THR_POS_B]) = L_to_cms * p_onshell([THR_POS_WP, THR_POS_B])
p_onshell([THR_POS_WM, THR_POS_BBAR]) = L_to_cms_inv * p_onshell([THR_POS_WM, THR_POS_BBAR])
end subroutine threshold_projection_born
@ %def threshold_projection_born
@ This routine computes the bounds of the Dalitz region for massive emitters.
The corresponding derivation can be found in [[1202.0465]], App. A.
It is also used for the POWHEG matching so the routine is public.
The input parameter [[m2]] corresponds to the squared mass of the emitter.
<<PHS fks: public>>=
public :: compute_dalitz_bounds
<<PHS fks: sub interfaces>>=
pure module subroutine compute_dalitz_bounds &
(q0, m2, mrec2, z1, z2, k0_rec_max)
real(default), intent(in) :: q0, m2, mrec2
real(default), intent(out) :: z1, z2, k0_rec_max
end subroutine compute_dalitz_bounds
<<PHS fks: procedures>>=
pure module subroutine compute_dalitz_bounds &
(q0, m2, mrec2, z1, z2, k0_rec_max)
real(default), intent(in) :: q0, m2, mrec2
real(default), intent(out) :: z1, z2, k0_rec_max
k0_rec_max = (q0**2 - m2 + mrec2) / (two * q0)
z1 = (k0_rec_max + sqrt(k0_rec_max**2 - mrec2)) / q0
z2 = (k0_rec_max - sqrt(k0_rec_max**2 - mrec2)) / q0
end subroutine compute_dalitz_bounds
@ %def compute_dalitz_bounds
@ Compute the [[kt2]] of a given emitter
<<PHS fks: real kinematics: TBP>>=
procedure :: kt2 => real_kinematics_kt2
<<PHS fks: sub interfaces>>=
module function real_kinematics_kt2 &
(real_kinematics, i_phs, emitter, kt2_type, xi, y) result (kt2)
real(default) :: kt2
class(real_kinematics_t), intent(in) :: real_kinematics
integer, intent(in) :: emitter, i_phs, kt2_type
real(default), intent(in), optional :: xi, y
end function real_kinematics_kt2
<<PHS fks: procedures>>=
module function real_kinematics_kt2 &
(real_kinematics, i_phs, emitter, kt2_type, xi, y) result (kt2)
real(default) :: kt2
class(real_kinematics_t), intent(in) :: real_kinematics
integer, intent(in) :: emitter, i_phs, kt2_type
real(default), intent(in), optional :: xi, y
real(default) :: xii, yy
real(default) :: q, E_em, z, z1, z2, m2, mrec2, k0_rec_max
type(vector4_t) :: p_emitter
if (present (y)) then
yy = y
else
yy = real_kinematics%y (i_phs)
end if
if (present (xi)) then
xii = xi
else
xii = real_kinematics%xi_tilde * real_kinematics%xi_max (i_phs)
end if
select case (kt2_type)
case (UBF_FSR_SIMPLE)
kt2 = real_kinematics%cms_energy2 / two * xii**2 * (1 - yy)
case (UBF_FSR_MASSIVE)
q = sqrt (real_kinematics%cms_energy2)
p_emitter = real_kinematics%p_born_cms%phs_point(1)%select (emitter)
mrec2 = (q - p_emitter%p(0))**2 - sum (p_emitter%p(1:3)**2)
m2 = p_emitter**2
E_em = energy (p_emitter)
call compute_dalitz_bounds (q, m2, mrec2, z1, z2, k0_rec_max)
z = z2 - (z2 - z1) * (one + yy) / two
kt2 = xii**2 * q**3 * (one - z) / &
(two * E_em - z * xii * q)
case (UBF_FSR_MASSLESS_RECOIL)
kt2 = real_kinematics%cms_energy2 / two * xii**2 * (1 - yy**2) / two
case (UBF_ISR)
kt2 = real_kinematics%cms_energy2 / four * xii**2 * (1 - yy**2) / (1 - xii)
case default
kt2 = zero
call msg_bug ("kt2_type must be set to a known value")
end select
end function real_kinematics_kt2
@ %def real_kinematics_kt2
@ These are the possible values for [[upper_bound_func_type]] and will be
used to decide which UBF object is allocated and which $K_T$ scale for the
matching is computed.
<<PHS fks: parameters>>=
integer, parameter, public :: UBF_FSR_SIMPLE = 1
integer, parameter, public :: UBF_FSR_MASSIVE = 2
integer, parameter, public :: UBF_FSR_MASSLESS_RECOIL = 3
integer, parameter, public :: UBF_ISR = 4
@ %def UBF_FSR_SIMPLE UBF_FSR_MASSIVE UBF_FSR_MASSLESS_RECOIL UBF_ISR
@
<<PHS fks: real kinematics: TBP>>=
procedure :: final => real_kinematics_final
<<PHS fks: sub interfaces>>=
module subroutine real_kinematics_final (real_kin)
class(real_kinematics_t), intent(inout) :: real_kin
end subroutine real_kinematics_final
<<PHS fks: procedures>>=
module subroutine real_kinematics_final (real_kin)
class(real_kinematics_t), intent(inout) :: real_kin
if (allocated (real_kin%xi_max)) deallocate (real_kin%xi_max)
if (allocated (real_kin%y)) deallocate (real_kin%y)
if (allocated (real_kin%alr_to_i_phs)) deallocate (real_kin%alr_to_i_phs)
if (allocated (real_kin%jac_rand)) deallocate (real_kin%jac_rand)
if (allocated (real_kin%y_soft)) deallocate (real_kin%y_soft)
if (allocated (real_kin%xi_ref_momenta)) &
deallocate (real_kin%xi_ref_momenta)
call real_kin%p_born_cms%final (); call real_kin%p_born_lab%final ()
call real_kin%p_real_cms%final (); call real_kin%p_real_lab%final ()
end subroutine real_kinematics_final
@ %def real_kinematics_final
@
<<PHS fks: parameters>>=
integer, parameter, public :: I_XI = 1
integer, parameter, public :: I_Y = 2
integer, parameter, public :: I_PHI = 3
integer, parameter, public :: PHS_MODE_UNDEFINED = 0
integer, parameter, public :: PHS_MODE_ADDITIONAL_PARTICLE = 1
integer, parameter, public :: PHS_MODE_COLLINEAR_REMNANT = 2
@ %def parameters
@
<<PHS fks: public>>=
public :: phs_fks_config_t
<<PHS fks: types>>=
type, extends (phs_wood_config_t) :: phs_fks_config_t
integer :: mode = PHS_MODE_UNDEFINED
character(32) :: md5sum_born_config
logical :: born_2_to_1 = .false.
logical :: make_dalitz_plot = .false.
contains
<<PHS fks: fks config: TBP>>
end type phs_fks_config_t
@ %def phs_fks_config_t
@
<<PHS fks: fks config: TBP>>=
procedure :: clear_phase_space => fks_config_clear_phase_space
<<PHS fks: sub interfaces>>=
module subroutine fks_config_clear_phase_space (phs_config)
class(phs_fks_config_t), intent(inout) :: phs_config
end subroutine fks_config_clear_phase_space
<<PHS fks: procedures>>=
module subroutine fks_config_clear_phase_space (phs_config)
class(phs_fks_config_t), intent(inout) :: phs_config
end subroutine fks_config_clear_phase_space
@ %def fks_config_clear_phase_space
@
<<PHS fks: fks config: TBP>>=
procedure :: write => phs_fks_config_write
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_config_write (object, unit, include_id)
class(phs_fks_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
end subroutine phs_fks_config_write
<<PHS fks: procedures>>=
module subroutine phs_fks_config_write (object, unit, include_id)
class(phs_fks_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: include_id
integer :: u
u = given_output_unit (unit)
call object%phs_wood_config_t%write (u)
write (u, "(3x,A,I0)") "NLO mode = ", object%mode
write (u, "(3x,A,L1)") "2->1 proc = ", object%born_2_to_1
write (u, "(3x,A,L1)") "Dalitz = ", object%make_dalitz_plot
write (u, "(A,A)") "Extra Born md5sum: ", object%md5sum_born_config
end subroutine phs_fks_config_write
@ %def phs_fks_config_write
@
<<PHS fks: fks config: TBP>>=
procedure :: set_mode => phs_fks_config_set_mode
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_config_set_mode (phs_config, mode)
class(phs_fks_config_t), intent(inout) :: phs_config
integer, intent(in) :: mode
end subroutine phs_fks_config_set_mode
<<PHS fks: procedures>>=
module subroutine phs_fks_config_set_mode (phs_config, mode)
class(phs_fks_config_t), intent(inout) :: phs_config
integer, intent(in) :: mode
select case (mode)
case (NLO_REAL, NLO_MISMATCH)
phs_config%mode = PHS_MODE_ADDITIONAL_PARTICLE
case (NLO_DGLAP)
phs_config%mode = PHS_MODE_COLLINEAR_REMNANT
end select
end subroutine phs_fks_config_set_mode
@ %def phs_fks_config_set_mod
@
<<PHS fks: fks config: TBP>>=
procedure :: configure => phs_fks_config_configure
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_fks_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
end subroutine phs_fks_config_configure
<<PHS fks: procedures>>=
module subroutine phs_fks_config_configure (phs_config, sqrts, &
sqrts_fixed, lab_is_cm, azimuthal_dependence, rebuild, &
ignore_mismatch, nlo_type, subdir)
class(phs_fks_config_t), intent(inout) :: phs_config
real(default), intent(in) :: sqrts
logical, intent(in), optional :: sqrts_fixed
logical, intent(in), optional :: lab_is_cm
logical, intent(in), optional :: azimuthal_dependence
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: subdir
if (present (nlo_type)) phs_config%nlo_type = nlo_type
if (.not. phs_config%is_combined_integration) then
select case (phs_config%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
phs_config%n_par = phs_config%n_par + 3
if (phs_config%nlo_type == NLO_REAL .and. phs_config%n_out == 2) then
phs_config%born_2_to_1 = .true.
end if
case (PHS_MODE_COLLINEAR_REMNANT)
phs_config%n_par = phs_config%n_par + 1
end select
end if
call phs_config%compute_md5sum ()
end subroutine phs_fks_config_configure
@ %def phs_fks_config_configure
@
<<PHS fks: fks config: TBP>>=
procedure :: startup_message => phs_fks_config_startup_message
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_config_startup_message (phs_config, unit)
class(phs_fks_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
end subroutine phs_fks_config_startup_message
<<PHS fks: procedures>>=
module subroutine phs_fks_config_startup_message (phs_config, unit)
class(phs_fks_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
call phs_config%phs_wood_config_t%startup_message (unit)
end subroutine phs_fks_config_startup_message
@ %def phs_fks_config_startup_message
@ Gfortran 7/8/9 bug, has to remain in the main module:
<<PHS fks: fks config: TBP>>=
procedure, nopass :: allocate_instance => phs_fks_config_allocate_instance
<<PHS fks: main procedures>>=
subroutine phs_fks_config_allocate_instance (phs)
class(phs_t), intent(inout), pointer :: phs
allocate (phs_fks_t :: phs)
end subroutine phs_fks_config_allocate_instance
@ %def phs_fks_config_allocate_instance
@ If the phase space is generated from file, but we want to have resonance
histories, we must force the cascade sets to be generated. However, it must
be assured that Born flavors are used for this.
<<PHS fks: fks config: TBP>>=
procedure :: generate_phase_space_extra => &
phs_fks_config_generate_phase_space_extra
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_config_generate_phase_space_extra (phs_config)
class(phs_fks_config_t), intent(inout) :: phs_config
end subroutine phs_fks_config_generate_phase_space_extra
<<PHS fks: procedures>>=
module subroutine phs_fks_config_generate_phase_space_extra (phs_config)
class(phs_fks_config_t), intent(inout) :: phs_config
integer :: off_shell, extra_off_shell
type(flavor_t), dimension(:,:), allocatable :: flv_born
integer :: i, j
integer :: n_state, n_flv_born
integer :: unit_fds
logical :: valid
type(string_t) :: file_name
logical :: file_exists
if (phs_config%use_cascades2) then
allocate (phs_config%feyngraph_set)
else
allocate (phs_config%cascade_set)
end if
n_flv_born = size (phs_config%flv, 1) - 1
n_state = size (phs_config%flv, 2)
allocate (flv_born (n_flv_born, n_state))
do i = 1, n_flv_born
do j = 1, n_state
flv_born(i, j) = phs_config%flv(i, j)
end do
end do
if (phs_config%use_cascades2) then
file_name = char (phs_config%id) // ".fds"
inquire (file=char (file_name), exist=file_exists)
if (.not. file_exists) call msg_fatal &
("The O'Mega input file " // char (file_name) // &
" does not exist. " // "Please make sure that the " // &
"variable ?omega_write_phs_output has been set correctly.")
unit_fds = free_unit ()
open (unit=unit_fds, file=char(file_name), status='old', action='read')
end if
off_shell = phs_config%par%off_shell
do extra_off_shell = 0, max (n_flv_born - 2, 0)
phs_config%par%off_shell = off_shell + extra_off_shell
if (phs_config%use_cascades2) then
call feyngraph_set_generate (phs_config%feyngraph_set, &
phs_config%model, phs_config%n_in, phs_config%n_out - 1, &
flv_born, phs_config%par, phs_config%fatal_beam_decay, unit_fds, &
phs_config%vis_channels)
if (feyngraph_set_is_valid (phs_config%feyngraph_set)) exit
else
call cascade_set_generate (phs_config%cascade_set, &
phs_config%model, phs_config%n_in, phs_config%n_out - 1, &
flv_born, phs_config%par, phs_config%fatal_beam_decay)
if (cascade_set_is_valid (phs_config%cascade_set)) exit
end if
end do
if (phs_config%use_cascades2) then
close (unit_fds)
valid = feyngraph_set_is_valid (phs_config%feyngraph_set)
else
valid = cascade_set_is_valid (phs_config%cascade_set)
end if
if (.not. valid) &
call msg_fatal ("Resonance extraction: Phase space generation failed")
end subroutine phs_fks_config_generate_phase_space_extra
@ %def phs_fks_config_generate_phase_space_extra
@
<<PHS fks: fks config: TBP>>=
procedure :: set_born_config => phs_fks_config_set_born_config
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_config_set_born_config (phs_config, phs_cfg_born)
class(phs_fks_config_t), intent(inout) :: phs_config
type(phs_wood_config_t), intent(in), target :: phs_cfg_born
end subroutine phs_fks_config_set_born_config
<<PHS fks: procedures>>=
module subroutine phs_fks_config_set_born_config (phs_config, phs_cfg_born)
class(phs_fks_config_t), intent(inout) :: phs_config
type(phs_wood_config_t), intent(in), target :: phs_cfg_born
if (debug_on) &
call msg_debug (D_PHASESPACE, "phs_fks_config_set_born_config")
phs_config%forest = phs_cfg_born%forest
phs_config%n_channel = phs_cfg_born%n_channel
allocate (phs_config%channel (phs_config%n_channel))
phs_config%channel = phs_cfg_born%channel
phs_config%n_par = phs_cfg_born%n_par
phs_config%n_state = phs_cfg_born%n_state
phs_config%sqrts = phs_cfg_born%sqrts
phs_config%par = phs_cfg_born%par
phs_config%sqrts_fixed = phs_cfg_born%sqrts_fixed
phs_config%azimuthal_dependence = phs_cfg_born%azimuthal_dependence
phs_config%provides_chains = phs_cfg_born%provides_chains
phs_config%lab_is_cm = phs_cfg_born%lab_is_cm
phs_config%vis_channels = phs_cfg_born%vis_channels
phs_config%provides_equivalences = phs_cfg_born%provides_equivalences
allocate (phs_config%chain (size (phs_cfg_born%chain)))
phs_config%chain = phs_cfg_born%chain
phs_config%model => phs_cfg_born%model
phs_config%use_cascades2 = phs_cfg_born%use_cascades2
if (allocated (phs_cfg_born%cascade_set)) then
allocate (phs_config%cascade_set)
phs_config%cascade_set = phs_cfg_born%cascade_set
end if
if (allocated (phs_cfg_born%feyngraph_set)) then
allocate (phs_config%feyngraph_set)
phs_config%feyngraph_set = phs_cfg_born%feyngraph_set
end if
phs_config%md5sum_born_config = phs_cfg_born%md5sum_phs_config
end subroutine phs_fks_config_set_born_config
@ %def phs_fks_config_set_born_config
@
<<PHS fks: fks config: TBP>>=
procedure :: get_resonance_histories => &
phs_fks_config_get_resonance_histories
<<PHS fks: sub interfaces>>=
module function phs_fks_config_get_resonance_histories &
(phs_config) result (resonance_histories)
type(resonance_history_t), dimension(:), allocatable :: &
resonance_histories
class(phs_fks_config_t), intent(inout) :: phs_config
end function phs_fks_config_get_resonance_histories
<<PHS fks: procedures>>=
module function phs_fks_config_get_resonance_histories &
(phs_config) result (resonance_histories)
type(resonance_history_t), dimension(:), allocatable :: resonance_histories
class(phs_fks_config_t), intent(inout) :: phs_config
if (allocated (phs_config%cascade_set)) then
call cascade_set_get_resonance_histories (phs_config%cascade_set, &
n_filter = 2, res_hists = resonance_histories)
else if (allocated (phs_config%feyngraph_set)) then
call feyngraph_set_get_resonance_histories (phs_config%feyngraph_set, &
n_filter = 2, res_hists = resonance_histories)
else
if (debug_on) call msg_debug (D_PHASESPACE, "Have to rebuild phase space for resonance histories")
call phs_config%generate_phase_space_extra ()
if (phs_config%use_cascades2) then
call feyngraph_set_get_resonance_histories &
(phs_config%feyngraph_set, n_filter = 2, res_hists = resonance_histories)
else
call cascade_set_get_resonance_histories &
(phs_config%cascade_set, n_filter = 2, res_hists = resonance_histories)
end if
end if
end function phs_fks_config_get_resonance_histories
@ %def phs_fks_config_get_resonance_histories
@
<<PHS fks: public>>=
public :: dalitz_plot_t
<<PHS fks: types>>=
type :: dalitz_plot_t
integer :: unit = -1
type(string_t) :: filename
logical :: active = .false.
logical :: inverse = .false.
contains
<<PHS fks: dalitz plot: TBP>>
end type dalitz_plot_t
@ %def dalitz_plot_t
@
<<PHS fks: dalitz plot: TBP>>=
procedure :: init => dalitz_plot_init
<<PHS fks: sub interfaces>>=
module subroutine dalitz_plot_init (plot, unit, filename, inverse)
class(dalitz_plot_t), intent(inout) :: plot
integer, intent(in) :: unit
type(string_t), intent(in) :: filename
logical, intent(in) :: inverse
end subroutine dalitz_plot_init
<<PHS fks: procedures>>=
module subroutine dalitz_plot_init (plot, unit, filename, inverse)
class(dalitz_plot_t), intent(inout) :: plot
integer, intent(in) :: unit
type(string_t), intent(in) :: filename
logical, intent(in) :: inverse
plot%active = .true.
plot%unit = unit
plot%inverse = inverse
open (plot%unit, file = char (filename), action = "write")
end subroutine dalitz_plot_init
@ %def daltiz_plot_init
@
<<PHS fks: dalitz plot: TBP>>=
procedure :: write_header => dalitz_plot_write_header
<<PHS fks: sub interfaces>>=
module subroutine dalitz_plot_write_header (plot)
class(dalitz_plot_t), intent(in) :: plot
end subroutine dalitz_plot_write_header
<<PHS fks: procedures>>=
module subroutine dalitz_plot_write_header (plot)
class(dalitz_plot_t), intent(in) :: plot
write (plot%unit, "(A36)") "### Dalitz plot generated by WHIZARD"
if (plot%inverse) then
write (plot%unit, "(A10,1x,A4)") "### k0_n+1", "k0_n"
else
write (plot%unit, "(A8,1x,A6)") "### k0_n", "k0_n+1"
end if
end subroutine dalitz_plot_write_header
@ %def dalitz_plot_write_header
@
<<PHS fks: dalitz plot: TBP>>=
procedure :: register => dalitz_plot_register
<<PHS fks: sub interfaces>>=
module subroutine dalitz_plot_register (plot, k0_n, k0_np1)
class(dalitz_plot_t), intent(in) :: plot
real(default), intent(in) :: k0_n, k0_np1
end subroutine dalitz_plot_register
<<PHS fks: procedures>>=
module subroutine dalitz_plot_register (plot, k0_n, k0_np1)
class(dalitz_plot_t), intent(in) :: plot
real(default), intent(in) :: k0_n, k0_np1
if (plot%inverse) then
write (plot%unit, "(F8.4,1X,F8.4)") k0_np1, k0_n
else
write (plot%unit, "(F8.4,1X,F8.4)") k0_np1, k0_n
end if
end subroutine dalitz_plot_register
@ %def dalitz_plot_register
@
<<PHS fks: dalitz plot: TBP>>=
procedure :: final => dalitz_plot_final
<<PHS fks: sub interfaces>>=
module subroutine dalitz_plot_final (plot)
class(dalitz_plot_t), intent(inout) :: plot
end subroutine dalitz_plot_final
<<PHS fks: procedures>>=
module subroutine dalitz_plot_final (plot)
class(dalitz_plot_t), intent(inout) :: plot
logical :: opened
plot%active = .false.
plot%inverse = .false.
if (plot%unit >= 0) then
inquire (unit = plot%unit, opened = opened)
if (opened) close (plot%unit)
end if
plot%filename = var_str ('')
plot%unit = -1
end subroutine dalitz_plot_final
@ %def dalitz_plot_final
@
<<PHS fks: parameters>>=
integer, parameter, public :: GEN_REAL_PHASE_SPACE = 1
integer, parameter, public :: GEN_SOFT_MISMATCH = 2
integer, parameter, public :: GEN_SOFT_LIMIT_TEST = 3
integer, parameter, public :: GEN_COLL_LIMIT_TEST = 4
integer, parameter, public :: GEN_ANTI_COLL_LIMIT_TEST = 5
integer, parameter, public :: GEN_SOFT_COLL_LIMIT_TEST = 6
integer, parameter, public :: GEN_SOFT_ANTI_COLL_LIMIT_TEST = 7
integer, parameter, public :: SQRTS_FIXED = 1
integer, parameter, public :: SQRTS_VAR = 2
real(default), parameter :: xi_tilde_test_soft = 0.00001_default
real(default), parameter :: xi_tilde_test_coll = 0.5_default
real(default), parameter :: y_test_soft = 0.5_default
real(default), parameter :: y_test_coll = 0.9999999_default
!!! for testing EW singularities: y_test_coll = 0.99999999_default
@
@ Very soft or collinear phase-space points can become a problem for
matrix elements providers, as some scalar products cannot be evaluated
properly. Here, a nonsensical result can spoil the whole integration.
We therefore check the scalar products appearing to be below a certain
tolerance.\\
Naturally, this happens very rarely but for some processes,
setting [[?test_coll_limit = true]] and/or [[?test_soft_limit = true]]
leads to all phase space points beeing discarded by this routine.
<<PHS fks: public>>=
public :: check_scalar_products
<<PHS fks: sub interfaces>>=
module function check_scalar_products (p) result (valid)
logical :: valid
type(vector4_t), intent(in), dimension(:) :: p
end function check_scalar_products
<<PHS fks: procedures>>=
module function check_scalar_products (p) result (valid)
logical :: valid
type(vector4_t), intent(in), dimension(:) :: p
real(default), parameter :: tolerance = 1E-7_default
!!! for testing EW singularities: tolerance = 5E-9_default
integer :: i, j
valid = .true.
do i = 1, size (p)
do j = i, size (p)
if (i /= j) then
if (abs(p(i) * p(j)) < tolerance) then
valid = .false.
exit
end if
end if
end do
end do
end function check_scalar_products
@ %def check_scalar_products
@ [[xi_min]] should be set to a non-zero value in order to avoid
phase-space points with [[p_real(emitter) = 0]].
<<PHS fks: public>>=
public :: phs_fks_generator_t
<<PHS fks: types>>=
type :: phs_fks_generator_t
integer, dimension(:), allocatable :: emitters
type(real_kinematics_t), pointer :: real_kinematics => null()
type(isr_kinematics_t), pointer :: isr_kinematics => null()
integer :: n_in
real(default) :: xi_min
real(default) :: y_max
real(default) :: sqrts
real(default) :: E_gluon
real(default) :: mrec2
real(default), dimension(:), allocatable :: m2
logical :: massive_phsp = .false.
logical, dimension(:), allocatable :: is_massive
logical :: singular_jacobian = .false.
integer :: i_fsr_first = -1
type(resonance_contributors_t), dimension(:), allocatable :: resonance_contributors !!! Put somewhere else?
integer :: mode = GEN_REAL_PHASE_SPACE
contains
<<PHS fks: phs fks generator: TBP>>
end type phs_fks_generator_t
@ %def phs_fks_generator_t
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: connect_kinematics => phs_fks_generator_connect_kinematics
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_connect_kinematics &
(generator, isr_kinematics, real_kinematics, massive_phsp)
class(phs_fks_generator_t), intent(inout) :: generator
type(isr_kinematics_t), intent(in), pointer :: isr_kinematics
type(real_kinematics_t), intent(in), pointer :: real_kinematics
logical, intent(in) :: massive_phsp
end subroutine phs_fks_generator_connect_kinematics
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_connect_kinematics &
(generator, isr_kinematics, real_kinematics, massive_phsp)
class(phs_fks_generator_t), intent(inout) :: generator
type(isr_kinematics_t), intent(in), pointer :: isr_kinematics
type(real_kinematics_t), intent(in), pointer :: real_kinematics
logical, intent(in) :: massive_phsp
generator%real_kinematics => real_kinematics
generator%isr_kinematics => isr_kinematics
generator%massive_phsp = massive_phsp
end subroutine phs_fks_generator_connect_kinematics
@ %def phs_fks_generator_connect_kinematics
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_isr_kinematics => &
phs_fks_generator_compute_isr_kinematics
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_isr_kinematics &
(generator, r, p_in)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r
type(vector4_t), dimension(2), intent(in), optional :: p_in
end subroutine phs_fks_generator_compute_isr_kinematics
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_isr_kinematics &
(generator, r, p_in)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r
type(vector4_t), dimension(2), intent(in), optional :: p_in
integer :: em
type(vector4_t), dimension(2) :: p
if (present (p_in)) then
p = p_in
else
p = generator%real_kinematics%p_born_lab%phs_point(1)%select ([1,2])
end if
associate (isr_kinematics => generator%isr_kinematics)
do em = 1, 2
isr_kinematics%x(em) = p(em)%p(0) / isr_kinematics%beam_energy(em)
isr_kinematics%z(em) = one - (one - isr_kinematics%x(em)) * r
isr_kinematics%jacobian(em) = one - isr_kinematics%x(em)
end do
isr_kinematics%sqrts_born = (p(1) + p(2))**1
end associate
end subroutine phs_fks_generator_compute_isr_kinematics
@ %def phs_fks_generator_compute_isr_kinematics
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: final => phs_fks_generator_final
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_final (generator)
class(phs_fks_generator_t), intent(inout) :: generator
end subroutine phs_fks_generator_final
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_final (generator)
class(phs_fks_generator_t), intent(inout) :: generator
if (allocated (generator%emitters)) deallocate (generator%emitters)
if (associated (generator%real_kinematics)) &
nullify (generator%real_kinematics)
if (associated (generator%isr_kinematics)) &
nullify (generator%isr_kinematics)
if (allocated (generator%m2)) deallocate (generator%m2)
generator%massive_phsp = .false.
if (allocated (generator%is_massive)) deallocate (generator%is_massive)
generator%singular_jacobian = .false.
generator%i_fsr_first = -1
if (allocated (generator%resonance_contributors)) &
deallocate (generator%resonance_contributors)
generator%mode = GEN_REAL_PHASE_SPACE
end subroutine phs_fks_generator_final
@ %def phs_fks_generator_final
@ A resonance phase space is uniquely specified via the resonance contributors and the
corresponding emitters. The [[phs_identifier]] type also checks whether
the given contributor-emitter configuration has already been evaluated to
avoid duplicate computations.
<<PHS fks: public>>=
public :: phs_identifier_t
<<PHS fks: types>>=
type :: phs_identifier_t
integer, dimension(:), allocatable :: contributors
integer :: emitter = -1
logical :: evaluated = .false.
contains
<<PHS fks: phs identifier: TBP>>
end type phs_identifier_t
@ %def phs_identifier_t
@
<<PHS fks: phs identifier: TBP>>=
generic :: init => init_from_emitter, init_from_emitter_and_contributors
procedure :: init_from_emitter => phs_identifier_init_from_emitter
procedure :: init_from_emitter_and_contributors &
=> phs_identifier_init_from_emitter_and_contributors
<<PHS fks: sub interfaces>>=
module subroutine phs_identifier_init_from_emitter (phs_id, emitter)
class(phs_identifier_t), intent(out) :: phs_id
integer, intent(in) :: emitter
end subroutine phs_identifier_init_from_emitter
module subroutine phs_identifier_init_from_emitter_and_contributors &
(phs_id, emitter, contributors)
class(phs_identifier_t), intent(out) :: phs_id
integer, intent(in) :: emitter
integer, intent(in), dimension(:) :: contributors
end subroutine phs_identifier_init_from_emitter_and_contributors
<<PHS fks: procedures>>=
module subroutine phs_identifier_init_from_emitter (phs_id, emitter)
class(phs_identifier_t), intent(out) :: phs_id
integer, intent(in) :: emitter
phs_id%emitter = emitter
end subroutine phs_identifier_init_from_emitter
module subroutine phs_identifier_init_from_emitter_and_contributors &
(phs_id, emitter, contributors)
class(phs_identifier_t), intent(out) :: phs_id
integer, intent(in) :: emitter
integer, intent(in), dimension(:) :: contributors
allocate (phs_id%contributors (size (contributors)))
phs_id%contributors = contributors
phs_id%emitter = emitter
end subroutine phs_identifier_init_from_emitter_and_contributors
@ %def phs_identifier_init_from_emitter
@ %def phs_identifier_init_from_emitter_and_contributors
@
<<PHS fks: phs identifier: TBP>>=
procedure :: check => phs_identifier_check
<<PHS fks: sub interfaces>>=
module function phs_identifier_check &
(phs_id, emitter, contributors) result (check)
logical :: check
class(phs_identifier_t), intent(in) :: phs_id
integer, intent(in) :: emitter
integer, intent(in), dimension(:), optional :: contributors
end function phs_identifier_check
<<PHS fks: procedures>>=
module function phs_identifier_check &
(phs_id, emitter, contributors) result (check)
logical :: check
class(phs_identifier_t), intent(in) :: phs_id
integer, intent(in) :: emitter
integer, intent(in), dimension(:), optional :: contributors
check = phs_id%emitter == emitter
if (present (contributors)) then
if (.not. allocated (phs_id%contributors)) &
call msg_fatal ("Phs identifier: contributors not allocated!")
check = check .and. all (phs_id%contributors == contributors)
end if
end function phs_identifier_check
@ %def phs_identifier_check
@
<<PHS fks: phs identifier: TBP>>=
procedure :: write => phs_identifier_write
<<PHS fks: sub interfaces>>=
module subroutine phs_identifier_write (phs_id, unit)
class(phs_identifier_t), intent(in) :: phs_id
integer, intent(in), optional :: unit
end subroutine phs_identifier_write
<<PHS fks: procedures>>=
module subroutine phs_identifier_write (phs_id, unit)
class(phs_identifier_t), intent(in) :: phs_id
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, '(A)') 'phs_identifier: '
write (u, '(A,1X,I1)') 'Emitter: ', phs_id%emitter
if (allocated (phs_id%contributors)) then
write (u, '(A)', advance = 'no') 'Resonance contributors: '
do i = 1, size (phs_id%contributors)
write (u, '(I1,1X)', advance = 'no') phs_id%contributors(i)
end do
else
write (u, '(A)') 'No Contributors allocated'
end if
end subroutine phs_identifier_write
@ %def phs_identifier_write
@
<<PHS fks: public>>=
public :: check_for_phs_identifier
<<PHS fks: sub interfaces>>=
module subroutine check_for_phs_identifier &
(phs_id, n_in, emitter, contributors, phs_exist, i_phs)
type(phs_identifier_t), intent(in), dimension(:) :: phs_id
integer, intent(in) :: n_in, emitter
integer, intent(in), dimension(:), optional :: contributors
logical, intent(out) :: phs_exist
integer, intent(out) :: i_phs
end subroutine check_for_phs_identifier
<<PHS fks: procedures>>=
module subroutine check_for_phs_identifier &
(phs_id, n_in, emitter, contributors, phs_exist, i_phs)
type(phs_identifier_t), intent(in), dimension(:) :: phs_id
integer, intent(in) :: n_in, emitter
integer, intent(in), dimension(:), optional :: contributors
logical, intent(out) :: phs_exist
integer, intent(out) :: i_phs
integer :: i
phs_exist = .false.
i_phs = -1
do i = 1, size (phs_id)
if (phs_id(i)%emitter < 0) then
i_phs = i
exit
end if
phs_exist = phs_id(i)%emitter == emitter
if (present (contributors)) &
phs_exist = phs_exist .and. &
all (phs_id(i)%contributors == contributors)
if (phs_exist) then
i_phs = i
exit
end if
end do
end subroutine check_for_phs_identifier
@ %def check_for_phs_identifier
@
@ The fks phase space type contains the wood phase space and
separately the in- and outcoming momenta for the real process and the
corresponding Born momenta. Additionally, there are the variables
$\xi$,$\xi_{max}$, $y$ and $\phi$ which are used to create the real
phase space, as well as the jacobian and its corresponding soft and
collinear limit. Lastly, the array \texttt{ch\_to\_em} connects each
channel with an emitter.
<<PHS fks: public>>=
public :: phs_fks_t
<<PHS fks: types>>=
type, extends (phs_wood_t) :: phs_fks_t
integer :: mode = PHS_MODE_UNDEFINED
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: q_born
type(vector4_t), dimension(:), allocatable :: p_real
type(vector4_t), dimension(:), allocatable :: q_real
type(vector4_t), dimension(:), allocatable :: p_born_tot
type(phs_fks_generator_t) :: generator
real(default) :: r_isr
type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
contains
<<PHS fks: phs fks: TBP>>
end type phs_fks_t
@ %def phs_fks_t
@
<<PHS fks: interfaces>>=
interface compute_beta
module procedure compute_beta_massless
module procedure compute_beta_massive
end interface
interface get_xi_max_fsr
module procedure get_xi_max_fsr_massless
module procedure get_xi_max_fsr_massive
end interface
@ %def interfaces
@
<<PHS fks: phs fks: TBP>>=
procedure :: write => phs_fks_write
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_write (object, unit, verbose)
class(phs_fks_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine phs_fks_write
<<PHS fks: procedures>>=
module subroutine phs_fks_write (object, unit, verbose)
class(phs_fks_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i, n_id
u = given_output_unit (unit)
call object%base_write ()
n_id = size (object%phs_identifiers)
if (n_id == 0) then
write (u, "(A)") "No phs identifiers allocated! "
else
do i = 1, n_id
call object%phs_identifiers(i)%write (u)
end do
end if
end subroutine phs_fks_write
@ %def phs_fks_write
@ Initializer for the phase space. Calls the initialization of the
corresponding Born phase space, sets up the
channel-emitter-association and allocates space for the momenta.
<<PHS fks: phs fks: TBP>>=
procedure :: init => phs_fks_init
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_init (phs, phs_config)
class(phs_fks_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
end subroutine phs_fks_init
<<PHS fks: procedures>>=
module subroutine phs_fks_init (phs, phs_config)
class(phs_fks_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
call phs%base_init (phs_config)
select type (phs_config)
type is (phs_fks_config_t)
phs%config => phs_config
phs%forest = phs_config%forest
end select
select type (phs)
type is (phs_fks_t)
select type (phs_config)
type is (phs_fks_config_t)
phs%mode = phs_config%mode
end select
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
phs%n_r_born = phs%config%n_par - 3
case (PHS_MODE_COLLINEAR_REMNANT)
phs%n_r_born = phs%config%n_par - 1
end select
end select
end subroutine phs_fks_init
@ %def phs_fks_init
@ For real components of $2\to 1$ NLO processes we have to recompute the
flux factor as this has to be the one of the underlying Born.
<<PHS fks: phs fks: TBP>>=
procedure :: compute_flux => phs_fks_compute_flux
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_compute_flux (phs)
class(phs_fks_t), intent(inout) :: phs
end subroutine phs_fks_compute_flux
<<PHS fks: procedures>>=
module subroutine phs_fks_compute_flux (phs)
class(phs_fks_t), intent(inout) :: phs
call phs%compute_base_flux ()
select type (config => phs%config)
type is (phs_fks_config_t)
if (config%born_2_to_1) then
phs%flux = conv * twopi &
/ (2 * config%sqrts ** 2 * phs%m_out(1) ** 2)
end if
end select
end subroutine phs_fks_compute_flux
@ %def phs_fks_compute_flux
@
<<PHS fks: phs fks: TBP>>=
procedure :: allocate_momenta => phs_fks_allocate_momenta
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_allocate_momenta (phs, phs_config, data_is_born)
class(phs_fks_t), intent(inout) :: phs
class(phs_config_t), intent(in) :: phs_config
logical, intent(in) :: data_is_born
end subroutine phs_fks_allocate_momenta
<<PHS fks: procedures>>=
module subroutine phs_fks_allocate_momenta (phs, phs_config, data_is_born)
class(phs_fks_t), intent(inout) :: phs
class(phs_config_t), intent(in) :: phs_config
logical, intent(in) :: data_is_born
integer :: n_out_born
allocate (phs%p_born (phs_config%n_in))
allocate (phs%p_real (phs_config%n_in))
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
if (data_is_born) then
n_out_born = phs_config%n_out
else
n_out_born = phs_config%n_out - 1
end if
allocate (phs%q_born (n_out_born))
allocate (phs%q_real (n_out_born + 1))
allocate (phs%p_born_tot (phs_config%n_in + n_out_born))
end select
end subroutine phs_fks_allocate_momenta
@ %def phs_fks_allocate_momenta
@ Evaluate selected channel. First, the subroutine calls the
evaluation procedure of the underlying Born phase space, using $n_r -
3$ random numbers. Then, the remaining three random numbers are used
to create $\xi$, $y$ and $\phi$, from which the real momenta are
calculated from the Born momenta.
<<PHS fks: phs fks: TBP>>=
procedure :: evaluate_selected_channel => phs_fks_evaluate_selected_channel
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_evaluate_selected_channel (phs, c_in, r_in)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
end subroutine phs_fks_evaluate_selected_channel
<<PHS fks: procedures>>=
module subroutine phs_fks_evaluate_selected_channel (phs, c_in, r_in)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: c_in
real(default), intent(in), dimension(:) :: r_in
integer :: n_in
call phs%phs_wood_t%evaluate_selected_channel (c_in, r_in)
phs%r(:,c_in) = r_in
phs%q_defined = phs%phs_wood_t%q_defined
if (.not. phs%q_defined) return
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
n_in = phs%config%n_in
phs%p_born = phs%phs_wood_t%p
phs%q_born = phs%phs_wood_t%q
phs%p_born_tot (1: n_in) = phs%p_born
phs%p_born_tot (n_in + 1 :) = phs%q_born
call phs%set_reference_frames (.true.)
call phs%set_isr_kinematics (.true.)
case (PHS_MODE_COLLINEAR_REMNANT)
call phs%compute_isr_kinematics (r_in(phs%n_r_born + 1))
phs%r_isr = r_in(phs%n_r_born + 1)
end select
end subroutine phs_fks_evaluate_selected_channel
@ %def phs_fks_evaluate_selected_channel
@
<<PHS fks: phs fks: TBP>>=
procedure :: evaluate_other_channels => phs_fks_evaluate_other_channels
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_evaluate_other_channels (phs, c_in)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: c_in
end subroutine phs_fks_evaluate_other_channels
<<PHS fks: procedures>>=
module subroutine phs_fks_evaluate_other_channels (phs, c_in)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: c_in
call phs%phs_wood_t%evaluate_other_channels (c_in)
phs%r_defined = .true.
end subroutine phs_fks_evaluate_other_channels
@ %def phs_fks_evaluate_other_channels
@
<<PHS fks: phs fks: TBP>>=
procedure :: get_mcpar => phs_fks_get_mcpar
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_get_mcpar (phs, c, r)
class(phs_fks_t), intent(in) :: phs
integer, intent(in) :: c
real(default), dimension(:), intent(out) :: r
end subroutine phs_fks_get_mcpar
<<PHS fks: procedures>>=
module subroutine phs_fks_get_mcpar (phs, c, r)
class(phs_fks_t), intent(in) :: phs
integer, intent(in) :: c
real(default), dimension(:), intent(out) :: r
r(1 : phs%n_r_born) = phs%r(1 : phs%n_r_born,c)
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
r(phs%n_r_born + 1 :) = phs%r_real
case (PHS_MODE_COLLINEAR_REMNANT)
r(phs%n_r_born + 1 :) = phs%r_isr
end select
end subroutine phs_fks_get_mcpar
@ %def phs_fks_get_mcpar
@
<<PHS fks: phs fks: TBP>>=
procedure :: set_beam_energy => phs_fks_set_beam_energy
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_set_beam_energy (phs)
class(phs_fks_t), intent(inout) :: phs
end subroutine phs_fks_set_beam_energy
<<PHS fks: procedures>>=
module subroutine phs_fks_set_beam_energy (phs)
class(phs_fks_t), intent(inout) :: phs
call phs%generator%set_sqrts_hat (phs%config%sqrts)
end subroutine phs_fks_set_beam_energy
@ %def phs_fks_set_beam_energy
@
<<PHS fks: phs fks: TBP>>=
procedure :: set_emitters => phs_fks_set_emitters
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_set_emitters (phs, emitters)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in), dimension(:), allocatable :: emitters
end subroutine phs_fks_set_emitters
<<PHS fks: procedures>>=
module subroutine phs_fks_set_emitters (phs, emitters)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in), dimension(:), allocatable :: emitters
call phs%generator%set_emitters (emitters)
end subroutine phs_fks_set_emitters
@ %def phs_fks_set_emitters
@
<<PHS fks: phs fks: TBP>>=
procedure :: set_momenta => phs_fks_set_momenta
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_set_momenta (phs, p)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(in), dimension(:) :: p
end subroutine phs_fks_set_momenta
<<PHS fks: procedures>>=
module subroutine phs_fks_set_momenta (phs, p)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(in), dimension(:) :: p
integer :: n_in, n_tot_born
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
n_in = phs%config%n_in; n_tot_born = phs%config%n_tot - 1
phs%p_born = p(1 : n_in)
phs%q_born = p(n_in + 1 : n_tot_born)
phs%p_born_tot = p
end select
end subroutine phs_fks_set_momenta
@ %def phs_fks_set_momenta
@
<<PHS fks: phs fks: TBP>>=
procedure :: setup_masses => phs_fks_setup_masses
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_setup_masses (phs, n_tot)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: n_tot
end subroutine phs_fks_setup_masses
<<PHS fks: procedures>>=
module subroutine phs_fks_setup_masses (phs, n_tot)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: n_tot
call phs%generator%setup_masses (n_tot)
end subroutine phs_fks_setup_masses
@ %def phs_fks_setup_masses
@
<<PHS fks: phs fks: TBP>>=
procedure :: get_born_momenta => phs_fks_get_born_momenta
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_get_born_momenta (phs, p)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(out), dimension(:) :: p
end subroutine phs_fks_get_born_momenta
<<PHS fks: procedures>>=
module subroutine phs_fks_get_born_momenta (phs, p)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(out), dimension(:) :: p
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
p(1 : phs%config%n_in) = phs%p_born
p(phs%config%n_in + 1 :) = phs%q_born
case (PHS_MODE_COLLINEAR_REMNANT)
p(1:phs%config%n_in) = phs%phs_wood_t%p
p(phs%config%n_in + 1 : ) = phs%phs_wood_t%q
end select
if (.not. phs%config%lab_is_cm) p = phs%lt_cm_to_lab * p
end subroutine phs_fks_get_born_momenta
@ %def phs_fks_get_born_momenta
@
<<PHS fks: phs fks: TBP>>=
procedure :: get_outgoing_momenta => phs_fks_get_outgoing_momenta
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_get_outgoing_momenta (phs, q)
class(phs_fks_t), intent(in) :: phs
type(vector4_t), intent(out), dimension(:) :: q
end subroutine phs_fks_get_outgoing_momenta
<<PHS fks: procedures>>=
module subroutine phs_fks_get_outgoing_momenta (phs, q)
class(phs_fks_t), intent(in) :: phs
type(vector4_t), intent(out), dimension(:) :: q
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
q = phs%q_real
case (PHS_MODE_COLLINEAR_REMNANT)
q = phs%phs_wood_t%q
end select
end subroutine phs_fks_get_outgoing_momenta
@ %def phs_fks_get_outgoing_momenta
@
<<PHS fks: phs fks: TBP>>=
procedure :: get_incoming_momenta => phs_fks_get_incoming_momenta
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_get_incoming_momenta (phs, p)
class(phs_fks_t), intent(in) :: phs
type(vector4_t), intent(inout), dimension(:), allocatable :: p
end subroutine phs_fks_get_incoming_momenta
<<PHS fks: procedures>>=
module subroutine phs_fks_get_incoming_momenta (phs, p)
class(phs_fks_t), intent(in) :: phs
type(vector4_t), intent(inout), dimension(:), allocatable :: p
p = phs%p_real
end subroutine phs_fks_get_incoming_momenta
@ %def phs_fks_get_incoming_momenta
@
<<PHS fks: phs fks: TBP>>=
procedure :: set_isr_kinematics => phs_fks_set_isr_kinematics
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_set_isr_kinematics (phs, requires_boost)
class(phs_fks_t), intent(inout) :: phs
logical, intent(in) :: requires_boost
end subroutine phs_fks_set_isr_kinematics
<<PHS fks: procedures>>=
module subroutine phs_fks_set_isr_kinematics (phs, requires_boost)
class(phs_fks_t), intent(inout) :: phs
logical, intent(in) :: requires_boost
type(vector4_t), dimension(2) :: p
if (phs%generator%isr_kinematics%isr_mode == SQRTS_VAR) then
if (requires_boost) then
p = phs%lt_cm_to_lab &
* phs%generator%real_kinematics%p_born_cms%phs_point(1)%select ([1,2])
else
p = phs%generator%real_kinematics%p_born_lab%phs_point(1)%select ([1,2])
end if
call phs%generator%set_isr_kinematics (p)
end if
end subroutine phs_fks_set_isr_kinematics
@ %def phs_fks_set_isr_kinematics
@
<<PHS fks: phs fks: TBP>>=
procedure :: generate_radiation_variables => &
phs_fks_generate_radiation_variables
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generate_radiation_variables &
(phs, r_in, threshold)
class(phs_fks_t), intent(inout) :: phs
real(default), intent(in), dimension(:) :: r_in
logical, intent(in) :: threshold
end subroutine phs_fks_generate_radiation_variables
<<PHS fks: procedures>>=
module subroutine phs_fks_generate_radiation_variables &
(phs, r_in, threshold)
class(phs_fks_t), intent(inout) :: phs
real(default), intent(in), dimension(:) :: r_in
logical, intent(in) :: threshold
type(vector4_t), dimension(:), allocatable :: p_born
if (size (r_in) /= 3) call msg_fatal &
("Real kinematics need to be generated using three random numbers!")
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
allocate (p_born (size (phs%p_born_tot)))
if (threshold) then
p_born = phs%get_onshell_projected_momenta ()
else
p_born = phs%p_born_tot
if (.not. phs%lab_is_cm ()) &
p_born = inverse (phs%lt_cm_to_lab) * p_born
end if
call phs%generator%generate_radiation_variables &
(r_in, p_born, phs%phs_identifiers, threshold)
phs%r_real = r_in
end select
end subroutine phs_fks_generate_radiation_variables
@ %def phs_fks_generate_radiation_variables
@
<<PHS fks: phs fks: TBP>>=
procedure :: compute_xi_ref_momenta => phs_fks_compute_xi_ref_momenta
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_compute_xi_ref_momenta (phs, p_in, contributors)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(in), dimension(:), optional :: p_in
type(resonance_contributors_t), intent(in), dimension(:), optional :: &
contributors
end subroutine phs_fks_compute_xi_ref_momenta
<<PHS fks: procedures>>=
module subroutine phs_fks_compute_xi_ref_momenta (phs, p_in, contributors)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(in), dimension(:), optional :: p_in
type(resonance_contributors_t), intent(in), dimension(:), optional :: &
contributors
if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) then
if (present (p_in)) then
call phs%generator%compute_xi_ref_momenta (p_in, contributors)
else
call phs%generator%compute_xi_ref_momenta &
(phs%p_born_tot, contributors)
end if
end if
end subroutine phs_fks_compute_xi_ref_momenta
@ %def phs_fks_compute_xi_ref_momenta
@
<<PHS fks: phs fks: TBP>>=
procedure :: compute_xi_ref_momenta_threshold => &
phs_fks_compute_xi_ref_momenta_threshold
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_compute_xi_ref_momenta_threshold (phs)
class(phs_fks_t), intent(inout) :: phs
end subroutine phs_fks_compute_xi_ref_momenta_threshold
<<PHS fks: procedures>>=
module subroutine phs_fks_compute_xi_ref_momenta_threshold (phs)
class(phs_fks_t), intent(inout) :: phs
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
call phs%generator%compute_xi_ref_momenta_threshold &
(phs%get_onshell_projected_momenta ())
end select
end subroutine phs_fks_compute_xi_ref_momenta_threshold
@ %def phs_fks_compute_xi_ref_momenta
@
<<PHS fks: phs fks: TBP>>=
procedure :: compute_cms_energy => phs_fks_compute_cms_energy
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_compute_cms_energy (phs)
class(phs_fks_t), intent(inout) :: phs
end subroutine phs_fks_compute_cms_energy
<<PHS fks: procedures>>=
module subroutine phs_fks_compute_cms_energy (phs)
class(phs_fks_t), intent(inout) :: phs
if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) &
call phs%generator%compute_cms_energy (phs%p_born_tot)
end subroutine phs_fks_compute_cms_energy
@ %def phs_fks_compute_cms_energy
@ When initial-state radiation is involved, either due to beamstrahlung or
QCD/QED corrections, it is important to have access to both the phase
space points in the center-of-mass and lab frame.
<<PHS fks: phs fks: TBP>>=
procedure :: set_reference_frames => phs_fks_set_reference_frames
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_set_reference_frames (phs, is_cms)
class(phs_fks_t), intent(inout) :: phs
logical, intent(in) :: is_cms
end subroutine phs_fks_set_reference_frames
<<PHS fks: procedures>>=
module subroutine phs_fks_set_reference_frames (phs, is_cms)
class(phs_fks_t), intent(inout) :: phs
logical, intent(in) :: is_cms
associate (real_kinematics => phs%generator%real_kinematics)
if (phs%config%lab_is_cm) then
real_kinematics%p_born_cms%phs_point(1) = phs%p_born_tot
real_kinematics%p_born_lab%phs_point(1) = phs%p_born_tot
else
if (is_cms) then
real_kinematics%p_born_cms%phs_point(1) &
= phs%p_born_tot
real_kinematics%p_born_lab%phs_point(1) &
= phs%lt_cm_to_lab * phs%p_born_tot
else
real_kinematics%p_born_cms%phs_point(1) &
= inverse (phs%lt_cm_to_lab) * phs%p_born_tot
real_kinematics%p_born_lab%phs_point(1) &
= phs%p_born_tot
end if
end if
end associate
end subroutine phs_fks_set_reference_frames
@ %def phs_fks_set_reference_frames
@
<<PHS fks: phs fks: TBP>>=
procedure :: i_phs_is_isr => phs_fks_i_phs_is_isr
<<PHS fks: sub interfaces>>=
module function phs_fks_i_phs_is_isr (phs, i_phs) result (is_isr)
logical :: is_isr
class(phs_fks_t), intent(in) :: phs
integer, intent(in) :: i_phs
end function phs_fks_i_phs_is_isr
<<PHS fks: procedures>>=
module function phs_fks_i_phs_is_isr (phs, i_phs) result (is_isr)
logical :: is_isr
class(phs_fks_t), intent(in) :: phs
integer, intent(in) :: i_phs
is_isr = phs%phs_identifiers(i_phs)%emitter <= phs%generator%n_in
end function phs_fks_i_phs_is_isr
@ %def phs_fks_i_phs_is_isr
@
\subsection{Creation of the real phase space - FSR}
At this point, the Born phase space has been generated, as well as the
three random variables $\xi$, $y$ and $\phi$. The question is how the
real phase space is generated for a final-state emission
configuration. We work with two different sets of momenta, the Born
configuration $\Bigl\{ \bar{k}_{\oplus}, \bar{k}_{\ominus}, \bar{k}_{1}, ...,
\bar{k}_{n} \Bigr\}$ and the real configuration $\Bigl\{ k_{\oplus},
k_{\ominus}, k_1,..., k_n, k_{n+1} \Bigr\}$. We define the momentum of
the emitter to be on the $n$-th position and the momentum of the
radiated particle to be at position $n+1$. The magnitude of the
spatial component of k is denoted by $\underline{k}$.
For final-state emissions, it is $\bar{k}_\oplus = k_\oplus$ and
$\bar{k}_\ominus = k_\ominus$. Thus, the center-of-mass systems
coincide and it is
\begin{equation}
q = \sum_{i=1}^n \bar{k}_i = \sum_{i=1}^{n+1} k_i,
\end{equation}
with $\vec{q} = 0$ and $q^2 = \left(q^0\right)^2$.
We want to construct the real phase space from the Born phase space
using three random numbers. They are defined as follows:
\begin{itemize}
\item $\xi = \frac{2k_{n+1}^0}{\sqrt{s}} \in [0, \xi_{max}]$, where
$k_{n+1}$ denotes the four-momentum of the radiated particle.
\item $y = \cos\theta = \frac{\vec{k}_n \cdot
\vec{k}_{n+1}}{\underline{k}_n \underline{k}_{n+1}}$ is the
splitting angle.
\item The angle between tho two splitting particles in the transversal
plane, $phi \in [0,2\pi]$.
\end{itemize}
Further, $k_{rec} = \sum_{i=1}^{n-1} k_i$ denotes the sum of all
recoiling momenta.
<<PHS fks: phs fks generator: TBP>>=
generic :: generate_fsr => generate_fsr_default, generate_fsr_resonances
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_fsr_default => phs_fks_generator_generate_fsr_default
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_fsr_default &
(generator, emitter, i_phs, &
p_born, p_real, xi_y_phi, no_jacobians)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
end subroutine phs_fks_generator_generate_fsr_default
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_fsr_default &
(generator, emitter, i_phs, &
p_born, p_real, xi_y_phi, no_jacobians)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
real(default) :: q0
call generator%generate_fsr_in (p_born, p_real)
q0 = sum (p_born(1:generator%n_in))**1
generator%i_fsr_first = generator%n_in + 1
call generator%generate_fsr_out (emitter, i_phs, p_born, p_real, q0, &
xi_y_phi = xi_y_phi, no_jacobians = no_jacobians)
if (debug_active (D_PHASESPACE)) then
call vector4_check_momentum_conservation (p_real, generator%n_in, &
rel_smallness = 1000 * tiny_07, abs_smallness = tiny_07)
end if
end subroutine phs_fks_generator_generate_fsr_default
@ %def phs_fks_generator_generate_fsr
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_fsr_resonances => &
phs_fks_generator_generate_fsr_resonances
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_fsr_resonances (generator, &
emitter, i_phs, i_con, p_born, p_real, xi_y_phi, no_jacobians)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
integer, intent(in) :: i_con
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
end subroutine phs_fks_generator_generate_fsr_resonances
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_fsr_resonances (generator, &
emitter, i_phs, i_con, p_born, p_real, xi_y_phi, no_jacobians)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
integer, intent(in) :: i_con
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
integer, dimension(:), allocatable :: resonance_list
integer, dimension(size(p_born)) :: inv_resonance_list
type(vector4_t), dimension(:), allocatable :: p_tmp_born
type(vector4_t), dimension(:), allocatable :: p_tmp_real
type(vector4_t) :: p_resonance
real(default) :: q0
integer :: i, j, nlegborn, nlegreal
integer :: i_emitter
type(lorentz_transformation_t) :: boost_to_resonance
integer :: n_resonant_particles
if (debug_on) call msg_debug2 (D_PHASESPACE, "phs_fks_generator_generate_fsr_resonances")
nlegborn = size (p_born); nlegreal = nlegborn + 1
allocate (resonance_list (size (generator%resonance_contributors(i_con)%c)))
resonance_list = generator%resonance_contributors(i_con)%c
n_resonant_particles = size (resonance_list)
if (.not. any (resonance_list == emitter)) then
call msg_fatal ("Emitter must be included in the resonance list!")
else
do i = 1, n_resonant_particles
if (resonance_list (i) == emitter) i_emitter = i
end do
end if
inv_resonance_list = &
create_inverse_resonance_list (nlegborn, resonance_list)
allocate (p_tmp_born (n_resonant_particles))
allocate (p_tmp_real (n_resonant_particles + 1))
p_tmp_born = vector4_null
p_tmp_real = vector4_null
j = 1
do i = 1, n_resonant_particles
p_tmp_born(j) = p_born(resonance_list(i))
j = j + 1
end do
call generator%generate_fsr_in (p_born, p_real)
p_resonance = generator%real_kinematics%xi_ref_momenta(i_con)
q0 = p_resonance**1
boost_to_resonance = inverse (boost (p_resonance, q0))
p_tmp_born = boost_to_resonance * p_tmp_born
generator%i_fsr_first = 1
call generator%generate_fsr_out (emitter, i_phs, p_tmp_born, p_tmp_real, &
q0, i_emitter, xi_y_phi)
p_tmp_real = inverse (boost_to_resonance) * p_tmp_real
do i = generator%n_in + 1, nlegborn
if (any (resonance_list == i)) then
p_real(i) = p_tmp_real(inv_resonance_list (i))
else
p_real(i) = p_born (i)
end if
end do
p_real(nlegreal) = p_tmp_real (n_resonant_particles + 1)
if (debug_active (D_PHASESPACE)) then
call vector4_check_momentum_conservation (p_real, generator%n_in, &
rel_smallness = 1000 * tiny_07, abs_smallness = tiny_07)
end if
contains
function create_inverse_resonance_list (nlegborn, resonance_list) &
result (inv_resonance_list)
integer, intent(in) :: nlegborn
integer, intent(in), dimension(:) :: resonance_list
integer, dimension(nlegborn) :: inv_resonance_list
integer :: i, j
inv_resonance_list = 0
j = 1
do i = 1, nlegborn
if (any (i == resonance_list)) then
inv_resonance_list (i) = j
j = j + 1
end if
end do
end function create_inverse_resonance_list
function boosted_energy () result (E)
real(default) :: E
type(vector4_t) :: p_boost
p_boost = boost_to_resonance * p_resonance
E = p_boost%p(0)
end function boosted_energy
end subroutine phs_fks_generator_generate_fsr_resonances
@ %def phs_fks_generator_generate_fsr_resonances
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_fsr_threshold => &
phs_fks_generator_generate_fsr_threshold
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_fsr_threshold (generator, &
emitter, i_phs, p_born, p_real, xi_y_phi)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in), dimension(3), optional :: xi_y_phi
end subroutine phs_fks_generator_generate_fsr_threshold
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_fsr_threshold (generator, &
emitter, i_phs, p_born, p_real, xi_y_phi)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in), dimension(3), optional :: xi_y_phi
type(vector4_t), dimension(2) :: p_tmp_born
type(vector4_t), dimension(3) :: p_tmp_real
integer :: nlegborn, nlegreal
type(vector4_t) :: p_top
real(default) :: q0
type(lorentz_transformation_t) :: boost_to_top
integer :: leg, other_leg
real(default) :: sqrts, mtop
if (debug_on) call msg_debug2 &
(D_PHASESPACE, "phs_fks_generator_generate_fsr_resonances")
nlegborn = size (p_born); nlegreal = nlegborn + 1
leg = thr_leg(emitter); other_leg = 3 - leg
p_tmp_born(1) = p_born (ass_boson(leg))
p_tmp_born(2) = p_born (ass_quark(leg))
call generator%generate_fsr_in (p_born, p_real)
p_top = generator%real_kinematics%xi_ref_momenta(leg)
q0 = p_top**1
sqrts = two * p_born(1)%p(0)
mtop = m1s_to_mpole (sqrts)
if (sqrts**2 - four * mtop**2 > zero) then
boost_to_top = inverse (boost (p_top, q0))
else
boost_to_top = identity
end if
p_tmp_born = boost_to_top * p_tmp_born
generator%i_fsr_first = 1
call generator%generate_fsr_out (emitter, i_phs, p_tmp_born, &
p_tmp_real, q0, 2, xi_y_phi)
p_tmp_real = inverse (boost_to_top) * p_tmp_real
p_real(ass_boson(leg)) = p_tmp_real(1)
p_real(ass_quark(leg)) = p_tmp_real(2)
p_real(ass_boson(other_leg)) = p_born(ass_boson(other_leg))
p_real(ass_quark(other_leg)) = p_born(ass_quark(other_leg))
p_real(THR_POS_GLUON) = p_tmp_real(3)
end subroutine phs_fks_generator_generate_fsr_threshold
@ %def phs_fks_generator_generate_fsr_threshold
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_fsr_in => phs_fks_generator_generate_fsr_in
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_fsr_in &
(generator, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
end subroutine phs_fks_generator_generate_fsr_in
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_fsr_in &
(generator, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
integer :: i
do i = 1, generator%n_in
p_real(i) = p_born(i)
end do
end subroutine phs_fks_generator_generate_fsr_in
@ %def phs_fks_generator_generate_fsr_in
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_fsr_out => phs_fks_generator_generate_fsr_out
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_fsr_out (generator, &
emitter, i_phs, p_born, p_real, q0, p_emitter_index, &
xi_y_phi, no_jacobians)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in) :: q0
integer, intent(in), optional :: p_emitter_index
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
end subroutine phs_fks_generator_generate_fsr_out
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_fsr_out (generator, &
emitter, i_phs, p_born, p_real, q0, p_emitter_index, &
xi_y_phi, no_jacobians)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default), intent(in) :: q0
integer, intent(in), optional :: p_emitter_index
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
real(default) :: xi, y, phi
integer :: nlegborn, nlegreal
real(default) :: uk_np1, uk_n
real(default) :: uk_rec, k_rec0
type(vector3_t) :: k_n_born, k
real(default) :: uk_n_born, uk, k2, k0_n
real(default) :: cpsi, beta
type(vector3_t) :: vec, vec_orth
type(lorentz_transformation_t) :: rot
integer :: i, p_em
logical :: compute_jac
p_em = emitter; if (present (p_emitter_index)) p_em = p_emitter_index
compute_jac = .true.
if (present (no_jacobians)) compute_jac = .not. no_jacobians
if (generator%i_fsr_first < 0) &
call msg_fatal ("FSR generator is called for outgoing particles but "&
&"i_fsr_first is not set!")
if (present (xi_y_phi)) then
xi = xi_y_phi(I_XI)
y = xi_y_phi(I_Y)
phi = xi_y_phi(I_PHI)
else
associate (rad_var => generator%real_kinematics)
xi = rad_var%xi_tilde
if (rad_var%supply_xi_max) xi = xi * rad_var%xi_max(i_phs)
y = rad_var%y(i_phs)
phi = rad_var%phi
end associate
end if
nlegborn = size (p_born)
nlegreal = nlegborn + 1
generator%E_gluon = q0 * xi / two
uk_np1 = generator%E_gluon
k_n_born = p_born(p_em)%p(1:3)
uk_n_born = k_n_born**1
generator%mrec2 = (q0 - p_born(p_em)%p(0))**2 &
- space_part_norm(p_born(p_em))**2
if (generator%is_massive(emitter)) then
call generator%compute_emitter_kinematics (y, emitter, &
i_phs, q0, k0_n, uk_n, uk, compute_jac)
else
call generator%compute_emitter_kinematics (y, q0, uk_n, uk)
generator%real_kinematics%y_soft(i_phs) = y
k0_n = uk_n
end if
if (debug_on) call msg_debug2 &
(D_PHASESPACE, "phs_fks_generator_generate_fsr_out")
call debug_input_values ()
vec = uk_n / uk_n_born * k_n_born
vec_orth = create_orthogonal (vec)
p_real(p_em)%p(0) = k0_n
p_real(p_em)%p(1:3) = vec%p(1:3)
cpsi = (uk_n**2 + uk**2 - uk_np1**2) / (two * uk_n * uk)
!!! This is to catch the case where cpsi = 1, but numerically
!!! turns out to be slightly larger than 1.
call check_cpsi_bound (cpsi)
rot = rotation (cpsi, - sqrt (one - cpsi**2), vec_orth)
p_real(p_em) = rot * p_real(p_em)
vec = uk_np1 / uk_n_born * k_n_born
vec_orth = create_orthogonal (vec)
p_real(nlegreal)%p(0) = uk_np1
p_real(nlegreal)%p(1:3) = vec%p(1:3)
cpsi = (uk_np1**2 + uk**2 - uk_n**2) / (two * uk_np1 * uk)
call check_cpsi_bound (cpsi)
rot = rotation (cpsi, sqrt (one - cpsi**2), vec_orth)
p_real(nlegreal) = rot * p_real(nlegreal)
call construct_recoiling_momenta ()
if (compute_jac) call compute_jacobians ()
contains
<<PHS fks: generator generate fsr out procedures>>
end subroutine phs_fks_generator_generate_fsr_out
@ %def phs_fks_generator_generate_fsr_out
@
<<PHS fks: generator generate fsr out procedures>>=
subroutine debug_input_values ()
if (debug2_active (D_PHASESPACE)) then
call generator%write ()
print *, 'emitter = ', emitter
print *, 'p_born:'
call vector4_write_set (p_born)
print *, 'p_real:'
call vector4_write_set (p_real)
print *, 'q0 = ', q0
if (present(p_emitter_index)) then
print *, 'p_emitter_index = ', p_emitter_index
else
print *, 'p_emitter_index not given'
end if
end if
end subroutine debug_input_values
<<PHS fks: generator generate fsr out procedures>>=
subroutine check_cpsi_bound (cpsi)
real(default), intent(inout) :: cpsi
if (cpsi > one) then
cpsi = one
else if (cpsi < -one) then
cpsi = - one
end if
end subroutine check_cpsi_bound
@ Construction of the recoiling momenta. The reshuffling of momenta
must not change the invariant mass of the recoiling system, which
means $k_{\rm{rec}}^2 = \bar{k_{\rm{rec}}}^2$. Therefore, the momenta
are related by a boost, $\bar{k}_i = \Lambda k_i$. The boost parameter
is
\begin{equation*}
\beta = \frac{q^2 - (k_{\rm{rec}}^0 +
\underline{k}_{\rm{rec}})^2}{q^2 + (k_{\rm{rec}}^0 +
\underline{k}_{\rm{rec}})^2}
\end{equation*}
<<PHS fks: generator generate fsr out procedures>>=
subroutine construct_recoiling_momenta ()
type(lorentz_transformation_t) :: lambda
k_rec0 = q0 - p_real(p_em)%p(0) - p_real(nlegreal)%p(0)
if (k_rec0**2 > generator%mrec2) then
uk_rec = sqrt (k_rec0**2 - generator%mrec2)
else
uk_rec = 0
end if
if (generator%is_massive(emitter)) then
beta = compute_beta (q0**2, k_rec0, uk_rec, &
p_born(p_em)%p(0), uk_n_born)
else
beta = compute_beta (q0**2, k_rec0, uk_rec)
end if
k = p_real(p_em)%p(1:3) + p_real(nlegreal)%p(1:3)
vec%p(1:3) = one / uk * k%p(1:3)
lambda = boost (beta / sqrt(one - beta**2), vec)
do i = generator%i_fsr_first, nlegborn
if (i /= p_em) then
p_real(i) = lambda * p_born(i)
end if
end do
vec%p(1:3) = p_born(p_em)%p(1:3) / uk_n_born
rot = rotation (cos(phi), sin(phi), vec)
p_real(nlegreal) = rot * p_real(nlegreal)
p_real(p_em) = rot * p_real(p_em)
end subroutine construct_recoiling_momenta
@ The factor $\frac{q^2}{(4\pi)^3}$ is not included here since it is
supplied during phase space generation. Also, we already divide by
$\xi$.
<<PHS fks: generator generate fsr out procedures>>=
subroutine compute_jacobians ()
associate (jac => generator%real_kinematics%jac(i_phs))
if (generator%is_massive(emitter)) then
jac%jac(1) = jac%jac(1) * four / q0 / uk_n_born / xi
else
k2 = two * uk_n * uk_np1* (one - y)
jac%jac(1) = uk_n**2 / uk_n_born / (uk_n - k2 / (two * q0))
end if
jac%jac(2) = one
jac%jac(3) = one - xi / two * q0 / uk_n_born
end associate
end subroutine compute_jacobians
@ %def compute_jacobians
@
<<PHS fks: phs fks: TBP>>=
procedure :: generate_fsr_in => phs_fks_generate_fsr_in
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generate_fsr_in (phs)
class(phs_fks_t), intent(inout) :: phs
end subroutine phs_fks_generate_fsr_in
<<PHS fks: procedures>>=
module subroutine phs_fks_generate_fsr_in (phs)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), dimension(:), allocatable :: p
p = phs%generator%real_kinematics%p_born_lab%get_momenta &
(1, phs%generator%n_in)
end subroutine phs_fks_generate_fsr_in
@ %def phs_fks_generate_fsr_in
@
<<PHS fks: phs fks: TBP>>=
procedure :: generate_fsr => phs_fks_generate_fsr
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generate_fsr (phs, emitter, i_phs, p_real, &
i_con, xi_y_phi, no_jacobians)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(inout), dimension(:) :: p_real
integer, intent(in), optional :: i_con
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
end subroutine phs_fks_generate_fsr
<<PHS fks: procedures>>=
module subroutine phs_fks_generate_fsr (phs, emitter, i_phs, p_real, &
i_con, xi_y_phi, no_jacobians)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(inout), dimension(:) :: p_real
integer, intent(in), optional :: i_con
real(default), intent(in), dimension(3), optional :: xi_y_phi
logical, intent(in), optional :: no_jacobians
type(vector4_t), dimension(:), allocatable :: p
associate (generator => phs%generator)
p = generator%real_kinematics%p_born_cms%phs_point(1)
generator%real_kinematics%supply_xi_max = .true.
if (present (i_con)) then
call generator%generate_fsr (emitter, i_phs, i_con, p, p_real, &
xi_y_phi, no_jacobians)
else
call generator%generate_fsr (emitter, i_phs, p, p_real, &
xi_y_phi, no_jacobians)
end if
generator%real_kinematics%p_real_cms%phs_point(i_phs) = p_real
if (.not. phs%config%lab_is_cm) p_real = phs%lt_cm_to_lab * p_real
generator%real_kinematics%p_real_lab%phs_point(i_phs) = p_real
end associate
end subroutine phs_fks_generate_fsr
@ %def phs_fks_generate_fsr
@
<<PHS fks: phs fks: TBP>>=
procedure :: get_onshell_projected_momenta => &
phs_fks_get_onshell_projected_momenta
<<PHS fks: sub interfaces>>=
pure module function phs_fks_get_onshell_projected_momenta (phs) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(phs_fks_t), intent(in) :: phs
end function phs_fks_get_onshell_projected_momenta
<<PHS fks: procedures>>=
pure module function phs_fks_get_onshell_projected_momenta (phs) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(phs_fks_t), intent(in) :: phs
p = phs%generator%real_kinematics%p_born_onshell%phs_point(1)
end function phs_fks_get_onshell_projected_momenta
@ %def phs_fks_get_onshell_projected_momenta
@
<<PHS fks: phs fks: TBP>>=
procedure :: generate_fsr_threshold => phs_fks_generate_fsr_threshold
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generate_fsr_threshold &
(phs, emitter, i_phs, p_real)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(inout), dimension(:), optional :: p_real
end subroutine phs_fks_generate_fsr_threshold
<<PHS fks: procedures>>=
module subroutine phs_fks_generate_fsr_threshold &
(phs, emitter, i_phs, p_real)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(inout), dimension(:), optional :: p_real
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: pp
integer :: leg
associate (generator => phs%generator)
generator%real_kinematics%supply_xi_max = .true.
allocate (p_born (1 : generator%real_kinematics%p_born_cms%get_n_particles()))
p_born = generator%real_kinematics%p_born_onshell%get_momenta (1)
allocate (pp (size (p_born) + 1))
call generator%generate_fsr_threshold (emitter, i_phs, p_born, pp)
leg = thr_leg (emitter)
call generator%real_kinematics%p_real_onshell(leg)%set_momenta (i_phs, pp)
if (present (p_real)) p_real = pp
end associate
end subroutine phs_fks_generate_fsr_threshold
@ %def phs_fks_generate_fsr_threshold
@
<<PHS fks: phs fks: TBP>>=
generic :: compute_xi_max => &
compute_xi_max_internal, compute_xi_max_with_output
procedure :: compute_xi_max_internal => phs_fks_compute_xi_max_internal
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_compute_xi_max_internal (phs, p, threshold)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(in), dimension(:) :: p
logical, intent(in) :: threshold
end subroutine phs_fks_compute_xi_max_internal
<<PHS fks: procedures>>=
module subroutine phs_fks_compute_xi_max_internal (phs, p, threshold)
class(phs_fks_t), intent(inout) :: phs
type(vector4_t), intent(in), dimension(:) :: p
logical, intent(in) :: threshold
integer :: i_phs, i_con, emitter
do i_phs = 1, size (phs%phs_identifiers)
associate (phs_id => phs%phs_identifiers(i_phs), generator => phs%generator)
emitter = phs_id%emitter
if (threshold) then
call generator%compute_xi_max (emitter, i_phs, p, &
generator%real_kinematics%xi_max(i_phs), i_con = thr_leg(emitter))
else if (allocated (phs_id%contributors)) then
do i_con = 1, size (phs_id%contributors)
call generator%compute_xi_max (emitter, i_phs, p, &
generator%real_kinematics%xi_max(i_phs), i_con = 1)
end do
else
call generator%compute_xi_max (emitter, i_phs, p, &
generator%real_kinematics%xi_max(i_phs))
end if
end associate
end do
end subroutine phs_fks_compute_xi_max_internal
@ %def phs_fks_compute_xi_max
@
<<PHS fks: phs fks: TBP>>=
procedure :: compute_xi_max_with_output => phs_fks_compute_xi_max_with_output
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_compute_xi_max_with_output &
(phs, emitter, i_phs, y, p, xi_max)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: i_phs, emitter
real(default), intent(in) :: y
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(out) :: xi_max
end subroutine phs_fks_compute_xi_max_with_output
<<PHS fks: procedures>>=
module subroutine phs_fks_compute_xi_max_with_output &
(phs, emitter, i_phs, y, p, xi_max)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: i_phs, emitter
real(default), intent(in) :: y
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(out) :: xi_max
call phs%generator%compute_xi_max (emitter, i_phs, p, xi_max, y_in = y)
end subroutine phs_fks_compute_xi_max_with_output
@ %def phs_fks_compute_xi_max_with_output
@
<<PHS fks: phs fks generator: TBP>>=
generic :: compute_emitter_kinematics => &
compute_emitter_kinematics_massless, &
compute_emitter_kinematics_massive
procedure :: compute_emitter_kinematics_massless => &
phs_fks_generator_compute_emitter_kinematics_massless
procedure :: compute_emitter_kinematics_massive => &
phs_fks_generator_compute_emitter_kinematics_massive
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_emitter_kinematics_massless &
(generator, y, q0, uk_em, uk)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: y, q0
real(default), intent(out) :: uk_em, uk
end subroutine phs_fks_generator_compute_emitter_kinematics_massless
module subroutine phs_fks_generator_compute_emitter_kinematics_massive &
(generator, y, em, i_phs, q0, k0_em, uk_em, uk, compute_jac)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: y
integer, intent(in) :: em, i_phs
real(default), intent(in) :: q0
real(default), intent(inout) :: k0_em, uk_em, uk
logical, intent(in) :: compute_jac
end subroutine phs_fks_generator_compute_emitter_kinematics_massive
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_emitter_kinematics_massless &
(generator, y, q0, uk_em, uk)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: y, q0
real(default), intent(out) :: uk_em, uk
real(default) :: k0_np1, q2
k0_np1 = generator%E_gluon
q2 = q0**2
uk_em = (q2 - generator%mrec2 - two * q0 * k0_np1) / &
(two * (q0 - k0_np1 * (one - y)))
uk = sqrt (uk_em**2 + k0_np1**2 + two * uk_em * k0_np1 * y)
end subroutine phs_fks_generator_compute_emitter_kinematics_massless
module subroutine phs_fks_generator_compute_emitter_kinematics_massive &
(generator, y, em, i_phs, q0, k0_em, uk_em, uk, compute_jac)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: y
integer, intent(in) :: em, i_phs
real(default), intent(in) :: q0
real(default), intent(inout) :: k0_em, uk_em, uk
logical, intent(in) :: compute_jac
real(default) :: k0_np1, q2, mrec2, m2
real(default) :: k0_rec_max, k0_em_max, k0_rec, uk_rec
real(default) :: z, z1, z2
k0_np1 = generator%E_gluon
q2 = q0**2
mrec2 = generator%mrec2
m2 = generator%m2(em)
k0_rec_max = (q2 - m2 + mrec2) / (two * q0)
k0_em_max = (q2 + m2 - mrec2) /(two * q0)
z1 = (k0_rec_max + sqrt (k0_rec_max**2 - mrec2)) / q0
z2 = (k0_rec_max - sqrt (k0_rec_max**2 - mrec2)) / q0
z = z2 - (z2 - z1) * (one + y) / two
k0_em = k0_em_max - k0_np1 * z
k0_rec = q0 - k0_np1 - k0_em
uk_em = sqrt(k0_em**2 - m2)
uk_rec = sqrt(k0_rec**2 - mrec2)
uk = uk_rec
if (compute_jac) &
generator%real_kinematics%jac(i_phs)%jac = q0 * (z1 - z2) / four * k0_np1
generator%real_kinematics%y_soft(i_phs) = &
(two * q2 * z - q2 - mrec2 + m2) / (sqrt(k0_em_max**2 - m2) * q0) / two
end subroutine phs_fks_generator_compute_emitter_kinematics_massive
@ %def phs_fks_generator_compute_emitter_kinematics
@
<<PHS fks: procedures>>=
function recompute_xi_max (q0, mrec2, m2, y) result (xi_max)
real(default) :: xi_max
real(default), intent(in) :: q0, mrec2, m2, y
real(default) :: q2, k0_np1_max, k0_rec_max
real(default) :: z1, z2, z
q2 = q0**2
k0_rec_max = (q2 - m2 + mrec2) / (two * q0)
z1 = (k0_rec_max + sqrt (k0_rec_max**2 - mrec2)) / q0
z2 = (k0_rec_max - sqrt (k0_rec_max**2 - mrec2)) / q0
z = z2 - (z2 - z1) * (one + y) / 2
k0_np1_max = - (q2 * z**2 - two * q0 * k0_rec_max * z + mrec2) / (two * q0 * z * (one - z))
xi_max = two * k0_np1_max / q0
end function recompute_xi_max
@ %def recompute_xi_max
@
<<PHS fks: procedures>>=
function compute_beta_massless (q2, k0_rec, uk_rec) result (beta)
real(default), intent(in) :: q2, k0_rec, uk_rec
real(default) :: beta
beta = (q2 - (k0_rec + uk_rec)**2) / (q2 + (k0_rec + uk_rec)**2)
end function compute_beta_massless
function compute_beta_massive (q2, k0_rec, uk_rec, &
k0_em_born, uk_em_born) result (beta)
real(default), intent(in) :: q2, k0_rec, uk_rec
real(default), intent(in) :: k0_em_born, uk_em_born
real(default) :: beta
real(default) :: k0_rec_born, uk_rec_born, alpha
k0_rec_born = sqrt(q2) - k0_em_born
uk_rec_born = uk_em_born
alpha = (k0_rec + uk_rec) / (k0_rec_born + uk_rec_born)
beta = (one - alpha**2) / (one + alpha**2)
end function compute_beta_massive
@ %def compute_beta
@ The momentum of the radiated particle is computed according to
\begin{equation}
\label{eq:phs_fks:compute_k_n}
\underline{k}_n = \frac{q^2 - M_{\rm{rec}}^2 -
2q^0\underline{k}_{n+1}}{2(q^0 - \underline{k}_{n+1}(1-y))},
\end{equation}
with $k = k_n + k_{n+1}$ and $M_{\rm{rec}}^2 = k_{\rm{rec}}^2 =
\left(q-k\right)^2$. Because of $\boldsymbol{\bar{k}}_n \parallel
\boldsymbol{k}_n + \boldsymbol{k}_{n+1}$ we find $M_{\rm{rec}}^2 =
\left(q-\bar{k}_n\right)^2$.
Equation \ref{eq:phs_fks:compute_k_n} follows from the fact that
$\left(\boldsymbol{k} - \boldsymbol{k}_n\right)^2 =
\boldsymbol{k}_{n+1}^2$, which is equivalent to $\boldsymbol{k}_n
\cdot \boldsymbol{k} = \frac{1}{2} \left(\underline{k}_n^2 +
\underline{k}^2 - \underline{k}_{n+1}^2\right)$.\\
$\boldsymbol{k}_n$ and $\boldsymbol{k}_{n+1}$ are obtained by first
setting up vectors parallel to $\boldsymbol{\bar{k}}_n$,
\begin{equation*}
\boldsymbol{k}_n' = \underline{k}_n
\frac{\bar{\pmb{k}}_n}{\underline{\bar{k}}_n}, \quad \pmb{k}_{n+1}'
= \underline{k}_{n+1}\frac{\bar{\pmb{k}}_n}{\underline{\bar{k}}_n},
\end{equation*}
and then rotating these vectors by an amount of $\cos\psi_n =
\frac{\boldsymbol{k}_n\cdot\pmb{k}}{\underline{k}_n \underline{k}}$.
@ The emitted particle cannot have more momentum than the emitter has
in the Born phase space. Thus, there is an upper bound for $\xi$,
determined by the condition $k_{n+1}^0 = \underline{\bar{k}}_n$, which
is equal to
\begin{equation*}
\xi_{\rm{max}} = \frac{2}{\underline{\bar{k}}_n}{q^0}.
\end{equation*}
<<PHS fks: procedures>>=
pure function get_xi_max_fsr_massless (p_born, q0, emitter) result (xi_max)
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: q0
integer, intent(in) :: emitter
real(default) :: xi_max
real(default) :: uk_n_born
uk_n_born = space_part_norm (p_born(emitter))
xi_max = two * uk_n_born / q0
end function get_xi_max_fsr_massless
@ %def get_xi_max_fsr_massless
@ The computation of $\xi_{\rm{max}}$ for massive emitters is described
in arXiv:1202.0465. Let's recapitulate it here.
We consider the Dalitz-domain created by $k_{n+1}^0$, $k_n^0$ and
$k_{\rm{rec}}^0$ and introduce the parameterization
\begin{equation*}
k_n^0 = \bar{k}_n^0 - zk_{n+1}^0
\end{equation*}
Then, for each value of $z$, there exists a maximum value of
$\underline{k}_{n+1}$ from which $\xi_{\rm{max}}$ can be extracted via
$\xi_{\rm{max}} = 2k_{n+1}^0/q$. It is determined by the condition
\begin{equation*}
\underline{k}_{n+1} \pm \underline{k}_n \pm \underline{k}_{\rm{rec}} = 0.
\end{equation*}
This can be manipulated to yield
\begin{equation*}
\left(\underline{k}_{n+1}^2 + \underline{k}_n^2 -
\underline{k}_{\rm{rec}}^2\right)^2 =
4\underline{k}^2_{n+1}\underline{k}_n^2.
\end{equation*}
Here we can use $\underline{k}_n^2 = \left(k_n^0\right)^2 - m^2$ and
$\underline{k}_{\rm{rec}}^2 = \left(q - k_n^0 - k_{n+1}^0\right)^2 -
M_{\rm{rec}}^2$, as well as the above parameterization of $k_n^0$, to
obtain
\begin{equation*}
4\underline{k}_{n+1}^2\left(2\underline{k}_{n+1}qz(1-z) +
q^2z^2 - 2q\bar{k}_{\rm{rec}}^0z + M_{\rm{rec}}^2\right) = 0.
\end{equation*}
Solving for $k_{n+1}^0$ gives
\begin{equation}
k_{n+1}^0 = \frac{2q\bar{k}^0_{\rm{rec}}z - q^2z^2 - M_{\rm{rec}}^2}{2qz(1-z)}.
\label{XiMaxMassive}
\end{equation}
It is still open how to compute $z$. For this, consider that the
right-hand-side of equation (\ref{XiMaxMassive}) vanishes for
\begin{equation*}
z_{1,2} = \left(\bar{k}_{\rm{rec}}^0 \pm
\sqrt{\left(\bar{k}_{\rm{rec}}^0\right)^2 - M_{\rm{rec}}^2}\right)/q,
\end{equation*}
which corresponds to the borders of the Dalitz-region where the gluon
momentum vanishes. Thus we define
\begin{equation*}
z = z_2 - \frac{1}{2} (z_2 - z_1)(1+y).
\end{equation*}
<<PHS fks: procedures>>=
pure function get_xi_max_fsr_massive (p_born, q0, emitter, m2, y) result (xi_max)
real(default) :: xi_max
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: q0
integer, intent(in) :: emitter
real(default), intent(in) :: m2, y
real(default) :: mrec2
real(default) :: k0_rec_max
real(default) :: z, z1, z2
real(default) :: k0_np1_max
associate (p => p_born(emitter)%p)
mrec2 = (q0 - p(0))**2 - p(1)**2 - p(2)**2 - p(3)**2
end associate
call compute_dalitz_bounds (q0, m2, mrec2, z1, z2, k0_rec_max)
z = z2 - (z2 - z1) * (one + y) / two
k0_np1_max = - (q0**2 * z**2 - two * q0 * k0_rec_max * z + mrec2) &
/ (two * q0 * z * (one - z))
xi_max = two * k0_np1_max / q0
end function get_xi_max_fsr_massive
@ %def get_xi_max_fsr_massive
@
<<PHS fks: parameters>>=
integer, parameter, public :: I_PLUS = 1
integer, parameter, public :: I_MINUS = 2
@ %def parameters
@ Computes $\xi_{\text{max}}$ in the case of ISR as documented in eq. \ref{eqn:xi_max_isr}.
It is also used for the POWHEG matching.
<<PHS fks: public>>=
public :: get_xi_max_isr
<<PHS fks: sub interfaces>>=
module function get_xi_max_isr (xb, y) result (xi_max)
real(default) :: xi_max
real(default), dimension(2), intent(in) :: xb
real(default), intent(in) :: y
end function get_xi_max_isr
<<PHS fks: procedures>>=
module function get_xi_max_isr (xb, y) result (xi_max)
real(default) :: xi_max
real(default), dimension(2), intent(in) :: xb
real(default), intent(in) :: y
xi_max = one - max (xi_max_isr_plus (xb(I_PLUS), y), xi_max_isr_minus (xb(I_MINUS), y))
contains
function xi_max_isr_plus (x, y)
real(default) :: xi_max_isr_plus
real(default), intent(in) :: x, y
real(default) :: deno
deno = sqrt ((one + x**2)**2 * (one - y)**2 + 16 * y * x**2) + (one - y) * (1 - x**2)
xi_max_isr_plus = two * (one + y) * x**2 / deno
end function xi_max_isr_plus
function xi_max_isr_minus (x, y)
real(default) :: xi_max_isr_minus
real(default), intent(in) :: x, y
real(default) :: deno
deno = sqrt ((one + x**2)**2 * (one + y)**2 - 16 * y * x**2) + (one + y) * (1 - x**2)
xi_max_isr_minus = two * (one - y) * x**2 / deno
end function xi_max_isr_minus
end function get_xi_max_isr
@ %def get_xi_max_isr
@
<<PHS fks: procedures>>=
recursive function get_xi_max_isr_decay (p) result (xi_max)
real(default) :: xi_max
type(vector4_t), dimension(:), intent(in) :: p
integer :: n_tot
type(vector4_t), dimension(:), allocatable :: p_dec_new
n_tot = size (p)
if (n_tot == 3) then
xi_max = xi_max_one_to_two (p(1), p(2), p(3))
else
allocate (p_dec_new (n_tot - 1))
p_dec_new(1) = sum (p (3 : ))
p_dec_new(2 : n_tot - 1) = p (3 : n_tot)
xi_max = min (xi_max_one_to_two (p(1), p(2), sum(p(3 : ))), &
get_xi_max_isr_decay (p_dec_new))
end if
contains
function xi_max_one_to_two (p_in, p_out1, p_out2) result (xi_max)
real(default) :: xi_max
type(vector4_t), intent(in) :: p_in, p_out1, p_out2
real(default) :: m_in, m_out1, m_out2
m_in = p_in**1
m_out1 = p_out1**1; m_out2 = p_out2**1
xi_max = one - (m_out1 + m_out2)**2 / m_in**2
end function xi_max_one_to_two
end function get_xi_max_isr_decay
@ %def get_xi_max_isr_decay
@
\subsection{Creation of the real phase space - ISR}
<<PHS fks: phs fks: TBP>>=
procedure :: generate_isr => phs_fks_generate_isr
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generate_isr (phs, i_phs, p_real)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: i_phs
type(vector4_t), intent(inout), dimension(:) :: p_real
end subroutine phs_fks_generate_isr
<<PHS fks: procedures>>=
module subroutine phs_fks_generate_isr (phs, i_phs, p_real)
class(phs_fks_t), intent(inout) :: phs
integer, intent(in) :: i_phs
type(vector4_t), intent(inout), dimension(:) :: p_real
type(vector4_t) :: p0, p1
type(lorentz_transformation_t) :: lt
real(default) :: sqrts_hat
type(vector4_t), dimension(:), allocatable :: p_work
associate (generator => phs%generator)
select case (generator%n_in)
case (1)
p_work = generator%real_kinematics%p_born_cms%phs_point(1)
call generator%generate_isr_fixed_beam_energy (i_phs, p_work, p_real)
phs%config%lab_is_cm = .true.
case (2)
select case (generator%isr_kinematics%isr_mode)
case (SQRTS_FIXED)
p_work = generator%real_kinematics%p_born_cms%phs_point(1)
call generator%generate_isr_fixed_beam_energy (i_phs, p_work, p_real)
case (SQRTS_VAR)
p_work = generator%real_kinematics%p_born_lab%phs_point(1)
call generator%generate_isr (i_phs, p_work, p_real)
end select
end select
generator%real_kinematics%p_real_lab%phs_point(i_phs) = p_real
if (.not. phs%config%lab_is_cm) then
sqrts_hat = (p_real(1) + p_real(2))**1
p0 = p_real(1) + p_real(2)
lt = boost (p0, sqrts_hat)
p1 = inverse(lt) * p_real(1)
lt = lt * rotation_to_2nd (3, space_part (p1))
phs%generator%real_kinematics%p_real_cms%phs_point(i_phs) &
= inverse (lt) * p_real
else
phs%generator%real_kinematics%p_real_cms%phs_point(i_phs) &
= p_real
end if
end associate
end subroutine phs_fks_generate_isr
@ %def phs_fks_generate_isr
@ The real phase space for an inital-state emission involved in a decay
process is generated by first setting the gluon momentum like in the
scattering case by using its angular coordinates $y$ and $\phi$ and then
adjusting the gluon energy with $\xi$. The emitter momentum is kept
identical to the Born case, i.e. $p_{\rm{in}} = \bar{p}_{\rm{in}}$, so
that after the emission it has momentum $p_{\rm{virt}} = p_{\rm{in}} -
p_{\rm{g}}$ and invariant mass $m^2 = p_{\rm{virt}}^2$. Note that the
final state momenta have to remain on-shell, so that $p_1^2 =
\bar{p}_1^2 = m_1^2$ and $p_2^2 = \bar{p}_2^2 = m_2^2$. Let $\Lambda$ be
the boost from into the rest frame of the emitter after emission, i.e.
$\Lambda p_{\rm{virt}} = \left(m, 0, 0, 0\right)$. In this reference
frame, the spatial components of the final-state momenta sum up to zero,
and their magnitude is
\begin{equation*}
p = \frac{\sqrt {\lambda (m^2, m_1^2, m_2^2)}}{2m},
\end{equation*}
a fact already used in the evaluation of the phase space trees of
[[phs_forest]]. Obviously, from this, the final-state energies can be
deferred via $E_i^2 = m_i^2 - p^2$. In the next step, the $p_{1,2}$ are
set up as vectors $(E,0,0,\pm p)$ along the z-axis and then rotated
about the same azimuthal and polar angles as in the Born system.
Finally, the momenta are boosted out of the rest frame by multiplying
with $\Lambda$.
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_isr_fixed_beam_energy => &
phs_fks_generator_generate_isr_fixed_beam_energy
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_isr_fixed_beam_energy &
(generator, i_phs, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
end subroutine phs_fks_generator_generate_isr_fixed_beam_energy
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_isr_fixed_beam_energy &
(generator, i_phs, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default) :: xi_max, xi, y, phi
integer :: nlegborn, nlegreal, i
real(default) :: k0_np1
real(default) :: msq_in
type(vector4_t) :: p_virt
real(default) :: jac_real
associate (rad_var => generator%real_kinematics)
xi_max = rad_var%xi_max(i_phs)
xi = rad_var%xi_tilde * xi_max
y = rad_var%y(i_phs)
phi = rad_var%phi
rad_var%y_soft(i_phs) = y
end associate
nlegborn = size (p_born)
nlegreal = nlegborn + 1
msq_in = sum (p_born(1:generator%n_in))**2
generator%real_kinematics%jac(i_phs)%jac = one
p_real(1) = p_born(1)
if (generator%n_in > 1) p_real(2) = p_born(2)
k0_np1 = zero
do i = 1, generator%n_in
k0_np1 = k0_np1 + p_real(i)%p(0) * xi / two
end do
p_real(nlegreal)%p(0) = k0_np1
p_real(nlegreal)%p(1) = k0_np1 * sqrt(one - y**2) * sin(phi)
p_real(nlegreal)%p(2) = k0_np1 * sqrt(one - y**2) * cos(phi)
p_real(nlegreal)%p(3) = k0_np1 * y
p_virt = sum (p_real(1:generator%n_in)) - p_real(nlegreal)
jac_real = one
call generate_on_shell_decay (p_virt, &
p_born(generator%n_in + 1 : nlegborn), &
p_real(generator%n_in + 1 : nlegreal - 1), 1, msq_in, jac_real)
associate (jac => generator%real_kinematics%jac(i_phs))
jac%jac(1) = jac_real
jac%jac(2) = one
end associate
end subroutine phs_fks_generator_generate_isr_fixed_beam_energy
@ %def phs_fks_generator_generate_isr_fixed_beam_energy
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_isr_factorized => &
phs_fks_generator_generate_isr_factorized
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_isr_factorized &
(generator, i_phs, emitter, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs, emitter
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
end subroutine phs_fks_generator_generate_isr_factorized
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_isr_factorized &
(generator, i_phs, emitter, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs, emitter
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
type(vector4_t), dimension(3) :: p_tmp_born
type(vector4_t), dimension(4) :: p_tmp_real
type(vector4_t) :: p_top
type(lorentz_transformation_t) :: boost_to_rest_frame
integer, parameter :: nlegreal = 7
!!! Factorized phase space so far only required for ee -> bwbw
p_tmp_born = vector4_null; p_tmp_real = vector4_null
p_real(1:2) = p_born(1:2)
if (emitter == THR_POS_B) then
p_top = p_born (THR_POS_WP) + p_born (THR_POS_B)
p_tmp_born(2) = p_born (THR_POS_WP)
p_tmp_born(3) = p_born (THR_POS_B)
else if (emitter == THR_POS_BBAR) then
p_top = p_born (THR_POS_WM) + p_born (THR_POS_BBAR)
p_tmp_born(2) = p_born (THR_POS_WM)
p_tmp_born(3) = p_born (THR_POS_BBAR)
else
call msg_fatal ("Threshold computation requires emitters to be at position 5 and 6 " // &
"Please check if your process specification fulfills this requirement.")
end if
p_tmp_born (1) = p_top
boost_to_rest_frame = inverse (boost (p_top, p_top**1))
p_tmp_born = boost_to_rest_frame * p_tmp_born
call generator%compute_xi_max_isr_factorized (i_phs, p_tmp_born)
call generator%generate_isr_fixed_beam_energy &
(i_phs, p_tmp_born, p_tmp_real)
p_tmp_real = inverse (boost_to_rest_frame) * p_tmp_real
if (emitter == THR_POS_B) then
p_real(THR_POS_WP) = p_tmp_real(2)
p_real(THR_POS_B) = p_tmp_real(3)
p_real(THR_POS_WM) = p_born(THR_POS_WM)
p_real(THR_POS_BBAR) = p_born(THR_POS_BBAR)
!!! Exception has been handled above
else
p_real(THR_POS_WM) = p_tmp_real(2)
p_real(THR_POS_BBAR) = p_tmp_real(3)
p_real(THR_POS_WP) = p_born(THR_POS_WP)
p_real(THR_POS_B) = p_born(THR_POS_B)
end if
p_real(nlegreal) = p_tmp_real(4)
end subroutine phs_fks_generator_generate_isr_factorized
@ %def phs_fks_generator_generate_isr_factorized
@ Construction of the real momenta [[p_real]] in case of ISR.
Follows the discussion in [0709.2092] sec. 5.1.
The sequence of Lorentz boosts required to construct [[p_real]] from
[[p_born]] is as follows:
\begin{enumerate}
\item[\labelitemii] We construct the IS momenta of [[p_real]] from
the Born momenta via rescaling:
[[p_real(1:2)]] $= \frac{x}{\overline{x}} \cdot$ [[p_born(1:2)]].
If the Born momenta are imported in the lab frame, these will define
the real lab frame.
\item[\labelitemii] We construct the momentum of the radiated
particle in the real CMS:
$k_{n+1} = \frac{s \xi}{2} \cdot (1, \sin(\theta) \sin(\phi),
\sin(\theta) \cos(\phi), \cos(\theta))$
\setcounter{enumi}{-1}
\item We first boost the momentum of the radiated particle from the
real CMS to the real lab frame determined from [[p_real(1:2)]].
\item We initialize the non-radiated real FS momenta by a
longitudinal boost of [[p_born]] to a system with zero rapidity,
i.e. zero longitudinal momenum. This is $\mathbb{B}_L$.
\item We boost these momenta in a transverse direction to compensate
the transverse momentum of the radiation. This is
$\mathbb{B}_T$. Note: we switched $\mathbb{B}_T$ and
$\mathbb{B}^{-1}_T$ in Eq. (5.16) and their definition
w.r.t. [0709.2092].
\item We restore longitudinal momentum conservation by applying the
inverse boost of $\mathbb{B}_L$ to all non-radiated real FS momenta.
\end{enumerate}
This way, all components of [[p_real]] are constructed in the real Lab frame.
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_isr => phs_fks_generator_generate_isr
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_isr &
(generator, i_phs, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs
type(vector4_t), intent(in) , dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
end subroutine phs_fks_generator_generate_isr
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_isr &
(generator, i_phs, p_born, p_real)
!!! Important: Import Born momenta in the lab frame
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs
type(vector4_t), intent(in) , dimension(:) :: p_born
type(vector4_t), intent(inout), dimension(:) :: p_real
real(default) :: xi_max, xi_tilde, xi, y, phi
integer :: nlegborn, nlegreal
real(default) :: sqrts_real
real(default) :: k0_np1
type(lorentz_transformation_t) :: &
lambda_transv, lambda_longit, lambda_longit_inv
real(default) :: x_plus, x_minus, xb_plus, xb_minus
real(default) :: onemy, onepy
integer :: i
real(default) :: xi_plus, xi_minus
real(default) :: beta_gamma
type(vector3_t) :: beta_vec
associate (rad_var => generator%real_kinematics)
xi_max = rad_var%xi_max(i_phs)
xi_tilde = rad_var%xi_tilde
xi = xi_tilde * xi_max
y = rad_var%y(i_phs)
onemy = one - y; onepy = one + y
phi = rad_var%phi
rad_var%y_soft(i_phs) = y
end associate
nlegborn = size (p_born)
nlegreal = nlegborn + 1
generator%isr_kinematics%sqrts_born = (p_born(1) + p_born(2))**1
!!! Initial state real momenta
xb_plus = generator%isr_kinematics%x(I_PLUS)
xb_minus = generator%isr_kinematics%x(I_MINUS)
x_plus = xb_plus / sqrt(one - xi) * sqrt ((two - xi * onemy) / &
(two - xi * onepy))
x_minus = xb_minus / sqrt(one - xi) * sqrt ((two - xi * onepy) / &
(two - xi * onemy))
xi_plus = xi_tilde * (one - xb_plus)
xi_minus = xi_tilde * (one - xb_minus)
p_real(I_PLUS) = x_plus / xb_plus * p_born(I_PLUS)
p_real(I_MINUS) = x_minus / xb_minus * p_born(I_MINUS)
!!! Fraction of momentum fractions in a collinear splitting
generator%isr_kinematics%z(I_PLUS) = (one - xi_plus)
generator%isr_kinematics%z(I_MINUS) = (one - xi_minus)
!!! Create radiation momentum in the real CMS
sqrts_real = generator%isr_kinematics%sqrts_born / sqrt (one - xi)
k0_np1 = sqrts_real * xi / two
p_real(nlegreal)%p(0) = k0_np1
p_real(nlegreal)%p(1) = k0_np1 * sqrt (one - y**2) * sin(phi)
p_real(nlegreal)%p(2) = k0_np1 * sqrt (one - y**2) * cos(phi)
p_real(nlegreal)%p(3) = k0_np1 * y
!!! Boosts the radiation from real CMS to the real LAB frame
call get_boost_parameters (p_real, beta_gamma, beta_vec)
lambda_longit = create_longitudinal_boost &
(beta_gamma, beta_vec, inverse = .true.)
p_real(nlegreal) = lambda_longit * p_real(nlegreal)
call get_boost_parameters (p_born, beta_gamma, beta_vec)
lambda_longit = create_longitudinal_boost &
(beta_gamma, beta_vec, inverse = .false.)
forall (i = 3 : nlegborn) p_real(i) = lambda_longit * p_born(i)
lambda_transv = create_transversal_boost (p_real(nlegreal), xi, sqrts_real)
forall (i = 3 : nlegborn) p_real(i) = lambda_transv * p_real(i)
lambda_longit_inv = create_longitudinal_boost &
(beta_gamma, beta_vec, inverse = .true.)
forall (i = 3 : nlegborn) p_real(i) = lambda_longit_inv * p_real(i)
!!! Compute Jacobians
associate (jac => generator%real_kinematics%jac(i_phs))
!!! Additional 1 / (1 - xi) factor because in the real jacobian,
!!! there is s_real in the numerator
- !!! We also have to adapt the flux factor, which is 1/2s_real for
+ !!! We also have to adapt the flux factor, which is 1/(2s_real) for
!!! the real component
!!! The reweighting factor is s_born / s_real, cancelling the
- !!! (1-x) factor from above
+ !!! (1-xi) factor from above
jac%jac(1) = one / (one - xi)
jac%jac(2) = one
jac%jac(3) = one / (one - xi_plus)**2
jac%jac(4) = one / (one - xi_minus)**2
end associate
contains
subroutine get_boost_parameters (p, beta_gamma, beta_vec)
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(out) :: beta_gamma
type(vector3_t), intent(out) :: beta_vec
beta_vec = (p(1)%p(1:3) + p(2)%p(1:3)) / (p(1)%p(0) + p(2)%p(0))
beta_gamma = beta_vec**1 / sqrt (one - beta_vec**2)
beta_vec = beta_vec / beta_vec**1
end subroutine get_boost_parameters
function create_longitudinal_boost &
(beta_gamma, beta_vec, inverse) result (lambda)
real(default), intent(in) :: beta_gamma
type(vector3_t), intent(in) :: beta_vec
logical, intent(in) :: inverse
type(lorentz_transformation_t) :: lambda
if (inverse) then
lambda = boost (beta_gamma, beta_vec)
else
lambda = boost (-beta_gamma, beta_vec)
end if
end function create_longitudinal_boost
function create_transversal_boost (p_rad, xi, sqrts_real) result (lambda)
type(vector4_t), intent(in) :: p_rad
real(default), intent(in) :: xi, sqrts_real
type(lorentz_transformation_t) :: lambda
type(vector3_t) :: vec_transverse
real(default) :: pt2, beta, beta_gamma
pt2 = transverse_part (p_rad)**2
beta = one / sqrt (one + sqrts_real**2 * (one - xi) / pt2)
beta_gamma = beta / sqrt (one - beta**2)
vec_transverse%p(1:2) = p_rad%p(1:2)
vec_transverse%p(3) = zero
vec_transverse = normalize (vec_transverse)
lambda = boost (-beta_gamma, vec_transverse)
end function create_transversal_boost
end subroutine phs_fks_generator_generate_isr
@ %def phs_fks_generator_generate_isr
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: set_sqrts_hat => phs_fks_generator_set_sqrts_hat
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_set_sqrts_hat (generator, sqrts)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: sqrts
end subroutine phs_fks_generator_set_sqrts_hat
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_set_sqrts_hat (generator, sqrts)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: sqrts
generator%sqrts = sqrts
end subroutine phs_fks_generator_set_sqrts_hat
@ %def phs_fks_generator_set_sqrts_hat
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: set_emitters => phs_fks_generator_set_emitters
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_set_emitters (generator, emitters)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in), dimension(:), allocatable :: emitters
end subroutine phs_fks_generator_set_emitters
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_set_emitters (generator, emitters)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in), dimension(:), allocatable :: emitters
allocate (generator%emitters (size (emitters)))
generator%emitters = emitters
end subroutine phs_fks_generator_set_emitters
@ %def phs_fks_generator_set_emitters
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: setup_masses => phs_fks_generator_setup_masses
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_setup_masses (generator, n_tot)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: n_tot
end subroutine phs_fks_generator_setup_masses
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_setup_masses (generator, n_tot)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: n_tot
if (.not. allocated (generator%m2)) then
allocate (generator%is_massive (n_tot))
allocate (generator%m2 (n_tot))
generator%is_massive = .false.
generator%m2 = zero
end if
end subroutine phs_fks_generator_setup_masses
@ %def phs_fks_generator_setup_masses
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: set_xi_and_y_bounds => phs_fks_generator_set_xi_and_y_bounds
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_set_xi_and_y_bounds &
(generator, fks_xi_min, fks_y_max)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in), optional :: fks_xi_min, fks_y_max
end subroutine phs_fks_generator_set_xi_and_y_bounds
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_set_xi_and_y_bounds &
(generator, fks_xi_min, fks_y_max)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in), optional :: fks_xi_min, fks_y_max
real(default) :: xi_min, y_max
xi_min = zero; y_max = one
if (present (fks_xi_min)) xi_min = fks_xi_min
if (present (fks_y_max)) y_max = fks_y_max
generator%xi_min = min (one, max (xi_min, tiny_07))
generator%y_max = min (abs (y_max), one)
end subroutine phs_fks_generator_set_xi_and_y_bounds
@ %def phs_fks_generator_set_xi_and_y_bounds
@ Sets [[x]] in the [[isr_kinematics]] of the generator.
<<PHS fks: phs fks generator: TBP>>=
procedure :: set_isr_kinematics => phs_fks_generator_set_isr_kinematics
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_set_isr_kinematics (generator, p)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), dimension(2), intent(in) :: p
end subroutine phs_fks_generator_set_isr_kinematics
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_set_isr_kinematics (generator, p)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), dimension(2), intent(in) :: p
if (allocated (generator%isr_kinematics%beam_energy)) then
select case (size (generator%isr_kinematics%beam_energy))
case (1)
generator%isr_kinematics%x = p%p(0) / &
generator%isr_kinematics%beam_energy(1)
case (2)
generator%isr_kinematics%x = p%p(0) / &
generator%isr_kinematics%beam_energy
end select
else
generator%isr_kinematics%x = 0
end if
end subroutine phs_fks_generator_set_isr_kinematics
@ %def phs_fks_generator_set_isr_kinematics
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_radiation_variables => &
phs_fks_generator_generate_radiation_variables
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_radiation_variables &
(generator, r_in, p_born, phs_identifiers, threshold)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in), dimension(:) :: r_in
type(vector4_t), intent(in), dimension(:) :: p_born
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
logical, intent(in), optional :: threshold
end subroutine phs_fks_generator_generate_radiation_variables
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_radiation_variables &
(generator, r_in, p_born, phs_identifiers, threshold)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in), dimension(:) :: r_in
type(vector4_t), intent(in), dimension(:) :: p_born
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
logical, intent(in), optional :: threshold
associate (rad_var => generator%real_kinematics)
rad_var%phi = r_in (I_PHI) * twopi
select case (generator%mode)
case (GEN_REAL_PHASE_SPACE)
rad_var%jac_rand = twopi
call generator%compute_y_real_phs (r_in(I_Y), p_born, phs_identifiers, &
rad_var%jac_rand, rad_var%y, threshold)
case (GEN_SOFT_MISMATCH)
rad_var%jac_mismatch = twopi
call generator%compute_y_mismatch (r_in(I_Y), rad_var%jac_mismatch, &
rad_var%y_mismatch, rad_var%y_soft)
case default
call generator%compute_y_test (rad_var%y)
end select
call generator%compute_xi_tilde (r_in(I_XI))
call generator%set_masses (p_born, phs_identifiers)
end associate
end subroutine phs_fks_generator_generate_radiation_variables
@ %def phs_fks_generator_generate_radiation_variables
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_xi_ref_momenta => &
phs_fks_generator_compute_xi_ref_momenta
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_xi_ref_momenta &
(generator, p_born, resonance_contributors)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
type(resonance_contributors_t), intent(in), dimension(:), optional &
:: resonance_contributors
end subroutine phs_fks_generator_compute_xi_ref_momenta
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_xi_ref_momenta &
(generator, p_born, resonance_contributors)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
type(resonance_contributors_t), intent(in), dimension(:), optional &
:: resonance_contributors
integer :: i_con, n_contributors
if (present (resonance_contributors)) then
n_contributors = size (resonance_contributors)
if (.not. allocated (generator%resonance_contributors)) &
allocate (generator%resonance_contributors (n_contributors))
do i_con = 1, n_contributors
generator%real_kinematics%xi_ref_momenta(i_con) = &
get_resonance_momentum (p_born, resonance_contributors(i_con)%c)
generator%resonance_contributors(i_con) = &
resonance_contributors(i_con)
end do
else
generator%real_kinematics%xi_ref_momenta(1) = &
sum (p_born(1:generator%n_in))
end if
end subroutine phs_fks_generator_compute_xi_ref_momenta
@ %def phs_fks_generator_compute_xi_ref_momenta
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_xi_ref_momenta_threshold &
=> phs_fks_generator_compute_xi_ref_momenta_threshold
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_xi_ref_momenta_threshold &
(generator, p_born)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
end subroutine phs_fks_generator_compute_xi_ref_momenta_threshold
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_xi_ref_momenta_threshold &
(generator, p_born)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
generator%real_kinematics%xi_ref_momenta(1) = &
p_born(THR_POS_WP) + p_born(THR_POS_B)
generator%real_kinematics%xi_ref_momenta(2) = &
p_born(THR_POS_WM) + p_born(THR_POS_BBAR)
end subroutine phs_fks_generator_compute_xi_ref_momenta_threshold
@ %def phs_fks_generator_compute_xi_ref_momenta_threshold
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_cms_energy => phs_fks_generator_compute_cms_energy
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_cms_energy (generator, p_born)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
end subroutine phs_fks_generator_compute_cms_energy
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_cms_energy (generator, p_born)
class(phs_fks_generator_t), intent(inout) :: generator
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t) :: p_sum
p_sum = sum (p_born (1 : generator%n_in))
generator%real_kinematics%cms_energy2 = p_sum**2
end subroutine phs_fks_generator_compute_cms_energy
@ %def phs_fks_generator_compute_cms_energy
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_xi_max => phs_fks_generator_compute_xi_max
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_xi_max (generator, emitter, &
i_phs, p, xi_max, i_con, y_in)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs, emitter
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(out) :: xi_max
integer, intent(in), optional :: i_con
real(default), intent(in), optional :: y_in
end subroutine phs_fks_generator_compute_xi_max
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_xi_max (generator, emitter, &
i_phs, p, xi_max, i_con, y_in)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs, emitter
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(out) :: xi_max
integer, intent(in), optional :: i_con
real(default), intent(in), optional :: y_in
real(default) :: q0
type(vector4_t), dimension(:), allocatable :: pp, pp_decay
type(vector4_t) :: p_res
type(lorentz_transformation_t) :: L_to_resonance
real(default) :: y
if (.not. any (generator%emitters == emitter)) return
allocate (pp (size (p)))
associate (rad_var => generator%real_kinematics)
if (present (i_con)) then
q0 = rad_var%xi_ref_momenta(i_con)**1
else
q0 = energy (sum (p(1:generator%n_in)))
end if
if (present (y_in)) then
y = y_in
else
y = rad_var%y(i_phs)
end if
if (present (i_con)) then
p_res = rad_var%xi_ref_momenta(i_con)
L_to_resonance = inverse (boost (p_res, q0))
pp = L_to_resonance * p
else
pp = p
end if
if (emitter <= generator%n_in) then
select case (generator%isr_kinematics%isr_mode)
case (SQRTS_FIXED)
if (generator%n_in > 1) then
allocate (pp_decay (size (pp) - 1))
else
allocate (pp_decay (size (pp)))
end if
pp_decay (1) = sum (pp(1:generator%n_in))
pp_decay (2 : ) = pp (generator%n_in + 1 : )
xi_max = get_xi_max_isr_decay (pp_decay)
deallocate (pp_decay)
case (SQRTS_VAR)
xi_max = get_xi_max_isr (generator%isr_kinematics%x, y)
end select
else
if (generator%is_massive(emitter)) then
xi_max = get_xi_max_fsr (pp, q0, emitter, generator%m2(emitter), y)
else
xi_max = get_xi_max_fsr (pp, q0, emitter)
end if
end if
deallocate (pp)
end associate
end subroutine phs_fks_generator_compute_xi_max
@ %def phs_fks_generator_compute_xi_max
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_xi_max_isr_factorized &
=> phs_fks_generator_compute_xi_max_isr_factorized
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_xi_max_isr_factorized &
(generator, i_phs, p)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p
end subroutine phs_fks_generator_compute_xi_max_isr_factorized
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_xi_max_isr_factorized &
(generator, i_phs, p)
class(phs_fks_generator_t), intent(inout) :: generator
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p
generator%real_kinematics%xi_max(i_phs) = get_xi_max_isr_decay (p)
end subroutine phs_fks_generator_compute_xi_max_isr_factorized
@ %def phs_fks_generator_compute_xi_max_isr_factorized
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: set_masses => phs_fks_generator_set_masses
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_set_masses &
(generator, p, phs_identifiers)
class(phs_fks_generator_t), intent(inout) :: generator
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
type(vector4_t), intent(in), dimension(:) :: p
end subroutine phs_fks_generator_set_masses
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_set_masses &
(generator, p, phs_identifiers)
class(phs_fks_generator_t), intent(inout) :: generator
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
type(vector4_t), intent(in), dimension(:) :: p
integer :: emitter, i_phs
do i_phs = 1, size (phs_identifiers)
emitter = phs_identifiers(i_phs)%emitter
if (any (generator%emitters == emitter) .and. emitter > 0) then
if (generator%is_massive (emitter) .and. emitter > generator%n_in) &
generator%m2(emitter) = p(emitter)**2
end if
end do
end subroutine phs_fks_generator_set_masses
@ %def phs_fhs_generator_set_masses
@
<<PHS fks: public>>=
public :: compute_y_from_emitter
<<PHS fks: sub interfaces>>=
module subroutine compute_y_from_emitter (r_y, p, n_in, emitter, &
massive, y_max, jac_rand, y, contributors, threshold)
real(default), intent(in) :: r_y
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: n_in
integer, intent(in) :: emitter
logical, intent(in) :: massive
real(default), intent(in) :: y_max
real(default), intent(inout) :: jac_rand
real(default), intent(out) :: y
integer, intent(in), dimension(:), allocatable, optional :: contributors
logical, intent(in), optional :: threshold
end subroutine compute_y_from_emitter
<<PHS fks: procedures>>=
module subroutine compute_y_from_emitter (r_y, p, n_in, emitter, &
massive, y_max, jac_rand, y, contributors, threshold)
real(default), intent(in) :: r_y
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: n_in
integer, intent(in) :: emitter
logical, intent(in) :: massive
real(default), intent(in) :: y_max
real(default), intent(inout) :: jac_rand
real(default), intent(out) :: y
integer, intent(in), dimension(:), allocatable, optional :: contributors
logical, intent(in), optional :: threshold
logical :: thr, resonance
type(vector4_t) :: p_res, p_em
real(default) :: q0
type(lorentz_transformation_t) :: boost_to_resonance
integer :: i
real(default) :: beta, one_m_beta, one_p_beta
thr = .false.; if (present (threshold)) thr = threshold
p_res = vector4_null
if (present (contributors)) then
resonance = allocated (contributors)
else
resonance = .false.
end if
if (massive) then
if (resonance) then
do i = 1, size (contributors)
p_res = p_res + p(contributors(i))
end do
else if (thr) then
p_res = p(ass_boson(thr_leg(emitter))) + p(ass_quark(thr_leg(emitter)))
else
p_res = sum (p(1:n_in))
end if
q0 = p_res**1
boost_to_resonance = inverse (boost (p_res, q0))
p_em = boost_to_resonance * p(emitter)
beta = beta_emitter (q0, p_em)
one_m_beta = one - beta
one_p_beta = one + beta
y = one / beta * (one - one_p_beta * &
exp ( - r_y * log(one_p_beta / one_m_beta)))
jac_rand = jac_rand * &
(one - beta * y) * log(one_p_beta / one_m_beta) / beta
else
y = (one - two * r_y) * y_max
jac_rand = jac_rand * 3 * (one - y**2) * y_max
y = 1.5_default * (y - y**3 / 3)
end if
end subroutine compute_y_from_emitter
@ %def compute_y_from_emitter
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_y_real_phs => phs_fks_generator_compute_y_real_phs
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_y_real_phs &
(generator, r_y, p, phs_identifiers, &
jac_rand, y, threshold)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r_y
type(vector4_t), intent(in), dimension(:) :: p
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
real(default), intent(inout), dimension(:) :: jac_rand
real(default), intent(out), dimension(:) :: y
logical, intent(in), optional :: threshold
end subroutine phs_fks_generator_compute_y_real_phs
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_y_real_phs &
(generator, r_y, p, phs_identifiers, &
jac_rand, y, threshold)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r_y
type(vector4_t), intent(in), dimension(:) :: p
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
real(default), intent(inout), dimension(:) :: jac_rand
real(default), intent(out), dimension(:) :: y
logical, intent(in), optional :: threshold
real(default) :: beta, one_p_beta, one_m_beta
type(lorentz_transformation_t) :: boost_to_resonance
real(default) :: q0
type(vector4_t) :: p_res, p_em
integer :: i, i_phs, emitter
logical :: thr
logical :: construct_massive_fsr
construct_massive_fsr = .false.
thr = .false.; if (present (threshold)) thr = threshold
do i_phs = 1, size (phs_identifiers)
emitter = phs_identifiers(i_phs)%emitter
!!! We need this additional check because of decay phase spaces
!!! t -> bW has a massive emitter at position 1, which should
!!! not be treated here.
construct_massive_fsr = emitter > generator%n_in
if (construct_massive_fsr) construct_massive_fsr = &
construct_massive_fsr .and. generator%is_massive (emitter)
call compute_y_from_emitter (r_y, p, generator%n_in, &
emitter, construct_massive_fsr, &
generator%y_max, jac_rand(i_phs), y(i_phs), &
phs_identifiers(i_phs)%contributors, threshold)
end do
end subroutine phs_fks_generator_compute_y_real_phs
@ %def phs_fks_generator_compute_y_real_phs
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_y_mismatch => phs_fks_generator_compute_y_mismatch
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_y_mismatch &
(generator, r_y, jac_rand, y, y_soft)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r_y
real(default), intent(inout) :: jac_rand
real(default), intent(out) :: y
real(default), intent(out), dimension(:) :: y_soft
end subroutine phs_fks_generator_compute_y_mismatch
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_y_mismatch &
(generator, r_y, jac_rand, y, y_soft)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r_y
real(default), intent(inout) :: jac_rand
real(default), intent(out) :: y
real(default), intent(out), dimension(:) :: y_soft
y = (one - two * r_y) * generator%y_max
jac_rand = jac_rand * 3 * (one - y**2) * generator%y_max
y = 1.5_default * (y - y**3 / 3)
y_soft = y
end subroutine phs_fks_generator_compute_y_mismatch
@ %def phs_fks_generator_compute_y_mismatch
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_y_test => phs_fks_generator_compute_y_test
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_compute_y_test (generator, y)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(out), dimension(:):: y
end subroutine phs_fks_generator_compute_y_test
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_compute_y_test (generator, y)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(out), dimension(:):: y
select case (generator%mode)
case (GEN_SOFT_LIMIT_TEST)
y = y_test_soft
case (GEN_COLL_LIMIT_TEST)
y = y_test_coll
case (GEN_ANTI_COLL_LIMIT_TEST)
y = - y_test_coll
case (GEN_SOFT_COLL_LIMIT_TEST)
y = y_test_coll
case (GEN_SOFT_ANTI_COLL_LIMIT_TEST)
y = - y_test_coll
end select
end subroutine phs_fks_generator_compute_y_test
@ %def phs_fks_generator_compute_y_test
@
<<PHS fks: public>>=
public :: beta_emitter
<<PHS fks: sub interfaces>>=
pure module function beta_emitter (q0, p) result (beta)
real(default), intent(in) :: q0
type(vector4_t), intent(in) :: p
real(default) :: beta
end function beta_emitter
<<PHS fks: procedures>>=
pure module function beta_emitter (q0, p) result (beta)
real(default), intent(in) :: q0
type(vector4_t), intent(in) :: p
real(default) :: beta
real(default) :: m2, mrec2, k0_max
m2 = p**2
mrec2 = (q0 - p%p(0))**2 - p%p(1)**2 - p%p(2)**2 - p%p(3)**2
k0_max = (q0**2 - mrec2 + m2) / (two * q0)
beta = sqrt(one - m2 / k0_max**2)
end function beta_emitter
@ %def beta_emitter
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: compute_xi_tilde => phs_fks_generator_compute_xi_tilde
<<PHS fks: sub interfaces>>=
pure module subroutine phs_fks_generator_compute_xi_tilde (generator, r)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r
end subroutine phs_fks_generator_compute_xi_tilde
<<PHS fks: procedures>>=
pure module subroutine phs_fks_generator_compute_xi_tilde (generator, r)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: r
real(default) :: deno
associate (rad_var => generator%real_kinematics)
select case (generator%mode)
case (GEN_REAL_PHASE_SPACE)
if (generator%singular_jacobian) then
rad_var%xi_tilde = (one - generator%xi_min) - (one - r)**2 * &
(one - two * generator%xi_min)
rad_var%jac_rand = rad_var%jac_rand * two * (one - r) * &
(one - two * generator%xi_min)
else
rad_var%xi_tilde = generator%xi_min + r * (one - generator%xi_min)
rad_var%jac_rand = rad_var%jac_rand * (one - generator%xi_min)
end if
case (GEN_SOFT_MISMATCH)
deno = one - r
if (deno < tiny_13) deno = tiny_13
rad_var%xi_mismatch = generator%xi_min + r / deno
rad_var%jac_mismatch = rad_var%jac_mismatch / deno**2
case (GEN_SOFT_LIMIT_TEST)
rad_var%xi_tilde = r * two * xi_tilde_test_soft
rad_var%jac_rand = two * xi_tilde_test_soft
case (GEN_COLL_LIMIT_TEST)
rad_var%xi_tilde = xi_tilde_test_coll
rad_var%jac_rand = xi_tilde_test_coll
case (GEN_ANTI_COLL_LIMIT_TEST)
rad_var%xi_tilde = xi_tilde_test_coll
rad_var%jac_rand = xi_tilde_test_coll
case (GEN_SOFT_COLL_LIMIT_TEST)
rad_var%xi_tilde = r * two * xi_tilde_test_soft
rad_var%jac_rand = two * xi_tilde_test_soft
case (GEN_SOFT_ANTI_COLL_LIMIT_TEST)
rad_var%xi_tilde = r * two * xi_tilde_test_soft
rad_var%jac_rand = two * xi_tilde_test_soft
end select
end associate
end subroutine phs_fks_generator_compute_xi_tilde
@ %def phs_fks_generator_compute_xi_tilde
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: prepare_generation => phs_fks_generator_prepare_generation
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_prepare_generation (generator, &
r_in, i_phs, emitter, p_born, phs_identifiers, contributors, i_con)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), dimension(3), intent(in) :: r_in
integer, intent(in) :: i_phs, emitter
type(vector4_t), intent(in), dimension(:) :: p_born
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
type(resonance_contributors_t), intent(in), dimension(:), optional :: &
contributors
integer, intent(in), optional :: i_con
end subroutine phs_fks_generator_prepare_generation
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_prepare_generation (generator, &
r_in, i_phs, emitter, p_born, phs_identifiers, contributors, i_con)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), dimension(3), intent(in) :: r_in
integer, intent(in) :: i_phs, emitter
type(vector4_t), intent(in), dimension(:) :: p_born
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
type(resonance_contributors_t), intent(in), dimension(:), optional :: &
contributors
integer, intent(in), optional :: i_con
call generator%generate_radiation_variables (r_in, p_born, phs_identifiers)
call generator%compute_xi_ref_momenta &
(generator%real_kinematics%p_born_lab%phs_point(1)%get (), &
contributors)
call generator%compute_xi_max (emitter, i_phs, p_born, &
generator%real_kinematics%xi_max(i_phs), i_con = i_con)
end subroutine phs_fks_generator_prepare_generation
@ %def phs_fks_generator_prepare_generation
@ Get [[xi]] and [[y]] from an external routine (e.g. [[powheg]]) and
generate an FSR phase space. Note that the flag [[supply_xi_max]] is
set to [[.false.]] because it is assumed that the upper bound on [[xi]]
has already been taken into account during its generation.
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_fsr_from_xi_and_y => &
phs_fks_generator_generate_fsr_from_xi_and_y
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_fsr_from_xi_and_y &
(generator, xi, y, &
phi, emitter, i_phs, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: xi, y, phi
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(out), dimension(:) :: p_real
end subroutine phs_fks_generator_generate_fsr_from_xi_and_y
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_fsr_from_xi_and_y &
(generator, xi, y, &
phi, emitter, i_phs, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: xi, y, phi
integer, intent(in) :: emitter, i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(out), dimension(:) :: p_real
associate (rad_var => generator%real_kinematics)
rad_var%supply_xi_max = .false.
rad_var%xi_tilde = xi
rad_var%y(i_phs) = y
rad_var%phi = phi
end associate
call generator%set_sqrts_hat (p_born(1)%p(0) + p_born(2)%p(0))
call generator%generate_fsr (emitter, i_phs, p_born, p_real)
end subroutine phs_fks_generator_generate_fsr_from_xi_and_y
@ %def phs_fks_generator_generate_fsr_from_xi_and_y
@ Get [[xi]] and [[y]] from an external routine (e.g. [[powheg]]) and
generate the ISR phase space.
For this, we need to overwrite all variables of the real kinematics
dependent on $(\xi,y,\phi)$ that we need to compute [[p_real]].
From the [[isr_kinematics]] we just need [[sqme_born]] and [[x]].
Both do not depend on the real radiation so we can leave them as they are.
<<PHS fks: phs fks generator: TBP>>=
procedure :: generate_isr_from_xi_and_y => &
phs_fks_generator_generate_isr_from_xi_and_y
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_generate_isr_from_xi_and_y &
(generator, xi, xi_max, y, phi, i_phs, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: xi, xi_max, y, phi
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(out), dimension(:) :: p_real
end subroutine phs_fks_generator_generate_isr_from_xi_and_y
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_generate_isr_from_xi_and_y &
(generator, xi, xi_max, y, phi, i_phs, p_born, p_real)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: xi, xi_max, y, phi
integer, intent(in) :: i_phs
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(out), dimension(:) :: p_real
associate (rad_var => generator%real_kinematics)
rad_var%xi_max(i_phs) = xi_max
rad_var%xi_tilde = xi / xi_max
rad_var%y(i_phs) = y
rad_var%phi = phi
end associate
call generator%generate_isr (i_phs, p_born, p_real)
end subroutine phs_fks_generator_generate_isr_from_xi_and_y
@ %def phs_fks_generator_generate_isr_from_xi_and_y
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: get_radiation_variables => &
phs_fks_generator_get_radiation_variables
<<PHS fks: sub interfaces>>=
pure module subroutine phs_fks_generator_get_radiation_variables &
(generator, i_phs, xi, y, phi)
class(phs_fks_generator_t), intent(in) :: generator
integer, intent(in) :: i_phs
real(default), intent(out) :: xi, y
real(default), intent(out), optional :: phi
end subroutine phs_fks_generator_get_radiation_variables
<<PHS fks: procedures>>=
pure module subroutine phs_fks_generator_get_radiation_variables &
(generator, i_phs, xi, y, phi)
class(phs_fks_generator_t), intent(in) :: generator
integer, intent(in) :: i_phs
real(default), intent(out) :: xi, y
real(default), intent(out), optional :: phi
associate (rad_var => generator%real_kinematics)
xi = rad_var%xi_max(i_phs) * rad_var%xi_tilde
y = rad_var%y(i_phs)
if (present (phi)) phi = rad_var%phi
end associate
end subroutine phs_fks_generator_get_radiation_variables
@ %def phs_fks_generator_get_radiation_variables
@
<<PHS fks: phs fks generator: TBP>>=
procedure :: write => phs_fks_generator_write
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_generator_write (generator, unit)
class(phs_fks_generator_t), intent(in) :: generator
integer, intent(in), optional :: unit
end subroutine phs_fks_generator_write
<<PHS fks: procedures>>=
module subroutine phs_fks_generator_write (generator, unit)
class(phs_fks_generator_t), intent(in) :: generator
integer, intent(in), optional :: unit
integer :: u
type(string_t) :: massive_phsp
u = given_output_unit (unit); if (u < 0) return
if (generator%massive_phsp) then
massive_phsp = " massive "
else
massive_phsp = " massless "
end if
write (u, "(A)") char ("This is a generator for a" &
// massive_phsp // "phase space")
if (associated (generator%real_kinematics)) then
call generator%real_kinematics%write ()
else
write (u, "(A)") "Warning: There are no real " // &
"kinematics associated with this generator"
end if
call write_separator (u)
write (u, "(A," // FMT_17 // ",1X)") "sqrts : ", generator%sqrts
write (u, "(A," // FMT_17 // ",1X)") "E_gluon : ", generator%E_gluon
write (u, "(A," // FMT_17 // ",1X)") "mrec2 : ", generator%mrec2
end subroutine phs_fks_generator_write
@ %def phs_fks_generator_write
@
<<PHS fks: phs fks: TBP>>=
procedure :: compute_isr_kinematics => phs_fks_compute_isr_kinematics
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_compute_isr_kinematics (phs, r)
class(phs_fks_t), intent(inout) :: phs
real(default), intent(in) :: r
end subroutine phs_fks_compute_isr_kinematics
<<PHS fks: procedures>>=
module subroutine phs_fks_compute_isr_kinematics (phs, r)
class(phs_fks_t), intent(inout) :: phs
real(default), intent(in) :: r
if (.not. phs%config%lab_is_cm) then
call phs%generator%compute_isr_kinematics &
(r, phs%lt_cm_to_lab * phs%phs_wood_t%p)
else
call phs%generator%compute_isr_kinematics (r, phs%phs_wood_t%p)
end if
end subroutine phs_fks_compute_isr_kinematics
@ %def phs_fks_compute_isr_kinematics
@
<<PHS fks: phs fks: TBP>>=
procedure :: final => phs_fks_final
<<PHS fks: sub interfaces>>=
module subroutine phs_fks_final (object)
class(phs_fks_t), intent(inout) :: object
end subroutine phs_fks_final
<<PHS fks: procedures>>=
module subroutine phs_fks_final (object)
class(phs_fks_t), intent(inout) :: object
call object%forest%final ()
call object%generator%final ()
end subroutine phs_fks_final
@ %def phs_fks_final
@
<<PHS fks: procedures>>=
subroutine filter_particles_from_resonances &
(res_hist, exclusion_list, &
model, res_hist_filtered)
type(resonance_history_t), intent(in), dimension(:) :: res_hist
type(string_t), intent(in), dimension(:) :: exclusion_list
type(model_t), intent(in) :: model
type(resonance_history_t), intent(out), dimension(:), allocatable :: &
res_hist_filtered
integer :: i_hist, i_flv, i_new, n_orig
logical, dimension(size (res_hist)) :: to_filter
type(flavor_t) :: flv
to_filter = .false.
n_orig = size (res_hist)
do i_flv = 1, size (exclusion_list)
call flv%init (exclusion_list (i_flv), model)
do i_hist = 1, size (res_hist)
if (res_hist(i_hist)%has_flavor (flv)) to_filter (i_hist) = .true.
end do
end do
allocate (res_hist_filtered (n_orig - count (to_filter)))
i_new = 1
do i_hist = 1, size (res_hist)
if (.not. to_filter (i_hist)) then
res_hist_filtered (i_new) = res_hist (i_hist)
i_new = i_new + 1
end if
end do
end subroutine filter_particles_from_resonances
@ %def filter_particles_from_resonances
@
<<PHS fks: procedures>>=
subroutine clean_resonance_histories &
(res_hist, n_in, flv, res_hist_clean, success)
type(resonance_history_t), intent(in), dimension(:) :: res_hist
integer, intent(in) :: n_in
integer, intent(in), dimension(:) :: flv
type(resonance_history_t), intent(out), dimension(:), allocatable :: &
res_hist_clean
logical, intent(out) :: success
integer :: i_hist
type(resonance_history_t), dimension(:), allocatable :: &
res_hist_colored, res_hist_contracted
if (debug_on) call msg_debug (D_SUBTRACTION, "resonance_mapping_init")
if (debug_active (D_SUBTRACTION)) then
call msg_debug (D_SUBTRACTION, "Original resonances:")
do i_hist = 1, size(res_hist)
call res_hist(i_hist)%write ()
end do
end if
call remove_uncolored_resonances ()
call contract_resonances (res_hist_colored, res_hist_contracted)
call remove_subresonances (res_hist_contracted, res_hist_clean)
!!! Here, we are still not sure whether we actually would rather use
!!! call remove_multiple_resonances (res_hist_contracted, res_hist_clean)
if (debug_active (D_SUBTRACTION)) then
call msg_debug (D_SUBTRACTION, "Resonances after removing uncolored and duplicates: ")
do i_hist = 1, size (res_hist_clean)
call res_hist_clean(i_hist)%write ()
end do
end if
if (size (res_hist_clean) == 0) then
call msg_warning ("No resonances found. Proceed in usual FKS mode.")
success = .false.
else
success = .true.
end if
contains
subroutine remove_uncolored_resonances ()
type(resonance_history_t), dimension(:), allocatable :: res_hist_tmp
integer :: n_hist, nleg_out, n_removed
integer :: i_res, i_hist
n_hist = size (res_hist)
nleg_out = size (flv) - n_in
allocate (res_hist_tmp (n_hist))
allocate (res_hist_colored (n_hist))
do i_hist = 1, n_hist
res_hist_tmp(i_hist) = res_hist(i_hist)
call res_hist_tmp(i_hist)%add_offset (n_in)
n_removed = 0
do i_res = 1, res_hist_tmp(i_hist)%n_resonances
associate (resonance => res_hist_tmp(i_hist)%resonances(i_res - n_removed))
if (.not. any (is_colored (flv (resonance%contributors%c))) &
.or. size (resonance%contributors%c) == nleg_out) then
call res_hist_tmp(i_hist)%remove_resonance (i_res - n_removed)
n_removed = n_removed + 1
end if
end associate
end do
if (allocated (res_hist_tmp(i_hist)%resonances)) then
if (any (res_hist_colored == res_hist_tmp(i_hist))) then
cycle
else
do i_res = 1, res_hist_tmp(i_hist)%n_resonances
associate (resonance => res_hist_tmp(i_hist)%resonances(i_res))
call res_hist_colored(i_hist)%add_resonance (resonance)
end associate
end do
end if
end if
end do
end subroutine remove_uncolored_resonances
subroutine contract_resonances (res_history_in, res_history_out)
type(resonance_history_t), intent(in), dimension(:) :: res_history_in
type(resonance_history_t), intent(out), dimension(:), allocatable :: res_history_out
logical, dimension(:), allocatable :: i_non_zero
integer :: n_hist_non_zero, n_hist
integer :: i_hist_new
n_hist = size (res_history_in); n_hist_non_zero = 0
allocate (i_non_zero (n_hist))
i_non_zero = .false.
do i_hist = 1, n_hist
if (res_history_in(i_hist)%n_resonances /= 0) then
n_hist_non_zero = n_hist_non_zero + 1
i_non_zero(i_hist) = .true.
end if
end do
allocate (res_history_out (n_hist_non_zero))
i_hist_new = 1
do i_hist = 1, n_hist
if (i_non_zero (i_hist)) then
res_history_out (i_hist_new) = res_history_in (i_hist)
i_hist_new = i_hist_new + 1
end if
end do
end subroutine contract_resonances
subroutine remove_subresonances (res_history_in, res_history_out)
type(resonance_history_t), intent(in), dimension(:) :: res_history_in
type(resonance_history_t), intent(out), dimension(:), allocatable :: res_history_out
logical, dimension(:), allocatable :: i_non_sub_res
integer :: n_hist, n_hist_non_sub_res
integer :: i_hist1, i_hist2
logical :: is_not_subres
n_hist = size (res_history_in); n_hist_non_sub_res = 0
allocate (i_non_sub_res (n_hist)); i_non_sub_res = .false.
do i_hist1 = 1, n_hist
is_not_subres = .true.
do i_hist2 = 1, n_hist
if (i_hist1 == i_hist2) cycle
is_not_subres = is_not_subres .and. &
.not.(res_history_in(i_hist2) .contains. res_history_in(i_hist1))
end do
if (is_not_subres) then
n_hist_non_sub_res = n_hist_non_sub_res + 1
i_non_sub_res (i_hist1) = .true.
end if
end do
allocate (res_history_out (n_hist_non_sub_res))
i_hist2 = 1
do i_hist1 = 1, n_hist
if (i_non_sub_res (i_hist1)) then
res_history_out (i_hist2) = res_history_in (i_hist1)
i_hist2 = i_hist2 + 1
end if
end do
end subroutine remove_subresonances
subroutine remove_multiple_resonances (res_history_in, res_history_out)
type(resonance_history_t), intent(in), dimension(:) :: res_history_in
type(resonance_history_t), intent(out), dimension(:), allocatable :: res_history_out
integer :: n_hist, n_hist_single
logical, dimension(:), allocatable :: i_hist_single
integer :: i_hist, j
n_hist = size (res_history_in)
n_hist_single = 0
allocate (i_hist_single (n_hist)); i_hist_single = .false.
do i_hist = 1, n_hist
if (res_history_in(i_hist)%n_resonances == 1) then
n_hist_single = n_hist_single + 1
i_hist_single(i_hist) = .true.
end if
end do
allocate (res_history_out (n_hist_single))
j = 1
do i_hist = 1, n_hist
if (i_hist_single(i_hist)) then
res_history_out(j) = res_history_in(i_hist)
j = j + 1
end if
end do
end subroutine remove_multiple_resonances
end subroutine clean_resonance_histories
@ %def clean_resonance_histories
@
<<PHS fks: public>>=
public :: get_filtered_resonance_histories
<<PHS fks: sub interfaces>>=
module subroutine get_filtered_resonance_histories &
(phs_config, n_in, flv_state, model, excluded_resonances, &
resonance_histories_filtered, success)
type(phs_fks_config_t), intent(inout) :: phs_config
integer, intent(in) :: n_in
integer, intent(in), dimension(:,:), allocatable :: flv_state
type(model_t), intent(in) :: model
type(string_t), intent(in), dimension(:), allocatable :: &
excluded_resonances
type(resonance_history_t), intent(out), dimension(:), &
allocatable :: resonance_histories_filtered
logical, intent(out) :: success
end subroutine get_filtered_resonance_histories
<<PHS fks: procedures>>=
module subroutine get_filtered_resonance_histories &
(phs_config, n_in, flv_state, model, excluded_resonances, &
resonance_histories_filtered, success)
type(phs_fks_config_t), intent(inout) :: phs_config
integer, intent(in) :: n_in
integer, intent(in), dimension(:,:), allocatable :: flv_state
type(model_t), intent(in) :: model
type(string_t), intent(in), dimension(:), allocatable :: &
excluded_resonances
type(resonance_history_t), intent(out), dimension(:), &
allocatable :: resonance_histories_filtered
logical, intent(out) :: success
type(resonance_history_t), dimension(:), allocatable :: resonance_histories
type(resonance_history_t), dimension(:), allocatable :: &
resonance_histories_clean!, resonance_histories_filtered
allocate (resonance_histories (size (phs_config%get_resonance_histories ())))
resonance_histories = phs_config%get_resonance_histories ()
call clean_resonance_histories (resonance_histories, &
n_in, flv_state (:,1), resonance_histories_clean, success)
if (success .and. allocated (excluded_resonances)) then
call filter_particles_from_resonances (resonance_histories_clean, &
excluded_resonances, model, resonance_histories_filtered)
else
allocate (resonance_histories_filtered (size (resonance_histories_clean)))
resonance_histories_filtered = resonance_histories_clean
end if
end subroutine get_filtered_resonance_histories
@ %def get_filtered_resonance_histories
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Unit tests}
Test module for FKS phase space, followed by the corresponding implementation module.
<<[[phs_fks_ut.f90]]>>=
<<File header>>
module phs_fks_ut
use unit_tests
use phs_fks_uti
<<Standard module head>>
<<PHS fks: public test>>
contains
<<PHS fks: test driver>>
end module phs_fks_ut
@ %def phs_fks_ut
@
<<[[phs_fks_uti.f90]]>>=
<<File header>>
module phs_fks_uti
<<Use kinds>>
use format_utils, only: write_separator, pac_fmt
use format_defs, only: FMT_15, FMT_19
use numeric_utils, only: nearly_equal
use constants, only: tiny_07, zero, one, two
use lorentz
use phs_points, only: assignment(=)
use physics_defs, only: THR_POS_B, THR_POS_BBAR, THR_POS_WP, THR_POS_WM, THR_POS_GLUON
use physics_defs, only: thr_leg
use resonances, only: resonance_contributors_t
use phs_fks
<<Standard module head>>
<<PHS fks: test declarations>>
contains
<<PHS fks: tests>>
end module phs_fks_uti
@ %def phs_fks_uti
@ API: driver for the unit tests below.
<<PHS fks: public test>>=
public :: phs_fks_generator_test
<<PHS fks: test driver>>=
subroutine phs_fks_generator_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
call test(phs_fks_generator_1, "phs_fks_generator_1", &
"Test the generation of FKS phase spaces", u, results)
call test(phs_fks_generator_2, "phs_fks_generator_2", &
"Test the generation of an ISR FKS phase space", u, results)
call test(phs_fks_generator_3, "phs_fks_generator_3", &
"Test the generation of a real phase space for decays", &
u, results)
call test(phs_fks_generator_4, "phs_fks_generator_4", &
"Test the generation of an FSR phase space with "&
&"conserved invariant resonance masses", u, results)
call test(phs_fks_generator_5, "phs_fks_generator_5", &
"Test on-shell projection of a Born phase space and the generation"&
&" of a real phase-space from that", u, results)
call test(phs_fks_generator_6, "phs_fks_generator_6", &
"Test the generation of a real phase space for 1 -> 3 decays", &
u, results)
call test(phs_fks_generator_7, "phs_fks_generator_7", &
"Test the generation of an ISR FKS phase space for fixed beam energy", &
u, results)
end subroutine phs_fks_generator_test
@ %def phs_fks_generator_test
@
<<PHS fks: test declarations>>=
public :: phs_fks_generator_1
<<PHS fks: tests>>=
subroutine phs_fks_generator_1 (u)
integer, intent(in) :: u
type(phs_fks_generator_t) :: generator
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: p_real
integer :: emitter, i_phs
real(default) :: x1, x2, x3
real(default), parameter :: sqrts = 250.0_default
type(phs_identifier_t), dimension(2) :: phs_identifiers
write (u, "(A)") "* Test output: phs_fks_generator_1"
write (u, "(A)") "* Purpose: Create massless fsr phase space"
write (u, "(A)")
allocate (p_born (4))
p_born(1)%p(0) = 125.0_default
p_born(1)%p(1:2) = 0.0_default
p_born(1)%p(3) = 125.0_default
p_born(2)%p(0) = 125.0_default
p_born(2)%p(1:2) = 0.0_default
p_born(2)%p(3) = -125.0_default
p_born(3)%p(0) = 125.0_default
p_born(3)%p(1) = -39.5618_default
p_born(3)%p(2) = -20.0791_default
p_born(3)%p(3) = -114.6957_default
p_born(4)%p(0) = 125.0_default
p_born(4)%p(1:3) = -p_born(3)%p(1:3)
allocate (generator%isr_kinematics)
generator%n_in = 2
generator%isr_kinematics%isr_mode = SQRTS_FIXED
call generator%set_xi_and_y_bounds ()
call generator%set_sqrts_hat (sqrts)
write (u, "(A)") "* Use four-particle phase space containing: "
call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
write (u, "(A)") "***********************"
write (u, "(A)")
x1 = 0.5_default; x2 = 0.25_default; x3 = 0.75_default
write (u, "(A)" ) "* Use random numbers: "
write (u, "(A,F3.2,1X,A,F3.2,1X,A,F3.2)") &
"x1: ", x1, "x2: ", x2, "x3: ", x3
allocate (generator%real_kinematics)
call generator%real_kinematics%init (4, 2, 2, 1)
allocate (generator%emitters (2))
generator%emitters(1) = 3; generator%emitters(2) = 4
allocate (generator%m2 (4))
generator%m2 = zero
allocate (generator%is_massive (4))
generator%is_massive(1:2) = .false.
generator%is_massive(3:4) = .true.
phs_identifiers(1)%emitter = 3
phs_identifiers(2)%emitter = 4
call generator%compute_xi_ref_momenta (p_born)
call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
do i_phs = 1, 2
emitter = phs_identifiers(i_phs)%emitter
call generator%compute_xi_max (emitter, i_phs, p_born, &
generator%real_kinematics%xi_max(i_phs))
end do
write (u, "(A)") &
"* With these, the following radiation variables have been produced:"
associate (rad_var => generator%real_kinematics)
write (u, "(A,F3.2)") "xi_tilde: ", rad_var%xi_tilde
write (u, "(A,F3.2)") "y: " , rad_var%y(1)
write (u, "(A,F3.2)") "phi: ", rad_var%phi
end associate
call write_separator (u)
write (u, "(A)") "Produce real momenta: "
i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
allocate (p_real (5))
call generator%generate_fsr (emitter, i_phs, p_born, p_real)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_fks_generator_1"
end subroutine phs_fks_generator_1
@ %def phs_fks_generator_1
@
<<PHS fks: test declarations>>=
public :: phs_fks_generator_2
<<PHS fks: tests>>=
subroutine phs_fks_generator_2 (u)
integer, intent(in) :: u
type(phs_fks_generator_t) :: generator
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: p_real
integer :: emitter, i_phs
real(default) :: x1, x2, x3
real(default), parameter :: sqrts_hadronic = 250.0_default
type(phs_identifier_t), dimension(2) :: phs_identifiers
write (u, "(A)") "* Test output: phs_fks_generator_2"
write (u, "(A)") "* Purpose: Create massless ISR phase space"
write (u, "(A)")
allocate (p_born (4))
p_born(1)%p(0) = 114.661_default
p_born(1)%p(1:2) = 0.0_default
p_born(1)%p(3) = 114.661_default
p_born(2)%p(0) = 121.784_default
p_born(2)%p(1:2) = 0.0_default
p_born(2)%p(3) = -121.784_default
p_born(3)%p(0) = 115.148_default
p_born(3)%p(1) = -46.250_default
p_born(3)%p(2) = -37.711_default
p_born(3)%p(3) = 98.478_default
p_born(4)%p(0) = 121.296_default
p_born(4)%p(1:2) = -p_born(3)%p(1:2)
p_born(4)%p(3) = -105.601_default
phs_identifiers(1)%emitter = 1
phs_identifiers(2)%emitter = 2
allocate (generator%emitters (2))
allocate (generator%isr_kinematics)
generator%emitters(1) = 1; generator%emitters(2) = 2
generator%sqrts = sqrts_hadronic
allocate (generator%isr_kinematics%beam_energy(2))
generator%isr_kinematics%beam_energy = sqrts_hadronic / two
call generator%set_sqrts_hat (sqrts_hadronic)
call generator%set_isr_kinematics (p_born)
generator%n_in = 2
generator%isr_kinematics%isr_mode = SQRTS_VAR
call generator%set_xi_and_y_bounds ()
write (u, "(A)") "* Use four-particle phase space containing: "
call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
write (u, "(A)") "***********************"
write (u, "(A)")
x1=0.5_default; x2=0.25_default; x3=0.65_default
write (u, "(A)" ) "* Use random numbers: "
write (u, "(A,F3.2,1X,A,F3.2,1X,A,F3.2)") &
"x1: ", x1, "x2: ", x2, "x3: ", x3
allocate (generator%real_kinematics)
call generator%real_kinematics%init (4, 2, 2, 1)
call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
allocate (generator%m2 (2))
generator%m2(1) = 0._default; generator%m2(2) = 0._default
allocate (generator%is_massive (4))
generator%is_massive = .false.
call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
call generator%compute_xi_ref_momenta (p_born)
do i_phs = 1, 2
emitter = phs_identifiers(i_phs)%emitter
call generator%compute_xi_max (emitter, i_phs, p_born, &
generator%real_kinematics%xi_max(i_phs))
end do
write (u, "(A)") &
"* With these, the following radiation variables have been produced:"
associate (rad_var => generator%real_kinematics)
write (u, "(A,F3.2)") "xi_tilde: ", rad_var%xi_tilde
write (u, "(A,F3.2)") "y: " , rad_var%y(1)
write (u, "(A,F3.2)") "phi: ", rad_var%phi
end associate
write (u, "(A)") "Initial-state momentum fractions: "
associate (xb => generator%isr_kinematics%x)
write (u, "(A,F3.2)") "x_born_plus: ", xb(1)
write (u, "(A,F3.2)") "x_born_minus: ", xb(2)
end associate
call write_separator (u)
write (u, "(A)") "Produce real momenta: "
i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
allocate (p_real(5))
call generator%generate_isr (i_phs, p_born, p_real)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_fks_generator_2"
end subroutine phs_fks_generator_2
@ %def phs_fks_generator_2
@
<<PHS fks: test declarations>>=
public :: phs_fks_generator_3
<<PHS fks: tests>>=
subroutine phs_fks_generator_3 (u)
integer, intent(in) :: u
type(phs_fks_generator_t) :: generator
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: p_real
real(default) :: x1, x2, x3
real(default) :: mB, mW, mT
integer :: i, emitter, i_phs
type(phs_identifier_t), dimension(2) :: phs_identifiers
write (u, "(A)") "* Test output: phs_fks_generator_3"
write (u, "(A)") "* Puropse: Create real phase space for particle decays"
write (u, "(A)")
allocate (p_born(3))
p_born(1)%p(0) = 172._default
p_born(1)%p(1) = 0._default
p_born(1)%p(2) = 0._default
p_born(1)%p(3) = 0._default
p_born(2)%p(0) = 104.72866679_default
p_born(2)%p(1) = 45.028053213_default
p_born(2)%p(2) = 29.450337581_default
p_born(2)%p(3) = -5.910229156_default
p_born(3)%p(0) = 67.271333209_default
p_born(3)%p(1:3) = -p_born(2)%p(1:3)
generator%n_in = 1
allocate (generator%isr_kinematics)
generator%isr_kinematics%isr_mode = SQRTS_FIXED
call generator%set_xi_and_y_bounds ()
mB = 4.2_default
mW = 80.376_default
mT = 172._default
generator%sqrts = mT
write (u, "(A)") "* Use three-particle phase space containing: "
call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
write (u, "(A)") "**********************"
write (u, "(A)")
x1 = 0.5_default; x2 = 0.25_default; x3 = 0.6_default
write (u, "(A)") "* Use random numbers: "
write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
"x1: ", x1, "x2: ", x2, "x3: ", x3
allocate (generator%real_kinematics)
call generator%real_kinematics%init (3, 2, 2, 1)
call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
allocate (generator%emitters(2))
generator%emitters(1) = 1
generator%emitters(2) = 3
allocate (generator%m2 (3), generator%is_massive(3))
generator%m2(1) = mT**2
generator%m2(2) = mW**2
generator%m2(3) = mB**2
generator%is_massive = .true.
phs_identifiers(1)%emitter = 1
phs_identifiers(2)%emitter = 3
call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
call generator%compute_xi_ref_momenta (p_born)
do i_phs = 1, 2
emitter = phs_identifiers(i_phs)%emitter
call generator%compute_xi_max (emitter, i_phs, p_born, &
generator%real_kinematics%xi_max(i_phs))
end do
write (u, "(A)") &
"* With these, the following radiation variables have been produced: "
associate (rad_var => generator%real_kinematics)
write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
do i = 1, 2
write (u, "(A,I1,A,F5.2)") "i: ", i, "y: " , rad_var%y(i)
end do
write (u, "(A,F4.2)") "phi: ", rad_var%phi
end associate
call write_separator (u)
write (u, "(A)") "Produce real momenta via initial-state emission: "
i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
allocate (p_real (4))
call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
call pacify (p_real, 1E-6_default)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
call write_separator(u)
write (u, "(A)") "Produce real momenta via final-state emisson: "
i_phs = 2; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
call generator%generate_fsr (emitter, i_phs, p_born, p_real)
call pacify (p_real, 1E-6_default)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_fks_generator_3"
end subroutine phs_fks_generator_3
@ %def phs_fks_generator_3
@
<<PHS fks: test declarations>>=
public :: phs_fks_generator_4
<<PHS fks: tests>>=
subroutine phs_fks_generator_4 (u)
integer, intent(in) :: u
type(phs_fks_generator_t) :: generator
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: p_real
integer, dimension(:), allocatable :: emitters
integer, dimension(:,:), allocatable :: resonance_lists
type(resonance_contributors_t), dimension(2) :: alr_contributors
real(default) :: x1, x2, x3
real(default), parameter :: sqrts = 250.0_default
integer, parameter :: nlegborn = 6
integer :: i_phs, i_con, emitter
real(default) :: m_inv_born, m_inv_real
character(len=7) :: fmt
type(phs_identifier_t), dimension(2) :: phs_identifiers
call pac_fmt (fmt, FMT_19, FMT_15, .true.)
write (u, "(A)") "* Test output: phs_fks_generator_4"
write (u, "(A)") "* Purpose: Create FSR phase space with fixed resonances"
write (u, "(A)")
allocate (p_born (nlegborn))
p_born(1)%p(0) = 250._default
p_born(1)%p(1) = 0._default
p_born(1)%p(2) = 0._default
p_born(1)%p(3) = 250._default
p_born(2)%p(0) = 250._default
p_born(2)%p(1) = 0._default
p_born(2)%p(2) = 0._default
p_born(2)%p(3) = -250._default
p_born(3)%p(0) = 145.91184486_default
p_born(3)%p(1) = 50.39727589_default
p_born(3)%p(2) = 86.74156041_default
p_born(3)%p(3) = -69.03608748_default
p_born(4)%p(0) = 208.1064784_default
p_born(4)%p(1) = -44.07610020_default
p_born(4)%p(2) = -186.34264578_default
p_born(4)%p(3) = 13.48038407_default
p_born(5)%p(0) = 26.25614471_default
p_born(5)%p(1) = -25.12258068_default
p_born(5)%p(2) = -1.09540228_default
p_born(5)%p(3) = -6.27703505_default
p_born(6)%p(0) = 119.72553196_default
p_born(6)%p(1) = 18.80140499_default
p_born(6)%p(2) = 100.69648766_default
p_born(6)%p(3) = 61.83273846_default
allocate (generator%isr_kinematics)
generator%n_in = 2
generator%isr_kinematics%isr_mode = SQRTS_FIXED
call generator%set_xi_and_y_bounds ()
call generator%set_sqrts_hat (sqrts)
write (u, "(A)") "* Test process: e+ e- -> W+ W- b b~"
write (u, "(A)") "* Resonance pairs: (3,5) and (4,6)"
write (u, "(A)") "* Use four-particle phase space containing: "
call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
write (u, "(A)") "******************************"
write (u, "(A)")
x1 = 0.5_default; x2 = 0.25_default; x3 = 0.75_default
write (u, "(A)") "* Use random numbers: "
write (u, "(A,F3.2,1X,A,F3.2,1X,A,F3.2)") &
"x1: ", x1, "x2: ", x2, "x3: ", x3
allocate (generator%real_kinematics)
call generator%real_kinematics%init (nlegborn, 2, 2, 2)
allocate (generator%emitters (2))
generator%emitters(1) = 5; generator%emitters(2) = 6
allocate (generator%m2 (nlegborn))
generator%m2 = p_born**2
allocate (generator%is_massive (nlegborn))
generator%is_massive (1:2) = .false.
generator%is_massive (3:6) = .true.
phs_identifiers(1)%emitter = 5
phs_identifiers(2)%emitter = 6
do i_phs = 1, 2
allocate (phs_identifiers(i_phs)%contributors (2))
end do
allocate (resonance_lists (2, 2))
resonance_lists (1,:) = [3,5]
resonance_lists (2,:) = [4,6]
!!! Here is obviously some redundance. Surely we can improve on this.
do i_phs = 1, 2
phs_identifiers(i_phs)%contributors = resonance_lists(i_phs,:)
end do
do i_con = 1, 2
allocate (alr_contributors(i_con)%c (size (resonance_lists(i_con,:))))
alr_contributors(i_con)%c = resonance_lists(i_con,:)
end do
call generator%generate_radiation_variables &
([x1, x2, x3], p_born, phs_identifiers)
allocate (p_real(nlegborn + 1))
call generator%compute_xi_ref_momenta (p_born, alr_contributors)
!!! Keep the distinction between i_phs and i_con because in general,
!!! they are not the same.
do i_phs = 1, 2
i_con = i_phs
emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1,1X,A,I1,A,I1,A)") &
"* Generate FSR phase space for emitter ", emitter, &
"and resonance pair (", resonance_lists (i_con, 1), ",", &
resonance_lists (i_con, 2), ")"
call generator%compute_xi_max (emitter, i_phs, p_born, &
generator%real_kinematics%xi_max(i_phs), i_con = i_con)
call generator%generate_fsr (emitter, i_phs, i_con, p_born, p_real)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
call write_separator(u)
write (u, "(A)") "* Check if resonance masses are conserved: "
m_inv_born = compute_resonance_mass (p_born, resonance_lists (i_con,:))
m_inv_real = compute_resonance_mass (p_real, resonance_lists (i_con,:), 7)
write (u, "(A,1X, " // fmt // ")") "m_inv_born = ", m_inv_born
write (u, "(A,1X, " // fmt // ")") "m_inv_real = ", m_inv_real
if (abs (m_inv_born - m_inv_real) < tiny_07) then
write (u, "(A)") " Success! "
else
write (u, "(A)") " Failure! "
end if
call write_separator(u)
call write_separator(u)
end do
deallocate (p_real)
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_fks_generator_4"
end subroutine phs_fks_generator_4
@ %def phs_fks_generator_4
@
<<PHS fks: test declarations>>=
public :: phs_fks_generator_5
<<PHS fks: tests>>=
subroutine phs_fks_generator_5 (u)
use ttv_formfactors, only: init_parameters
integer, intent(in) :: u
type(phs_fks_generator_t) :: generator
type(vector4_t), dimension(:), allocatable :: p_born, pb1
type(vector4_t), dimension(:), allocatable :: p_born_onshell, pb1_os
type(vector4_t), dimension(:), allocatable :: p_real
real(default) :: x1, x2, x3
real(default) :: mB, mW, mtop, mcheck
integer :: i, emitter, i_phs
type(phs_identifier_t), dimension(2) :: phs_identifiers
type(lorentz_transformation_t) :: L_to_cms
real(default), parameter :: sqrts = 360._default
real(default), parameter :: momentum_tolerance = 1E-10_default
real(default) :: mpole, gam_out
write (u, "(A)") "* Test output: phs_fks_generator_5"
write (u, "(A)") "* Puropse: Perform threshold on-shell projection of "
write (u, "(A)") "* Born momenta and create a real phase-space "
write (u, "(A)") "* point from those. "
write (u, "(A)")
allocate (p_born(6), p_born_onshell(6))
p_born(1)%p(0) = sqrts / two
p_born(1)%p(1:2) = zero
p_born(1)%p(3) = sqrts / two
p_born(2)%p(0) = sqrts / two
p_born(2)%p(1:2) = zero
p_born(2)%p(3) = -sqrts / two
p_born(3)%p(0) = 117.1179139230_default
p_born(3)%p(1) = 56.91215483880_default
p_born(3)%p(2) = -40.02386013017_default
p_born(3)%p(3) = -49.07634310496_default
p_born(4)%p(0) = 98.91904548743_default
p_born(4)%p(1) = 56.02241403836_default
p_born(4)%p(2) = -8.302977504723_default
p_born(4)%p(3) = -10.50293716131_default
p_born(5)%p(0) = 62.25884689208_default
p_born(5)%p(1) = -60.00786540278_default
p_born(5)%p(2) = 4.753602375910_default
p_born(5)%p(3) = 15.32916731546_default
p_born(6)%p(0) = 81.70419369751_default
p_born(6)%p(1) = -52.92670347439_default
p_born(6)%p(2) = 43.57323525898_default
p_born(6)%p(3) = 44.25011295081_default
generator%n_in = 2
allocate (generator%isr_kinematics)
generator%isr_kinematics%isr_mode = SQRTS_FIXED
call generator%set_xi_and_y_bounds ()
mB = 4.2_default
mW = 80.376_default
mtop = 172._default
generator%sqrts = sqrts
!!! Dummy-initialization of the threshold model because generate_fsr_threshold
!!! uses m1s_to_mpole to determine if it is above or below threshold.
call init_parameters (mpole, gam_out, mtop, one, one / 1.5_default, 125._default, &
0.47_default, 0.118_default, 91._default, 80._default, 4.2_default, &
one, one, one, one, zero, zero, zero, zero, zero, zero, .false., zero)
write (u, "(A)") "* Use four-particle phase space containing: "
call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
call vector4_check_momentum_conservation &
(p_born, 2, unit = u, abs_smallness = momentum_tolerance, verbose = .true.)
write (u, "(A)") "**********************"
write (u, "(A)")
allocate (generator%real_kinematics)
call generator%real_kinematics%init (7, 2, 2, 2)
call generator%real_kinematics%init_onshell (7, 2)
generator%real_kinematics%p_born_cms%phs_point(1) = p_born
write (u, "(A)") "Get boost projection system -> CMS: "
L_to_cms = get_boost_for_threshold_projection (p_born, sqrts, mtop)
call L_to_cms%write (u, testflag = .true., ultra = .true.)
write (u, "(A)") "**********************"
write (u, "(A)")
write (u, "(A)") "* Perform onshell-projection:"
pb1 = generator%real_kinematics%p_born_cms%phs_point(1)
call threshold_projection_born (mtop, L_to_cms, pb1, p_born_onshell)
generator%real_kinematics%p_born_onshell%phs_point(1) = p_born_onshell
call generator%real_kinematics%p_born_onshell%write &
(1, unit = u, testflag = .true., ultra = .true.)
pb1_os = generator%real_kinematics%p_born_onshell%phs_point(1)
call check_phsp (pb1_os, 0)
allocate (generator%emitters (2))
generator%emitters(1) = THR_POS_B; generator%emitters(2) = THR_POS_BBAR
allocate (generator%m2 (6), generator%is_massive(6))
generator%m2 = p_born**2
generator%is_massive (1:2) = .false.
generator%is_massive (3:6) = .true.
phs_identifiers(1)%emitter = THR_POS_B
phs_identifiers(2)%emitter = THR_POS_BBAR
x1 = 0.5_default; x2 = 0.25_default; x3 = 0.6_default
write (u, "(A)") "* Use random numbers: "
write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
"x1: ", x1, "x2: ", x2, "x3: ", x3
call generator%generate_radiation_variables ([x1,x2,x3], p_born_onshell, phs_identifiers)
do i_phs = 1, 2
emitter = phs_identifiers(i_phs)%emitter
call generator%compute_xi_ref_momenta_threshold (p_born_onshell)
call generator%compute_xi_max (emitter, i_phs, p_born_onshell, &
generator%real_kinematics%xi_max(i_phs), i_con = thr_leg(emitter))
end do
write (u, "(A)") &
"* With these, the following radiation variables have been produced: "
associate (rad_var => generator%real_kinematics)
write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
write (u, "(A)") "xi_max: "
write (u, "(2F5.2)") rad_var%xi_max(1), rad_var%xi_max(2)
write (u, "(A)") "y: "
write (u, "(2F5.2)") rad_var%y(1), rad_var%y(2)
write (u, "(A,F4.2)") "phi: ", rad_var%phi
end associate
call write_separator (u)
write (u, "(A)") "* Produce real momenta from on-shell phase space: "
allocate (p_real(7))
do i_phs = 1, 2
emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
call generator%generate_fsr_threshold (emitter, i_phs, p_born_onshell, p_real)
call check_phsp (p_real, emitter)
end do
call write_separator(u)
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_fks_generator_5"
contains
subroutine check_phsp (p, emitter)
type(vector4_t), intent(inout), dimension(:) :: p
integer, intent(in) :: emitter
type(vector4_t) :: pp
real(default) :: E_tot
logical :: check
write (u, "(A)") "* Check momentum conservation: "
call vector4_check_momentum_conservation &
(p, 2, unit = u, abs_smallness = momentum_tolerance, verbose = .true.)
write (u, "(A)") "* Check invariant masses: "
write (u, "(A)", advance = "no") "inv(W+, b, gl): "
pp = p(THR_POS_WP) + p(THR_POS_B)
if (emitter == THR_POS_B) pp = pp + p(THR_POS_GLUON)
if (nearly_equal (pp**1, mtop)) then
write (u, "(A)") "CHECK"
else
write (u, "(A,F7.3)") "FAIL: ", pp**1
end if
write (u, "(A)", advance = "no") "inv(W-, bbar): "
pp = p(THR_POS_WM) + p(THR_POS_BBAR)
if (emitter == THR_POS_BBAR) pp = pp + p(THR_POS_GLUON)
if (nearly_equal (pp**1, mtop)) then
write (u, "(A)") "CHECK"
else
write (u, "(A,F7.3)") "FAIL: ", pp**1
end if
write (u, "(A)") "* Sum of energies equal to sqrts?"
E_tot = sum(p(1:2)%p(0)); check = nearly_equal (E_tot, sqrts)
write (u, "(A,L1)") "Initial state: ", check
if (.not. check) write (u, "(A,F7.3)") "E_tot: ", E_tot
if (emitter > 0) then
E_tot = sum(p(3:7)%p(0))
else
E_tot = sum(p(3:6)%p(0))
end if
check = nearly_equal (E_tot, sqrts)
write (u, "(A,L1)") "Final state : ", check
if (.not. check) write (u, "(A,F7.3)") "E_tot: ", E_tot
call pacify (p, 1E-6_default)
call vector4_write_set (p, u, testflag = .true., ultra = .true.)
end subroutine check_phsp
end subroutine phs_fks_generator_5
@ %def phs_fks_generator_5
@
<<PHS fks: test declarations>>=
public :: phs_fks_generator_6
<<PHS fks: tests>>=
subroutine phs_fks_generator_6 (u)
integer, intent(in) :: u
type(phs_fks_generator_t) :: generator
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: p_real
real(default) :: x1, x2, x3
real(default) :: mB, mW, mT
integer :: i, emitter, i_phs
type(phs_identifier_t), dimension(2) :: phs_identifiers
write (u, "(A)") "* Test output: phs_fks_generator_6"
write (u, "(A)") "* Puropse: Create real phase space for particle decays"
write (u, "(A)")
allocate (p_born(4))
p_born(1)%p(0) = 173.1_default
p_born(1)%p(1) = zero
p_born(1)%p(2) = zero
p_born(1)%p(3) = zero
p_born(2)%p(0) = 68.17074462929_default
p_born(2)%p(1) = -37.32578717617_default
p_born(2)%p(2) = 30.99675959336_default
p_born(2)%p(3) = -47.70321718398_default
p_born(3)%p(0) = 65.26639312326_default
p_born(3)%p(1) = -1.362927648502_default
p_born(3)%p(2) = -33.25327150840_default
p_born(3)%p(3) = 56.14324922494_default
p_born(4)%p(0) = 39.66286224745_default
p_born(4)%p(1) = 38.68871482467_default
p_born(4)%p(2) = 2.256511915049_default
p_born(4)%p(3) = -8.440032040958_default
generator%n_in = 1
allocate (generator%isr_kinematics)
generator%isr_kinematics%isr_mode = SQRTS_FIXED
call generator%set_xi_and_y_bounds ()
mB = 4.2_default
mW = 80.376_default
mT = 173.1_default
generator%sqrts = mT
write (u, "(A)") "* Use four-particle phase space containing: "
call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
write (u, "(A)") "**********************"
write (u, "(A)")
x1=0.5_default; x2=0.25_default; x3=0.6_default
write (u, "(A)") "* Use random numbers: "
write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
"x1: ", x1, "x2: ", x2, "x3: ", x3
allocate (generator%real_kinematics)
call generator%real_kinematics%init (3, 2, 2, 1)
call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
allocate (generator%emitters(2))
generator%emitters(1) = 1
generator%emitters(2) = 2
allocate (generator%m2 (4), generator%is_massive(4))
generator%m2(1) = mT**2
generator%m2(2) = mB**2
generator%m2(3) = zero
generator%m2(4) = zero
generator%is_massive(1:2) = .true.
generator%is_massive(3:4) = .false.
phs_identifiers(1)%emitter = 1
phs_identifiers(2)%emitter = 2
call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
call generator%compute_xi_ref_momenta (p_born)
do i_phs = 1, 2
emitter = phs_identifiers(i_phs)%emitter
call generator%compute_xi_max (emitter, i_phs, p_born, &
generator%real_kinematics%xi_max(i_phs))
end do
write (u, "(A)") &
"* With these, the following radiation variables have been produced: "
associate (rad_var => generator%real_kinematics)
write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
do i = 1, 2
write (u, "(A,I1,A,F5.2)") "i: ", i, "y: " , rad_var%y(i)
end do
write (u, "(A,F4.2)") "phi: ", rad_var%phi
end associate
call write_separator (u)
write (u, "(A)") "Produce real momenta via initial-state emission: "
i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
allocate (p_real(5))
call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
call pacify (p_real, 1E-6_default)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
call write_separator(u)
write (u, "(A)") "Produce real momenta via final-state emisson: "
i_phs = 2; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
call generator%generate_fsr (emitter, i_phs, p_born, p_real)
call pacify (p_real, 1E-6_default)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_fks_generator_6"
end subroutine phs_fks_generator_6
@ %def phs_fks_generator_6
@
<<PHS fks: test declarations>>=
public :: phs_fks_generator_7
<<PHS fks: tests>>=
subroutine phs_fks_generator_7 (u)
integer, intent(in) :: u
type(phs_fks_generator_t) :: generator
type(vector4_t), dimension(:), allocatable :: p_born
type(vector4_t), dimension(:), allocatable :: p_real
real(default) :: x1, x2, x3
integer :: i, emitter, i_phs
type(phs_identifier_t), dimension(2) :: phs_identifiers
real(default), parameter :: sqrts = 1000.0_default
write (u, "(A)") "* Test output: phs_fks_generator_7"
write (u, "(A)") "* Puropse: Create real phase space for scattering ISR"
write (u, "(A)") "* keeping the beam energy fixed."
write (u, "(A)")
allocate (p_born(4))
p_born(1)%p(0) = 500._default
p_born(1)%p(1) = 0._default
p_born(1)%p(2) = 0._default
p_born(1)%p(3) = 500._default
p_born(2)%p(0) = 500._default
p_born(2)%p(1) = 0._default
p_born(2)%p(2) = 0._default
p_born(2)%p(3) = -500._default
p_born(3)%p(0) = 500._default
p_born(3)%p(1) = 11.275563070_default
p_born(3)%p(2) = -13.588797663_default
p_born(3)%p(3) = 486.93070588_default
p_born(4)%p(0) = 500._default
p_born(4)%p(1:3) = -p_born(3)%p(1:3)
phs_identifiers(1)%emitter = 1
phs_identifiers(2)%emitter = 2
allocate (generator%emitters(2))
generator%n_in = 2
allocate (generator%isr_kinematics)
generator%isr_kinematics%isr_mode = SQRTS_FIXED
call generator%set_xi_and_y_bounds ()
generator%emitters(1) = 1; generator%emitters(2) = 2
generator%sqrts = sqrts
write (u, "(A)") "* Use 2 -> 2 phase space containing: "
call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
write (u, "(A)") "**********************"
write (u, "(A)")
x1 = 0.5_default; x2 = 0.25_default; x3 = 0.6_default
write (u, "(A)") "* Use random numbers: "
write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
"x1: ", x1, "x2: ", x2, "x3: ", x3
allocate (generator%real_kinematics)
call generator%real_kinematics%init (4, 2, 2, 1)
call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
allocate (generator%m2 (4))
generator%m2 = 0._default
allocate (generator%is_massive(4))
generator%is_massive = .false.
call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
call generator%compute_xi_ref_momenta (p_born)
do i_phs = 1, 2
emitter = phs_identifiers(i_phs)%emitter
call generator%compute_xi_max (emitter, i_phs, p_born, &
generator%real_kinematics%xi_max(i_phs))
end do
write (u, "(A)") &
"* With these, the following radiation variables have been produced: "
associate (rad_var => generator%real_kinematics)
write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
do i = 1, 2
write (u, "(A,I1,A,F5.2)") "i: ", i, "y: " , rad_var%y(i)
end do
write (u, "(A,F4.2)") "phi: ", rad_var%phi
end associate
call write_separator (u)
write (u, "(A)") "Produce real momenta via initial-state emission: "
i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
allocate (p_real(5))
call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
call pacify (p_real, 1E-6_default)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
call write_separator(u)
i_phs = 2; emitter = phs_identifiers(i_phs)%emitter
write (u, "(A,I1)") "emitter: ", emitter
call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
call pacify (p_real, 1E-6_default)
call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
write (u, "(A)")
write (u, "(A)") "* Test output end: phs_fks_generator_7"
end subroutine phs_fks_generator_7
@ %def phs_fks_generator_3
@
\section{Dispatch}
<<[[dispatch_phase_space.f90]]>>=
<<File header>>
module dispatch_phase_space
<<Use kinds>>
<<Use strings>>
use variables, only: var_list_t
use os_interface, only: os_data_t
use sf_mappings, only: sf_channel_t
use beam_structures, only: beam_structure_t
use dispatch_beams, only: sf_prop_t, strfun_mode
use mappings
use phs_forests, only: phs_parameters_t
use phs_base
<<Standard module head>>
<<Dispatch phs: public>>
interface
<<Dispatch phs: sub interfaces>>
end interface
end module dispatch_phase_space
@ %def dispatch_phase_space
@
<<[[dispatch_phase_space_sub.f90]]>>=
<<File header>>
submodule (dispatch_phase_space) dispatch_phase_space_s
use io_units, only: free_unit
use diagnostics
use phs_none
use phs_single
use phs_rambo
use phs_wood
use phs_fks
implicit none
contains
<<Dispatch phs: procedures>>
end submodule dispatch_phase_space_s
@ %def dispatch_phase_space_s
@
Allocate a phase-space object according to the variable [[$phs_method]].
<<Dispatch phs: public>>=
public :: dispatch_phs
<<Dispatch phs: sub interfaces>>=
module subroutine dispatch_phs (phs, var_list, os_data, process_id, &
mapping_defaults, phs_par, phs_method_in)
class(phs_config_t), allocatable, intent(inout) :: phs
type(var_list_t), intent(in) :: var_list
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in) :: process_id
type(mapping_defaults_t), intent(in), optional :: mapping_defaults
type(phs_parameters_t), intent(in), optional :: phs_par
type(string_t), intent(in), optional :: phs_method_in
end subroutine dispatch_phs
<<Dispatch phs: procedures>>=
module subroutine dispatch_phs (phs, var_list, os_data, process_id, &
mapping_defaults, phs_par, phs_method_in)
class(phs_config_t), allocatable, intent(inout) :: phs
type(var_list_t), intent(in) :: var_list
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in) :: process_id
type(mapping_defaults_t), intent(in), optional :: mapping_defaults
type(phs_parameters_t), intent(in), optional :: phs_par
type(string_t), intent(in), optional :: phs_method_in
type(string_t) :: phs_method, phs_file, run_id
logical :: use_equivalences, vis_channels, fatal_beam_decay
integer :: u_phs
logical :: exist
if (present (phs_method_in)) then
phs_method = phs_method_in
else
phs_method = &
var_list%get_sval (var_str ("$phs_method"))
end if
phs_file = &
var_list%get_sval (var_str ("$phs_file"))
use_equivalences = &
var_list%get_lval (var_str ("?use_vamp_equivalences"))
vis_channels = &
var_list%get_lval (var_str ("?vis_channels"))
fatal_beam_decay = &
var_list%get_lval (var_str ("?fatal_beam_decay"))
run_id = &
var_list%get_sval (var_str ("$run_id"))
select case (char (phs_method))
case ("none")
allocate (phs_none_config_t :: phs)
case ("single")
allocate (phs_single_config_t :: phs)
if (vis_channels) then
call msg_warning ("Visualizing phase space channels not " // &
"available for method 'single'.")
end if
case ("rambo")
allocate (phs_rambo_config_t :: phs)
if (vis_channels) &
call msg_warning ("Visualizing phase space channels not " // &
"available for method 'rambo'.")
case ("fks")
allocate (phs_fks_config_t :: phs)
if (use_equivalences) then
select type (phs)
type is (phs_fks_config_t)
call phs%enable_equivalences ()
end select
end if
case ("wood", "default", "fast_wood")
call dispatch_wood ()
case default
call msg_fatal ("Phase space: parameterization method '" &
// char (phs_method) // "' not implemented")
end select
contains
<<Dispatch phs: dispatch phs: procedures>>
end subroutine dispatch_phs
@ %def dispatch_phs
@
<<Dispatch phs: dispatch phs: procedures>>=
subroutine dispatch_wood ()
allocate (phs_wood_config_t :: phs)
select type (phs)
type is (phs_wood_config_t)
if (phs_file /= "") then
inquire (file = char (phs_file), exist = exist)
if (exist) then
call msg_message ("Phase space: reading configuration from '" &
// char (phs_file) // "'")
u_phs = free_unit ()
open (u_phs, file = char (phs_file), &
action = "read", status = "old")
call phs%set_input (u_phs)
else
call msg_fatal ("Phase space: configuration file '" &
// char (phs_file) // "' not found")
end if
end if
if (present (phs_par)) &
call phs%set_parameters (phs_par)
if (use_equivalences) &
call phs%enable_equivalences ()
if (present (mapping_defaults)) &
call phs%set_mapping_defaults (mapping_defaults)
if (phs_method == "fast_wood") phs%use_cascades2 = .true.
phs%vis_channels = vis_channels
phs%fatal_beam_decay = fatal_beam_decay
phs%os_data = os_data
phs%run_id = run_id
end select
end subroutine dispatch_wood
@
@ Configure channel mappings, using some conditions
from the phase space configuration. If there are no structure
functions, we enable a default setup with a single (dummy)
structure-function channel. Otherwise, we look at the channel
collection that we got from the phase-space configuration step. Each
entry should be translated into an independent structure-function
channel, where typically there is one default entry, which could be
mapped using a standard s-channel mapping if the structure function
setup recommends this, and other entries with s-channel resonances.
The latter need to be translated into global mappings from the
structure-function chain.
<<Dispatch phs: public>>=
public :: dispatch_sf_channels
<<Dispatch phs: sub interfaces>>=
module subroutine dispatch_sf_channels (sf_channel, sf_string, sf_prop, &
coll, var_list, sqrts, beam_structure)
type(sf_channel_t), dimension(:), allocatable, intent(out) :: sf_channel
type(string_t), intent(out) :: sf_string
type(sf_prop_t), intent(in) :: sf_prop
type(phs_channel_collection_t), intent(in) :: coll
type(var_list_t), intent(in) :: var_list
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in) :: beam_structure
end subroutine dispatch_sf_channels
<<Dispatch phs: procedures>>=
module subroutine dispatch_sf_channels (sf_channel, sf_string, sf_prop, &
coll, var_list, sqrts, beam_structure)
type(sf_channel_t), dimension(:), allocatable, intent(out) :: sf_channel
type(string_t), intent(out) :: sf_string
type(sf_prop_t), intent(in) :: sf_prop
type(phs_channel_collection_t), intent(in) :: coll
type(var_list_t), intent(in) :: var_list
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in) :: beam_structure
type(beam_structure_t) :: beam_structure_tmp
class(channel_prop_t), allocatable :: prop
integer :: n_strfun, n_sf_channel, i
logical :: sf_allow_s_mapping, circe1_map, circe1_generate
logical :: s_mapping_enable, endpoint_mapping, power_mapping
logical :: single_parameter
integer, dimension(:), allocatable :: s_mapping, single_mapping
real(default) :: s_mapping_power
real(default) :: circe1_mapping_slope, endpoint_mapping_slope
real(default) :: power_mapping_eps
beam_structure_tmp = beam_structure
call beam_structure_tmp%expand (strfun_mode)
n_strfun = beam_structure_tmp%get_n_record ()
sf_string = beam_structure_tmp%to_string (sf_only = .true.)
sf_allow_s_mapping = &
var_list%get_lval (var_str ("?sf_allow_s_mapping"))
circe1_generate = &
var_list%get_lval (var_str ("?circe1_generate"))
circe1_map = &
var_list%get_lval (var_str ("?circe1_map"))
circe1_mapping_slope = &
var_list%get_rval (var_str ("circe1_mapping_slope"))
s_mapping_enable = .false.
s_mapping_power = 1
endpoint_mapping = .false.
endpoint_mapping_slope = 1
power_mapping = .false.
single_parameter = .false.
select case (char (sf_string))
case ("", "[any particles]")
case ("pdf_builtin, none", &
"pdf_builtin_photon, none", &
"none, pdf_builtin", &
"none, pdf_builtin_photon", &
"lhapdf, none", &
"lhapdf_photon, none", &
"none, lhapdf", &
"none, lhapdf_photon")
single_parameter = .true.
case ("pdf_builtin, none => none, pdf_builtin", &
"pdf_builtin, none => none, pdf_builtin_photon", &
"pdf_builtin_photon, none => none, pdf_builtin", &
"pdf_builtin_photon, none => none, pdf_builtin_photon", &
"lhapdf, none => none, lhapdf", &
"lhapdf, none => none, lhapdf_photon", &
"lhapdf_photon, none => none, lhapdf", &
"lhapdf_photon, none => none, lhapdf_photon")
allocate (s_mapping (2), source = [1, 2])
s_mapping_enable = .true.
s_mapping_power = 2
case ("pdf_builtin, none => none, pdf_builtin => epa, none => none, epa", &
"pdf_builtin, none => none, pdf_builtin => ewa, none => none, ewa", &
"pdf_builtin, none => none, pdf_builtin => ewa, none => none, epa", &
"pdf_builtin, none => none, pdf_builtin => epa, none => none, ewa")
allocate (s_mapping (2), source = [1, 2])
s_mapping_enable = .true.
s_mapping_power = 2
case ("isr, none", &
"none, isr")
allocate (single_mapping (1), source = [1])
single_parameter = .true.
case ("isr, none => none, isr")
allocate (s_mapping (2), source = [1, 2])
power_mapping = .true.
power_mapping_eps = minval (sf_prop%isr_eps)
case ("isr, none => none, isr => epa, none => none, epa", &
"isr, none => none, isr => ewa, none => none, ewa", &
"isr, none => none, isr => ewa, none => none, epa", &
"isr, none => none, isr => epa, none => none, ewa")
allocate (s_mapping (2), source = [1, 2])
power_mapping = .true.
power_mapping_eps = minval (sf_prop%isr_eps)
case ("circe1 => isr, none => none, isr => epa, none => none, epa", &
"circe1 => isr, none => none, isr => ewa, none => none, ewa", &
"circe1 => isr, none => none, isr => ewa, none => none, epa", &
"circe1 => isr, none => none, isr => epa, none => none, ewa")
if (circe1_generate) then
allocate (s_mapping (2), source = [2, 3])
else
allocate (s_mapping (3), source = [1, 2, 3])
endpoint_mapping = .true.
endpoint_mapping_slope = circe1_mapping_slope
end if
power_mapping = .true.
power_mapping_eps = minval (sf_prop%isr_eps)
case ("pdf_builtin, none => none, isr", &
"pdf_builtin_photon, none => none, isr", &
"lhapdf, none => none, isr", &
"lhapdf_photon, none => none, isr")
allocate (single_mapping (1), source = [2])
case ("isr, none => none, pdf_builtin", &
"isr, none => none, pdf_builtin_photon", &
"isr, none => none, lhapdf", &
"isr, none => none, lhapdf_photon")
allocate (single_mapping (1), source = [1])
case ("epa, none", &
"none, epa")
allocate (single_mapping (1), source = [1])
single_parameter = .true.
case ("epa, none => none, epa")
allocate (single_mapping (2), source = [1, 2])
case ("epa, none => none, isr", &
"isr, none => none, epa", &
"ewa, none => none, isr", &
"isr, none => none, ewa")
allocate (single_mapping (2), source = [1, 2])
case ("pdf_builtin, none => none, epa", &
"pdf_builtin_photon, none => none, epa", &
"lhapdf, none => none, epa", &
"lhapdf_photon, none => none, epa")
allocate (single_mapping (1), source = [2])
case ("pdf_builtin, none => none, ewa", &
"pdf_builtin_photon, none => none, ewa", &
"lhapdf, none => none, ewa", &
"lhapdf_photon, none => none, ewa")
allocate (single_mapping (1), source = [2])
case ("epa, none => none, pdf_builtin", &
"epa, none => none, pdf_builtin_photon", &
"epa, none => none, lhapdf", &
"epa, none => none, lhapdf_photon")
allocate (single_mapping (1), source = [1])
case ("ewa, none => none, pdf_builtin", &
"ewa, none => none, pdf_builtin_photon", &
"ewa, none => none, lhapdf", &
"ewa, none => none, lhapdf_photon")
allocate (single_mapping (1), source = [1])
case ("ewa, none", &
"none, ewa")
allocate (single_mapping (1), source = [1])
single_parameter = .true.
case ("ewa, none => none, ewa")
allocate (single_mapping (2), source = [1, 2])
case ("energy_scan, none => none, energy_scan")
allocate (s_mapping (2), source = [1, 2])
case ("sf_test_1, none => none, sf_test_1")
allocate (s_mapping (2), source = [1, 2])
case ("circe1")
if (circe1_generate) then
!!! no mapping
else if (circe1_map) then
allocate (s_mapping (1), source = [1])
endpoint_mapping = .true.
endpoint_mapping_slope = circe1_mapping_slope
else
allocate (s_mapping (1), source = [1])
s_mapping_enable = .true.
end if
case ("circe1 => isr, none => none, isr")
if (circe1_generate) then
allocate (s_mapping (2), source = [2, 3])
else
allocate (s_mapping (3), source = [1, 2, 3])
endpoint_mapping = .true.
endpoint_mapping_slope = circe1_mapping_slope
end if
power_mapping = .true.
power_mapping_eps = minval (sf_prop%isr_eps)
case ("circe1 => isr, none", &
"circe1 => none, isr")
allocate (single_mapping (1), source = [2])
case ("circe1 => epa, none => none, epa")
if (circe1_generate) then
allocate (single_mapping (2), source = [2, 3])
else
call msg_fatal ("CIRCE/EPA: supported with ?circe1_generate=true &
&only")
end if
case ("circe1 => ewa, none => none, ewa")
if (circe1_generate) then
allocate (single_mapping (2), source = [2, 3])
else
call msg_fatal ("CIRCE/EWA: supported with ?circe1_generate=true &
&only")
end if
case ("circe1 => epa, none", &
"circe1 => none, epa")
if (circe1_generate) then
allocate (single_mapping (1), source = [2])
else
call msg_fatal ("CIRCE/EPA: supported with ?circe1_generate=true &
&only")
end if
case ("circe1 => epa, none => none, isr", &
"circe1 => isr, none => none, epa", &
"circe1 => ewa, none => none, isr", &
"circe1 => isr, none => none, ewa")
if (circe1_generate) then
allocate (single_mapping (2), source = [2, 3])
else
call msg_fatal ("CIRCE/EPA: supported with ?circe1_generate=true &
&only")
end if
case ("circe2", &
"gaussian", &
"beam_events")
!!! no mapping
case ("circe2 => isr, none => none, isr", &
"gaussian => isr, none => none, isr", &
"beam_events => isr, none => none, isr")
allocate (s_mapping (2), source = [2, 3])
power_mapping = .true.
power_mapping_eps = minval (sf_prop%isr_eps)
case ("circe2 => isr, none", &
"circe2 => none, isr", &
"gaussian => isr, none", &
"gaussian => none, isr", &
"beam_events => isr, none", &
"beam_events => none, isr")
allocate (single_mapping (1), source = [2])
case ("circe2 => epa, none => none, epa", &
"gaussian => epa, none => none, epa", &
"beam_events => epa, none => none, epa")
allocate (single_mapping (2), source = [2, 3])
case ("circe2 => epa, none", &
"circe2 => none, epa", &
"circe2 => ewa, none", &
"circe2 => none, ewa", &
"gaussian => epa, none", &
"gaussian => none, epa", &
"gaussian => ewa, none", &
"gaussian => none, ewa", &
"beam_events => epa, none", &
"beam_events => none, epa", &
"beam_events => ewa, none", &
"beam_events => none, ewa")
allocate (single_mapping (1), source = [2])
case ("circe2 => epa, none => none, isr", &
"circe2 => isr, none => none, epa", &
"circe2 => ewa, none => none, isr", &
"circe2 => isr, none => none, ewa", &
"gaussian => epa, none => none, isr", &
"gaussian => isr, none => none, epa", &
"gaussian => ewa, none => none, isr", &
"gaussian => isr, none => none, ewa", &
"beam_events => epa, none => none, isr", &
"beam_events => isr, none => none, epa", &
"beam_events => ewa, none => none, isr", &
"beam_events => isr, none => none, ewa")
allocate (single_mapping (2), source = [2, 3])
case ("energy_scan")
case default
call msg_fatal ("Beam structure: " &
// char (sf_string) // " not supported")
end select
if (sf_allow_s_mapping .and. coll%n > 0) then
n_sf_channel = coll%n
allocate (sf_channel (n_sf_channel))
do i = 1, n_sf_channel
call sf_channel(i)%init (n_strfun)
if (allocated (single_mapping)) then
call sf_channel(i)%activate_mapping (single_mapping)
end if
if (allocated (prop)) deallocate (prop)
call coll%get_entry (i, prop)
if (allocated (prop)) then
if (endpoint_mapping .and. power_mapping) then
select type (prop)
type is (resonance_t)
call sf_channel(i)%set_eir_mapping (s_mapping, &
a = endpoint_mapping_slope, eps = power_mapping_eps, &
m = prop%mass / sqrts, w = prop%width / sqrts)
type is (on_shell_t)
call sf_channel(i)%set_eio_mapping (s_mapping, &
a = endpoint_mapping_slope, eps = power_mapping_eps, &
m = prop%mass / sqrts)
end select
else if (endpoint_mapping) then
select type (prop)
type is (resonance_t)
call sf_channel(i)%set_epr_mapping (s_mapping, &
a = endpoint_mapping_slope, &
m = prop%mass / sqrts, w = prop%width / sqrts)
type is (on_shell_t)
call sf_channel(i)%set_epo_mapping (s_mapping, &
a = endpoint_mapping_slope, &
m = prop%mass / sqrts)
end select
else if (power_mapping) then
select type (prop)
type is (resonance_t)
call sf_channel(i)%set_ipr_mapping (s_mapping, &
eps = power_mapping_eps, &
m = prop%mass / sqrts, w = prop%width / sqrts)
type is (on_shell_t)
call sf_channel(i)%set_ipo_mapping (s_mapping, &
eps = power_mapping_eps, &
m = prop%mass / sqrts)
end select
else if (allocated (s_mapping)) then
select type (prop)
type is (resonance_t)
call sf_channel(i)%set_res_mapping (s_mapping, &
m = prop%mass / sqrts, w = prop%width / sqrts, &
single = single_parameter)
type is (on_shell_t)
call sf_channel(i)%set_os_mapping (s_mapping, &
m = prop%mass / sqrts, &
single = single_parameter)
end select
else if (allocated (single_mapping)) then
select type (prop)
type is (resonance_t)
call sf_channel(i)%set_res_mapping (single_mapping, &
m = prop%mass / sqrts, w = prop%width / sqrts, &
single = single_parameter)
type is (on_shell_t)
call sf_channel(i)%set_os_mapping (single_mapping, &
m = prop%mass / sqrts, &
single = single_parameter)
end select
end if
else if (endpoint_mapping .and. power_mapping) then
call sf_channel(i)%set_ei_mapping (s_mapping, &
a = endpoint_mapping_slope, eps = power_mapping_eps)
else if (endpoint_mapping .and. .not. allocated (single_mapping)) then
call sf_channel(i)%set_ep_mapping (s_mapping, &
a = endpoint_mapping_slope)
else if (power_mapping .and. .not. allocated (single_mapping)) then
call sf_channel(i)%set_ip_mapping (s_mapping, &
eps = power_mapping_eps)
else if (s_mapping_enable .and. .not. allocated (single_mapping)) then
call sf_channel(i)%set_s_mapping (s_mapping, &
power = s_mapping_power)
end if
end do
else if (sf_allow_s_mapping) then
allocate (sf_channel (1))
call sf_channel(1)%init (n_strfun)
if (allocated (single_mapping)) then
call sf_channel(1)%activate_mapping (single_mapping)
else if (endpoint_mapping .and. power_mapping) then
call sf_channel(i)%set_ei_mapping (s_mapping, &
a = endpoint_mapping_slope, eps = power_mapping_eps)
else if (endpoint_mapping) then
call sf_channel(1)%set_ep_mapping (s_mapping, &
a = endpoint_mapping_slope)
else if (power_mapping) then
call sf_channel(1)%set_ip_mapping (s_mapping, &
eps = power_mapping_eps)
else if (s_mapping_enable) then
call sf_channel(1)%set_s_mapping (s_mapping, &
power = s_mapping_power)
end if
else
allocate (sf_channel (1))
call sf_channel(1)%init (n_strfun)
if (allocated (single_mapping)) then
call sf_channel(1)%activate_mapping (single_mapping)
end if
end if
end subroutine dispatch_sf_channels
@ %def dispatch_sf_channels
@
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[dispatch_phs_ut.f90]]>>=
<<File header>>
module dispatch_phs_ut
use unit_tests
use dispatch_phs_uti
<<Standard module head>>
<<Dispatch phs: public test>>
contains
<<Dispatch phs: test driver>>
end module dispatch_phs_ut
@ %def dispatch_phs_ut
@
<<[[dispatch_phs_uti.f90]]>>=
<<File header>>
module dispatch_phs_uti
<<Use kinds>>
<<Use strings>>
use variables
use io_units, only: free_unit
use os_interface, only: os_data_t
use process_constants
use model_data
use models
use phs_base
use phs_none
use phs_forests
use phs_wood
use mappings
use dispatch_phase_space
<<Standard module head>>
<<Dispatch phs: test declarations>>
contains
<<Dispatch phs: tests>>
end module dispatch_phs_uti
@ %def dispatch_phs_ut
@ API: driver for the unit tests below.
<<Dispatch phs: public test>>=
public ::dispatch_phs_test
<<Dispatch phs: test driver>>=
subroutine dispatch_phs_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Dispatch phs: execute tests>>
end subroutine dispatch_phs_test
@ %def dispatch_phs_test
@
\subsubsection{Select type: phase-space configuration object}
<<Dispatch phs: execute tests>>=
call test (dispatch_phs_1, "dispatch_phs_1", &
"phase-space configuration", &
u, results)
<<Dispatch phs: test declarations>>=
public :: dispatch_phs_1
<<Dispatch phs: tests>>=
subroutine dispatch_phs_1 (u)
integer, intent(in) :: u
type(var_list_t) :: var_list
class(phs_config_t), allocatable :: phs
type(phs_parameters_t) :: phs_par
type(os_data_t) :: os_data
type(mapping_defaults_t) :: mapping_defs
write (u, "(A)") "* Test output: dispatch_phs_1"
write (u, "(A)") "* Purpose: select phase-space configuration method"
write (u, "(A)")
call var_list%init_defaults (0)
write (u, "(A)") "* Allocate PHS as phs_none_t"
write (u, "(A)")
call var_list%set_string (&
var_str ("$phs_method"), &
var_str ("none"), is_known = .true.)
call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"))
call phs%write (u)
call phs%final ()
deallocate (phs)
write (u, "(A)")
write (u, "(A)") "* Allocate PHS as phs_single_t"
write (u, "(A)")
call var_list%set_string (&
var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"))
call phs%write (u)
call phs%final ()
deallocate (phs)
write (u, "(A)")
write (u, "(A)") "* Allocate PHS as phs_wood_t"
write (u, "(A)")
call var_list%set_string (&
var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"))
call phs%write (u)
call phs%final ()
deallocate (phs)
write (u, "(A)")
write (u, "(A)") "* Setting parameters for phs_wood_t"
write (u, "(A)")
phs_par%m_threshold_s = 123
phs_par%m_threshold_t = 456
phs_par%t_channel = 42
phs_par%off_shell = 17
phs_par%keep_nonresonant = .false.
mapping_defs%energy_scale = 987
mapping_defs%invariant_mass_scale = 654
mapping_defs%momentum_transfer_scale = 321
mapping_defs%step_mapping = .false.
mapping_defs%step_mapping_exp = .false.
mapping_defs%enable_s_mapping = .true.
call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"), &
mapping_defs, phs_par)
call phs%write (u)
call phs%final ()
call var_list%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_phs_1"
end subroutine dispatch_phs_1
@ %def dispatch_phs_1
@
\subsubsection{Phase-space configuration with file}
<<Dispatch phs: execute tests>>=
call test (dispatch_phs_2, "dispatch_phs_2", &
"configure phase space using file", &
u, results)
<<Dispatch phs: test declarations>>=
public :: dispatch_phs_2
<<Dispatch phs: tests>>=
subroutine dispatch_phs_2 (u)
use phs_base_ut, only: init_test_process_data
use phs_wood_ut, only: write_test_phs_file
use phs_forests
integer, intent(in) :: u
type(var_list_t) :: var_list
type(os_data_t) :: os_data
type(process_constants_t) :: process_data
type(model_list_t) :: model_list
type(model_t), pointer :: model
class(phs_config_t), allocatable :: phs
integer :: u_phs
write (u, "(A)") "* Test output: dispatch_phs_2"
write (u, "(A)") "* Purpose: select 'wood' phase-space &
&for a test process"
write (u, "(A)") "* and read phs configuration from file"
write (u, "(A)")
write (u, "(A)") "* Initialize a process"
write (u, "(A)")
call var_list%init_defaults (0)
call os_data%init ()
call syntax_model_file_init ()
call model_list%read_model &
(var_str ("Test"), var_str ("Test.mdl"), os_data, model)
call syntax_phs_forest_init ()
call init_test_process_data (var_str ("dispatch_phs_2"), process_data)
write (u, "(A)") "* Write phase-space file"
u_phs = free_unit ()
open (u_phs, file = "dispatch_phs_2.phs", action = "write", status = "replace")
call write_test_phs_file (u_phs, var_str ("dispatch_phs_2"))
close (u_phs)
write (u, "(A)")
write (u, "(A)") "* Allocate PHS as phs_wood_t"
write (u, "(A)")
call var_list%set_string (&
var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call var_list%set_string (&
var_str ("$phs_file"), &
var_str ("dispatch_phs_2.phs"), is_known = .true.)
call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_2"))
call phs%init (process_data, model)
call phs%configure (sqrts = 1000._default)
call phs%write (u)
write (u, "(A)")
select type (phs)
type is (phs_wood_config_t)
call phs%write_forest (u)
end select
call phs%final ()
call var_list%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_phs_2"
end subroutine dispatch_phs_2
@ %def dispatch_phs_2
@
Index: trunk/src/process_integration/process_integration.nw
===================================================================
--- trunk/src/process_integration/process_integration.nw (revision 8819)
+++ trunk/src/process_integration/process_integration.nw (revision 8820)
@@ -1,23892 +1,23920 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: integration and process objects and such
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Integration and Process Objects}
\includemodulegraph{process_integration}
This is the central part of the \whizard\ package. It provides the
functionality for evaluating structure functions, kinematics and matrix
elements, integration and event generation. It combines the various
parts that deal with those tasks individually and organizes the data
transfer between them.
\begin{description}
\item[subevt\_expr]
This enables process observables as (abstract) expressions, to be
evaluated for each process call.
\item[parton\_states]
A [[parton_state_t]] object represents an elementary partonic
interaction. There are two versions: one for the isolated
elementary process, one for the elementary process convoluted with
the structure-function chain. The parton state is an effective
state. It needs not coincide with the seed-kinematics state which is
used in evaluating phase space.
\item[process]
Here, all pieces are combined for the purpose of evaluating the
elementary processes. The whole algorithm is coded in terms of
abstract data types as defined in the appropriate modules: [[prc_core]]
for matrix-element evaluation, [[prc_core_def]] for the associated
configuration and driver, [[sf_base]] for beams and structure-functions,
[[phs_base]] for phase space, and [[mci_base]] for integration and event
generation.
\item[process\_config]
\item[process\_counter]
Very simple object for statistics
\item[process\_mci]
\item[pcm]
\item[kinematics]
\item[instances]
While the above modules set up all static information, the instances
have the changing event data. There are term and process instances but
no component instances.
\item[process\_stacks]
Process stacks collect process objects.
\end{description}
We combine here hard interactions, phase space, and (for scatterings)
structure functions and interfaces them to the integration module.
The process object implements the combination of a fixed beam and
structure-function setup with a number of elementary processes. The
latter are called process components. The process object
represents an entity which is supposedly observable. It should
be meaningful to talk about the cross section of a process.
The individual components of a process are, technically, processes
themselves, but they may have unphysical cross sections which have to
be added for a physical result. Process components may be exclusive
tree-level elementary processes, dipole subtraction term, loop
corrections, etc.
The beam and structure function setup is common to all process
components. Thus, there is only one instance of this part.
The process may be a scattering process or a decay process. In the
latter case, there are no structure functions, and the beam setup
consists of a single particle. Otherwise, the two classes are treated
on the same footing.
Once a sampling point has been chosen, a process determines a set of
partons with a correlated density matrix of quantum numbers. In
general, each sampling point will generate, for each process component,
one or more distinct parton configurations. This is the [[computed]]
state. The computed state is the subject of the multi-channel
integration algorithm.
For NLO computations, it is necessary to project the computed states
onto another set of parton configurations (e.g., by recombining
certain pairs). This is the [[observed]] state. When computing
partonic observables, the information is taken from the observed
state.
For the purpose of event generation, we will later select one parton
configuration from the observed state and collapse the correlated
quantum state. This configuration is then dressed by applying parton
shower, decays and hadronization. The decay chain, in particular,
combines a scattering process with possible subsequent decay processes
on the parton level, which are full-fledged process objects themselves.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process observables}
We define an abstract [[subevt_expr_t]] object as an extension of the
[[subevt_t]] type. The object contains a local variable list, variable
instances (as targets for pointers in the variable list), and evaluation
trees. The evaluation trees reference both the variables and the [[subevt]].
There are two instances of the abstract type: one for process instances, one
for physical events. Both have a common logical expression [[selection]]
which determines whether the object passes user-defined cuts.
The intention is that we fill the [[subevt_t]] base object and compute the
variables once we have evaluated a kinematical phase space point (or a
complete event). We then evaluate the expressions and can use the results in
further calculations.
The [[process_expr_t]] extension contains furthermore scale and weight
expressions. The [[event_expr_t]] extension contains a reweighting-factor
expression and a logical expression for event analysis. In practice, we will
link the variable list of the [[event_obs]] object to the variable list of the
currently active [[process_obs]] object, such that the process variables are
available to both objects. Event variables are meaningful only for physical
events.
Note that there are unit tests, but they are deferred to the
[[expr_tests]] module.
<<[[subevt_expr.f90]]>>=
<<File header>>
module subevt_expr
<<Use kinds>>
<<Use strings>>
use lorentz
use subevents
use variables
use flavors
use quantum_numbers
use interactions
use particles
use expr_base
<<Standard module head>>
<<Subevt expr: public>>
<<Subevt expr: types>>
<<Subevt expr: interfaces>>
interface
<<Subevt expr: sub interfaces>>
end interface
end module subevt_expr
@ %def subevt_expr
@
<<[[subevt_expr_sub.f90]]>>=
<<File header>>
submodule (subevt_expr) subevt_expr_s
use constants, only: zero, one
use io_units
use format_utils, only: write_separator
use diagnostics
implicit none
contains
<<Subevt expr: procedures>>
end submodule subevt_expr_s
@ %def subevt_expr_s
@
\subsection{Abstract base type}
<<Subevt expr: types>>=
type, extends (subevt_t), abstract :: subevt_expr_t
logical :: subevt_filled = .false.
type(var_list_t) :: var_list
real(default) :: sqrts_hat = 0
integer :: n_in = 0
integer :: n_out = 0
integer :: n_tot = 0
logical :: has_selection = .false.
class(expr_t), allocatable :: selection
logical :: colorize_subevt = .false.
contains
<<Subevt expr: subevt expr: TBP>>
end type subevt_expr_t
@ %def subevt_expr_t
@ Output: Base and extended version. We already have a [[write]] routine for
the [[subevt_t]] parent type.
<<Subevt expr: subevt expr: TBP>>=
procedure :: base_write => subevt_expr_write
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_write (object, unit, pacified)
class(subevt_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacified
end subroutine subevt_expr_write
<<Subevt expr: procedures>>=
module subroutine subevt_expr_write (object, unit, pacified)
class(subevt_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Local variables:"
call write_separator (u)
call object%var_list%write (u, follow_link=.false., &
pacified = pacified)
call write_separator (u)
if (object%subevt_filled) then
call object%subevt_t%write (u, pacified = pacified)
if (object%has_selection) then
call write_separator (u)
write (u, "(1x,A)") "Selection expression:"
call write_separator (u)
call object%selection%write (u)
end if
else
write (u, "(1x,A)") "subevt: [undefined]"
end if
end subroutine subevt_expr_write
@ %def subevt_expr_write
@ Finalizer.
<<Subevt expr: subevt expr: TBP>>=
procedure (subevt_expr_final), deferred :: final
procedure :: base_final => subevt_expr_final
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_final (object)
class(subevt_expr_t), intent(inout) :: object
end subroutine subevt_expr_final
<<Subevt expr: procedures>>=
module subroutine subevt_expr_final (object)
class(subevt_expr_t), intent(inout) :: object
call object%var_list%final ()
if (object%has_selection) then
call object%selection%final ()
end if
end subroutine subevt_expr_final
@ %def subevt_expr_final
@
\subsection{Initialization}
Initialization: define local variables and establish pointers.
The common variables are [[sqrts]] (the nominal beam energy, fixed),
[[sqrts_hat]] (the actual energy), [[n_in]], [[n_out]], and [[n_tot]] for
the [[subevt]]. With the exception of [[sqrts]], all are implemented as
pointers to subobjects.
<<Subevt expr: subevt expr: TBP>>=
procedure (subevt_expr_setup_vars), deferred :: setup_vars
procedure :: base_setup_vars => subevt_expr_setup_vars
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_setup_vars (expr, sqrts)
class(subevt_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
end subroutine subevt_expr_setup_vars
<<Subevt expr: procedures>>=
module subroutine subevt_expr_setup_vars (expr, sqrts)
class(subevt_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%var_list%final ()
call expr%var_list%append_real (var_str ("sqrts"), sqrts, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_real_ptr (var_str ("sqrts_hat"), &
expr%sqrts_hat, is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_int_ptr (var_str ("n_in"), expr%n_in, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_int_ptr (var_str ("n_out"), expr%n_out, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_int_ptr (var_str ("n_tot"), expr%n_tot, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
end subroutine subevt_expr_setup_vars
@ %def subevt_expr_setup_vars
@ Append the subevent expr (its base-type core) itself to the variable
list, if it is not yet present.
<<Subevt expr: subevt expr: TBP>>=
procedure :: setup_var_self => subevt_expr_setup_var_self
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_setup_var_self (expr)
class(subevt_expr_t), intent(inout), target :: expr
end subroutine subevt_expr_setup_var_self
<<Subevt expr: procedures>>=
module subroutine subevt_expr_setup_var_self (expr)
class(subevt_expr_t), intent(inout), target :: expr
if (.not. expr%var_list%contains (var_str ("@evt"))) then
call expr%var_list%append_subevt_ptr &
(var_str ("@evt"), expr%subevt_t, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic=.true.)
end if
end subroutine subevt_expr_setup_var_self
@ %def subevt_expr_setup_var_self
@ Link a variable list to the local one. This could be done event by event,
but before evaluating expressions.
<<Subevt expr: subevt expr: TBP>>=
procedure :: link_var_list => subevt_expr_link_var_list
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_link_var_list (expr, var_list)
class(subevt_expr_t), intent(inout) :: expr
type(var_list_t), intent(in), target :: var_list
end subroutine subevt_expr_link_var_list
<<Subevt expr: procedures>>=
module subroutine subevt_expr_link_var_list (expr, var_list)
class(subevt_expr_t), intent(inout) :: expr
type(var_list_t), intent(in), target :: var_list
call expr%var_list%link (var_list)
end subroutine subevt_expr_link_var_list
@ %def subevt_expr_link_var_list
@ Compile the selection expression. If there is no expression, the build
method will not allocate the expression object.
<<Subevt expr: subevt expr: TBP>>=
procedure :: setup_selection => subevt_expr_setup_selection
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_setup_selection (expr, ef_cuts)
class(subevt_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_cuts
end subroutine subevt_expr_setup_selection
<<Subevt expr: procedures>>=
module subroutine subevt_expr_setup_selection (expr, ef_cuts)
class(subevt_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_cuts
call ef_cuts%build (expr%selection)
if (allocated (expr%selection)) then
call expr%setup_var_self ()
call expr%selection%setup_lexpr (expr%var_list)
expr%has_selection = .true.
end if
end subroutine subevt_expr_setup_selection
@ %def subevt_expr_setup_selection
@ (De)activate color storage and evaluation for the expression. The subevent
particles will have color information.
<<Subevt expr: subevt expr: TBP>>=
procedure :: colorize => subevt_expr_colorize
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_colorize (expr, colorize_subevt)
class(subevt_expr_t), intent(inout), target :: expr
logical, intent(in) :: colorize_subevt
end subroutine subevt_expr_colorize
<<Subevt expr: procedures>>=
module subroutine subevt_expr_colorize (expr, colorize_subevt)
class(subevt_expr_t), intent(inout), target :: expr
logical, intent(in) :: colorize_subevt
expr%colorize_subevt = colorize_subevt
end subroutine subevt_expr_colorize
@ %def subevt_expr_colorize
@
\subsection{Evaluation}
Reset to initial state, i.e., mark the [[subevt]] as invalid.
<<Subevt expr: subevt expr: TBP>>=
procedure :: reset_contents => subevt_expr_reset_contents
procedure :: base_reset_contents => subevt_expr_reset_contents
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_reset_contents (expr)
class(subevt_expr_t), intent(inout) :: expr
- end subroutine subevt_expr_reset_contents
+ end subroutine subevt_expr_reset_contents
<<Subevt expr: procedures>>=
module subroutine subevt_expr_reset_contents (expr)
class(subevt_expr_t), intent(inout) :: expr
expr%subevt_filled = .false.
end subroutine subevt_expr_reset_contents
@ %def subevt_expr_reset_contents
@ Evaluate the selection expression and return the result. There is also a
deferred version: this should evaluate the remaining expressions if the event
has passed.
<<Subevt expr: subevt expr: TBP>>=
procedure :: base_evaluate => subevt_expr_evaluate
<<Subevt expr: sub interfaces>>=
module subroutine subevt_expr_evaluate (expr, passed)
class(subevt_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
end subroutine subevt_expr_evaluate
<<Subevt expr: procedures>>=
module subroutine subevt_expr_evaluate (expr, passed)
class(subevt_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
if (expr%has_selection) then
call expr%selection%evaluate ()
if (expr%selection%is_known ()) then
passed = expr%selection%get_log ()
else
call msg_error ("Evaluate selection expression: result undefined")
passed = .false.
end if
else
passed = .true.
end if
end subroutine subevt_expr_evaluate
@ %def subevt_expr_evaluate
@
\subsection{Implementation for partonic events}
This implementation contains the expressions that we can evaluate for the
partonic process during integration.
<<Subevt expr: public>>=
public :: parton_expr_t
<<Subevt expr: types>>=
type, extends (subevt_expr_t) :: parton_expr_t
integer, dimension(:), allocatable :: i_beam
integer, dimension(:), allocatable :: i_in
integer, dimension(:), allocatable :: i_out
logical :: has_scale = .false.
logical :: has_fac_scale = .false.
logical :: has_ren_scale = .false.
logical :: has_weight = .false.
class(expr_t), allocatable :: scale
class(expr_t), allocatable :: fac_scale
class(expr_t), allocatable :: ren_scale
class(expr_t), allocatable :: weight
contains
<<Subevt expr: parton expr: TBP>>
end type parton_expr_t
@ %def parton_expr_t
@ Finalizer.
<<Subevt expr: parton expr: TBP>>=
procedure :: final => parton_expr_final
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_final (object)
class(parton_expr_t), intent(inout) :: object
end subroutine parton_expr_final
<<Subevt expr: procedures>>=
module subroutine parton_expr_final (object)
class(parton_expr_t), intent(inout) :: object
call object%base_final ()
if (object%has_scale) then
call object%scale%final ()
end if
if (object%has_fac_scale) then
call object%fac_scale%final ()
end if
if (object%has_ren_scale) then
call object%ren_scale%final ()
end if
if (object%has_weight) then
call object%weight%final ()
end if
end subroutine parton_expr_final
@ %def parton_expr_final
@ Output: continue writing the active expressions, after the common selection
expression.
Note: the [[prefix]] argument is declared in the [[write]] method of the
[[subevt_t]] base type. Here, it is unused.
<<Subevt expr: parton expr: TBP>>=
procedure :: write => parton_expr_write
-<<Subevt expr: sub interfaces>>=
+<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_write (object, unit, prefix, pacified)
class(parton_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
end subroutine parton_expr_write
<<Subevt expr: procedures>>=
module subroutine parton_expr_write (object, unit, prefix, pacified)
class(parton_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
call object%base_write (u, pacified = pacified)
if (object%subevt_filled) then
if (object%has_scale) then
call write_separator (u)
write (u, "(1x,A)") "Scale expression:"
call write_separator (u)
call object%scale%write (u)
end if
if (object%has_fac_scale) then
call write_separator (u)
write (u, "(1x,A)") "Factorization scale expression:"
call write_separator (u)
call object%fac_scale%write (u)
end if
if (object%has_ren_scale) then
call write_separator (u)
write (u, "(1x,A)") "Renormalization scale expression:"
call write_separator (u)
call object%ren_scale%write (u)
end if
if (object%has_weight) then
call write_separator (u)
write (u, "(1x,A)") "Weight expression:"
call write_separator (u)
call object%weight%write (u)
end if
end if
end subroutine parton_expr_write
@ %def parton_expr_write
@ Define variables.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_vars => parton_expr_setup_vars
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_setup_vars (expr, sqrts)
class(parton_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
end subroutine parton_expr_setup_vars
<<Subevt expr: procedures>>=
module subroutine parton_expr_setup_vars (expr, sqrts)
class(parton_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%base_setup_vars (sqrts)
end subroutine parton_expr_setup_vars
@ %def parton_expr_setup_vars
@ Compile the scale expressions. If a pointer is disassociated, there is
no expression.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_scale => parton_expr_setup_scale
procedure :: setup_fac_scale => parton_expr_setup_fac_scale
procedure :: setup_ren_scale => parton_expr_setup_ren_scale
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_setup_scale (expr, ef_scale)
class(parton_expr_t), intent(inout), target :: expr
- class(expr_factory_t), intent(in) :: ef_scale
+ class(expr_factory_t), intent(in) :: ef_scale
end subroutine parton_expr_setup_scale
module subroutine parton_expr_setup_fac_scale (expr, ef_fac_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_fac_scale
end subroutine parton_expr_setup_fac_scale
module subroutine parton_expr_setup_ren_scale (expr, ef_ren_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_ren_scale
end subroutine parton_expr_setup_ren_scale
<<Subevt expr: procedures>>=
module subroutine parton_expr_setup_scale (expr, ef_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_scale
call ef_scale%build (expr%scale)
if (allocated (expr%scale)) then
call expr%setup_var_self ()
call expr%scale%setup_expr (expr%var_list)
expr%has_scale = .true.
end if
end subroutine parton_expr_setup_scale
module subroutine parton_expr_setup_fac_scale (expr, ef_fac_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_fac_scale
call ef_fac_scale%build (expr%fac_scale)
if (allocated (expr%fac_scale)) then
call expr%setup_var_self ()
call expr%fac_scale%setup_expr (expr%var_list)
expr%has_fac_scale = .true.
end if
end subroutine parton_expr_setup_fac_scale
module subroutine parton_expr_setup_ren_scale (expr, ef_ren_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_ren_scale
call ef_ren_scale%build (expr%ren_scale)
if (allocated (expr%ren_scale)) then
call expr%setup_var_self ()
call expr%ren_scale%setup_expr (expr%var_list)
expr%has_ren_scale = .true.
end if
end subroutine parton_expr_setup_ren_scale
@ %def parton_expr_setup_scale
@ %def parton_expr_setup_fac_scale
@ %def parton_expr_setup_ren_scale
@ Compile the weight expression.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_weight => parton_expr_setup_weight
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_setup_weight (expr, ef_weight)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_weight
end subroutine parton_expr_setup_weight
<<Subevt expr: procedures>>=
module subroutine parton_expr_setup_weight (expr, ef_weight)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_weight
call ef_weight%build (expr%weight)
if (allocated (expr%weight)) then
call expr%setup_var_self ()
call expr%weight%setup_expr (expr%var_list)
expr%has_weight = .true.
end if
end subroutine parton_expr_setup_weight
@ %def parton_expr_setup_weight
@ Filling the partonic state consists of two parts. The first routine
prepares the subevt without assigning momenta. It takes the particles from an
[[interaction_t]]. It needs the indices and flavors for the beam,
incoming, and outgoing particles.
We can assume that the particle content of the subevt does not change.
Therefore, we set the event variables [[n_in]], [[n_out]], [[n_tot]] already
in this initialization step.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_subevt => parton_expr_setup_subevt
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_setup_subevt (expr, int, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: i_beam, i_in, i_out
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
end subroutine parton_expr_setup_subevt
<<Subevt expr: procedures>>=
module subroutine parton_expr_setup_subevt (expr, int, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: i_beam, i_in, i_out
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
allocate (expr%i_beam (size (i_beam)))
allocate (expr%i_in (size (i_in)))
allocate (expr%i_out (size (i_out)))
expr%i_beam = i_beam
expr%i_in = i_in
expr%i_out = i_out
call interaction_to_subevt (int, &
expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
call expr%set_pdg_beam (f_beam%get_pdg ())
call expr%set_pdg_incoming (f_in%get_pdg ())
call expr%set_pdg_outgoing (f_out%get_pdg ())
call expr%set_p2_beam (f_beam%get_mass () ** 2)
call expr%set_p2_incoming (f_in%get_mass () ** 2)
call expr%set_p2_outgoing (f_out%get_mass () ** 2)
expr%n_in = size (i_in)
expr%n_out = size (i_out)
expr%n_tot = expr%n_in + expr%n_out
end subroutine parton_expr_setup_subevt
@ %def parton_expr_setup_subevt
<<Subevt expr: parton expr: TBP>>=
procedure :: renew_flv_content_subevt => parton_expr_renew_flv_content_subevt
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_renew_flv_content_subevt (expr, int, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: i_beam, i_in, i_out
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
end subroutine parton_expr_renew_flv_content_subevt
<<Subevt expr: procedures>>=
module subroutine parton_expr_renew_flv_content_subevt (expr, int, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: i_beam, i_in, i_out
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
expr%i_beam = i_beam
expr%i_in = i_in
expr%i_out = i_out
call expr%set_pdg_beam (f_beam%get_pdg ())
call expr%set_pdg_incoming (f_in%get_pdg ())
call expr%set_pdg_outgoing (f_out%get_pdg ())
expr%n_in = size (i_in)
expr%n_out = size (i_out)
expr%n_tot = expr%n_in + expr%n_out
end subroutine parton_expr_renew_flv_content_subevt
@ %def parton_expr_renew_flv_content_subevt
@ Transfer PDG codes, masses (initalization) and momenta to a
predefined subevent. We use the flavor assignment of the first
branch in the interaction state matrix. Only incoming and outgoing
particles are transferred. Switch momentum sign for incoming
particles.
<<Subevt expr: interfaces>>=
interface interaction_momenta_to_subevt
module procedure interaction_momenta_to_subevt_id
module procedure interaction_momenta_to_subevt_tr
end interface
<<Subevt expr: sub interfaces>>=
module subroutine interaction_momenta_to_subevt_id &
(int, j_beam, j_in, j_out, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
end subroutine interaction_momenta_to_subevt_id
module subroutine interaction_momenta_to_subevt_tr &
(int, j_beam, j_in, j_out, lt, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
type(lorentz_transformation_t), intent(in) :: lt
end subroutine interaction_momenta_to_subevt_tr
<<Subevt expr: procedures>>=
subroutine interaction_to_subevt (int, j_beam, j_in, j_out, subevt)
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(out) :: subevt
type(flavor_t), dimension(:), allocatable :: flv
integer :: n_beam, n_in, n_out, i, j
allocate (flv (int%get_n_tot ()))
flv = quantum_numbers_get_flavor (int%get_quantum_numbers (1))
n_beam = size (j_beam)
n_in = size (j_in)
n_out = size (j_out)
call subevt_init (subevt, n_beam + n_in + n_out)
do i = 1, n_beam
j = j_beam(i)
call subevt%set_beam (i, flv(j)%get_pdg (), &
vector4_null, flv(j)%get_mass () ** 2)
end do
do i = 1, n_in
j = j_in(i)
call subevt%set_incoming (n_beam + i, flv(j)%get_pdg (), &
vector4_null, flv(j)%get_mass () ** 2)
end do
do i = 1, n_out
j = j_out(i)
call subevt%set_outgoing (n_beam + n_in + i, &
flv(j)%get_pdg (), vector4_null, &
flv(j)%get_mass () ** 2)
end do
end subroutine interaction_to_subevt
module subroutine interaction_momenta_to_subevt_id &
(int, j_beam, j_in, j_out, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
call subevt%set_p_beam (- int%get_momenta (j_beam))
call subevt%set_p_incoming (- int%get_momenta (j_in))
call subevt%set_p_outgoing (int%get_momenta (j_out))
end subroutine interaction_momenta_to_subevt_id
module subroutine interaction_momenta_to_subevt_tr &
(int, j_beam, j_in, j_out, lt, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
type(lorentz_transformation_t), intent(in) :: lt
call subevt%set_p_beam (- lt * int%get_momenta (j_beam))
call subevt%set_p_incoming (- lt * int%get_momenta (j_in))
call subevt%set_p_outgoing (lt * int%get_momenta (j_out))
end subroutine interaction_momenta_to_subevt_tr
@ %def interaction_momenta_to_subevt
@ The second part takes the momenta from the interaction object and thus
completes the subevt. The partonic energy can then be computed.
<<Subevt expr: parton expr: TBP>>=
procedure :: fill_subevt => parton_expr_fill_subevt
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_fill_subevt (expr, int)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
end subroutine parton_expr_fill_subevt
<<Subevt expr: procedures>>=
module subroutine parton_expr_fill_subevt (expr, int)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
call interaction_momenta_to_subevt (int, &
expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
expr%sqrts_hat = expr%get_sqrts_hat ()
expr%subevt_filled = .true.
end subroutine parton_expr_fill_subevt
@ %def parton_expr_fill_subevt
@ Evaluate, if the event passes the selection. For absent expressions we take
default values.
<<Subevt expr: parton expr: TBP>>=
procedure :: evaluate => parton_expr_evaluate
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_evaluate (expr, passed, scale, fac_scale, &
ren_scale, weight, scale_forced, force_evaluation)
class(parton_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: scale
real(default), allocatable, intent(out) :: fac_scale
real(default), allocatable, intent(out) :: ren_scale
real(default), intent(out) :: weight
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
end subroutine parton_expr_evaluate
<<Subevt expr: procedures>>=
module subroutine parton_expr_evaluate (expr, passed, scale, fac_scale, &
ren_scale, weight, scale_forced, force_evaluation)
class(parton_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: scale
real(default), allocatable, intent(out) :: fac_scale
real(default), allocatable, intent(out) :: ren_scale
real(default), intent(out) :: weight
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
logical :: force_scale, force_eval
force_scale = .false.; force_eval = .false.
if (present (scale_forced)) force_scale = allocated (scale_forced)
if (present (force_evaluation)) force_eval = force_evaluation
call expr%base_evaluate (passed)
if (passed .or. force_eval) then
if (force_scale) then
scale = scale_forced
else if (expr%has_scale) then
call expr%scale%evaluate ()
if (expr%scale%is_known ()) then
scale = expr%scale%get_real ()
else
call msg_error ("Evaluate scale expression: result undefined")
scale = zero
end if
else
scale = expr%sqrts_hat
end if
if (expr%has_fac_scale) then
call expr%fac_scale%evaluate ()
if (expr%fac_scale%is_known ()) then
if (.not. allocated (fac_scale)) then
allocate (fac_scale, source = expr%fac_scale%get_real ())
else
fac_scale = expr%fac_scale%get_real ()
end if
else
call msg_error ("Evaluate factorization scale expression: &
&result undefined")
end if
end if
if (expr%has_ren_scale) then
call expr%ren_scale%evaluate ()
if (expr%ren_scale%is_known ()) then
if (.not. allocated (ren_scale)) then
allocate (ren_scale, source = expr%ren_scale%get_real ())
else
ren_scale = expr%ren_scale%get_real ()
end if
else
call msg_error ("Evaluate renormalization scale expression: &
&result undefined")
end if
end if
if (expr%has_weight) then
call expr%weight%evaluate ()
if (expr%weight%is_known ()) then
weight = expr%weight%get_real ()
else
call msg_error ("Evaluate weight expression: result undefined")
weight = zero
end if
else
weight = one
end if
else
weight = zero
end if
end subroutine parton_expr_evaluate
@ %def parton_expr_evaluate
@ Return the beam/incoming parton indices.
<<Subevt expr: parton expr: TBP>>=
procedure :: get_beam_index => parton_expr_get_beam_index
procedure :: get_in_index => parton_expr_get_in_index
<<Subevt expr: sub interfaces>>=
module subroutine parton_expr_get_beam_index (expr, i_beam)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_beam
end subroutine parton_expr_get_beam_index
module subroutine parton_expr_get_in_index (expr, i_in)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_in
end subroutine parton_expr_get_in_index
<<Subevt expr: procedures>>=
module subroutine parton_expr_get_beam_index (expr, i_beam)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_beam
i_beam = expr%i_beam
end subroutine parton_expr_get_beam_index
module subroutine parton_expr_get_in_index (expr, i_in)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_in
i_in = expr%i_in
end subroutine parton_expr_get_in_index
@ %def parton_expr_get_beam_index
@ %def parton_expr_get_in_index
@
\subsection{Implementation for full events}
This implementation contains the expressions that we can evaluate for the
full event. It also contains data that pertain to the event, suitable
for communication with external event formats. These data
simultaneously serve as pointer targets for the variable lists hidden
in the expressions (eval trees).
Squared matrix element and weight values: when reading events from
file, the [[ref]] value is the number in the file, while the [[prc]]
value is the number that we calculate from the momenta in the file,
possibly with different parameters. When generating events the first
time, or if we do not recalculate, the numbers should coincide.
Furthermore, the array of [[alt]] values is copied from an array of
alternative event records. These values should represent calculated
values.
<<Subevt expr: public>>=
public :: event_expr_t
<<Subevt expr: types>>=
type, extends (subevt_expr_t) :: event_expr_t
logical :: has_reweight = .false.
logical :: has_analysis = .false.
class(expr_t), allocatable :: reweight
class(expr_t), allocatable :: analysis
logical :: has_id = .false.
type(string_t) :: id
logical :: has_num_id = .false.
integer :: num_id = 0
logical :: has_index = .false.
integer :: index = 0
logical :: has_sqme_ref = .false.
real(default) :: sqme_ref = 0
logical :: has_sqme_prc = .false.
real(default) :: sqme_prc = 0
logical :: has_weight_ref = .false.
real(default) :: weight_ref = 0
logical :: has_weight_prc = .false.
real(default) :: weight_prc = 0
logical :: has_excess_prc = .false.
real(default) :: excess_prc = 0
integer :: n_alt = 0
logical :: has_sqme_alt = .false.
real(default), dimension(:), allocatable :: sqme_alt
logical :: has_weight_alt = .false.
real(default), dimension(:), allocatable :: weight_alt
contains
<<Subevt expr: event expr: TBP>>
end type event_expr_t
@ %def event_expr_t
@ Finalizer for the expressions.
<<Subevt expr: event expr: TBP>>=
procedure :: final => event_expr_final
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_final (object)
class(event_expr_t), intent(inout) :: object
end subroutine event_expr_final
<<Subevt expr: procedures>>=
module subroutine event_expr_final (object)
class(event_expr_t), intent(inout) :: object
call object%base_final ()
if (object%has_reweight) then
call object%reweight%final ()
end if
if (object%has_analysis) then
call object%analysis%final ()
end if
end subroutine event_expr_final
@ %def event_expr_final
@ Output: continue writing the active expressions, after the common selection
expression.
Note: the [[prefix]] argument is declared in the [[write]] method of the
[[subevt_t]] base type. Here, it is unused.
<<Subevt expr: event expr: TBP>>=
procedure :: write => event_expr_write
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_write (object, unit, prefix, pacified)
class(event_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
end subroutine event_expr_write
<<Subevt expr: procedures>>=
module subroutine event_expr_write (object, unit, prefix, pacified)
class(event_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
call object%base_write (u, pacified = pacified)
if (object%subevt_filled) then
if (object%has_reweight) then
call write_separator (u)
write (u, "(1x,A)") "Reweighting expression:"
call write_separator (u)
call object%reweight%write (u)
end if
if (object%has_analysis) then
call write_separator (u)
write (u, "(1x,A)") "Analysis expression:"
call write_separator (u)
call object%analysis%write (u)
end if
end if
end subroutine event_expr_write
@ %def event_expr_write
@ Initializer. This is required only for the [[sqme_alt]] and
[[weight_alt]] arrays.
<<Subevt expr: event expr: TBP>>=
procedure :: init => event_expr_init
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_init (expr, n_alt)
class(event_expr_t), intent(out) :: expr
integer, intent(in), optional :: n_alt
end subroutine event_expr_init
<<Subevt expr: procedures>>=
module subroutine event_expr_init (expr, n_alt)
class(event_expr_t), intent(out) :: expr
integer, intent(in), optional :: n_alt
if (present (n_alt)) then
expr%n_alt = n_alt
allocate (expr%sqme_alt (n_alt), source = 0._default)
allocate (expr%weight_alt (n_alt), source = 0._default)
end if
end subroutine event_expr_init
@ %def event_expr_init
@ Define variables. We have the variables of the base type plus
specific variables for full events. There is the event index.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_vars => event_expr_setup_vars
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_setup_vars (expr, sqrts)
class(event_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
end subroutine event_expr_setup_vars
<<Subevt expr: procedures>>=
module subroutine event_expr_setup_vars (expr, sqrts)
class(event_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%base_setup_vars (sqrts)
call expr%var_list%append_string_ptr (var_str ("$process_id"), &
expr%id, is_known = expr%has_id, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_int_ptr (var_str ("process_num_id"), &
expr%num_id, is_known = expr%has_num_id, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_real_ptr (var_str ("sqme"), &
expr%sqme_prc, is_known = expr%has_sqme_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_real_ptr (var_str ("sqme_ref"), &
expr%sqme_ref, is_known = expr%has_sqme_ref, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_int_ptr (var_str ("event_index"), &
expr%index, is_known = expr%has_index, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_real_ptr (var_str ("event_weight"), &
expr%weight_prc, is_known = expr%has_weight_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_real_ptr (var_str ("event_weight_ref"), &
expr%weight_ref, is_known = expr%has_weight_ref, &
locked = .true., verbose = .false., intrinsic = .true.)
call expr%var_list%append_real_ptr (var_str ("event_excess"), &
expr%excess_prc, is_known = expr%has_excess_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
end subroutine event_expr_setup_vars
@ %def event_expr_setup_vars
@ Compile the analysis expression. If the pointer is disassociated, there is
no expression.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_analysis => event_expr_setup_analysis
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_setup_analysis (expr, ef_analysis)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_analysis
end subroutine event_expr_setup_analysis
<<Subevt expr: procedures>>=
module subroutine event_expr_setup_analysis (expr, ef_analysis)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_analysis
call ef_analysis%build (expr%analysis)
if (allocated (expr%analysis)) then
call expr%setup_var_self ()
call expr%analysis%setup_lexpr (expr%var_list)
expr%has_analysis = .true.
end if
end subroutine event_expr_setup_analysis
@ %def event_expr_setup_analysis
@ Compile the reweight expression.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_reweight => event_expr_setup_reweight
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_setup_reweight (expr, ef_reweight)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_reweight
end subroutine event_expr_setup_reweight
<<Subevt expr: procedures>>=
module subroutine event_expr_setup_reweight (expr, ef_reweight)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_reweight
call ef_reweight%build (expr%reweight)
if (allocated (expr%reweight)) then
call expr%setup_var_self ()
call expr%reweight%setup_expr (expr%var_list)
expr%has_reweight = .true.
end if
end subroutine event_expr_setup_reweight
@ %def event_expr_setup_reweight
@ Store the string or numeric process ID. This should be done during
initialization.
<<Subevt expr: event expr: TBP>>=
procedure :: set_process_id => event_expr_set_process_id
procedure :: set_process_num_id => event_expr_set_process_num_id
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_set_process_id (expr, id)
class(event_expr_t), intent(inout) :: expr
type(string_t), intent(in) :: id
end subroutine event_expr_set_process_id
module subroutine event_expr_set_process_num_id (expr, num_id)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: num_id
end subroutine event_expr_set_process_num_id
<<Subevt expr: procedures>>=
module subroutine event_expr_set_process_id (expr, id)
class(event_expr_t), intent(inout) :: expr
type(string_t), intent(in) :: id
expr%id = id
expr%has_id = .true.
end subroutine event_expr_set_process_id
module subroutine event_expr_set_process_num_id (expr, num_id)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: num_id
expr%num_id = num_id
expr%has_num_id = .true.
end subroutine event_expr_set_process_num_id
@ %def event_expr_set_process_id
@ %def event_expr_set_process_num_id
@ Reset / set the data that pertain to a particular event. The event
index is reset unless explicitly told to keep it.
<<Subevt expr: event expr: TBP>>=
procedure :: reset_contents => event_expr_reset_contents
procedure :: set => event_expr_set
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_reset_contents (expr)
class(event_expr_t), intent(inout) :: expr
end subroutine event_expr_reset_contents
module subroutine event_expr_set (expr, &
weight_ref, weight_prc, weight_alt, &
excess_prc, &
sqme_ref, sqme_prc, sqme_alt)
class(event_expr_t), intent(inout) :: expr
real(default), intent(in), optional :: weight_ref, weight_prc
real(default), intent(in), optional :: excess_prc
real(default), intent(in), optional :: sqme_ref, sqme_prc
real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
end subroutine event_expr_set
<<Subevt expr: procedures>>=
module subroutine event_expr_reset_contents (expr)
class(event_expr_t), intent(inout) :: expr
call expr%base_reset_contents ()
expr%has_sqme_ref = .false.
expr%has_sqme_prc = .false.
expr%has_sqme_alt = .false.
expr%has_weight_ref = .false.
expr%has_weight_prc = .false.
expr%has_weight_alt = .false.
expr%has_excess_prc = .false.
end subroutine event_expr_reset_contents
module subroutine event_expr_set (expr, &
weight_ref, weight_prc, weight_alt, &
excess_prc, &
sqme_ref, sqme_prc, sqme_alt)
class(event_expr_t), intent(inout) :: expr
real(default), intent(in), optional :: weight_ref, weight_prc
real(default), intent(in), optional :: excess_prc
real(default), intent(in), optional :: sqme_ref, sqme_prc
real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
if (present (sqme_ref)) then
expr%has_sqme_ref = .true.
expr%sqme_ref = sqme_ref
end if
if (present (sqme_prc)) then
expr%has_sqme_prc = .true.
expr%sqme_prc = sqme_prc
end if
if (present (sqme_alt)) then
expr%has_sqme_alt = .true.
expr%sqme_alt = sqme_alt
end if
if (present (weight_ref)) then
expr%has_weight_ref = .true.
expr%weight_ref = weight_ref
end if
if (present (weight_prc)) then
expr%has_weight_prc = .true.
expr%weight_prc = weight_prc
end if
if (present (weight_alt)) then
expr%has_weight_alt = .true.
expr%weight_alt = weight_alt
end if
if (present (excess_prc)) then
expr%has_excess_prc = .true.
expr%excess_prc = excess_prc
end if
end subroutine event_expr_set
@ %def event_expr_reset_contents event_expr_set
@ Access the subevent index.
<<Subevt expr: event expr: TBP>>=
procedure :: has_event_index => event_expr_has_event_index
procedure :: get_event_index => event_expr_get_event_index
<<Subevt expr: sub interfaces>>=
module function event_expr_has_event_index (expr) result (flag)
class(event_expr_t), intent(in) :: expr
logical :: flag
end function event_expr_has_event_index
module function event_expr_get_event_index (expr) result (index)
class(event_expr_t), intent(in) :: expr
integer :: index
end function event_expr_get_event_index
<<Subevt expr: procedures>>=
module function event_expr_has_event_index (expr) result (flag)
class(event_expr_t), intent(in) :: expr
logical :: flag
flag = expr%has_index
end function event_expr_has_event_index
module function event_expr_get_event_index (expr) result (index)
class(event_expr_t), intent(in) :: expr
integer :: index
if (expr%has_index) then
index = expr%index
else
index = 0
end if
end function event_expr_get_event_index
@ %def event_expr_has_event_index
@ %def event_expr_get_event_index
@ Set/increment the subevent index. Initialize it if necessary.
<<Subevt expr: event expr: TBP>>=
procedure :: set_event_index => event_expr_set_event_index
procedure :: reset_event_index => event_expr_reset_event_index
procedure :: increment_event_index => event_expr_increment_event_index
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_set_event_index (expr, index)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: index
end subroutine event_expr_set_event_index
module subroutine event_expr_reset_event_index (expr)
class(event_expr_t), intent(inout) :: expr
end subroutine event_expr_reset_event_index
module subroutine event_expr_increment_event_index (expr, offset)
class(event_expr_t), intent(inout) :: expr
integer, intent(in), optional :: offset
end subroutine event_expr_increment_event_index
<<Subevt expr: procedures>>=
module subroutine event_expr_set_event_index (expr, index)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: index
expr%index = index
expr%has_index = .true.
end subroutine event_expr_set_event_index
module subroutine event_expr_reset_event_index (expr)
class(event_expr_t), intent(inout) :: expr
expr%has_index = .false.
end subroutine event_expr_reset_event_index
module subroutine event_expr_increment_event_index (expr, offset)
class(event_expr_t), intent(inout) :: expr
integer, intent(in), optional :: offset
if (expr%has_index) then
expr%index = expr%index + 1
else if (present (offset)) then
call expr%set_event_index (offset + 1)
else
call expr%set_event_index (1)
end if
end subroutine event_expr_increment_event_index
@ %def event_expr_set_event_index
@ %def event_expr_increment_event_index
@ Fill the event expression: take the particle data and kinematics
from a [[particle_set]] object.
We allow the particle content to change for each event. Therefore, we set the
event variables each time.
Also increment the event index; initialize it if necessary.
<<Subevt expr: event expr: TBP>>=
procedure :: fill_subevt => event_expr_fill_subevt
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_fill_subevt (expr, particle_set)
class(event_expr_t), intent(inout) :: expr
type(particle_set_t), intent(in) :: particle_set
end subroutine event_expr_fill_subevt
<<Subevt expr: procedures>>=
module subroutine event_expr_fill_subevt (expr, particle_set)
class(event_expr_t), intent(inout) :: expr
type(particle_set_t), intent(in) :: particle_set
call particle_set%to_subevt (expr%subevt_t, expr%colorize_subevt)
expr%sqrts_hat = expr%get_sqrts_hat ()
expr%n_in = expr%get_n_in ()
expr%n_out = expr%get_n_out ()
expr%n_tot = expr%n_in + expr%n_out
expr%subevt_filled = .true.
end subroutine event_expr_fill_subevt
@ %def event_expr_fill_subevt
@ Evaluate, if the event passes the selection. For absent expressions we take
default values.
<<Subevt expr: event expr: TBP>>=
procedure :: evaluate => event_expr_evaluate
<<Subevt expr: sub interfaces>>=
module subroutine event_expr_evaluate &
(expr, passed, reweight, analysis_flag)
class(event_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: reweight
logical, intent(out) :: analysis_flag
end subroutine event_expr_evaluate
<<Subevt expr: procedures>>=
module subroutine event_expr_evaluate (expr, passed, reweight, analysis_flag)
class(event_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: reweight
logical, intent(out) :: analysis_flag
call expr%base_evaluate (passed)
if (passed) then
if (expr%has_reweight) then
call expr%reweight%evaluate ()
if (expr%reweight%is_known ()) then
reweight = expr%reweight%get_real ()
else
call msg_error ("Evaluate reweight expression: &
&result undefined")
reweight = 0
end if
else
reweight = 1
end if
if (expr%has_analysis) then
call expr%analysis%evaluate ()
if (expr%analysis%is_known ()) then
analysis_flag = expr%analysis%get_log ()
else
call msg_error ("Evaluate analysis expression: &
&result undefined")
analysis_flag = .false.
end if
else
analysis_flag = .true.
end if
end if
end subroutine event_expr_evaluate
@ %def event_expr_evaluate
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Parton states}
A [[parton_state_t]] object contains the effective kinematics and
dynamics of an elementary partonic interaction, with or without the
beam/structure function state included. The type is abstract and has
two distinct extensions. The [[isolated_state_t]] extension describes
the isolated elementary interaction where the [[int_eff]] subobject
contains the complex transition amplitude, exclusive in all quantum
numbers. The particle content and kinematics describe the effective
partonic state. The [[connected_state_t]] extension contains the
partonic [[subevt]] and the expressions for cuts and scales which use
it.
In the isolated state, the effective partonic interaction may either
be identical to the hard interaction, in which case it is just a
pointer to the latter. Or it may involve a rearrangement of partons,
in which case we allocate it explicitly and flag this by
[[int_is_allocated]].
The [[trace]] evaluator contains the absolute square of the effective
transition amplitude matrix, summed over final states. It is also summed over
initial states, depending on the the beam setup allows. The result is used for
integration.
The [[matrix]] evaluator is the counterpart of [[trace]] which is kept
exclusive in all observable quantum numbers. The [[flows]] evaluator is
furthermore exclusive in colors, but neglecting all color interference. The
[[matrix]] and [[flows]] evaluators are filled only for sampling points that
become part of physical events.
Note: It would be natural to make the evaluators allocatable. The extra
[[has_XXX]] flags indicate whether evaluators are active, instead.
This module contains no unit tests. The tests are covered by the
[[processes]] module below.
<<[[parton_states.f90]]>>=
<<File header>>
module parton_states
<<Use kinds>>
use variables
use expr_base
use model_data
use flavors
use quantum_numbers
use state_matrices
use interactions
use evaluators
use beams
use sf_base
use prc_core
use subevt_expr
<<Standard module head>>
<<Parton states: public>>
<<Parton states: types>>
interface
<<Parton states: sub interfaces>>
end interface
end module parton_states
@ %def parton_states
@
<<[[parton_states_sub.f90]]>>=
<<File header>>
submodule (parton_states) parton_states_s
<<Use debug>>
use io_units
use format_utils, only: write_separator
use diagnostics
use lorentz
use subevents
use helicities
use colors
use polarizations
use process_constants
implicit none
contains
<<Parton states: procedures>>
end submodule parton_states_s
@ %def parton_states_s
@
\subsection{Abstract base type}
The common part are the evaluators, one for the trace (summed over all
quantum numbers), one for the transition matrix (summed only over
unobservable quantum numbers), and one for the flow distribution
(transition matrix without interferences, exclusive in color flow).
<<Parton states: types>>=
type, abstract :: parton_state_t
logical :: has_trace = .false.
logical :: has_matrix = .false.
logical :: has_flows = .false.
type(evaluator_t) :: trace
type(evaluator_t) :: matrix
type(evaluator_t) :: flows
contains
<<Parton states: parton state: TBP>>
end type parton_state_t
@ %def parton_state_t
@ The [[isolated_state_t]] extension contains the [[sf_chain_eff]] object
and the (hard) effective interaction [[int_eff]], separately, both are
implemented as a pointer. The evaluators (trace, matrix, flows) apply
to the hard interaction only.
If the effective interaction differs from the hard interaction, the
pointer is allocated explicitly. Analogously for [[sf_chain_eff]].
<<Parton states: public>>=
public :: isolated_state_t
<<Parton states: types>>=
type, extends (parton_state_t) :: isolated_state_t
logical :: sf_chain_is_allocated = .false.
type(sf_chain_instance_t), pointer :: sf_chain_eff => null ()
logical :: int_is_allocated = .false.
type(interaction_t), pointer :: int_eff => null ()
contains
<<Parton states: isolated state: TBP>>
end type isolated_state_t
@ %def isolated_state_t
@ The [[connected_state_t]] extension contains all data that enable
the evaluation of observables for the effective connected state. The
evaluators connect the (effective) structure-function chain and hard
interaction that were kept separate in the [[isolated_state_t]].
The [[flows_sf]] evaluator is an extended copy of the
structure-function
The [[expr]] subobject consists of the [[subevt]], a simple event record,
expressions for cuts etc.\ which refer to this record, and a [[var_list]]
which contains event-specific variables, linked to the process variable
list. Variables used within the expressions are looked up in [[var_list]].
<<Parton states: public>>=
public :: connected_state_t
<<Parton states: types>>=
type, extends (parton_state_t) :: connected_state_t
type(state_flv_content_t) :: state_flv
logical :: has_flows_sf = .false.
type(evaluator_t) :: flows_sf
logical :: has_expr = .false.
type(parton_expr_t) :: expr
contains
<<Parton states: connected state: TBP>>
end type connected_state_t
@ %def connected_state_t
@ Output: each evaluator is written only when it is active. The
[[sf_chain]] is only written if it is explicitly allocated.
<<Parton states: parton state: TBP>>=
procedure :: write => parton_state_write
<<Parton states: sub interfaces>>=
module subroutine parton_state_write (state, unit, testflag)
class(parton_state_t), intent(in) :: state
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine parton_state_write
<<Parton states: procedures>>=
module subroutine parton_state_write (state, unit, testflag)
class(parton_state_t), intent(in) :: state
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
select type (state)
class is (isolated_state_t)
if (state%sf_chain_is_allocated) then
call write_separator (u)
call state%sf_chain_eff%write (u)
end if
if (state%int_is_allocated) then
call write_separator (u)
write (u, "(1x,A)") &
"Effective interaction:"
call write_separator (u)
call state%int_eff%basic_write (u, testflag = testflag)
end if
class is (connected_state_t)
if (state%has_flows_sf) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (extension of the beam evaluator &
&with color contractions):"
call write_separator (u)
call state%flows_sf%write (u, testflag = testflag)
end if
end select
if (state%has_trace) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (trace of the squared transition matrix):"
call write_separator (u)
call state%trace%write (u, testflag = testflag)
end if
if (state%has_matrix) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (squared transition matrix):"
call write_separator (u)
call state%matrix%write (u, testflag = testflag)
end if
if (state%has_flows) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (squared color-flow matrix):"
call write_separator (u)
call state%flows%write (u, testflag = testflag)
end if
select type (state)
class is (connected_state_t)
if (state%has_expr) then
call write_separator (u)
call state%expr%write (u)
end if
end select
end subroutine parton_state_write
@ %def parton_state_write
@ Finalize interaction and evaluators, but only if allocated.
<<Parton states: parton state: TBP>>=
procedure :: final => parton_state_final
<<Parton states: sub interfaces>>=
module subroutine parton_state_final (state)
class(parton_state_t), intent(inout) :: state
end subroutine parton_state_final
<<Parton states: procedures>>=
module subroutine parton_state_final (state)
class(parton_state_t), intent(inout) :: state
if (state%has_flows) then
call state%flows%final ()
state%has_flows = .false.
end if
if (state%has_matrix) then
call state%matrix%final ()
state%has_matrix = .false.
end if
if (state%has_trace) then
call state%trace%final ()
state%has_trace = .false.
end if
select type (state)
class is (connected_state_t)
if (state%has_flows_sf) then
call state%flows_sf%final ()
state%has_flows_sf = .false.
end if
call state%expr%final ()
class is (isolated_state_t)
if (state%int_is_allocated) then
call state%int_eff%final ()
deallocate (state%int_eff)
state%int_is_allocated = .false.
end if
if (state%sf_chain_is_allocated) then
call state%sf_chain_eff%final ()
end if
end select
end subroutine parton_state_final
@ %def parton_state_final
@
\subsection{Common Initialization}
Initialize the isolated parton state. In this version, the
effective structure-function chain [[sf_chain_eff]] and the effective
interaction [[int_eff]] both are trivial pointers to the seed
structure-function chain and to the hard interaction, respectively.
<<Parton states: isolated state: TBP>>=
procedure :: init => isolated_state_init
<<Parton states: sub interfaces>>=
module subroutine isolated_state_init (state, sf_chain, int)
class(isolated_state_t), intent(out) :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(interaction_t), intent(in), target :: int
end subroutine isolated_state_init
<<Parton states: procedures>>=
module subroutine isolated_state_init (state, sf_chain, int)
class(isolated_state_t), intent(out) :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(interaction_t), intent(in), target :: int
state%sf_chain_eff => sf_chain
state%int_eff => int
end subroutine isolated_state_init
@ %def isolated_state_init
@
\subsection{Evaluator initialization: isolated state}
Create an evaluator for the trace of the squared transition matrix.
The trace goes over all outgoing quantum numbers. Whether we trace
over incoming quantum numbers other than color, depends on the given
[[qn_mask_in]].
There are two options: explicitly computing the color factor table
([[use_cf]] false; [[nc]] defined), or taking the color factor
table from the hard matrix element data.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_trace => isolated_state_setup_square_trace
<<Parton states: sub interfaces>>=
module subroutine isolated_state_setup_square_trace (state, core, &
qn_mask_in, col, keep_fs_flavor)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
integer, intent(in), dimension(:), allocatable :: col
logical, intent(in) :: keep_fs_flavor
end subroutine isolated_state_setup_square_trace
<<Parton states: procedures>>=
module subroutine isolated_state_setup_square_trace (state, core, &
qn_mask_in, col, keep_fs_flavor)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
!!! Actually need allocatable attribute here for once because col might
!!! enter the subroutine non-allocated.
integer, intent(in), dimension(:), allocatable :: col
logical, intent(in) :: keep_fs_flavor
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
qn_mask( : data%n_in) = &
quantum_numbers_mask (.false., .true., .false.) &
.or. qn_mask_in
qn_mask(data%n_in + 1 : ) = &
quantum_numbers_mask (.not. keep_fs_flavor, .true., .true.)
if (core%use_color_factors) then
call state%trace%init_square (state%int_eff, qn_mask, &
col_flow_index = data%cf_index, &
col_factor = data%color_factors, &
col_index_hi = col, &
nc = core%nc)
else
call state%trace%init_square (state%int_eff, qn_mask, nc = core%nc)
end if
end associate
state%has_trace = .true.
end subroutine isolated_state_setup_square_trace
@ %def isolated_state_setup_square_trace
@ Set up an identity-evaluator for the trace. This implies that [[me]]
is considered to be a squared amplitude, as for example for BLHA matrix
elements.
<<Parton states: isolated state: TBP>>=
procedure :: setup_identity_trace => isolated_state_setup_identity_trace
<<Parton states: sub interfaces>>=
module subroutine isolated_state_setup_identity_trace (state, core, &
qn_mask_in, keep_fs_flavors, keep_colors)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
logical, intent(in), optional :: keep_fs_flavors, keep_colors
end subroutine isolated_state_setup_identity_trace
<<Parton states: procedures>>=
module subroutine isolated_state_setup_identity_trace (state, core, &
qn_mask_in, keep_fs_flavors, keep_colors)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
logical, intent(in), optional :: keep_fs_flavors, keep_colors
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
logical :: fs_flv_flag, col_flag
fs_flv_flag = .true.; col_flag = .true.
if (present(keep_fs_flavors)) fs_flv_flag = .not. keep_fs_flavors
if (present(keep_colors)) col_flag = .not. keep_colors
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
qn_mask( : data%n_in) = &
quantum_numbers_mask (.false., col_flag, .false.) .or. qn_mask_in
qn_mask(data%n_in + 1 : ) = &
quantum_numbers_mask (fs_flv_flag, col_flag, .true.)
end associate
call state%int_eff%set_mask (qn_mask)
call state%trace%init_identity (state%int_eff)
state%has_trace = .true.
end subroutine isolated_state_setup_identity_trace
@ %def isolated_state_setup_identity_trace
@ Set up the evaluator for the transition matrix, exclusive in
helicities where this is requested.
For all unstable final-state particles we keep polarization according to the
applicable decay options. If the process is a decay itself, this applies also
to the initial state.
For all polarized final-state particles, we keep polarization including
off-diagonal entries. We drop helicity completely for unpolarized final-state
particles.
For the initial state, if the particle has not been handled yet, we
apply the provided [[qn_mask_in]] which communicates the beam properties.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_matrix => isolated_state_setup_square_matrix
<<Parton states: sub interfaces>>=
module subroutine isolated_state_setup_square_matrix &
(state, core, model, qn_mask_in, col)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
integer, dimension(:), intent(in) :: col
end subroutine isolated_state_setup_square_matrix
<<Parton states: procedures>>=
module subroutine isolated_state_setup_square_matrix &
(state, core, model, qn_mask_in, col)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
integer, dimension(:), intent(in) :: col
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
logical :: helmask, helmask_hd
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
allocate (flv (data%n_flv))
do i = 1, data%n_in + data%n_out
call flv%init (data%flv_state(i,:), model)
if ((data%n_in == 1 .or. i > data%n_in) &
.and. any (.not. flv%is_stable ())) then
helmask = all (flv%decays_isotropically ())
helmask_hd = all (flv%decays_diagonal ())
qn_mask(i) = quantum_numbers_mask (.false., .true., helmask, &
mask_hd = helmask_hd)
else if (i > data%n_in) then
helmask = all (.not. flv%is_polarized ())
qn_mask(i) = quantum_numbers_mask (.false., .true., helmask)
else
qn_mask(i) = quantum_numbers_mask (.false., .true., .false.) &
.or. qn_mask_in(i)
end if
end do
if (core%use_color_factors) then
call state%matrix%init_square (state%int_eff, qn_mask, &
col_flow_index = data%cf_index, &
col_factor = data%color_factors, &
col_index_hi = col, &
nc = core%nc)
else
call state%matrix%init_square (state%int_eff, &
qn_mask, &
nc = core%nc)
end if
end associate
state%has_matrix = .true.
end subroutine isolated_state_setup_square_matrix
@ %def isolated_state_setup_square_matrix
@ This procedure initializes the evaluator that computes the
contributions to color flows, neglecting color interference.
The incoming-particle mask can be used to sum over incoming flavor.
Helicity handling: see above.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_flows => isolated_state_setup_square_flows
<<Parton states: sub interfaces>>=
module subroutine isolated_state_setup_square_flows &
(state, core, model, qn_mask_in)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
end subroutine isolated_state_setup_square_flows
<<Parton states: procedures>>=
module subroutine isolated_state_setup_square_flows &
(state, core, model, qn_mask_in)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
logical :: helmask, helmask_hd
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
allocate (flv (data%n_flv))
do i = 1, data%n_in + data%n_out
call flv%init (data%flv_state(i,:), model)
if ((data%n_in == 1 .or. i > data%n_in) &
.and. any (.not. flv%is_stable ())) then
helmask = all (flv%decays_isotropically ())
helmask_hd = all (flv%decays_diagonal ())
qn_mask(i) = quantum_numbers_mask (.false., .false., helmask, &
mask_hd = helmask_hd)
else if (i > data%n_in) then
helmask = all (.not. flv%is_polarized ())
qn_mask(i) = quantum_numbers_mask (.false., .false., helmask)
else
qn_mask(i) = quantum_numbers_mask (.false., .false., .false.) &
.or. qn_mask_in(i)
end if
end do
call state%flows%init_square (state%int_eff, qn_mask, &
expand_color_flows = .true.)
end associate
state%has_flows = .true.
end subroutine isolated_state_setup_square_flows
@ %def isolated_state_setup_square_flows
@
\subsection{Evaluator initialization: connected state}
Set up a trace evaluator as a product of two evaluators (incoming state,
effective interaction). In the result, all quantum numbers are summed over.
If the optional [[int]] interaction is provided, use this for the
first factor in the convolution. Otherwise, use the final interaction
of the stored [[sf_chain]].
The [[resonant]] flag applies if we want to construct
a decay chain. The resonance property can propagate to the final
event output.
If an extended structure function is required [[requires_extended_sf]],
we have to not consider [[sub]] as a quantum number.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_trace => connected_state_setup_connected_trace
<<Parton states: sub interfaces>>=
module subroutine connected_state_setup_connected_trace &
(state, isolated, int, resonant, undo_helicities, &
keep_fs_flavors, requires_extended_sf)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
logical, intent(in), optional :: undo_helicities
logical, intent(in), optional :: keep_fs_flavors
logical, intent(in), optional :: requires_extended_sf
end subroutine connected_state_setup_connected_trace
<<Parton states: procedures>>=
module subroutine connected_state_setup_connected_trace &
(state, isolated, int, resonant, undo_helicities, &
keep_fs_flavors, requires_extended_sf)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
logical, intent(in), optional :: undo_helicities
logical, intent(in), optional :: keep_fs_flavors
logical, intent(in), optional :: requires_extended_sf
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int, beam_int
logical :: reduce, fs_flv_flag
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
"connected_state_setup_connected_trace")
reduce = .false.; fs_flv_flag = .true.
if (present (undo_helicities)) reduce = undo_helicities
if (present (keep_fs_flavors)) fs_flv_flag = .not. keep_fs_flavors
mask = quantum_numbers_mask (fs_flv_flag, .true., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
end if
if (debug2_active (D_PROCESS_INTEGRATION)) then
call src_int%basic_write ()
end if
call state%trace%init_product (src_int, isolated%trace, &
qn_mask_conn = mask, &
qn_mask_rest = mask, &
connections_are_resonant = resonant, &
ignore_sub_for_qn = requires_extended_sf)
if (reduce) then
beam_int => isolated%sf_chain_eff%get_beam_int_ptr ()
call undo_qn_hel (beam_int, mask, beam_int%get_n_tot ())
call undo_qn_hel (src_int, mask, src_int%get_n_tot ())
call beam_int%set_matrix_element (cmplx (1, 0, default))
call src_int%set_matrix_element (cmplx (1, 0, default))
end if
state%has_trace = .true.
contains
subroutine undo_qn_hel (int_in, mask, n_tot)
type(interaction_t), intent(inout) :: int_in
type(quantum_numbers_mask_t), intent(in) :: mask
integer, intent(in) :: n_tot
type(quantum_numbers_mask_t), dimension(n_tot) :: mask_in
mask_in = mask
call int_in%set_mask (mask_in)
end subroutine undo_qn_hel
end subroutine connected_state_setup_connected_trace
@ %def connected_state_setup_connected_trace
@ Set up a matrix evaluator as a product of two evaluators (incoming
state, effective interation). In the intermediate state, color and
helicity is summed over. In the final state, we keep the quantum
numbers which are present in the original evaluators.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_matrix => connected_state_setup_connected_matrix
<<Parton states: sub interfaces>>=
module subroutine connected_state_setup_connected_matrix &
(state, isolated, int, resonant, qn_filter_conn)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
end subroutine connected_state_setup_connected_matrix
<<Parton states: procedures>>=
module subroutine connected_state_setup_connected_matrix &
(state, isolated, int, resonant, qn_filter_conn)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int
mask = quantum_numbers_mask (.false., .true., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
end if
call state%matrix%init_product &
(src_int, isolated%matrix, mask, &
qn_filter_conn = qn_filter_conn, &
connections_are_resonant = resonant)
state%has_matrix = .true.
end subroutine connected_state_setup_connected_matrix
@ %def connected_state_setup_connected_matrix
@ Set up a matrix evaluator as a product of two evaluators (incoming
state, effective interation). In the intermediate state, only
helicity is summed over. In the final state, we keep the quantum
numbers which are present in the original evaluators.
If the optional [[int]] interaction is provided, use this for the
first factor in the convolution. Otherwise, use the final interaction
of the stored [[sf_chain]], after creating an intermediate interaction
that includes a correlated color state. We assume that for a
caller-provided [[int]], this is not necessary.
For fixed-order NLO differential distribution, we are interested at
the partonic level, no parton showering takes place as this would
demand for a proper matching. So, the flows in the [[connected_state]]
are not needed, and the color part will be masked for the interaction
coming from the [[sf_chain]]. The squared matrix elements coming from
the OLP provider at the moment do not come with flows anyhow. This
needs to be revised once the matching to the shower is completed.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_flows => connected_state_setup_connected_flows
<<Parton states: sub interfaces>>=
module subroutine connected_state_setup_connected_flows &
(state, isolated, int, resonant, qn_filter_conn, mask_color)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant, mask_color
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
end subroutine connected_state_setup_connected_flows
<<Parton states: procedures>>=
module subroutine connected_state_setup_connected_flows &
(state, isolated, int, resonant, qn_filter_conn, mask_color)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant, mask_color
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
type(quantum_numbers_mask_t) :: mask
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_sf
type(interaction_t), pointer :: src_int
logical :: mask_c
mask_c = .false.
if (present (mask_color)) mask_c = mask_color
mask = quantum_numbers_mask (.false., .false., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
call state%flows_sf%init_color_contractions (src_int)
state%has_flows_sf = .true.
src_int => state%flows_sf%interaction_t
if (mask_c) then
allocate (mask_sf (src_int%get_n_tot ()))
mask_sf = quantum_numbers_mask (.false., .true., .false.)
call src_int%reduce_state_matrix (mask_sf, keep_order = .true.)
end if
end if
call state%flows%init_product (src_int, isolated%flows, mask, &
qn_filter_conn = qn_filter_conn, &
connections_are_resonant = resonant)
state%has_flows = .true.
end subroutine connected_state_setup_connected_flows
@ %def connected_state_setup_connected_flows
@ Determine and store the flavor content for the connected state.
This queries the [[matrix]] evaluator component, which should hold the
requested flavor information.
<<Parton states: connected state: TBP>>=
procedure :: setup_state_flv => connected_state_setup_state_flv
<<Parton states: sub interfaces>>=
module subroutine connected_state_setup_state_flv (state, n_out_hard)
class(connected_state_t), intent(inout), target :: state
integer, intent(in) :: n_out_hard
end subroutine connected_state_setup_state_flv
<<Parton states: procedures>>=
module subroutine connected_state_setup_state_flv (state, n_out_hard)
class(connected_state_t), intent(inout), target :: state
integer, intent(in) :: n_out_hard
call state%matrix%get_flv_content (state%state_flv, n_out_hard)
end subroutine connected_state_setup_state_flv
@ %def connected_state_setup_state_flv
@ Return the current flavor state object.
<<Parton states: connected state: TBP>>=
procedure :: get_state_flv => connected_state_get_state_flv
<<Parton states: sub interfaces>>=
module function connected_state_get_state_flv (state) result (state_flv)
class(connected_state_t), intent(in) :: state
type(state_flv_content_t) :: state_flv
end function connected_state_get_state_flv
<<Parton states: procedures>>=
module function connected_state_get_state_flv (state) result (state_flv)
class(connected_state_t), intent(in) :: state
type(state_flv_content_t) :: state_flv
state_flv = state%state_flv
end function connected_state_get_state_flv
@ %def connected_state_get_state_flv
@
\subsection{Cuts and expressions}
Set up the [[subevt]] that corresponds to the connected interaction.
The index arrays refer to the interaction.
We assign the particles as follows: the beam particles are the first
two (decay process: one) entries in the trace evaluator. The incoming
partons are identified by their link to the outgoing partons of the
structure-function chain. The outgoing partons are those of the trace
evaluator, which include radiated partons during the
structure-function chain.
<<Parton states: connected state: TBP>>=
procedure :: setup_subevt => connected_state_setup_subevt
<<Parton states: sub interfaces>>=
module subroutine connected_state_setup_subevt &
(state, sf_chain, f_beam, f_in, f_out)
class(connected_state_t), intent(inout), target :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
end subroutine connected_state_setup_subevt
<<Parton states: procedures>>=
module subroutine connected_state_setup_subevt &
(state, sf_chain, f_beam, f_in, f_out)
class(connected_state_t), intent(inout), target :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
integer :: n_beam, n_in, n_out, n_vir, n_tot, i, j
integer, dimension(:), allocatable :: i_beam, i_in, i_out
integer :: sf_out_i
type(interaction_t), pointer :: sf_int
sf_int => sf_chain%get_out_int_ptr ()
n_beam = size (f_beam)
n_in = size (f_in)
n_out = size (f_out)
n_vir = state%trace%get_n_vir ()
n_tot = state%trace%get_n_tot ()
allocate (i_beam (n_beam), i_in (n_in), i_out (n_out))
i_beam = [(i, i = 1, n_beam)]
do j = 1, n_in
sf_out_i = sf_chain%get_out_i (j)
i_in(j) = interaction_find_link &
(state%trace%interaction_t, sf_int, sf_out_i)
end do
i_out = [(i, i = n_vir + 1, n_tot)]
call state%expr%setup_subevt (state%trace%interaction_t, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
state%has_expr = .true.
end subroutine connected_state_setup_subevt
@ %def connected_state_setup_subevt
<<Parton states: connected state: TBP>>=
procedure :: renew_flv_content_subevt => &
connected_state_renew_flv_content_subevt
<<Parton states: sub interfaces>>=
module subroutine connected_state_renew_flv_content_subevt &
(state, sf_chain, f_beam, f_in, f_out)
class(connected_state_t), intent(inout), target :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
end subroutine connected_state_renew_flv_content_subevt
<<Parton states: procedures>>=
module subroutine connected_state_renew_flv_content_subevt &
(state, sf_chain, f_beam, f_in, f_out)
class(connected_state_t), intent(inout), target :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
integer :: n_beam, n_in, n_out, n_vir, n_tot, i, j
integer, dimension(:), allocatable :: i_beam, i_in, i_out
integer :: sf_out_i
type(interaction_t), pointer :: sf_int
sf_int => sf_chain%get_out_int_ptr ()
n_beam = size (f_beam)
n_in = size (f_in)
n_out = size (f_out)
n_vir = state%trace%get_n_vir ()
n_tot = state%trace%get_n_tot ()
allocate (i_beam (n_beam), i_in (n_in), i_out (n_out))
i_beam = [(i, i = 1, n_beam)]
do j = 1, n_in
sf_out_i = sf_chain%get_out_i (j)
i_in(j) = interaction_find_link &
(state%trace%interaction_t, sf_int, sf_out_i)
end do
i_out = [(i, i = n_vir + 1, n_tot)]
call state%expr%renew_flv_content_subevt (state%trace%interaction_t, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
state%has_expr = .true.
end subroutine connected_state_renew_flv_content_subevt
@ %def connected_state_setup_subevt
@ Initialize the variable list specific for this state/term. We insert event
variables ([[sqrts_hat]]) and link the process variable list. The variable
list acquires pointers to subobjects of [[state]], which must therefore have a
[[target]] attribute.
<<Parton states: connected state: TBP>>=
procedure :: setup_var_list => connected_state_setup_var_list
<<Parton states: sub interfaces>>=
module subroutine connected_state_setup_var_list &
(state, process_var_list, beam_data)
class(connected_state_t), intent(inout), target :: state
type(var_list_t), intent(in), target :: process_var_list
type(beam_data_t), intent(in) :: beam_data
end subroutine connected_state_setup_var_list
<<Parton states: procedures>>=
module subroutine connected_state_setup_var_list &
(state, process_var_list, beam_data)
class(connected_state_t), intent(inout), target :: state
type(var_list_t), intent(in), target :: process_var_list
type(beam_data_t), intent(in) :: beam_data
call state%expr%setup_vars (beam_data%get_sqrts ())
call state%expr%link_var_list (process_var_list)
end subroutine connected_state_setup_var_list
@ %def connected_state_setup_var_list
@ Allocate the cut expression etc.
<<Parton states: connected state: TBP>>=
procedure :: setup_cuts => connected_state_setup_cuts
procedure :: setup_scale => connected_state_setup_scale
procedure :: setup_fac_scale => connected_state_setup_fac_scale
procedure :: setup_ren_scale => connected_state_setup_ren_scale
procedure :: setup_weight => connected_state_setup_weight
<<Parton states: sub interfaces>>=
module subroutine connected_state_setup_cuts (state, ef_cuts)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_cuts
end subroutine connected_state_setup_cuts
module subroutine connected_state_setup_scale (state, ef_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_scale
end subroutine connected_state_setup_scale
module subroutine connected_state_setup_fac_scale (state, ef_fac_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_fac_scale
end subroutine connected_state_setup_fac_scale
module subroutine connected_state_setup_ren_scale (state, ef_ren_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_ren_scale
end subroutine connected_state_setup_ren_scale
module subroutine connected_state_setup_weight (state, ef_weight)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_weight
end subroutine connected_state_setup_weight
<<Parton states: procedures>>=
module subroutine connected_state_setup_cuts (state, ef_cuts)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_cuts
call state%expr%setup_selection (ef_cuts)
end subroutine connected_state_setup_cuts
module subroutine connected_state_setup_scale (state, ef_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_scale
call state%expr%setup_scale (ef_scale)
end subroutine connected_state_setup_scale
module subroutine connected_state_setup_fac_scale (state, ef_fac_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_fac_scale
call state%expr%setup_fac_scale (ef_fac_scale)
end subroutine connected_state_setup_fac_scale
module subroutine connected_state_setup_ren_scale (state, ef_ren_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_ren_scale
call state%expr%setup_ren_scale (ef_ren_scale)
end subroutine connected_state_setup_ren_scale
module subroutine connected_state_setup_weight (state, ef_weight)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_weight
call state%expr%setup_weight (ef_weight)
end subroutine connected_state_setup_weight
@ %def connected_state_setup_expressions
@ Reset the expression object: invalidate the subevt.
<<Parton states: connected state: TBP>>=
procedure :: reset_expressions => connected_state_reset_expressions
<<Parton states: sub interfaces>>=
module subroutine connected_state_reset_expressions (state)
class(connected_state_t), intent(inout) :: state
end subroutine connected_state_reset_expressions
<<Parton states: procedures>>=
module subroutine connected_state_reset_expressions (state)
class(connected_state_t), intent(inout) :: state
if (state%has_expr) call state%expr%reset_contents ()
end subroutine connected_state_reset_expressions
@ %def connected_state_reset_expressions
@
\subsection{Evaluation}
Transfer momenta to the trace evaluator and fill the [[subevt]] with
this effective kinematics, if applicable.
Note: we may want to apply a boost for the [[subevt]].
<<Parton states: parton state: TBP>>=
procedure :: receive_kinematics => parton_state_receive_kinematics
<<Parton states: sub interfaces>>=
module subroutine parton_state_receive_kinematics (state)
class(parton_state_t), intent(inout), target :: state
end subroutine parton_state_receive_kinematics
<<Parton states: procedures>>=
module subroutine parton_state_receive_kinematics (state)
class(parton_state_t), intent(inout), target :: state
if (state%has_trace) then
call state%trace%receive_momenta ()
select type (state)
class is (connected_state_t)
if (state%has_expr) then
call state%expr%fill_subevt (state%trace%interaction_t)
end if
end select
end if
end subroutine parton_state_receive_kinematics
@ %def parton_state_receive_kinematics
@ Recover kinematics: We assume that the trace evaluator is filled
with momenta. Send those momenta back to the sources, then fill the
variables and subevent as above.
The incoming momenta of the connected state are not connected to the
isolated state but to the beam interaction. Therefore, the incoming
momenta within the isolated state do not become defined, yet.
Instead, we reconstruct the beam (and ISR) momentum configuration.
<<Parton states: parton state: TBP>>=
procedure :: send_kinematics => parton_state_send_kinematics
<<Parton states: sub interfaces>>=
module subroutine parton_state_send_kinematics (state)
class(parton_state_t), intent(inout), target :: state
end subroutine parton_state_send_kinematics
<<Parton states: procedures>>=
module subroutine parton_state_send_kinematics (state)
class(parton_state_t), intent(inout), target :: state
if (state%has_trace) then
call state%trace%send_momenta ()
select type (state)
class is (connected_state_t)
call state%expr%fill_subevt (state%trace%interaction_t)
end select
end if
end subroutine parton_state_send_kinematics
@ %def parton_state_send_kinematics
@ Evaluate the expressions. The routine evaluates first the cut expression.
If the event passes, it evaluates the other expressions. Where no expressions
are defined, default values are inserted.
<<Parton states: connected state: TBP>>=
procedure :: evaluate_expressions => connected_state_evaluate_expressions
<<Parton states: sub interfaces>>=
module subroutine connected_state_evaluate_expressions (state, passed, &
scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
class(connected_state_t), intent(inout) :: state
logical, intent(out) :: passed
real(default), intent(out) :: scale, weight
real(default), intent(out), allocatable :: fac_scale, ren_scale
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
end subroutine connected_state_evaluate_expressions
<<Parton states: procedures>>=
module subroutine connected_state_evaluate_expressions (state, passed, &
scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
class(connected_state_t), intent(inout) :: state
logical, intent(out) :: passed
real(default), intent(out) :: scale, weight
real(default), intent(out), allocatable :: fac_scale, ren_scale
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
if (state%has_expr) then
call state%expr%evaluate (passed, scale, fac_scale, ren_scale, weight, &
scale_forced, force_evaluation)
end if
end subroutine connected_state_evaluate_expressions
@ %def connected_state_evaluate_expressions
@ Evaluate the structure-function chain, if it is allocated
explicitly. The argument is the factorization scale.
If the chain is merely a pointer, the chain should already be
evaluated at this point.
<<Parton states: isolated state: TBP>>=
procedure :: evaluate_sf_chain => isolated_state_evaluate_sf_chain
<<Parton states: sub interfaces>>=
module subroutine isolated_state_evaluate_sf_chain (state, fac_scale)
class(isolated_state_t), intent(inout) :: state
real(default), intent(in) :: fac_scale
end subroutine isolated_state_evaluate_sf_chain
<<Parton states: procedures>>=
module subroutine isolated_state_evaluate_sf_chain (state, fac_scale)
class(isolated_state_t), intent(inout) :: state
real(default), intent(in) :: fac_scale
if (state%sf_chain_is_allocated) &
call state%sf_chain_eff%evaluate (fac_scale)
end subroutine isolated_state_evaluate_sf_chain
@ %def isolated_state_evaluate_sf_chain
@ Evaluate the trace.
<<Parton states: parton state: TBP>>=
procedure :: evaluate_trace => parton_state_evaluate_trace
<<Parton states: sub interfaces>>=
module subroutine parton_state_evaluate_trace (state)
class(parton_state_t), intent(inout) :: state
end subroutine parton_state_evaluate_trace
<<Parton states: procedures>>=
module subroutine parton_state_evaluate_trace (state)
class(parton_state_t), intent(inout) :: state
if (state%has_trace) call state%trace%evaluate ()
end subroutine parton_state_evaluate_trace
@ %def parton_state_evaluate_trace
<<Parton states: parton state: TBP>>=
procedure :: evaluate_matrix => parton_state_evaluate_matrix
<<Parton states: sub interfaces>>=
module subroutine parton_state_evaluate_matrix (state)
class(parton_state_t), intent(inout) :: state
end subroutine parton_state_evaluate_matrix
<<Parton states: procedures>>=
module subroutine parton_state_evaluate_matrix (state)
class(parton_state_t), intent(inout) :: state
if (state%has_matrix) call state%matrix%evaluate ()
end subroutine parton_state_evaluate_matrix
@ %def parton_state_evaluate_matrix
@ Evaluate the extra evaluators that we need for physical events.
<<Parton states: parton state: TBP>>=
procedure :: evaluate_event_data => parton_state_evaluate_event_data
<<Parton states: sub interfaces>>=
module subroutine parton_state_evaluate_event_data (state, only_momenta)
class(parton_state_t), intent(inout) :: state
logical, intent(in), optional :: only_momenta
end subroutine parton_state_evaluate_event_data
<<Parton states: procedures>>=
module subroutine parton_state_evaluate_event_data (state, only_momenta)
class(parton_state_t), intent(inout) :: state
logical, intent(in), optional :: only_momenta
logical :: only_mom
only_mom = .false.; if (present (only_momenta)) only_mom = only_momenta
select type (state)
type is (connected_state_t)
if (state%has_flows_sf) then
call state%flows_sf%receive_momenta ()
if (.not. only_mom) call state%flows_sf%evaluate ()
end if
end select
if (state%has_matrix) then
call state%matrix%receive_momenta ()
if (.not. only_mom) call state%matrix%evaluate ()
end if
if (state%has_flows) then
call state%flows%receive_momenta ()
if (.not. only_mom) call state%flows%evaluate ()
end if
end subroutine parton_state_evaluate_event_data
@ %def parton_state_evaluate_event_data
@ Normalize the helicity density matrix by its trace, i.e., factor out
the trace and put it into an overall normalization factor. The trace
and flow evaluators are unchanged.
<<Parton states: parton state: TBP>>=
procedure :: normalize_matrix_by_trace => &
parton_state_normalize_matrix_by_trace
<<Parton states: sub interfaces>>=
module subroutine parton_state_normalize_matrix_by_trace (state)
class(parton_state_t), intent(inout) :: state
end subroutine parton_state_normalize_matrix_by_trace
<<Parton states: procedures>>=
module subroutine parton_state_normalize_matrix_by_trace (state)
class(parton_state_t), intent(inout) :: state
if (state%has_matrix) call state%matrix%normalize_by_trace ()
end subroutine parton_state_normalize_matrix_by_trace
@ %def parton_state_normalize_matrix_by_trace
@
\subsection{Accessing the state}
Three functions return a pointer to the event-relevant interactions.
<<Parton states: parton state: TBP>>=
procedure :: get_trace_int_ptr => parton_state_get_trace_int_ptr
procedure :: get_matrix_int_ptr => parton_state_get_matrix_int_ptr
procedure :: get_flows_int_ptr => parton_state_get_flows_int_ptr
<<Parton states: sub interfaces>>=
module function parton_state_get_trace_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
end function parton_state_get_trace_int_ptr
module function parton_state_get_matrix_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
end function parton_state_get_matrix_int_ptr
module function parton_state_get_flows_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
end function parton_state_get_flows_int_ptr
<<Parton states: procedures>>=
module function parton_state_get_trace_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_trace) then
ptr => state%trace%interaction_t
else
ptr => null ()
end if
end function parton_state_get_trace_int_ptr
module function parton_state_get_matrix_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_matrix) then
ptr => state%matrix%interaction_t
else
ptr => null ()
end if
end function parton_state_get_matrix_int_ptr
module function parton_state_get_flows_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_flows) then
ptr => state%flows%interaction_t
else
ptr => null ()
end if
end function parton_state_get_flows_int_ptr
@ %def parton_state_get_trace_int_ptr
@ %def parton_state_get_matrix_int_ptr
@ %def parton_state_get_flows_int_ptr
@ Return the indices of the beam particles and the outgoing particles within
the trace (and thus, matrix and flows) evaluator, respectively.
<<Parton states: connected state: TBP>>=
procedure :: get_beam_index => connected_state_get_beam_index
procedure :: get_in_index => connected_state_get_in_index
<<Parton states: sub interfaces>>=
module subroutine connected_state_get_beam_index (state, i_beam)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_beam
end subroutine connected_state_get_beam_index
module subroutine connected_state_get_in_index (state, i_in)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_in
end subroutine connected_state_get_in_index
<<Parton states: procedures>>=
module subroutine connected_state_get_beam_index (state, i_beam)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_beam
call state%expr%get_beam_index (i_beam)
end subroutine connected_state_get_beam_index
module subroutine connected_state_get_in_index (state, i_in)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_in
call state%expr%get_in_index (i_in)
end subroutine connected_state_get_in_index
@ %def connected_state_get_beam_index
@ %def connected_state_get_in_index
@
<<Parton states: public>>=
public :: refill_evaluator
<<Parton states: sub interfaces>>=
module subroutine refill_evaluator (sqme, qn, flv_index, evaluator)
complex(default), intent(in), dimension(:) :: sqme
type(quantum_numbers_t), intent(in), dimension(:,:) :: qn
integer, intent(in), dimension(:), optional :: flv_index
type(evaluator_t), intent(inout) :: evaluator
end subroutine refill_evaluator
<<Parton states: procedures>>=
module subroutine refill_evaluator (sqme, qn, flv_index, evaluator)
complex(default), intent(in), dimension(:) :: sqme
type(quantum_numbers_t), intent(in), dimension(:,:) :: qn
integer, intent(in), dimension(:), optional :: flv_index
type(evaluator_t), intent(inout) :: evaluator
integer :: i, i_flv
do i = 1, size (sqme)
if (present (flv_index)) then
i_flv = flv_index(i)
else
i_flv = i
end if
call evaluator%add_to_matrix_element (qn(:,i_flv), sqme(i), &
match_only_flavor = .true.)
end do
end subroutine refill_evaluator
@ %def refill_evaluator
@ Return the number of outgoing (hard) particles for the state.
<<Parton states: parton state: TBP>>=
procedure :: get_n_out => parton_state_get_n_out
<<Parton states: sub interfaces>>=
module function parton_state_get_n_out (state) result (n)
class(parton_state_t), intent(in), target :: state
integer :: n
end function parton_state_get_n_out
<<Parton states: procedures>>=
module function parton_state_get_n_out (state) result (n)
class(parton_state_t), intent(in), target :: state
integer :: n
n = state%trace%get_n_out ()
end function parton_state_get_n_out
@ %def parton_state_get_n_out
@
\subsection{Unit tests}
<<[[parton_states_ut.f90]]>>=
<<File header>>
module parton_states_ut
use unit_tests
use parton_states_uti
<<Standard module head>>
<<Parton states: public test>>
contains
<<Parton states: test driver>>
end module parton_states_ut
@ %def parton_states_ut
<<[[parton_states_uti.f90]]>>=
<<File header>>
module parton_states_uti
<<Use kinds>>
<<Use strings>>
use constants, only: zero
use numeric_utils
use flavors
use colors
use helicities
use quantum_numbers
use sf_base, only: sf_chain_instance_t
use state_matrices, only: state_matrix_t
use prc_template_me, only: prc_template_me_t
use interactions, only: interaction_t
use models, only: model_t, create_test_model
use parton_states
<<Standard module head>>
<<Parton states: test declarations>>
contains
<<Parton states: tests>>
end module parton_states_uti
@ %def parton_states_uti
@
<<Parton states: public test>>=
public :: parton_states_test
<<Parton states: test driver>>=
subroutine parton_states_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Parton states: execute tests>>
end subroutine parton_states_test
@ %def parton_states_test
@
\subsubsection{Test a simple isolated state}
<<Parton states: execute tests>>=
call test (parton_states_1, "parton_states_1", &
"Create a 2 -> 2 isolated state and compute trace", &
u, results)
<<Parton states: test declarations>>=
public :: parton_states_1
<<Parton states: tests>>=
subroutine parton_states_1 (u)
integer, intent(in) :: u
type(state_matrix_t), allocatable :: state
type(flavor_t), dimension(2) :: flv_in
type(flavor_t), dimension(2) :: flv_out1, flv_out2
type(flavor_t), dimension(4) :: flv_tot
type(helicity_t), dimension(4) :: hel
type(color_t), dimension(4) :: col
integer :: h1, h2, h3, h4
integer :: f
integer :: i
type(quantum_numbers_t), dimension(4) :: qn
type(prc_template_me_t) :: core
type(sf_chain_instance_t), target :: sf_chain
type(interaction_t), target :: int
type(isolated_state_t) :: isolated_state
integer :: n_states = 0
integer, dimension(:), allocatable :: col_flow_index
type(quantum_numbers_mask_t), dimension(2) :: qn_mask
integer, dimension(8) :: i_allowed_states
complex(default), dimension(8) :: me
complex(default) :: me_check_tot, me_check_1, me_check_2, me2
logical :: tmp1, tmp2
type(model_t), pointer :: test_model => null ()
write (u, "(A)") "* Test output: parton_states_1"
write (u, "(A)") "* Purpose: Test the standard parton states"
write (u, "(A)")
call flv_in%init ([11, -11])
call flv_out1%init ([1, -1])
call flv_out2%init ([2, -2])
write (u, "(A)") "* Using incoming flavors: "
call flavor_write_array (flv_in, u)
write (u, "(A)") "* Two outgoing flavor structures: "
call flavor_write_array (flv_out1, u)
call flavor_write_array (flv_out2, u)
write (u, "(A)") "* Initialize state matrix"
allocate (state)
call state%init ()
write (u, "(A)") "* Fill state matrix"
call col(3)%init ([1])
call col(4)%init ([-1])
do f = 1, 2
do h1 = -1, 1, 2
do h2 = -1, 1, 2
do h3 = -1, 1, 2
do h4 = -1, 1, 2
n_states = n_states + 1
call hel%init ([h1, h2, h3, h4], [h1, h2, h3, h4])
if (f == 1) then
flv_tot = [flv_in, flv_out1]
else
flv_tot = [flv_in, flv_out2]
end if
call qn%init (flv_tot, col, hel)
call state%add_state (qn)
end do
end do
end do
end do
end do
!!! Two flavors, one color flow, 2 x 2 x 2 x 2 helicity configurations
!!! -> 32 states.
write (u, "(A)")
write (u, "(A,I2)") "* Generated number of states: ", n_states
call state%freeze ()
!!! Indices of the helicity configurations which are non-zero
i_allowed_states = [6, 7, 10, 11, 22, 23, 26, 27]
me = [cmplx (-1.89448E-5_default, 9.94456E-7_default, default), &
cmplx (-8.37887E-2_default, 4.30842E-3_default, default), &
cmplx (-1.99997E-1_default, -1.01985E-2_default, default), &
cmplx ( 1.79717E-5_default, 9.27038E-7_default, default), &
cmplx (-1.74859E-5_default, 8.78819E-7_default, default), &
cmplx ( 1.67577E-1_default, -8.61683E-3_default, default), &
cmplx ( 2.41331E-1_default, 1.23306E-2_default, default), &
cmplx (-3.59435E-5_default, -1.85407E-6_default, default)]
me_check_tot = cmplx (zero, zero, default)
me_check_1 = cmplx (zero, zero, default)
me_check_2 = cmplx (zero, zero, default)
do i = 1, 8
me2 = me(i) * conjg (me(i))
me_check_tot = me_check_tot + me2
if (i < 5) then
me_check_1 = me_check_1 + me2
else
me_check_2 = me_check_2 + me2
end if
call state%set_matrix_element (i_allowed_states(i), me(i))
end do
!!! Do not forget the color factor
me_check_tot = 3._default * me_check_tot
me_check_1 = 3._default * me_check_1
me_check_2 = 3._default * me_check_2
write (u, "(A)")
write (u, "(A)") "* Setup interaction"
call int%basic_init (2, 0, 2, set_relations = .true.)
call int%set_state_matrix (state)
core%data%n_in = 2; core%data%n_out = 2
core%data%n_flv = 2
allocate (core%data%flv_state (4, 2))
core%data%flv_state (1, :) = [11, 11]
core%data%flv_state (2, :) = [-11, -11]
core%data%flv_state (3, :) = [1, 2]
core%data%flv_state (4, :) = [-1, -2]
core%use_color_factors = .false.
core%nc = 3
write (u, "(A)") "* Init isolated state"
call isolated_state%init (sf_chain, int)
!!! There is only one color flow.
allocate (col_flow_index (n_states)); col_flow_index = 1
call qn_mask%init (.false., .false., .true., mask_cg = .false.)
write (u, "(A)") "* Give a trace to the isolated state"
call isolated_state%setup_square_trace (core, qn_mask, col_flow_index, .false.)
call isolated_state%evaluate_trace ()
write (u, "(A)")
write (u, "(A)", advance = "no") "* Squared matrix element correct: "
write (u, "(L1)") nearly_equal (me_check_tot, &
isolated_state%trace%get_matrix_element (1), rel_smallness = 0.00001_default)
write (u, "(A)") "* Give a matrix to the isolated state"
call create_test_model (var_str ("SM"), test_model)
call isolated_state%setup_square_matrix (core, test_model, qn_mask, col_flow_index)
call isolated_state%evaluate_matrix ()
write (u, "(A)") "* Sub-matrixelements correct: "
tmp1 = nearly_equal (me_check_1, &
isolated_state%matrix%get_matrix_element (1), rel_smallness = 0.00001_default)
tmp2 = nearly_equal (me_check_2, &
isolated_state%matrix%get_matrix_element (2), rel_smallness = 0.00001_default)
write (u, "(A,L1,A,L1)") "* 1: ", tmp1, ", 2: ", tmp2
write (u, "(A)") "* Test output end: parton_states_1"
end subroutine parton_states_1
@ %def parton_states_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process component management}
This module contains tools for managing and combining process
components and matrix-element code and values, acting at a level below
the actual process definition.
\subsection{Abstract base type}
The types introduced here are abstract base types.
<<[[pcm_base.f90]]>>=
<<File header>>
module pcm_base
<<Use kinds>>
<<Use strings>>
use os_interface, only: os_data_t
use process_libraries, only: process_library_t
use prc_core_def
use prc_core
use variables, only: var_list_t
use mappings, only: mapping_defaults_t
use phs_base, only: phs_config_t
use phs_forests, only: phs_parameters_t
use mci_base, only: mci_t
use model_data, only: model_data_t
use models, only: model_t
use blha_config, only: blha_master_t
use blha_olp_interfaces, only: blha_template_t
use process_config
use process_mci, only: process_mci_entry_t
<<Standard module head>>
<<PCM base: public>>
<<PCM base: parameters>>
<<PCM base: types>>
<<PCM base: interfaces>>
interface
<<PCM base: sub interfaces>>
end interface
end module pcm_base
@ %def pcm_base
@
<<[[pcm_base_sub.f90]]>>=
<<File header>>
submodule (pcm_base) pcm_base_s
use io_units
use diagnostics
use format_utils, only: write_integer_array
use format_utils, only: write_separator
use physics_defs, only: BORN, NLO_REAL
implicit none
contains
<<PCM base: procedures>>
end submodule pcm_base_s
@ %def pcm_base_s
@
\subsection{Core management}
This object holds information about the cores used by the components
and allocates the corresponding manager instance.
[[i_component]] is the index of the process component which this core belongs
to. The pointer to the core definition is a convenient help in configuring
the core itself.
We allow for a [[blha_config]] configuration object that covers BLHA cores.
The BLHA standard is suitable generic to warrant support outside of specific
type extension (i.e., applies to LO and NLO if requested). The BLHA
configuration is allocated only if the core requires it.
<<PCM base: public>>=
public :: core_entry_t
<<PCM base: types>>=
type :: core_entry_t
integer :: i_component = 0
logical :: active = .false.
class(prc_core_def_t), pointer :: core_def => null ()
type(blha_template_t), allocatable :: blha_config
class(prc_core_t), allocatable :: core
contains
<<PCM base: core entry: TBP>>
end type core_entry_t
@ %def core_entry_t
@
<<PCM base: core entry: TBP>>=
procedure :: get_core_ptr => core_entry_get_core_ptr
<<PCM base: sub interfaces>>=
module function core_entry_get_core_ptr (core_entry) result (core)
class(core_entry_t), intent(in), target :: core_entry
class(prc_core_t), pointer :: core
end function core_entry_get_core_ptr
<<PCM base: procedures>>=
module function core_entry_get_core_ptr (core_entry) result (core)
class(core_entry_t), intent(in), target :: core_entry
class(prc_core_t), pointer :: core
if (allocated (core_entry%core)) then
core => core_entry%core
else
core => null ()
end if
end function core_entry_get_core_ptr
@ %def core_entry_get_core_ptr
@ Configure the core object after allocation with correct type. The
[[core_def]] object pointer and the index [[i_component]] of the associated
process component are already there.
<<PCM base: core entry: TBP>>=
procedure :: configure => core_entry_configure
<<PCM base: sub interfaces>>=
module subroutine core_entry_configure (core_entry, lib, id)
class(core_entry_t), intent(inout) :: core_entry
type(process_library_t), intent(in), target :: lib
type(string_t), intent(in) :: id
end subroutine core_entry_configure
<<PCM base: procedures>>=
module subroutine core_entry_configure (core_entry, lib, id)
class(core_entry_t), intent(inout) :: core_entry
type(process_library_t), intent(in), target :: lib
type(string_t), intent(in) :: id
call core_entry%core%init &
(core_entry%core_def, lib, id, core_entry%i_component)
end subroutine core_entry_configure
@ %def core_entry_configure
@
\subsection{Process component manager}
The process-component manager [[pcm]] is the master component of the
[[process_t]] object. It serves two purposes:
\begin{enumerate}
\item
It holds configuration data which allow us to centrally manage the
components, terms, etc.\ of the process object.
\item
It implements the methods that realize the algorithm for constructing
the process object and computing an integral. This algorithm makes
use of the data stored within [[pcm]].
\end{enumerate}
To this end, the object is abstract and polymorphic. The two
extensions that we support, implement (a) default tree-level
calculation, optionally including a sum over sub-processes with
different particle content, or (b) the FKS-NLO subtraction algorithm for
QCD-corrected processes. In both cases, the type extensions may hold
suitable further data.
Data included in the base type:
The number of components determines the [[component_selected]] array.
[[i_phs_config]] is a lookup table that holds the PHS configuration index
for a given component index.
[[i_core]] is a lookup table that holds the core-entry index for a
given component index.
[[i_mci]] is a lookup table that holds the integrator (MCI) index for
a given component index.
<<PCM base: public>>=
public :: pcm_t
<<PCM base: types>>=
type, abstract :: pcm_t
logical :: initialized = .false.
logical :: has_pdfs = .false.
integer :: n_components = 0
integer :: n_cores = 0
integer :: n_mci = 0
logical, dimension(:), allocatable :: component_selected
logical, dimension(:), allocatable :: component_active
integer, dimension(:), allocatable :: i_phs_config
integer, dimension(:), allocatable :: i_core
integer, dimension(:), allocatable :: i_mci
type(blha_template_t) :: blha_defaults
logical :: uses_blha = .false.
type(os_data_t) :: os_data
contains
<<PCM base: pcm: TBP>>
end type pcm_t
@ %def pcm_t
@ The factory method. We use the [[inout]] intent, so calling this
again is an error.
<<PCM base: pcm: TBP>>=
procedure(pcm_allocate_workspace), deferred :: allocate_workspace
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_allocate_workspace (pcm, work)
import
class(pcm_t), intent(in) :: pcm
class(pcm_workspace_t), intent(inout), allocatable :: work
end subroutine pcm_allocate_workspace
end interface
@ %def pcm_allocate_workspace
@
<<PCM base: pcm: TBP>>=
procedure(pcm_is_nlo), deferred :: is_nlo
<<PCM base: interfaces>>=
abstract interface
function pcm_is_nlo (pcm) result (is_nlo)
import
logical :: is_nlo
class(pcm_t), intent(in) :: pcm
end function pcm_is_nlo
end interface
@ %def pcm_is_nlo
@
<<PCM base: pcm: TBP>>=
procedure(pcm_final), deferred :: final
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_final (pcm)
import
class(pcm_t), intent(inout) :: pcm
end subroutine pcm_final
end interface
@ %def pcm_final
@
\subsection{Initialization methods}
The PCM has the duty to coordinate and configure the process-object
components.
Initialize the PCM configuration itself, using environment data.
<<PCM base: pcm: TBP>>=
procedure(pcm_init), deferred :: init
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_init (pcm, env, meta)
import
class(pcm_t), intent(out) :: pcm
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
end subroutine pcm_init
end interface
@ %def pcm_init
@
Initialize the BLHA configuration block, the component-independent default
settings. This is to be called by [[pcm_init]]. We use the provided variable
list.
This block is filled regardless of whether BLHA is actually used, because why
not? We use a default value for the scheme (not set in unit tests).
<<PCM base: pcm: TBP>>=
procedure :: set_blha_defaults => pcm_set_blha_defaults
<<PCM base: sub interfaces>>=
module subroutine pcm_set_blha_defaults (pcm, polarized_beams, var_list)
class(pcm_t), intent(inout) :: pcm
type(var_list_t), intent(in) :: var_list
logical, intent(in) :: polarized_beams
end subroutine pcm_set_blha_defaults
<<PCM base: procedures>>=
module subroutine pcm_set_blha_defaults (pcm, polarized_beams, var_list)
class(pcm_t), intent(inout) :: pcm
type(var_list_t), intent(in) :: var_list
logical, intent(in) :: polarized_beams
logical :: muon_yukawa_off
real(default) :: top_yukawa
type(string_t) :: ew_scheme
muon_yukawa_off = &
var_list%get_lval (var_str ("?openloops_switch_off_muon_yukawa"))
top_yukawa = &
var_list%get_rval (var_str ("blha_top_yukawa"))
ew_scheme = &
var_list%get_sval (var_str ("$blha_ew_scheme"))
if (ew_scheme == "") ew_scheme = "Gmu"
call pcm%blha_defaults%init &
(polarized_beams, muon_yukawa_off, top_yukawa, ew_scheme)
end subroutine pcm_set_blha_defaults
@ %def pcm_set_blha_defaults
@ Read the method settings from the variable list and store them in the BLHA
master. The details depend on the [[pcm]] concrete type.
<<PCM base: pcm: TBP>>=
procedure(pcm_set_blha_methods), deferred :: set_blha_methods
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_set_blha_methods (pcm, blha_master, var_list)
import
class(pcm_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
end subroutine pcm_set_blha_methods
end interface
@ %def pcm_set_blha_methods
@ Produce the LO and NLO flavor-state tables (as far as available), as
appropriate for BLHA configuration. We may inspect either the PCM itself or
the array of process cores.
<<PCM base: pcm: TBP>>=
procedure(pcm_get_blha_flv_states), deferred :: get_blha_flv_states
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_get_blha_flv_states (pcm, core_entry, flv_born, flv_real)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
end subroutine pcm_get_blha_flv_states
end interface
@ %def pcm_get_blha_flv_states
@
Allocate the right number of process components. The number is also stored in
the process meta. Initially, all components are active but none are
selected.
<<PCM base: pcm: TBP>>=
procedure :: allocate_components => pcm_allocate_components
<<PCM base: sub interfaces>>=
module subroutine pcm_allocate_components (pcm, comp, meta)
class(pcm_t), intent(inout) :: pcm
type(process_component_t), dimension(:), allocatable, intent(out) :: comp
type(process_metadata_t), intent(in) :: meta
end subroutine pcm_allocate_components
<<PCM base: procedures>>=
module subroutine pcm_allocate_components (pcm, comp, meta)
class(pcm_t), intent(inout) :: pcm
type(process_component_t), dimension(:), allocatable, intent(out) :: comp
type(process_metadata_t), intent(in) :: meta
pcm%n_components = meta%n_components
allocate (comp (pcm%n_components))
allocate (pcm%component_selected (pcm%n_components), source = .false.)
allocate (pcm%component_active (pcm%n_components), source = .true.)
end subroutine pcm_allocate_components
@ %def pcm_allocate_components
@ Each process component belongs to a category/type, which we identify by a
universal integer constant. The categories can be taken from the process
definition. For easy lookup, we store the categories in an array.
<<PCM base: pcm: TBP>>=
procedure(pcm_categorize_components), deferred :: categorize_components
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_categorize_components (pcm, config)
import
class(pcm_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
end subroutine pcm_categorize_components
end interface
@ %def pcm_categorize_components
@
Allocate the right number and type(s) of process-core
objects, i.e., the interface object between the process and matrix-element
code.
Within the [[pcm]] block, also associate cores with components and store
relevant configuration data, including the [[i_core]] lookup table.
<<PCM base: pcm: TBP>>=
procedure(pcm_allocate_cores), deferred :: allocate_cores
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_allocate_cores (pcm, config, core_entry)
import
class(pcm_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
end subroutine pcm_allocate_cores
end interface
@ %def pcm_allocate_cores
@ Generate and interface external code for a single core, if this is
required.
<<PCM base: pcm: TBP>>=
procedure(pcm_prepare_any_external_code), deferred :: &
prepare_any_external_code
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
end subroutine pcm_prepare_any_external_code
end interface
@ %def pcm_prepare_any_external_code
@ Prepare the BLHA configuration for a core object that requires it. This
does not affect the core object, which may not yet be allocated.
<<PCM base: pcm: TBP>>=
procedure(pcm_setup_blha), deferred :: setup_blha
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_setup_blha (pcm, core_entry)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
end subroutine pcm_setup_blha
end interface
@ %def pcm_setup_blha
@ Configure the BLHA interface for a core object that requires it. This is
separate from the previous method, assuming that the [[pcm]] has to allocate
the actual cores and acquire some data in-between.
<<PCM base: pcm: TBP>>=
procedure(pcm_prepare_blha_core), deferred :: prepare_blha_core
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_prepare_blha_core (pcm, core_entry, model)
import
class(pcm_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
end subroutine pcm_prepare_blha_core
end interface
@ %def pcm_prepare_blha_core
@ Allocate and configure the MCI (multi-channel integrator) records and their
relation to process components, appropriate for the algorithm implemented by
[[pcm]].
Create a [[mci_t]] template: the procedure [[dispatch_mci]] is called as a
factory method for allocating the [[mci_t]] object with a specific concrete
type. The call may depend on the concrete [[pcm]] type.
<<PCM base: public>>=
public :: dispatch_mci_proc
<<PCM base: interfaces>>=
abstract interface
subroutine dispatch_mci_proc (mci, var_list, process_id, is_nlo)
import
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
end subroutine dispatch_mci_proc
end interface
@ %def dispatch_mci_proc
<<PCM base: pcm: TBP>>=
procedure(pcm_setup_mci), deferred :: setup_mci
procedure(pcm_call_dispatch_mci), deferred :: call_dispatch_mci
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_setup_mci (pcm, mci_entry)
import
class(pcm_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
end subroutine pcm_setup_mci
end interface
abstract interface
subroutine pcm_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
import
class(pcm_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), intent(out), allocatable :: mci_template
end subroutine pcm_call_dispatch_mci
end interface
@ %def pcm_setup_mci
@ %def pcm_call_dispatch_mci
@ Proceed with PCM configuration based on the core and component
configuration data. Base version is empty.
<<PCM base: pcm: TBP>>=
procedure(pcm_complete_setup), deferred :: complete_setup
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_complete_setup (pcm, core_entry, component, model)
import
class(pcm_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
end subroutine pcm_complete_setup
end interface
@ %def pcm_complete_setup
@
\subsubsection{Retrieve information}
Return the core index that belongs to a particular component.
<<PCM base: pcm: TBP>>=
procedure :: get_i_core => pcm_get_i_core
<<PCM base: sub interfaces>>=
module function pcm_get_i_core (pcm, i_component) result (i_core)
class(pcm_t), intent(in) :: pcm
integer, intent(in) :: i_component
integer :: i_core
end function pcm_get_i_core
<<PCM base: procedures>>=
module function pcm_get_i_core (pcm, i_component) result (i_core)
class(pcm_t), intent(in) :: pcm
integer, intent(in) :: i_component
integer :: i_core
if (allocated (pcm%i_core)) then
i_core = pcm%i_core(i_component)
else
i_core = 0
end if
end function pcm_get_i_core
@ %def pcm_get_i_core
@
\subsubsection{Phase-space configuration}
Allocate and initialize the right number and type(s) of phase-space
configuration entries. The [[i_phs_config]] lookup table must be set
accordingly.
<<PCM base: pcm: TBP>>=
procedure(pcm_init_phs_config), deferred :: init_phs_config
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
import
class(pcm_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
end subroutine pcm_init_phs_config
end interface
@ %def pcm_init_phs_config
@
Initialize a single component. We require all process-configuration blocks,
and specific templates for the phase-space and integrator configuration.
We also provide the current component index [[i]] and the [[active]] flag.
<<PCM base: pcm: TBP>>=
procedure(pcm_init_component), deferred :: init_component
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_init_component &
(pcm, component, i, active, phs_config, env, meta, config)
import
class(pcm_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
end subroutine pcm_init_component
end interface
@ %def pcm_init_component
@
Record components in the process [[meta]] data if they have turned
out to be inactive.
<<PCM base: pcm: TBP>>=
procedure :: record_inactive_components => pcm_record_inactive_components
<<PCM base: sub interfaces>>=
module subroutine pcm_record_inactive_components (pcm, component, meta)
class(pcm_t), intent(inout) :: pcm
type(process_component_t), dimension(:), intent(in) :: component
type(process_metadata_t), intent(inout) :: meta
end subroutine pcm_record_inactive_components
<<PCM base: procedures>>=
module subroutine pcm_record_inactive_components (pcm, component, meta)
class(pcm_t), intent(inout) :: pcm
type(process_component_t), dimension(:), intent(in) :: component
type(process_metadata_t), intent(inout) :: meta
integer :: i
pcm%component_active = component%active
do i = 1, pcm%n_components
if (.not. component(i)%active) call meta%deactivate_component (i)
end do
end subroutine pcm_record_inactive_components
@ %def pcm_record_inactive_components
@
\subsection{Manager workspace}
This object deals with the actual (squared) matrix element values. It
holds any central data that are generated and/or used when calculating
a particular phase-space point.
Since phase-space points are associated with an integrator, we expect the
instances of this type to correspond to MCI instances.
<<PCM base: public>>=
public :: pcm_workspace_t
<<PCM base: types>>=
type, abstract :: pcm_workspace_t
! class(pcm_t), pointer :: config => null ()
logical :: bad_point = .false.
contains
<<PCM base: pcm instance: TBP>>
end type pcm_workspace_t
@ %def pcm_workspace_t
@
<<PCM base: pcm instance: TBP>>=
procedure(pcm_work_final), deferred :: final
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_work_final (pcm_work)
import
class(pcm_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_work_final
end interface
@ %def pcm_work_final
@
<<PCM base: pcm instance: TBP>>=
procedure(pcm_work_is_nlo), deferred :: is_nlo
<<PCM base: interfaces>>=
abstract interface
function pcm_work_is_nlo (pcm_work) result (is_nlo)
import
logical :: is_nlo
class(pcm_workspace_t), intent(inout) :: pcm_work
end function pcm_work_is_nlo
end interface
@ %def pcm_work_is_nlo
@
<<XXX PCM base: pcm instance: TBP>>=
procedure :: link_config => pcm_work_link_config
<<XXX PCM base: procedures>>=
subroutine pcm_work_link_config (pcm_work, config)
class(pcm_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in), target :: config
pcm_work%config => config
end subroutine pcm_work_link_config
@ %def pcm_work_link_config
@
<<PCM base: pcm instance: TBP>>=
procedure :: is_valid => pcm_work_is_valid
<<PCM base: sub interfaces>>=
module function pcm_work_is_valid (pcm_work) result (valid)
logical :: valid
class(pcm_workspace_t), intent(in) :: pcm_work
end function pcm_work_is_valid
<<PCM base: procedures>>=
module function pcm_work_is_valid (pcm_work) result (valid)
logical :: valid
class(pcm_workspace_t), intent(in) :: pcm_work
valid = .not. pcm_work%bad_point
end function pcm_work_is_valid
@ %def pcm_work_is_valid
@
<<PCM base: pcm instance: TBP>>=
procedure :: set_bad_point => pcm_work_set_bad_point
<<PCM base: sub interfaces>>=
pure module subroutine pcm_work_set_bad_point (pcm_work, bad_point)
class(pcm_workspace_t), intent(inout) :: pcm_work
logical, intent(in) :: bad_point
end subroutine pcm_work_set_bad_point
<<PCM base: procedures>>=
pure module subroutine pcm_work_set_bad_point (pcm_work, bad_point)
class(pcm_workspace_t), intent(inout) :: pcm_work
logical, intent(in) :: bad_point
pcm_work%bad_point = pcm_work%bad_point .or. bad_point
end subroutine pcm_work_set_bad_point
@ %def pcm_work_set_bad_point
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{The process object}
<<[[process.f90]]>>=
<<File header>>
module process
<<Use kinds>>
<<Use strings>>
<<Use debug>>
use diagnostics
use lorentz
use rng_base
use dispatch_rng, only: dispatch_rng_factory
use dispatch_rng, only: update_rng_seed_in_var_list
use os_interface
use sm_qcd
use mci_base
use flavors
use model_data
use models
use process_libraries
use process_constants
use variables
use beam_structures
use beams
use pdg_arrays
use expr_base
use sf_base
use sf_mappings
use resonances, only: resonance_history_t, resonance_history_set_t
use prc_test_core, only: test_t
use prc_core_def, only: prc_core_def_t
use prc_core, only: prc_core_t, helicity_selection_t
use phs_base
use parton_states, only: connected_state_t
use pcm_base
use pcm
use process_counter
use process_config
use process_mci
<<Standard module head>>
<<Process: public>>
<<Process: types>>
<<Process: interfaces>>
interface
<<Process: sub interfaces>>
end interface
contains
<<Process: main procedures>>
end module process
@ %def process
@
<<[[process_sub.f90]]>>=
<<File header>>
submodule (process) process_s
use io_units
use format_utils, only: write_separator
use constants
use numeric_utils
use cputime
use md5
use integration_results
use physics_defs
use interactions
use particles
use dispatch_phase_space, only: dispatch_phs
use prc_external, only: prc_external_t
use prc_recola, only: prc_recola_t
use blha_olp_interfaces, only: prc_blha_t, blha_template_t
use prc_threshold, only: prc_threshold_t
use phs_fks, only: phs_fks_config_t
use mappings, only: mapping_defaults_t
use phs_forests, only: phs_parameters_t
use phs_wood, only: phs_wood_config_t
use blha_config, only: blha_master_t
implicit none
contains
<<Process: procedures>>
end submodule process_s
@ %def process_s
@
\subsection{Process status}
Store counter and status information in a process object.
<<Process: types>>=
type :: process_status_t
private
end type process_status_t
@ %def process_status_t
@
\subsection{Process status}
Store integration results in a process object.
<<Process: types>>=
type :: process_results_t
private
end type process_results_t
@ %def process_results_t
@
\subsection{The process type}
NOTE: The description below represents the intended structure after
refactoring and disentangling the FKS-NLO vs. LO algorithm dependencies.
A [[process]] object is the internal representation of integration-run
methods and data, as they are controlled by the user via a Sindarin
script. The process object provides access to matrix elements (the
actual ``process'' definitions that the user has provided before), it
defines the separation into individually integrable components, and it
manages phase-space construction, the actual integration over phase
space, and the accumulation of results.
As a workspace for individual sampling calls, we introduce an
associated [[process_instance]] object type elsewhere. The
[[process]] object contains data that either define the configuration
or accumulate results from a complete integration pass.
After successful phase-space integration, subsequent event generation
is not actually represented by the [[process]] object. However, any
event generation refers to an existing [[process]] object which
represents a specific integration pass, and it uses a fresh
[[process_instance]] workspace for calculations.
The process object consists of several subobjects with their specific
purposes. The corresponding types are defined below. (Technically,
the subobject type definitions have to come before the process type
definition, but with NOWEB magic we reverse this order here.)
The [[meta]] object describes the process globally. All
contents become fixed when the object is initialized. Similarly, the
[[env]] component captures the (Sindarin) environment at the point
where the process object is initialized.
The [[config]] object holds physical and technical configuration data
that are collected and derived from the environment during process
initialization, and which are common to all process components.
The [[pcm]] object (process-component manager) is polymorphic. This
is an object which holds data which represent the process-object
structure and breakdown, and it contains the methods that implement
the algorithm of managing this structure, accumulating partial
results, and finally collecting the pieces. Depending on the generic
process type, the contents of [[pcm]] do vary. In particular, there
is some base-type data content and a simple (default) extension which
is designed for traditional \oMega\ matrix elements and tree-level
integration, possibly with several sub-processes to sum over. The
second extension is designed for the FKS phase-space and subtraction
algorithm for NLO QCD, which interfaces external one-loop providers.
The [[component]] subobjects are, first of all, interfaces to the
original process-component definitions that have been provided by the
user, which the program has already taken to produce matrix-element
code and interfaces. The management of those components is deferred
by [[pcm]], which contains the information that defines the role of
each component. In particular, in the default (LO) version, process
components correspond to distinct particle combinations which have
been included in the original process definition. In the FKS-NLO
version, the breakdown of a NLO process into Born, real, virtual,
etc.\ components determines the setup.
The [[phs_config]] subobjects hold data that allow and implement the
construction of phase-space configurations. The type
[[process_phs_config_t]] is a wrapper type around the concrete
polymorphic [[phs_config_t]] object type, which manages phase-space
construction, including some bookkeeping required for setting up
multi-channel integration. In the LO case, we expect a separate entry
for each independent sub-process. For the FKS-NLO algorithm, we
expect several entries: a default-type entry which implements the
underlying Born phase space, and additional entries which enable
the construction of various real-radiation and subtraction kinematics
configurations.
A [[core_entry]] is the interface to existing matrix-element and
interaction code. Depending on the process and its components, there
may be various distinct matrix elements to compute.
The [[mci_entry]] objects configure distinct MC input parameter sets
and their associated (multi-channel) integrators.
The [[rng_factory]] object is a single objects which constructs
individual random-number generators for various tasks, in a uniform
and well-defined way.
The [[beam_config]] object describes the incoming particles, either the
decay mother or the scattering beams. It also contains the spectrum-
and structure-function setup, which has to interact with the
phase-space and integrator facilities.
The [[term]] subobjects break down the process in its smallest parts
which appear in the calculation. For LO processes, the correspondence
between terms and components is one-to-one. The FKS-NLO algorithm
requires not just separation of Born, real, and virtual components but
also subtraction terms, and a decomposition of the real phase space
into singular regions. The general idea is that the integration
results of distinct sets of terms are summed over to provide the
results of individual components. This is also controlled by the
[[pcm]] subobject.
The [[process_status]] object is a bookkeeping device that allows us
to query the status of an ongoing calculation.
The [[process_results]] object collects the integration results for
external use, including integration history information.
<<Process: public>>=
public :: process_t
<<Process: types>>=
type :: process_t
private
type(process_metadata_t) :: &
meta
type(process_environment_t) :: &
env
type(process_config_data_t) :: &
config
class(pcm_t), allocatable :: &
pcm
type(process_component_t), dimension(:), allocatable :: &
component
type(process_phs_config_t), dimension(:), allocatable :: &
phs_entry
type(core_entry_t), dimension(:), allocatable :: &
core_entry
type(process_mci_entry_t), dimension(:), allocatable :: &
mci_entry
class(rng_factory_t), allocatable :: &
rng_factory
type(process_beam_config_t) :: &
beam_config
type(process_term_t), dimension(:), allocatable :: &
term
type(process_status_t) :: &
status
type(process_results_t) :: &
result
contains
<<Process: process: TBP>>
end type process_t
@ %def process_t
@
\subsection{Process pointer}
Wrapper type for storing pointers to process objects in arrays.
<<Process: public>>=
public :: process_ptr_t
<<Process: types>>=
type :: process_ptr_t
type(process_t), pointer :: p => null ()
end type process_ptr_t
@ %def process_ptr_t
@
\subsection{Output}
This procedure is an important debugging and inspection tool; it is
not used during normal operation. The process object is written
to a file (identified by unit, which may also be standard output).
Optional flags determine whether we show everything or just the
interesting parts.
The shorthand as a traditional TBP.
<<Process: process: TBP>>=
procedure :: write => process_write
<<Process: sub interfaces>>=
module subroutine process_write (process, screen, unit, &
show_os_data, show_var_list, show_rng, show_expressions, pacify)
class(process_t), intent(in) :: process
logical, intent(in) :: screen
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_os_data
logical, intent(in), optional :: show_var_list
logical, intent(in), optional :: show_rng
logical, intent(in), optional :: show_expressions
logical, intent(in), optional :: pacify
end subroutine process_write
<<Process: procedures>>=
module subroutine process_write (process, screen, unit, &
show_os_data, show_var_list, show_rng, show_expressions, pacify)
class(process_t), intent(in) :: process
logical, intent(in) :: screen
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_os_data
logical, intent(in), optional :: show_var_list
logical, intent(in), optional :: show_rng
logical, intent(in), optional :: show_expressions
logical, intent(in), optional :: pacify
integer :: u, iostat
character(0) :: iomsg
integer, dimension(:), allocatable :: v_list
u = given_output_unit (unit)
allocate (v_list (0))
call set_flag (v_list, F_SHOW_OS_DATA, show_os_data)
call set_flag (v_list, F_SHOW_VAR_LIST, show_var_list)
call set_flag (v_list, F_SHOW_RNG, show_rng)
call set_flag (v_list, F_SHOW_EXPRESSIONS, show_expressions)
call set_flag (v_list, F_PACIFY, pacify)
if (screen) then
call process%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
else
call process%write_formatted (u, "DT", v_list, iostat, iomsg)
end if
end subroutine process_write
@ %def process_write
@ Standard DTIO procedure with binding.
For the particular application, the screen format is triggered by the
[[LISTDIRECTED]] option for the [[iotype]] format editor string. The
other options activate when the particular parameter value is found in
[[v_list]].
NOTE: The DTIO [[generic]] binding is supported by gfortran since 7.0.
TODO wk 2018: The default could be to show everything, and we should have separate
switches for all major parts. Currently, there are only a few.
<<Process: process: TBP>>=
! generic :: write (formatted) => write_formatted
procedure :: write_formatted => process_write_formatted
<<Process: sub interfaces>>=
module subroutine process_write_formatted (dtv, unit, iotype, &
v_list, iostat, iomsg)
class(process_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
end subroutine process_write_formatted
<<Process: procedures>>=
module subroutine process_write_formatted (dtv, unit, iotype, &
v_list, iostat, iomsg)
class(process_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: u
logical :: screen
logical :: var_list
logical :: rng_factory
logical :: expressions
logical :: counters
logical :: os_data
logical :: model
logical :: pacify
integer :: i
u = unit
select case (iotype)
case ("LISTDIRECTED")
screen = .true.
case default
screen = .false.
end select
var_list = flagged (v_list, F_SHOW_VAR_LIST)
rng_factory = flagged (v_list, F_SHOW_RNG, .true.)
expressions = flagged (v_list, F_SHOW_EXPRESSIONS)
counters = .true.
os_data = flagged (v_list, F_SHOW_OS_DATA)
model = .false.
pacify = flagged (v_list, F_PACIFY)
associate (process => dtv)
if (screen) then
write (msg_buffer, "(A)") repeat ("-", 72)
call msg_message ()
else
call write_separator (u, 2)
end if
call process%meta%write (u, screen)
if (var_list) then
call process%env%write (u, show_var_list=var_list, &
show_model=.false., show_lib=.false., &
show_os_data=os_data)
else if (.not. screen) then
write (u, "(1x,A)") "Variable list: [not shown]"
end if
if (process%meta%type == PRC_UNKNOWN) then
call write_separator (u, 2)
return
else if (screen) then
return
end if
call write_separator (u)
call process%config%write (u, counters, model, expressions)
if (rng_factory) then
if (allocated (process%rng_factory)) then
call write_separator (u)
call process%rng_factory%write (u)
end if
end if
call write_separator (u, 2)
if (allocated (process%component)) then
write (u, "(1x,A)") "Process component configuration:"
do i = 1, size (process%component)
call write_separator (u)
call process%component(i)%write (u)
end do
else
write (u, "(1x,A)") "Process component configuration: [undefined]"
end if
call write_separator (u, 2)
if (allocated (process%term)) then
write (u, "(1x,A)") "Process term configuration:"
do i = 1, size (process%term)
call write_separator (u)
call process%term(i)%write (u)
end do
else
write (u, "(1x,A)") "Process term configuration: [undefined]"
end if
call write_separator (u, 2)
call process%beam_config%write (u)
call write_separator (u, 2)
if (allocated (process%mci_entry)) then
write (u, "(1x,A)") "Multi-channel integrator configurations:"
do i = 1, size (process%mci_entry)
call write_separator (u)
write (u, "(1x,A,I0,A)") "MCI #", i, ":"
call process%mci_entry(i)%write (u, pacify)
end do
end if
call write_separator (u, 2)
end associate
iostat = 0
iomsg = ""
end subroutine process_write_formatted
@ %def process_write_formatted
@
<<Process: process: TBP>>=
procedure :: write_meta => process_write_meta
<<Process: sub interfaces>>=
module subroutine process_write_meta (process, unit, testflag)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine process_write_meta
<<Process: procedures>>=
module subroutine process_write_meta (process, unit, testflag)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
select case (process%meta%type)
case (PRC_UNKNOWN)
write (u, "(1x,A)") "Process instance [undefined]"
return
case (PRC_DECAY)
write (u, "(1x,A)", advance="no") "Process instance [decay]:"
case (PRC_SCATTERING)
write (u, "(1x,A)", advance="no") "Process instance [scattering]:"
case default
call msg_bug ("process_instance_write: undefined process type")
end select
write (u, "(1x,A,A,A)") "'", char (process%meta%id), "'"
write (u, "(3x,A,A,A)") "Run ID = '", char (process%meta%run_id), "'"
if (allocated (process%meta%component_id)) then
write (u, "(3x,A)") "Process components:"
do i = 1, size (process%meta%component_id)
if (process%pcm%component_selected(i)) then
write (u, "(3x,'*')", advance="no")
else
write (u, "(4x)", advance="no")
end if
write (u, "(1x,I0,9A)") i, ": '", &
char (process%meta%component_id (i)), "': ", &
char (process%meta%component_description (i))
end do
end if
end subroutine process_write_meta
@ %def process_write_meta
@ Screen output. Write a short account of the process configuration
and the current results. The verbose version lists the components,
the short version just the results.
<<Process: process: TBP>>=
procedure :: show => process_show
<<Process: sub interfaces>>=
module subroutine process_show (object, unit, verbose)
class(process_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine process_show
<<Process: procedures>>=
module subroutine process_show (object, unit, verbose)
class(process_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
logical :: verb
real(default) :: err_percent
u = given_output_unit (unit)
verb = .true.; if (present (verbose)) verb = verbose
if (verb) then
call object%meta%show (u, object%config%model%get_name ())
select case (object%meta%type)
case (PRC_DECAY)
write (u, "(2x,A)", advance="no") "Computed width ="
case (PRC_SCATTERING)
write (u, "(2x,A)", advance="no") "Computed cross section ="
case default; return
end select
else
if (object%meta%run_id /= "") then
write (u, "('Run',1x,A,':',1x)", advance="no") &
char (object%meta%run_id)
end if
write (u, "(A)", advance="no") char (object%meta%id)
select case (object%meta%num_id)
case (0)
write (u, "(':')")
case default
write (u, "(1x,'(',I0,')',':')") object%meta%num_id
end select
write (u, "(2x)", advance="no")
end if
if (object%has_integral_tot ()) then
write (u, "(ES14.7,1x,'+-',ES9.2)", advance="no") &
object%get_integral_tot (), object%get_error_tot ()
select case (object%meta%type)
case (PRC_DECAY)
write (u, "(1x,A)", advance="no") "GeV"
case (PRC_SCATTERING)
write (u, "(1x,A)", advance="no") "fb "
case default
write (u, "(1x,A)", advance="no") " "
end select
if (object%get_integral_tot () /= 0) then
err_percent = abs (100 &
* object%get_error_tot () / object%get_integral_tot ())
else
err_percent = 0
end if
if (err_percent == 0) then
write (u, "(1x,'(',F4.0,4x,'%)')") err_percent
else if (err_percent < 0.1) then
write (u, "(1x,'(',F7.3,1x,'%)')") err_percent
else if (err_percent < 1) then
write (u, "(1x,'(',F6.2,2x,'%)')") err_percent
else if (err_percent < 10) then
write (u, "(1x,'(',F5.1,3x,'%)')") err_percent
else
write (u, "(1x,'(',F4.0,4x,'%)')") err_percent
end if
else
write (u, "(A)") "[integral undefined]"
end if
end subroutine process_show
@ %def process_show
@ Finalizer. Explicitly iterate over all subobjects that may contain
allocated pointers.
TODO wk 2018 (workaround): The finalizer for the [[config_data]] component is not
called. The reason is that this deletes model data local to the process,
but these could be referenced by pointers (flavor objects) from some
persistent event record. Obviously, such side effects should be avoided, but
this requires refactoring the event-handling procedures.
<<Process: process: TBP>>=
procedure :: final => process_final
<<Process: sub interfaces>>=
module subroutine process_final (process)
class(process_t), intent(inout) :: process
end subroutine process_final
<<Process: procedures>>=
module subroutine process_final (process)
class(process_t), intent(inout) :: process
integer :: i
! call process%meta%final ()
call process%env%final ()
! call process%config%final ()
if (allocated (process%component)) then
do i = 1, size (process%component)
call process%component(i)%final ()
end do
end if
if (allocated (process%term)) then
do i = 1, size (process%term)
call process%term(i)%final ()
end do
end if
call process%beam_config%final ()
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
call process%mci_entry(i)%final ()
end do
end if
if (allocated (process%pcm)) then
call process%pcm%final ()
deallocate (process%pcm)
end if
end subroutine process_final
@ %def process_final
@
\subsubsection{Process setup}
Initialize a process. We need a process library [[lib]] and the process
identifier [[proc_id]] (string). We will fetch the current run ID from the
variable list [[var_list]].
We collect all important data from the environment and store them in the
appropriate places. OS data, model, and variable list are copied
into [[env]] (true snapshot), also the process library (pointer only).
The [[meta]] subobject is initialized with process ID and attributes taken
from the process library.
We initialize the [[config]] subobject with all data that are relevant for
this run, using the settings from [[env]]. These data determine the MD5 sum
for this run, which allows us to identify the setup and possibly skips in a
later re-run.
We also allocate and initialize the embedded RNG factory. We take the seed
from the [[var_list]], and we should return the [[var_list]] to the caller
with a new seed.
Finally, we allocate the process component manager [[pcm]], which implements
the chosen algorithm for process integration. The first task of the manager
is to allocate the component array and to determine the component categories
(e.g., Born/Virtual etc.).
TODO wk 2018: The [[pcm]] dispatcher should be provided by the caller, if we
eventually want to eliminate dependencies on concrete [[pcm_t]] extensions.
Gfortran 7/8/9 bug, has to remain in the main module:
<<Process: process: TBP>>=
procedure :: init => process_init
<<Process: main procedures>>=
subroutine process_init &
(process, proc_id, lib, os_data, model, var_list, beam_structure)
class(process_t), intent(out) :: process
type(string_t), intent(in) :: proc_id
type(process_library_t), intent(in), target :: lib
type(os_data_t), intent(in) :: os_data
class(model_t), intent(in), target :: model
type(var_list_t), intent(inout), target, optional :: var_list
type(beam_structure_t), intent(in), optional :: beam_structure
integer :: next_rng_seed
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_init")
associate &
(meta => process%meta, env => process%env, config => process%config)
call env%init &
(model, lib, os_data, var_list, beam_structure)
call meta%init &
(proc_id, lib, env%get_var_list_ptr ())
call config%init &
(meta, env)
call dispatch_rng_factory &
(process%rng_factory, env%get_var_list_ptr (), next_rng_seed)
call update_rng_seed_in_var_list (var_list, next_rng_seed)
call dispatch_pcm &
(process%pcm, config%process_def%is_nlo ())
associate (pcm => process%pcm)
call pcm%init (env, meta)
call pcm%allocate_components (process%component, meta)
call pcm%categorize_components (config)
end associate
end associate
end subroutine process_init
@ %def process_init
@
\subsection{Process component manager}
The [[pcm]] (read: process-component manager) takes the responsibility of
steering the actual algorithm of configuration and integration. Depending on
the concrete type, different algorithms can be implemented.
The first version of this supports just two implementations: leading-order
(tree-level) integration and event generation, and NLO (QCD/FKS subtraction).
We thus can start with a single logical for steering the dispatcher.
TODO wk 2018: Eventually, we may eliminate all references to the extensions of
[[pcm_t]] from this module and therefore move this outside the module as well.
Gfortran 7/8/9 bug, has to be in the main module:
<<Process: main procedures>>=
subroutine dispatch_pcm (pcm, is_nlo)
class(pcm_t), allocatable, intent(out) :: pcm
logical, intent(in) :: is_nlo
if (.not. is_nlo) then
allocate (pcm_default_t :: pcm)
else
allocate (pcm_nlo_t :: pcm)
end if
end subroutine dispatch_pcm
@ %def dispatch_pcm
@ This step is performed after phase-space and core objects are done: collect
all missing information and prepare the process component manager for the
appropriate integration algorithm.
<<Process: process: TBP>>=
procedure :: complete_pcm_setup => process_complete_pcm_setup
<<Process: sub interfaces>>=
module subroutine process_complete_pcm_setup (process)
class(process_t), intent(inout) :: process
end subroutine process_complete_pcm_setup
<<Process: procedures>>=
module subroutine process_complete_pcm_setup (process)
class(process_t), intent(inout) :: process
call process%pcm%complete_setup &
(process%core_entry, process%component, process%env%get_model_ptr ())
end subroutine process_complete_pcm_setup
@ %def process_complete_pcm_setup
@
\subsection{Core management}
Allocate cores (interface objects to matrix-element code).
The [[dispatch_core]] procedure is taken as an argument, so we do not depend on
the implementation, and thus on the specific core types.
The [[helicity_selection]] object collects data that the matrix-element
code needs for configuring the appropriate behavior.
After the cores have been allocated, and assuming the phs initial
configuration has been done before, we proceed with computing the [[pcm]]
internal data.
<<Process: process: TBP>>=
procedure :: setup_cores => process_setup_cores
<<Process: sub interfaces>>=
module subroutine process_setup_cores (process, dispatch_core, &
helicity_selection, use_color_factors, has_beam_pol)
class(process_t), intent(inout) :: process
procedure(dispatch_core_proc) :: dispatch_core
type(helicity_selection_t), intent(in), optional :: helicity_selection
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
end subroutine process_setup_cores
<<Process: procedures>>=
module subroutine process_setup_cores (process, dispatch_core, &
helicity_selection, use_color_factors, has_beam_pol)
class(process_t), intent(inout) :: process
procedure(dispatch_core_proc) :: dispatch_core
type(helicity_selection_t), intent(in), optional :: helicity_selection
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
integer :: i
associate (pcm => process%pcm)
call pcm%allocate_cores (process%config, process%core_entry)
do i = 1, size (process%core_entry)
call dispatch_core (process%core_entry(i)%core, &
process%core_entry(i)%core_def, &
process%config%model, &
helicity_selection, &
process%config%qcd, &
use_color_factors, &
has_beam_pol)
call process%core_entry(i)%configure &
(process%env%get_lib_ptr (), process%meta%id)
if (process%core_entry(i)%core%uses_blha ()) then
call pcm%setup_blha (process%core_entry(i))
end if
end do
end associate
end subroutine process_setup_cores
@ %def process_setup_cores
<<Process: interfaces>>=
abstract interface
subroutine dispatch_core_proc (core, core_def, model, &
helicity_selection, qcd, use_color_factors, has_beam_pol)
import
class(prc_core_t), allocatable, intent(inout) :: core
class(prc_core_def_t), intent(in) :: core_def
class(model_data_t), intent(in), target, optional :: model
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(qcd_t), intent(in), optional :: qcd
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
end subroutine dispatch_core_proc
end interface
@ %def dispatch_core_proc
@ Use the [[pcm]] to initialize the BLHA interface for each core which
requires it.
<<Process: process: TBP>>=
procedure :: prepare_blha_cores => process_prepare_blha_cores
<<Process: sub interfaces>>=
module subroutine process_prepare_blha_cores (process)
class(process_t), intent(inout), target :: process
end subroutine process_prepare_blha_cores
<<Process: procedures>>=
module subroutine process_prepare_blha_cores (process)
class(process_t), intent(inout), target :: process
integer :: i
associate (pcm => process%pcm)
do i = 1, size (process%core_entry)
associate (core_entry => process%core_entry(i))
if (core_entry%core%uses_blha ()) then
pcm%uses_blha = .true.
call pcm%prepare_blha_core (core_entry, process%config%model)
end if
end associate
end do
end associate
end subroutine process_prepare_blha_cores
@ %def process_prepare_blha_cores
@ Create the BLHA interface data, using PCM for specific data, and write the
BLHA contract file(s).
We take various configuration data and copy them to the [[blha_master]]
record, which then creates and writes the contracts.
For assigning the QCD/EW coupling powers, we inspect the first process
component only. The other parameters are taken as-is from the process
environment variables.
<<Process: process: TBP>>=
procedure :: create_blha_interface => process_create_blha_interface
<<Process: sub interfaces>>=
module subroutine process_create_blha_interface (process)
class(process_t), intent(inout) :: process
end subroutine process_create_blha_interface
<<Process: procedures>>=
module subroutine process_create_blha_interface (process)
class(process_t), intent(inout) :: process
integer :: alpha_power, alphas_power
integer :: openloops_phs_tolerance, openloops_stability_log
logical :: use_cms
type(string_t) :: ew_scheme, correction_type
type(string_t) :: openloops_extra_cmd, openloops_allowed_libs
type(blha_master_t) :: blha_master
integer, dimension(:,:), allocatable :: flv_born, flv_real
if (process%pcm%uses_blha) then
call collect_configuration_parameters (process%get_var_list_ptr ())
call process%component(1)%config%get_coupling_powers &
(alpha_power, alphas_power)
associate (pcm => process%pcm)
call pcm%set_blha_methods (blha_master, process%get_var_list_ptr ())
call blha_master%set_ew_scheme (ew_scheme)
call blha_master%allocate_config_files ()
call blha_master%set_correction_type (correction_type)
call blha_master%setup_additional_features ( &
openloops_phs_tolerance, &
use_cms, &
openloops_stability_log, &
extra_cmd = openloops_extra_cmd, &
allowed_libs = openloops_allowed_libs, &
beam_structure = process%env%get_beam_structure ())
call pcm%get_blha_flv_states (process%core_entry, flv_born, flv_real)
call blha_master%set_photon_characteristics (flv_born, process%config%n_in)
call blha_master%generate (process%meta%id, &
process%config%model, process%config%n_in, &
alpha_power, alphas_power, &
flv_born, flv_real)
call blha_master%write_olp (process%meta%id)
end associate
end if
contains
subroutine collect_configuration_parameters (var_list)
type(var_list_t), intent(in) :: var_list
openloops_phs_tolerance = &
var_list%get_ival (var_str ("openloops_phs_tolerance"))
openloops_stability_log = &
var_list%get_ival (var_str ("openloops_stability_log"))
use_cms = &
var_list%get_lval (var_str ("?openloops_use_cms"))
ew_scheme = &
var_list%get_sval (var_str ("$blha_ew_scheme"))
correction_type = &
var_list%get_sval (var_str ("$nlo_correction_type"))
openloops_extra_cmd = &
var_list%get_sval (var_str ("$openloops_extra_cmd"))
openloops_allowed_libs = &
var_list%get_sval (var_str ("$openloops_allowed_libs"))
end subroutine collect_configuration_parameters
end subroutine process_create_blha_interface
@ %def process_create_blha_interface
@ Initialize the process components, one by one. We require templates for the
[[mci]] (integrator) and [[phs_config]] (phase-space) configuration data.
The [[active]] flag is set if the component has an associated matrix
element, so we can compute it. The case of no core is a unit-test case.
The specifics depend on the algorithm and are delegated to the [[pcm]]
process-component manager.
The optional [[phs_config]] overrides a pre-generated config array (for unit
test).
<<Process: process: TBP>>=
procedure :: init_components => process_init_components
<<Process: sub interfaces>>=
module subroutine process_init_components (process, phs_config)
class(process_t), intent(inout), target :: process
class(phs_config_t), allocatable, intent(in), optional :: phs_config
end subroutine process_init_components
<<Process: procedures>>=
module subroutine process_init_components (process, phs_config)
class(process_t), intent(inout), target :: process
class(phs_config_t), allocatable, intent(in), optional :: phs_config
integer :: i, i_core
class(prc_core_t), pointer :: core
logical :: active
associate (pcm => process%pcm)
do i = 1, pcm%n_components
i_core = pcm%get_i_core(i)
if (i_core > 0) then
core => process%get_core_ptr (i_core)
active = core%has_matrix_element ()
else
active = .true.
end if
select type (pcm => process%pcm)
type is (pcm_nlo_t)
if (pcm%use_real_partition .and. .not. pcm%use_real_singular) then
if (pcm%component_type(i) == COMP_REAL_SING) then
active = .false.
end if
end if
end select
if (present (phs_config)) then
call pcm%init_component (process%component(i), &
i, &
active, &
phs_config, &
process%env, process%meta, process%config)
else
call pcm%init_component (process%component(i), &
i, &
active, &
process%phs_entry(pcm%i_phs_config(i))%phs_config, &
process%env, process%meta, process%config)
end if
end do
end associate
end subroutine process_init_components
@ %def process_init_components
@ If process components have turned out to be inactive, this has to be
recorded in the [[meta]] block. Delegate to the [[pcm]].
<<Process: process: TBP>>=
procedure :: record_inactive_components => process_record_inactive_components
<<Process: sub interfaces>>=
module subroutine process_record_inactive_components (process)
class(process_t), intent(inout) :: process
end subroutine process_record_inactive_components
<<Process: procedures>>=
module subroutine process_record_inactive_components (process)
class(process_t), intent(inout) :: process
associate (pcm => process%pcm)
call pcm%record_inactive_components (process%component, process%meta)
end associate
end subroutine process_record_inactive_components
@ %def process_record_inactive_components
@ Determine the process terms for each process component.
<<Process: process: TBP>>=
procedure :: setup_terms => process_setup_terms
<<Process: sub interfaces>>=
module subroutine process_setup_terms (process, with_beams)
class(process_t), intent(inout), target :: process
logical, intent(in), optional :: with_beams
end subroutine process_setup_terms
<<Process: procedures>>=
module subroutine process_setup_terms (process, with_beams)
class(process_t), intent(inout), target :: process
logical, intent(in), optional :: with_beams
class(model_data_t), pointer :: model
integer :: i, j, k, i_term
integer, dimension(:), allocatable :: n_entry
integer :: n_components, n_tot
integer :: i_sub
type(string_t) :: subtraction_method
class(prc_core_t), pointer :: core => null ()
logical :: setup_subtraction_component, singular_real
logical :: requires_spin_correlations
integer :: nlo_type_to_fetch, n_emitters
i_sub = 0
model => process%config%model
n_components = process%meta%n_components
allocate (n_entry (n_components), source = 0)
do i = 1, n_components
associate (component => process%component(i))
if (component%active) then
n_entry(i) = 1
if (component%get_nlo_type () == NLO_REAL) then
select type (pcm => process%pcm)
type is (pcm_nlo_t)
if (pcm%component_type(i) /= COMP_REAL_FIN) &
n_entry(i) = n_entry(i) + pcm%region_data%get_n_phs ()
end select
end if
end if
end associate
end do
n_tot = sum (n_entry)
allocate (process%term (n_tot))
k = 0
if (process%is_nlo_calculation ()) then
i_sub = process%component(1)%config%get_associated_subtraction ()
subtraction_method = process%component(i_sub)%config%get_me_method ()
if (debug_on) call msg_debug2 &
(D_PROCESS_INTEGRATION, "process_setup_terms: ", subtraction_method)
end if
do i = 1, n_components
associate (component => process%component(i))
if (.not. component%active) cycle
allocate (component%i_term (n_entry(i)))
do j = 1, n_entry(i)
select type (pcm => process%pcm)
type is (pcm_nlo_t)
singular_real = component%get_nlo_type () == NLO_REAL &
.and. pcm%component_type(i) /= COMP_REAL_FIN
class default
singular_real = .false.
end select
setup_subtraction_component = singular_real .and. j == n_entry(i)
i_term = k + j
component%i_term(j) = i_term
if (singular_real) then
process%term(i_term)%i_sub = k + n_entry(i)
else
process%term(i_term)%i_sub = 0
end if
if (setup_subtraction_component) then
select type (pcm => process%pcm)
class is (pcm_nlo_t)
process%term(i_term)%i_core = pcm%i_core(pcm%i_sub)
end select
else
process%term(i_term)%i_core = process%pcm%get_i_core(i)
end if
if (process%term(i_term)%i_core == 0) then
call msg_bug ("Process '" // char (process%get_id ()) &
// "': core not found!")
end if
core => process%get_core_term (i_term)
if (i_sub > 0) then
select type (pcm => process%pcm)
type is (pcm_nlo_t)
requires_spin_correlations = &
pcm%region_data%requires_spin_correlations ()
n_emitters = pcm%region_data%get_n_emitters_sc ()
class default
requires_spin_correlations = .false.
n_emitters = 0
end select
if (requires_spin_correlations) then
call process%term(i_term)%init ( &
i_term, i, j, core, model, &
nlo_type = component%config%get_nlo_type (), &
use_beam_pol = with_beams, &
subtraction_method = subtraction_method, &
has_pdfs = process%pcm%has_pdfs, &
n_emitters = n_emitters)
else
call process%term(i_term)%init ( &
i_term, i, j, core, model, &
nlo_type = component%config%get_nlo_type (), &
use_beam_pol = with_beams, &
subtraction_method = subtraction_method, &
has_pdfs = process%pcm%has_pdfs)
end if
else
call process%term(i_term)%init ( &
i_term, i, j, core, model, &
nlo_type = component%config%get_nlo_type (), &
use_beam_pol = with_beams, &
has_pdfs = process%pcm%has_pdfs)
end if
end do
end associate
k = k + n_entry(i)
end do
process%config%n_terms = n_tot
end subroutine process_setup_terms
@ %def process_setup_terms
@ Initialize the beam setup. This is the trivial version where the
incoming state of the matrix element coincides with the initial state
of the process. For a scattering process, we need the c.m. energy,
all other variables are set to their default values (no polarization,
lab frame and c.m.\ frame coincide, etc.)
We assume that all components consistently describe a scattering
process, i.e., two incoming particles.
Note: The current layout of the [[beam_data_t]] record requires that the
flavor for each beam is unique. For processes with multiple
flavors in the initial state, one has to set up beams explicitly.
This restriction could be removed by extending the code in the
[[beams]] module.
<<Process: process: TBP>>=
procedure :: setup_beams_sqrts => process_setup_beams_sqrts
<<Process: sub interfaces>>=
module subroutine process_setup_beams_sqrts &
(process, sqrts, beam_structure, i_core)
class(process_t), intent(inout) :: process
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
integer, intent(in), optional :: i_core
end subroutine process_setup_beams_sqrts
<<Process: procedures>>=
module subroutine process_setup_beams_sqrts &
(process, sqrts, beam_structure, i_core)
class(process_t), intent(inout) :: process
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
integer, intent(in), optional :: i_core
type(pdg_array_t), dimension(:,:), allocatable :: pdg_in
integer, dimension(2) :: pdg_scattering
type(flavor_t), dimension(2) :: flv_in
integer :: i, i0, ic
allocate (pdg_in (2, process%meta%n_components))
i0 = 0
do i = 1, process%meta%n_components
if (process%component(i)%active) then
if (present (i_core)) then
ic = i_core
else
ic = process%pcm%get_i_core (i)
end if
associate (core => process%core_entry(ic)%core)
pdg_in(:,i) = core%data%get_pdg_in ()
end associate
if (i0 == 0) i0 = i
end if
end do
do i = 1, process%meta%n_components
if (.not. process%component(i)%active) then
pdg_in(:,i) = pdg_in(:,i0)
end if
end do
if (all (pdg_in%get_length () == 1) .and. &
all (pdg_in(1,:) == pdg_in(1,i0)) .and. &
all (pdg_in(2,:) == pdg_in(2,i0))) then
pdg_scattering(:) = pdg_in(:,i0)%get (1)
call flv_in%init (pdg_scattering, process%config%model)
call process%beam_config%init_scattering (flv_in, sqrts, beam_structure)
else
call msg_fatal ("Setting up process '" // char (process%meta%id) // "':", &
[var_str (" --------------------------------------------"), &
var_str ("Inconsistent initial state. This happens if either "), &
var_str ("several processes with non-matching initial states "), &
var_str ("have been added, or for a single process with an "), &
var_str ("initial state flavor sum. In that case, please set beams "), &
var_str ("explicitly [singling out a flavor / structure function.]")])
end if
end subroutine process_setup_beams_sqrts
@ %def process_setup_beams_sqrts
@ This is the version that applies to decay processes. The energy is the
particle mass, hence no extra argument.
<<Process: process: TBP>>=
procedure :: setup_beams_decay => process_setup_beams_decay
<<Process: sub interfaces>>=
module subroutine process_setup_beams_decay &
(process, rest_frame, beam_structure, i_core)
class(process_t), intent(inout), target :: process
logical, intent(in), optional :: rest_frame
type(beam_structure_t), intent(in), optional :: beam_structure
integer, intent(in), optional :: i_core
end subroutine process_setup_beams_decay
<<Process: procedures>>=
module subroutine process_setup_beams_decay &
(process, rest_frame, beam_structure, i_core)
class(process_t), intent(inout), target :: process
logical, intent(in), optional :: rest_frame
type(beam_structure_t), intent(in), optional :: beam_structure
integer, intent(in), optional :: i_core
type(pdg_array_t), dimension(:,:), allocatable :: pdg_in
integer, dimension(1) :: pdg_decay
type(flavor_t), dimension(1) :: flv_in
integer :: i, i0, ic
allocate (pdg_in (1, process%meta%n_components))
i0 = 0
do i = 1, process%meta%n_components
if (process%component(i)%active) then
if (present (i_core)) then
ic = i_core
else
ic = process%pcm%get_i_core (i)
end if
associate (core => process%core_entry(ic)%core)
pdg_in(:,i) = core%data%get_pdg_in ()
end associate
if (i0 == 0) i0 = i
end if
end do
do i = 1, process%meta%n_components
if (.not. process%component(i)%active) then
pdg_in(:,i) = pdg_in(:,i0)
end if
end do
if (all (pdg_in%get_length () == 1) &
.and. all (pdg_in(1,:) == pdg_in(1,i0))) then
pdg_decay(:) = pdg_in(:,i0)%get (1)
call flv_in%init (pdg_decay, process%config%model)
call process%beam_config%init_decay (flv_in, rest_frame, beam_structure)
else
call msg_fatal ("Setting up decay '" &
// char (process%meta%id) // "': decaying particle not unique")
end if
end subroutine process_setup_beams_decay
@ %def process_setup_beams_decay
@ We have to make sure that the masses of the various flavors
in a given position in the particle string coincide.
<<Process: process: TBP>>=
procedure :: check_masses => process_check_masses
<<Process: sub interfaces>>=
module subroutine process_check_masses (process)
class(process_t), intent(in) :: process
end subroutine process_check_masses
<<Process: procedures>>=
module subroutine process_check_masses (process)
class(process_t), intent(in) :: process
type(flavor_t), dimension(:), allocatable :: flv
real(default), dimension(:), allocatable :: mass
integer :: i, j
integer :: i_component
class(prc_core_t), pointer :: core
do i = 1, process%get_n_terms ()
i_component = process%term(i)%i_component
if (.not. process%component(i_component)%active) cycle
core => process%get_core_term (i)
associate (data => core%data)
allocate (flv (data%n_flv), mass (data%n_flv))
do j = 1, data%n_in + data%n_out
call flv%init (data%flv_state(j,:), process%config%model)
mass = flv%get_mass ()
if (any (.not. nearly_equal(mass, mass(1)))) then
call msg_fatal ("Process '" // char (process%meta%id) // "': " &
// "mass values in flavor combination do not coincide. ")
end if
end do
deallocate (flv, mass)
end associate
end do
end subroutine process_check_masses
@ %def process_check_masses
@ Set up index mapping for [[region_data]] for singular regions
equivalent w.r.t. their amplitudes. Has to be called after
[[region_data]] AND the [[core]] are fully set up. For processes with
structure function, subprocesses which lead to the same amplitude for
the hard interaction can differ if structure functions are applied. In
this case we remap flavor structures to themselves if the eqvivalent
hard interaction flavor structure has no identical initial state.
<<Process: process: TBP>>=
procedure :: optimize_nlo_singular_regions => &
process_optimize_nlo_singular_regions
<<Process: sub interfaces>>=
module subroutine process_optimize_nlo_singular_regions (process)
class(process_t), intent(inout) :: process
end subroutine process_optimize_nlo_singular_regions
<<Process: procedures>>=
module subroutine process_optimize_nlo_singular_regions (process)
class(process_t), intent(inout) :: process
class(prc_core_t), pointer :: core, core_sub
integer, dimension(:), allocatable :: eqv_flv_index_born
integer, dimension(:), allocatable :: eqv_flv_index_real
integer, dimension(:,:), allocatable :: flv_born, flv_real
integer :: i_flv, i_flv2, n_in, i
integer :: i_component, i_core, i_core_sub
logical :: fetched_born, fetched_real
logical :: optimize
fetched_born = .false.; fetched_real = .false.
select type (pcm => process%pcm)
type is (pcm_nlo_t)
optimize = pcm%settings%reuse_amplitudes_fks
if (optimize) then
do i_component = 1, pcm%n_components
i_core = pcm%get_i_core(i_component)
core => process%get_core_ptr (i_core)
if (.not. core%data_known) cycle
associate (data => core%data)
if (pcm%nlo_type_core(i_core) == NLO_REAL .and. &
.not. pcm%component_type(i_component) == COMP_SUB) then
if (allocated (core%data%eqv_flv_index)) then
eqv_flv_index_real = core%get_equivalent_flv_index ()
fetched_real = .true.
end if
i_core_sub = pcm%get_i_core (pcm%i_sub)
core_sub => process%get_core_ptr (i_core_sub)
if (allocated (core_sub%data%eqv_flv_index)) then
eqv_flv_index_born = core_sub%get_equivalent_flv_index ()
fetched_born = .true.
end if
if (fetched_born .and. fetched_real) exit
end if
end associate
end do
if (.not. fetched_born .or. .not. fetched_real) then
call msg_warning('Failed to fetch flavor equivalence indices. &
&Disabling singular region optimization')
optimize = .false.
eqv_flv_index_born = [(i, i = 1, pcm%region_data%n_flv_born)]
eqv_flv_index_real = [(i, i = 1, pcm%region_data%n_flv_real)]
end if
if (optimize .and. pcm%has_pdfs) then
flv_born = pcm%region_data%get_flv_states_born ()
flv_real = pcm%region_data%get_flv_states_real ()
n_in = pcm%region_data%n_in
do i_flv = 1, size (eqv_flv_index_born)
do i_flv2 = 1, i_flv
if (any (flv_born(1:n_in, eqv_flv_index_born(i_flv)) /= &
flv_born(1:n_in, i_flv))) then
eqv_flv_index_born(i_flv) = i_flv
exit
end if
end do
end do
do i_flv = 1, size (eqv_flv_index_real)
do i_flv2 = 1, i_flv
if (any (flv_real(1:n_in, eqv_flv_index_real(i_flv)) /= &
flv_real(1:n_in, i_flv))) then
eqv_flv_index_real(i_flv) = i_flv
exit
end if
end do
end do
end if
else
eqv_flv_index_born = [(i, i = 1, pcm%region_data%n_flv_born)]
eqv_flv_index_real = [(i, i = 1, pcm%region_data%n_flv_real)]
end if
pcm%region_data%eqv_flv_index_born = eqv_flv_index_born
pcm%region_data%eqv_flv_index_real = eqv_flv_index_real
call pcm%region_data%find_eqv_regions (optimize)
end select
end subroutine process_optimize_nlo_singular_regions
@ %def process_optimize_nlo_singular_regions
@ For some structure functions we need to get the list of initial
state flavors. This is a two-dimensional array. The first index is
the beam index, the second index is the component index. Each array
element is itself a PDG array object, which consists of the list of
incoming PDG values for this beam and component.
<<Process: process: TBP>>=
procedure :: get_pdg_in => process_get_pdg_in
<<Process: sub interfaces>>=
module subroutine process_get_pdg_in (process, pdg_in)
class(process_t), intent(in), target :: process
type(pdg_array_t), dimension(:,:), allocatable, intent(out) :: pdg_in
end subroutine process_get_pdg_in
<<Process: procedures>>=
module subroutine process_get_pdg_in (process, pdg_in)
class(process_t), intent(in), target :: process
type(pdg_array_t), dimension(:,:), allocatable, intent(out) :: pdg_in
integer :: i, i_core
allocate (pdg_in (process%config%n_in, process%meta%n_components))
do i = 1, process%meta%n_components
if (process%component(i)%active) then
i_core = process%pcm%get_i_core (i)
associate (core => process%core_entry(i_core)%core)
pdg_in(:,i) = core%data%get_pdg_in ()
end associate
end if
end do
end subroutine process_get_pdg_in
@ %def process_get_pdg_in
@ The phase-space configuration object, in case we need it separately.
<<Process: process: TBP>>=
procedure :: get_phs_config => process_get_phs_config
<<Process: sub interfaces>>=
module function process_get_phs_config &
(process, i_component) result (phs_config)
class(phs_config_t), pointer :: phs_config
class(process_t), intent(in), target :: process
integer, intent(in) :: i_component
end function process_get_phs_config
<<Process: procedures>>=
module function process_get_phs_config &
(process, i_component) result (phs_config)
class(phs_config_t), pointer :: phs_config
class(process_t), intent(in), target :: process
integer, intent(in) :: i_component
if (allocated (process%component)) then
phs_config => process%component(i_component)%phs_config
else
phs_config => null ()
end if
end function process_get_phs_config
@ %def process_get_phs_config
@ The resonance history set can be extracted from the phase-space
configuration. However, this is only possible if the default phase-space
method (wood) has been chosen. If [[include_trivial]] is set, we include the
resonance history with no resonances in the set.
<<Process: process: TBP>>=
procedure :: extract_resonance_history_set &
=> process_extract_resonance_history_set
<<Process: sub interfaces>>=
module subroutine process_extract_resonance_history_set &
(process, res_set, include_trivial, i_component)
class(process_t), intent(in), target :: process
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
integer, intent(in), optional :: i_component
end subroutine process_extract_resonance_history_set
<<Process: procedures>>=
module subroutine process_extract_resonance_history_set &
(process, res_set, include_trivial, i_component)
class(process_t), intent(in), target :: process
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
integer, intent(in), optional :: i_component
integer :: i
i = 1; if (present (i_component)) i = i_component
select type (phs_config => process%get_phs_config (i))
class is (phs_wood_config_t)
call phs_config%extract_resonance_history_set (res_set, include_trivial)
class default
call msg_error ("process '" // char (process%get_id ()) &
// "': extract resonance histories: phase-space method must be &
&'wood'. No resonances can be determined.")
end select
end subroutine process_extract_resonance_history_set
@ %def process_extract_resonance_history_set
@ Initialize from a complete beam setup. If the beam setup does not
apply directly to the process, choose a fallback option as a straight
scattering or decay process.
<<Process: process: TBP>>=
procedure :: setup_beams_beam_structure => process_setup_beams_beam_structure
<<Process: sub interfaces>>=
module subroutine process_setup_beams_beam_structure &
(process, beam_structure, sqrts, decay_rest_frame)
class(process_t), intent(inout) :: process
type(beam_structure_t), intent(in) :: beam_structure
real(default), intent(in) :: sqrts
logical, intent(in), optional :: decay_rest_frame
end subroutine process_setup_beams_beam_structure
<<Process: procedures>>=
module subroutine process_setup_beams_beam_structure &
(process, beam_structure, sqrts, decay_rest_frame)
class(process_t), intent(inout) :: process
type(beam_structure_t), intent(in) :: beam_structure
real(default), intent(in) :: sqrts
logical, intent(in), optional :: decay_rest_frame
integer :: n_in
logical :: applies
n_in = process%get_n_in ()
call beam_structure%check_against_n_in (process%get_n_in (), applies)
if (applies) then
call process%beam_config%init_beam_structure &
(beam_structure, sqrts, process%get_model_ptr (), decay_rest_frame)
else if (n_in == 2) then
call process%setup_beams_sqrts (sqrts, beam_structure)
else
call process%setup_beams_decay (decay_rest_frame, beam_structure)
end if
end subroutine process_setup_beams_beam_structure
@ %def process_setup_beams_beam_structure
@ Notify the user about beam setup.
<<Process: process: TBP>>=
procedure :: beams_startup_message => process_beams_startup_message
<<Process: sub interfaces>>=
module subroutine process_beams_startup_message &
(process, unit, beam_structure)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
end subroutine process_beams_startup_message
<<Process: procedures>>=
module subroutine process_beams_startup_message &
(process, unit, beam_structure)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
call process%beam_config%startup_message (unit, beam_structure)
end subroutine process_beams_startup_message
@ %def process_beams_startup_message
@ Initialize phase-space configuration by reading out the environment
variables. We return the rebuild flags and store parameters in the blocks
[[phs_par]] and [[mapping_defs]].
The phase-space configuration object(s) are allocated by [[pcm]].
<<Process: process: TBP>>=
procedure :: init_phs_config => process_init_phs_config
<<Process: sub interfaces>>=
module subroutine process_init_phs_config (process)
class(process_t), intent(inout) :: process
end subroutine process_init_phs_config
<<Process: procedures>>=
module subroutine process_init_phs_config (process)
class(process_t), intent(inout) :: process
type(var_list_t), pointer :: var_list
type(phs_parameters_t) :: phs_par
type(mapping_defaults_t) :: mapping_defs
var_list => process%env%get_var_list_ptr ()
phs_par%m_threshold_s = &
var_list%get_rval (var_str ("phs_threshold_s"))
phs_par%m_threshold_t = &
var_list%get_rval (var_str ("phs_threshold_t"))
phs_par%off_shell = &
var_list%get_ival (var_str ("phs_off_shell"))
phs_par%keep_nonresonant = &
var_list%get_lval (var_str ("?phs_keep_nonresonant"))
phs_par%t_channel = &
var_list%get_ival (var_str ("phs_t_channel"))
mapping_defs%energy_scale = &
var_list%get_rval (var_str ("phs_e_scale"))
mapping_defs%invariant_mass_scale = &
var_list%get_rval (var_str ("phs_m_scale"))
mapping_defs%momentum_transfer_scale = &
var_list%get_rval (var_str ("phs_q_scale"))
mapping_defs%step_mapping = &
var_list%get_lval (var_str ("?phs_step_mapping"))
mapping_defs%step_mapping_exp = &
var_list%get_lval (var_str ("?phs_step_mapping_exp"))
mapping_defs%enable_s_mapping = &
var_list%get_lval (var_str ("?phs_s_mapping"))
associate (pcm => process%pcm)
call pcm%init_phs_config (process%phs_entry, &
process%meta, process%env, phs_par, mapping_defs)
end associate
end subroutine process_init_phs_config
@ %def process_init_phs_config
@ We complete the kinematics configuration after the beam setup, but before we
configure the chain of structure functions. The reason is that we need the
total energy [[sqrts]] for the kinematics, but the structure-function setup
requires the number of channels, which depends on the kinematics
configuration. For instance, the kinematics module may return the need for
parameterizing an s-channel resonance.
<<Process: process: TBP>>=
procedure :: configure_phs => process_configure_phs
<<Process: sub interfaces>>=
module subroutine process_configure_phs (process, rebuild, &
ignore_mismatch, combined_integration, subdir)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
logical, intent(in), optional :: combined_integration
type(string_t), intent(in), optional :: subdir
end subroutine process_configure_phs
<<Process: procedures>>=
module subroutine process_configure_phs (process, rebuild, &
ignore_mismatch, combined_integration, subdir)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
logical, intent(in), optional :: combined_integration
type(string_t), intent(in), optional :: subdir
real(default) :: sqrts
integer :: i, i_born, nlo_type
class(phs_config_t), pointer :: phs_config_born
sqrts = process%get_sqrts ()
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) then
select type (pcm => process%pcm)
type is (pcm_default_t)
call component%configure_phs (sqrts, process%beam_config, &
rebuild, ignore_mismatch, subdir)
class is (pcm_nlo_t)
nlo_type = component%config%get_nlo_type ()
select case (nlo_type)
case (BORN, NLO_VIRTUAL, NLO_SUBTRACTION)
call component%configure_phs (sqrts, process%beam_config, &
rebuild, ignore_mismatch, subdir)
call check_and_extend_phs (component)
case (NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
i_born = component%config%get_associated_born ()
if (pcm%component_type(i) /= COMP_REAL_FIN) &
call check_and_extend_phs (component)
call process%component(i_born)%get_phs_config &
(phs_config_born)
select type (config => component%phs_config)
type is (phs_fks_config_t)
select type (phs_config_born)
type is (phs_wood_config_t)
config%md5sum_born_config = &
phs_config_born%md5sum_phs_config
call config%set_born_config (phs_config_born)
call config%set_mode (component%config%get_nlo_type ())
end select
end select
call component%configure_phs (sqrts, &
process%beam_config, rebuild, ignore_mismatch, subdir)
end select
class default
call msg_bug ("process_configure_phs: unsupported PCM type")
end select
end if
end associate
end do
contains
subroutine check_and_extend_phs (component)
type(process_component_t), intent(inout) :: component
if (combined_integration) then
select type (phs_config => component%phs_config)
class is (phs_wood_config_t)
phs_config%is_combined_integration = .true.
call phs_config%increase_n_par ()
end select
end if
end subroutine check_and_extend_phs
end subroutine process_configure_phs
@ %def process_configure_phs
@
<<Process: process: TBP>>=
procedure :: print_phs_startup_message => process_print_phs_startup_message
<<Process: sub interfaces>>=
module subroutine process_print_phs_startup_message (process)
class(process_t), intent(in) :: process
end subroutine process_print_phs_startup_message
<<Process: procedures>>=
module subroutine process_print_phs_startup_message (process)
class(process_t), intent(in) :: process
integer :: i_component
do i_component = 1, process%meta%n_components
associate (component => process%component(i_component))
if (component%active) then
call component%phs_config%startup_message ()
end if
end associate
end do
end subroutine process_print_phs_startup_message
@ %def process_print_phs_startup_message
@ Insert the structure-function configuration data. First allocate the
storage, then insert data one by one. The third procedure declares a
mapping (of the MC input parameters) for a specific channel and
structure-function combination.
We take the number of channels from the corresponding entry in the
[[config_data]] section.
Otherwise, these a simple wrapper routines. The extra level in the
call tree may allow for simple addressing of multiple concurrent beam
configurations, not implemented currently.
If we do not want structure functions, we simply do not call those procedures.
<<Process: process: TBP>>=
procedure :: init_sf_chain => process_init_sf_chain
generic :: set_sf_channel => set_sf_channel_single
procedure :: set_sf_channel_single => process_set_sf_channel
generic :: set_sf_channel => set_sf_channel_array
procedure :: set_sf_channel_array => process_set_sf_channel_array
<<Process: sub interfaces>>=
module subroutine process_init_sf_chain (process, sf_config, sf_trace_file)
class(process_t), intent(inout) :: process
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
end subroutine process_init_sf_chain
module subroutine process_set_sf_channel (process, c, sf_channel)
class(process_t), intent(inout) :: process
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
end subroutine process_set_sf_channel
module subroutine process_set_sf_channel_array (process, sf_channel)
class(process_t), intent(inout) :: process
type(sf_channel_t), dimension(:), intent(in) :: sf_channel
end subroutine process_set_sf_channel_array
<<Process: procedures>>=
module subroutine process_init_sf_chain (process, sf_config, sf_trace_file)
class(process_t), intent(inout) :: process
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
type(string_t) :: file
if (present (sf_trace_file)) then
if (sf_trace_file /= "") then
file = sf_trace_file
else
file = process%get_id () // "_sftrace.dat"
end if
call process%beam_config%init_sf_chain (sf_config, file)
else
call process%beam_config%init_sf_chain (sf_config)
end if
end subroutine process_init_sf_chain
module subroutine process_set_sf_channel (process, c, sf_channel)
class(process_t), intent(inout) :: process
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
call process%beam_config%set_sf_channel (c, sf_channel)
end subroutine process_set_sf_channel
module subroutine process_set_sf_channel_array (process, sf_channel)
class(process_t), intent(inout) :: process
type(sf_channel_t), dimension(:), intent(in) :: sf_channel
integer :: c
call process%beam_config%allocate_sf_channels (size (sf_channel))
do c = 1, size (sf_channel)
call process%beam_config%set_sf_channel (c, sf_channel(c))
end do
end subroutine process_set_sf_channel_array
@ %def process_init_sf_chain
@ %def process_set_sf_channel
@ Notify about the structure-function setup.
<<Process: process: TBP>>=
procedure :: sf_startup_message => process_sf_startup_message
<<Process: sub interfaces>>=
module subroutine process_sf_startup_message (process, sf_string, unit)
class(process_t), intent(in) :: process
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
end subroutine process_sf_startup_message
<<Process: procedures>>=
module subroutine process_sf_startup_message (process, sf_string, unit)
class(process_t), intent(in) :: process
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
call process%beam_config%sf_startup_message (sf_string, unit)
end subroutine process_sf_startup_message
@ %def process_sf_startup_message
@ As soon as both the kinematics configuration and the
structure-function setup are complete, we match parameterizations
(channels) for both. The matching entries are (re)set in the
[[component]] phase-space configuration, while the structure-function
configuration is left intact.
<<Process: process: TBP>>=
procedure :: collect_channels => process_collect_channels
<<Process: sub interfaces>>=
module subroutine process_collect_channels (process, coll)
class(process_t), intent(inout) :: process
type(phs_channel_collection_t), intent(inout) :: coll
end subroutine process_collect_channels
<<Process: procedures>>=
module subroutine process_collect_channels (process, coll)
class(process_t), intent(inout) :: process
type(phs_channel_collection_t), intent(inout) :: coll
integer :: i
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) &
call component%collect_channels (coll)
end associate
end do
end subroutine process_collect_channels
@ %def process_collect_channels
@ Independently, we should be able to check if any component does not
contain phase-space parameters. Such a process can only be integrated
if there are structure functions.
<<Process: process: TBP>>=
procedure :: contains_trivial_component => process_contains_trivial_component
<<Process: sub interfaces>>=
module function process_contains_trivial_component (process) result (flag)
class(process_t), intent(in) :: process
logical :: flag
end function process_contains_trivial_component
<<Process: procedures>>=
module function process_contains_trivial_component (process) result (flag)
class(process_t), intent(in) :: process
logical :: flag
integer :: i
flag = .true.
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) then
if (component%get_n_phs_par () == 0) return
end if
end associate
end do
flag = .false.
end function process_contains_trivial_component
@ %def process_contains_trivial_component
@
<<Process: process: TBP>>=
procedure :: get_master_component => process_get_master_component
<<Process: sub interfaces>>=
module function process_get_master_component &
(process, i_mci) result (i_component)
integer :: i_component
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_get_master_component
<<Process: procedures>>=
module function process_get_master_component &
(process, i_mci) result (i_component)
integer :: i_component
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer :: i
i_component = 0
do i = 1, size (process%component)
if (process%component(i)%i_mci == i_mci) then
i_component = i
return
end if
end do
end function process_get_master_component
@ %def process_get_master_component
@ Determine the MC parameter set structure and the MCI configuration for each
process component. We need data from the structure-function and phase-space
setup, so those should be complete before this is called. We also
make a random-number generator instance for each MCI group.
<<Process: process: TBP>>=
procedure :: setup_mci => process_setup_mci
<<Process: sub interfaces>>=
module subroutine process_setup_mci (process, dispatch_mci)
class(process_t), intent(inout) :: process
procedure(dispatch_mci_proc) :: dispatch_mci
end subroutine process_setup_mci
<<Process: procedures>>=
module subroutine process_setup_mci (process, dispatch_mci)
class(process_t), intent(inout) :: process
procedure(dispatch_mci_proc) :: dispatch_mci
class(mci_t), allocatable :: mci_template
integer :: i, i_mci
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_setup_mci")
associate (pcm => process%pcm)
call pcm%call_dispatch_mci (dispatch_mci, &
process%get_var_list_ptr (), process%meta%id, mci_template)
call pcm%setup_mci (process%mci_entry)
process%config%n_mci = pcm%n_mci
process%component(:)%i_mci = pcm%i_mci(:)
do i = 1, pcm%n_components
i_mci = process%pcm%i_mci(i)
if (i_mci > 0) then
associate (component => process%component(i), &
mci_entry => process%mci_entry(i_mci))
call mci_entry%configure (mci_template, &
process%meta%type, &
i_mci, i, component, process%beam_config%n_sfpar, &
process%rng_factory)
call mci_entry%set_parameters (process%get_var_list_ptr ())
end associate
end if
end do
end associate
end subroutine process_setup_mci
@ %def process_setup_mci
@ Set cuts. This is a parse node, namely the right-hand side of the [[cut]]
assignment. When creating an instance, we compile this into an evaluation
tree. The parse node may be null.
<<Process: process: TBP>>=
procedure :: set_cuts => process_set_cuts
<<Process: sub interfaces>>=
module subroutine process_set_cuts (process, ef_cuts)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_cuts
end subroutine process_set_cuts
<<Process: procedures>>=
module subroutine process_set_cuts (process, ef_cuts)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_cuts
allocate (process%config%ef_cuts, source = ef_cuts)
end subroutine process_set_cuts
@ %def process_set_cuts
@ Analogously for the other expressions.
<<Process: process: TBP>>=
procedure :: set_scale => process_set_scale
procedure :: set_fac_scale => process_set_fac_scale
procedure :: set_ren_scale => process_set_ren_scale
procedure :: set_weight => process_set_weight
<<Process: sub interfaces>>=
module subroutine process_set_scale (process, ef_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_scale
end subroutine process_set_scale
module subroutine process_set_weight (process, ef_weight)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_weight
end subroutine process_set_weight
module subroutine process_set_fac_scale (process, ef_fac_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_fac_scale
end subroutine process_set_fac_scale
module subroutine process_set_ren_scale (process, ef_ren_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_ren_scale
end subroutine process_set_ren_scale
<<Process: procedures>>=
module subroutine process_set_scale (process, ef_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_scale
allocate (process%config%ef_scale, source = ef_scale)
end subroutine process_set_scale
module subroutine process_set_fac_scale (process, ef_fac_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_fac_scale
allocate (process%config%ef_fac_scale, source = ef_fac_scale)
end subroutine process_set_fac_scale
module subroutine process_set_ren_scale (process, ef_ren_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_ren_scale
allocate (process%config%ef_ren_scale, source = ef_ren_scale)
end subroutine process_set_ren_scale
module subroutine process_set_weight (process, ef_weight)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_weight
allocate (process%config%ef_weight, source = ef_weight)
end subroutine process_set_weight
@ %def process_set_scale
@ %def process_set_fac_scale
@ %def process_set_ren_scale
@ %def process_set_weight
@
\subsubsection{MD5 sum}
The MD5 sum of the process object should reflect the state completely,
including integration results. It is used for checking the integrity
of event files. This global checksum includes checksums for the
various parts. In particular, the MCI object receives a checksum that
includes the configuration of all configuration parts relevant for an
individual integration. This checksum is used for checking the
integrity of integration grids.
We do not need MD5 sums for the process terms, since these are
generated from the component definitions.
<<Process: process: TBP>>=
procedure :: compute_md5sum => process_compute_md5sum
<<Process: sub interfaces>>=
module subroutine process_compute_md5sum (process)
class(process_t), intent(inout) :: process
end subroutine process_compute_md5sum
<<Process: procedures>>=
module subroutine process_compute_md5sum (process)
class(process_t), intent(inout) :: process
integer :: i
call process%config%compute_md5sum ()
do i = 1, process%config%n_components
associate (component => process%component(i))
if (component%active) then
call component%compute_md5sum ()
end if
end associate
end do
call process%beam_config%compute_md5sum ()
do i = 1, process%config%n_mci
call process%mci_entry(i)%compute_md5sum &
(process%config, process%component, process%beam_config)
end do
end subroutine process_compute_md5sum
@ %def process_compute_md5sum
@
<<Process: process: TBP>>=
procedure :: sampler_test => process_sampler_test
<<Process: sub interfaces>>=
module subroutine process_sampler_test (process, sampler, n_calls, i_mci)
class(process_t), intent(inout) :: process
class(mci_sampler_t), intent(inout) :: sampler
integer, intent(in) :: n_calls, i_mci
end subroutine process_sampler_test
<<Process: procedures>>=
module subroutine process_sampler_test (process, sampler, n_calls, i_mci)
class(process_t), intent(inout) :: process
class(mci_sampler_t), intent(inout) :: sampler
integer, intent(in) :: n_calls, i_mci
call process%mci_entry(i_mci)%sampler_test (sampler, n_calls)
end subroutine process_sampler_test
@ %def process_sampler_test
@ The finalizer should be called after all integration passes have been
completed. It will, for instance, write a summary of the integration
results.
[[integrate_dummy]] does a ``dummy'' integration in the sense that
nothing is done but just empty integration results appended.
<<Process: process: TBP>>=
procedure :: final_integration => process_final_integration
procedure :: integrate_dummy => process_integrate_dummy
<<Process: sub interfaces>>=
module subroutine process_final_integration (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
end subroutine process_final_integration
module subroutine process_integrate_dummy (process)
class(process_t), intent(inout) :: process
end subroutine process_integrate_dummy
<<Process: procedures>>=
module subroutine process_final_integration (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
call process%mci_entry(i_mci)%final_integration ()
end subroutine process_final_integration
module subroutine process_integrate_dummy (process)
class(process_t), intent(inout) :: process
type(integration_results_t) :: results
integer :: u_log
u_log = logfile_unit ()
call results%init (process%meta%type)
call results%display_init (screen = .true., unit = u_log)
call results%new_pass ()
call results%record (1, 0, 0._default, 0._default, 0._default)
call results%display_final ()
end subroutine process_integrate_dummy
@ %def process_final_integration
@ %def process_integrate_dummy
@
<<Process: process: TBP>>=
procedure :: integrate => process_integrate
<<Process: sub interfaces>>=
module subroutine process_integrate (process, i_mci, mci_work, &
mci_sampler, n_it, n_calls, adapt_grids, adapt_weights, final, &
pacify, nlo_type)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it, n_calls
logical, intent(in), optional :: adapt_grids, adapt_weights
logical, intent(in), optional :: final
logical, intent(in), optional :: pacify
integer, intent(in), optional :: nlo_type
end subroutine process_integrate
<<Process: procedures>>=
module subroutine process_integrate (process, i_mci, mci_work, &
mci_sampler, n_it, n_calls, adapt_grids, adapt_weights, final, &
pacify, nlo_type)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it, n_calls
logical, intent(in), optional :: adapt_grids, adapt_weights
logical, intent(in), optional :: final
logical, intent(in), optional :: pacify
integer, intent(in), optional :: nlo_type
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%integrate (mci_work%mci, mci_sampler, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify, &
nlo_type = nlo_type)
call mci_entry%results%display_pass (pacify)
end associate
end subroutine process_integrate
@ %def process_integrate
@
<<Process: process: TBP>>=
procedure :: generate_weighted_event => process_generate_weighted_event
<<Process: sub interfaces>>=
module subroutine process_generate_weighted_event (process, i_mci, &
mci_work, mci_sampler, keep_failed_events)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed_events
end subroutine process_generate_weighted_event
<<Process: procedures>>=
module subroutine process_generate_weighted_event (process, i_mci, &
mci_work, mci_sampler, keep_failed_events)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed_events
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%generate_weighted_event (mci_work%mci, &
mci_sampler, keep_failed_events)
end associate
end subroutine process_generate_weighted_event
@ %def process_generate_weighted_event
<<Process: process: TBP>>=
procedure :: generate_unweighted_event => process_generate_unweighted_event
<<Process: sub interfaces>>=
module subroutine process_generate_unweighted_event (process, i_mci, &
mci_work, mci_sampler)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
end subroutine process_generate_unweighted_event
<<Process: procedures>>=
module subroutine process_generate_unweighted_event (process, i_mci, &
mci_work, mci_sampler)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%generate_unweighted_event &
(mci_work%mci, mci_sampler)
end associate
end subroutine process_generate_unweighted_event
@ %def process_generate_unweighted_event
@ Display the final results for the sum of all components. This is useful,
obviously, only if there is more than one component and not if a combined
integration of all components together has been performed.
<<Process: process: TBP>>=
procedure :: display_summed_results => process_display_summed_results
<<Process: sub interfaces>>=
module subroutine process_display_summed_results (process, pacify)
class(process_t), intent(inout) :: process
logical, intent(in) :: pacify
end subroutine process_display_summed_results
<<Process: procedures>>=
module subroutine process_display_summed_results (process, pacify)
class(process_t), intent(inout) :: process
logical, intent(in) :: pacify
type(integration_results_t) :: results
integer :: u_log
u_log = logfile_unit ()
call results%init (process%meta%type)
call results%display_init (screen = .true., unit = u_log)
call results%new_pass ()
call results%record (1, 0, &
process%get_integral (), &
process%get_error (), &
process%get_efficiency (), suppress = pacify)
select type (pcm => process%pcm)
class is (pcm_nlo_t)
!!! Check that Born integral is there
if (.not. pcm%settings%combined_integration .and. &
process%component_can_be_integrated (1)) then
call results%record_correction (process%get_correction (), &
process%get_correction_error ())
end if
end select
call results%display_final ()
end subroutine process_display_summed_results
@ %def process_display_summed_results
@ Run LaTeX/Metapost to generate a ps/pdf file for the integration
history. We (re)write the driver file -- just in case it has been
missed before -- then we compile it.
<<Process: process: TBP>>=
procedure :: display_integration_history => &
process_display_integration_history
<<Process: sub interfaces>>=
module subroutine process_display_integration_history &
(process, i_mci, filename, os_data, eff_reset)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: eff_reset
end subroutine process_display_integration_history
<<Process: procedures>>=
module subroutine process_display_integration_history &
(process, i_mci, filename, os_data, eff_reset)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: eff_reset
call integration_results_write_driver &
(process%mci_entry(i_mci)%results, filename, eff_reset)
call integration_results_compile_driver &
(process%mci_entry(i_mci)%results, filename, os_data)
end subroutine process_display_integration_history
@ %def subroutine process_display_integration_history
@ Write a complete logfile (with hardcoded name based on the process ID).
We do not write internal data.
<<Process: process: TBP>>=
procedure :: write_logfile => process_write_logfile
<<Process: sub interfaces>>=
module subroutine process_write_logfile (process, i_mci, filename)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
end subroutine process_write_logfile
<<Process: procedures>>=
module subroutine process_write_logfile (process, i_mci, filename)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
type(time_t) :: time
integer :: unit, u
unit = free_unit ()
open (unit = unit, file = char (filename), action = "write", &
status = "replace")
u = given_output_unit (unit)
write (u, "(A)") repeat ("#", 79)
call process%meta%write (u, .false.)
write (u, "(A)") repeat ("#", 79)
write (u, "(3x,A,ES17.10)") "Integral = ", &
process%mci_entry(i_mci)%get_integral ()
write (u, "(3x,A,ES17.10)") "Error = ", &
process%mci_entry(i_mci)%get_error ()
write (u, "(3x,A,ES17.10)") "Accuracy = ", &
process%mci_entry(i_mci)%get_accuracy ()
write (u, "(3x,A,ES17.10)") "Chi2 = ", &
process%mci_entry(i_mci)%get_chi2 ()
write (u, "(3x,A,ES17.10)") "Efficiency = ", &
process%mci_entry(i_mci)%get_efficiency ()
call process%mci_entry(i_mci)%get_time (time, 10000)
if (time%is_known ()) then
write (u, "(3x,A,1x,A)") "T(10k evt) = ", char (time%to_string_dhms ())
else
write (u, "(3x,A)") "T(10k evt) = [undefined]"
end if
call process%mci_entry(i_mci)%results%write (u)
write (u, "(A)") repeat ("#", 79)
call process%mci_entry(i_mci)%results%write_chain_weights (u)
write (u, "(A)") repeat ("#", 79)
call process%mci_entry(i_mci)%counter%write (u)
write (u, "(A)") repeat ("#", 79)
call process%mci_entry(i_mci)%mci%write_log_entry (u)
write (u, "(A)") repeat ("#", 79)
call process%beam_config%data%write (u)
write (u, "(A)") repeat ("#", 79)
if (allocated (process%config%ef_cuts)) then
write (u, "(3x,A)") "Cut expression:"
call process%config%ef_cuts%write (u)
else
write (u, "(3x,A)") "No cuts used."
end if
call write_separator (u)
if (allocated (process%config%ef_scale)) then
write (u, "(3x,A)") "Scale expression:"
call process%config%ef_scale%write (u)
else
write (u, "(3x,A)") "No scale expression was given."
end if
call write_separator (u)
if (allocated (process%config%ef_fac_scale)) then
write (u, "(3x,A)") "Factorization scale expression:"
call process%config%ef_fac_scale%write (u)
else
write (u, "(3x,A)") "No factorization scale expression was given."
end if
call write_separator (u)
if (allocated (process%config%ef_ren_scale)) then
write (u, "(3x,A)") "Renormalization scale expression:"
call process%config%ef_ren_scale%write (u)
else
write (u, "(3x,A)") "No renormalization scale expression was given."
end if
call write_separator (u)
if (allocated (process%config%ef_weight)) then
call write_separator (u)
write (u, "(3x,A)") "Weight expression:"
call process%config%ef_weight%write (u)
else
write (u, "(3x,A)") "No weight expression was given."
end if
write (u, "(A)") repeat ("#", 79)
write (u, "(1x,A)") "Summary of quantum-number states:"
write (u, "(1x,A)") " + sign: allowed and contributing"
write (u, "(1x,A)") " no + : switched off at runtime"
call process%write_state_summary (u)
write (u, "(A)") repeat ("#", 79)
call process%env%write (u, show_var_list=.true., &
show_model=.false., show_lib=.false., show_os_data=.false.)
write (u, "(A)") repeat ("#", 79)
close (u)
end subroutine process_write_logfile
@ %def process_write_logfile
@ Display the quantum-number combinations of the process components, and their
current status (allowed or switched off).
<<Process: process: TBP>>=
procedure :: write_state_summary => process_write_state_summary
<<Process: sub interfaces>>=
module subroutine process_write_state_summary (process, unit)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
end subroutine process_write_state_summary
<<Process: procedures>>=
module subroutine process_write_state_summary (process, unit)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
integer :: i, i_component, u
u = given_output_unit (unit)
do i = 1, size (process%term)
call write_separator (u)
i_component = process%term(i)%i_component
if (i_component /= 0) then
call process%term(i)%write_state_summary &
(process%get_core_term(i), unit)
end if
end do
end subroutine process_write_state_summary
@ %def process_write_state_summary
@ Prepare event generation for the specified MCI entry. This implies, in
particular, checking the phase-space file.
<<Process: process: TBP>>=
procedure :: prepare_simulation => process_prepare_simulation
<<Process: sub interfaces>>=
module subroutine process_prepare_simulation (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
end subroutine process_prepare_simulation
<<Process: procedures>>=
module subroutine process_prepare_simulation (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
call process%mci_entry(i_mci)%prepare_simulation ()
end subroutine process_prepare_simulation
@ %def process_prepare_simulation
@
\subsubsection{Retrieve process data}
Tell whether integral (and error) are known.
<<Process: process: TBP>>=
generic :: has_integral => has_integral_tot, has_integral_mci
procedure :: has_integral_tot => process_has_integral_tot
procedure :: has_integral_mci => process_has_integral_mci
<<Process: sub interfaces>>=
module function process_has_integral_tot (process) result (flag)
logical :: flag
class(process_t), intent(in) :: process
end function process_has_integral_tot
module function process_has_integral_mci (process, i_mci) result (flag)
logical :: flag
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_has_integral_mci
<<Process: procedures>>=
module function process_has_integral_mci (process, i_mci) result (flag)
logical :: flag
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
if (allocated (process%mci_entry)) then
flag = process%mci_entry(i_mci)%has_integral ()
else
flag = .false.
end if
end function process_has_integral_mci
module function process_has_integral_tot (process) result (flag)
logical :: flag
class(process_t), intent(in) :: process
integer :: i, j, i_component
if (allocated (process%mci_entry)) then
flag = .true.
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated (i_component)) &
flag = flag .and. process%mci_entry(i)%has_integral ()
end do
end do
else
flag = .false.
end if
end function process_has_integral_tot
@ %def process_has_integral
@
Return the current integral and error obtained by the integrator [[i_mci]].
<<Process: process: TBP>>=
generic :: get_integral => get_integral_tot, get_integral_mci
generic :: get_error => get_error_tot, get_error_mci
generic :: get_efficiency => get_efficiency_tot, get_efficiency_mci
procedure :: get_integral_tot => process_get_integral_tot
procedure :: get_integral_mci => process_get_integral_mci
procedure :: get_error_tot => process_get_error_tot
procedure :: get_error_mci => process_get_error_mci
procedure :: get_efficiency_tot => process_get_efficiency_tot
procedure :: get_efficiency_mci => process_get_efficiency_mci
<<Process: sub interfaces>>=
module function process_get_integral_mci (process, i_mci) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_get_integral_mci
module function process_get_error_mci (process, i_mci) result (error)
real(default) :: error
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_get_error_mci
module function process_get_efficiency_mci &
(process, i_mci) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_get_efficiency_mci
module function process_get_integral_tot (process) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
end function process_get_integral_tot
module function process_get_error_tot (process) result (error)
real(default) :: variance
class(process_t), intent(in) :: process
real(default) :: error
end function process_get_error_tot
module function process_get_efficiency_tot (process) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
end function process_get_efficiency_tot
<<Process: procedures>>=
module function process_get_integral_mci (process, i_mci) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integral = process%mci_entry(i_mci)%get_integral ()
end function process_get_integral_mci
module function process_get_error_mci (process, i_mci) result (error)
real(default) :: error
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
error = process%mci_entry(i_mci)%get_error ()
end function process_get_error_mci
module function process_get_efficiency_mci &
(process, i_mci) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
efficiency = process%mci_entry(i_mci)%get_efficiency ()
end function process_get_efficiency_mci
module function process_get_integral_tot (process) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
integer :: i, j, i_component
integral = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) &
integral = integral + process%mci_entry(i)%get_integral ()
end do
end do
end if
end function process_get_integral_tot
module function process_get_error_tot (process) result (error)
real(default) :: variance
class(process_t), intent(in) :: process
real(default) :: error
integer :: i, j, i_component
variance = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) &
variance = variance + process%mci_entry(i)%get_error () ** 2
end do
end do
end if
error = sqrt (variance)
end function process_get_error_tot
module function process_get_efficiency_tot (process) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
real(default) :: den, eff, int
integer :: i, j, i_component
den = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) then
int = process%get_integral (i)
if (int > 0) then
eff = process%mci_entry(i)%get_efficiency ()
if (eff > 0) then
den = den + int / eff
else
efficiency = 0
return
end if
end if
end if
end do
end do
end if
if (den > 0) then
efficiency = process%get_integral () / den
else
efficiency = 0
end if
end function process_get_efficiency_tot
@ %def process_get_integral process_get_efficiency
@ Let us call the ratio of the NLO and the LO result $\iota = I_{NLO}
/ I_{LO}$. Then usual error propagation gives
\begin{equation*}
\sigma_{\iota}^2 = \left(\frac{\partial \iota}{\partial
I_{LO}}\right)^2 \sigma_{I_{LO}}^2
+ \left(\frac{\partial \iota}{\partial
I_{NLO}}\right)^2 \sigma_{I_{NLO}}^2
= \frac{I_{NLO}^2\sigma_{I_{LO}}^2}{I_{LO}^4} +
\frac{\sigma_{I_{NLO}}^2}{I_{LO}^2}.
\end{equation*}
<<Process: process: TBP>>=
procedure :: get_correction => process_get_correction
procedure :: get_correction_error => process_get_correction_error
<<Process: sub interfaces>>=
module function process_get_correction (process) result (ratio)
real(default) :: ratio
class(process_t), intent(in) :: process
end function process_get_correction
module function process_get_correction_error (process) result (error)
real(default) :: error
class(process_t), intent(in) :: process
end function process_get_correction_error
<<Process: procedures>>=
module function process_get_correction (process) result (ratio)
real(default) :: ratio
class(process_t), intent(in) :: process
integer :: i_mci, i_component
real(default) :: int_born, int_nlo
int_nlo = zero
int_born = process%mci_entry(1)%get_integral ()
i_mci = 2
do i_component = 2, size (process%component)
if (process%component_can_be_integrated (i_component)) then
int_nlo = int_nlo + process%mci_entry(i_mci)%get_integral ()
i_mci = i_mci + 1
end if
end do
ratio = int_nlo / int_born * 100
end function process_get_correction
module function process_get_correction_error (process) result (error)
real(default) :: error
class(process_t), intent(in) :: process
real(default) :: int_born, sum_int_nlo
real(default) :: err_born, err2
integer :: i_mci, i_component
sum_int_nlo = zero; err2 = zero
int_born = process%mci_entry(1)%get_integral ()
err_born = process%mci_entry(1)%get_error ()
i_mci = 2
do i_component = 2, size (process%component)
if (process%component_can_be_integrated (i_component)) then
sum_int_nlo = sum_int_nlo + process%mci_entry(i_mci)%get_integral ()
err2 = err2 + process%mci_entry(i_mci)%get_error()**2
i_mci = i_mci + 1
end if
end do
error = sqrt (err2 / int_born**2 + sum_int_nlo**2 * err_born**2 / int_born**4) * 100
end function process_get_correction_error
@ %def process_get_correction process_get_correction_error
@ This routine asks [[beam_config]] for the frame.
<<Process: process: TBP>>=
procedure :: lab_is_cm => process_lab_is_cm
<<Process: sub interfaces>>=
pure module function process_lab_is_cm (process) result (lab_is_cm)
logical :: lab_is_cm
class(process_t), intent(in) :: process
end function process_lab_is_cm
<<Process: procedures>>=
pure module function process_lab_is_cm (process) result (lab_is_cm)
logical :: lab_is_cm
class(process_t), intent(in) :: process
lab_is_cm = process%beam_config%lab_is_cm
end function process_lab_is_cm
@ %def process_lab_is_cm
@
<<Process: process: TBP>>=
procedure :: get_component_ptr => process_get_component_ptr
<<Process: sub interfaces>>=
module function process_get_component_ptr (process, i) result (component)
type(process_component_t), pointer :: component
class(process_t), intent(in), target :: process
integer, intent(in) :: i
end function process_get_component_ptr
<<Process: procedures>>=
module function process_get_component_ptr (process, i) result (component)
type(process_component_t), pointer :: component
class(process_t), intent(in), target :: process
integer, intent(in) :: i
component => process%component(i)
end function process_get_component_ptr
@ %def process_get_component_ptr
@
<<Process: process: TBP>>=
procedure :: get_qcd => process_get_qcd
<<Process: sub interfaces>>=
module function process_get_qcd (process) result (qcd)
type(qcd_t) :: qcd
class(process_t), intent(in) :: process
end function process_get_qcd
<<Process: procedures>>=
module function process_get_qcd (process) result (qcd)
type(qcd_t) :: qcd
class(process_t), intent(in) :: process
qcd = process%config%get_qcd ()
end function process_get_qcd
@ %def process_get_qcd
@
<<Process: process: TBP>>=
generic :: get_component_type => get_component_type_single
procedure :: get_component_type_single => process_get_component_type_single
<<Process: sub interfaces>>=
elemental module function process_get_component_type_single &
(process, i_component) result (comp_type)
integer :: comp_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_component_type_single
<<Process: procedures>>=
elemental module function process_get_component_type_single &
(process, i_component) result (comp_type)
integer :: comp_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
comp_type = process%component(i_component)%component_type
end function process_get_component_type_single
@ %def process_get_component_type_single
@
<<Process: process: TBP>>=
generic :: get_component_type => get_component_type_all
procedure :: get_component_type_all => process_get_component_type_all
<<Process: sub interfaces>>=
module function process_get_component_type_all &
(process) result (comp_type)
integer, dimension(:), allocatable :: comp_type
class(process_t), intent(in) :: process
end function process_get_component_type_all
<<Process: procedures>>=
module function process_get_component_type_all &
(process) result (comp_type)
integer, dimension(:), allocatable :: comp_type
class(process_t), intent(in) :: process
allocate (comp_type (size (process%component)))
comp_type = process%component%component_type
end function process_get_component_type_all
@ %def process_get_component_type_all
@
<<Process: process: TBP>>=
procedure :: get_component_i_terms => process_get_component_i_terms
<<Process: sub interfaces>>=
module function process_get_component_i_terms &
(process, i_component) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_component_i_terms
<<Process: procedures>>=
module function process_get_component_i_terms &
(process, i_component) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
allocate (i_term (size (process%component(i_component)%i_term)))
i_term = process%component(i_component)%i_term
end function process_get_component_i_terms
@ %def process_get_component_i_terms
@
<<Process: process: TBP>>=
procedure :: get_n_allowed_born => process_get_n_allowed_born
<<Process: sub interfaces>>=
module function process_get_n_allowed_born (process, i_born) result (n_born)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_born
integer :: n_born
end function process_get_n_allowed_born
<<Process: procedures>>=
module function process_get_n_allowed_born (process, i_born) result (n_born)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_born
integer :: n_born
n_born = process%term(i_born)%n_allowed
end function process_get_n_allowed_born
@ %def process_get_n_allowed_born
@ Workaround getter. Would be better to remove this.
<<Process: process: TBP>>=
procedure :: get_pcm_ptr => process_get_pcm_ptr
<<Process: sub interfaces>>=
module function process_get_pcm_ptr (process) result (pcm)
class(pcm_t), pointer :: pcm
class(process_t), intent(in), target :: process
end function process_get_pcm_ptr
<<Process: procedures>>=
module function process_get_pcm_ptr (process) result (pcm)
class(pcm_t), pointer :: pcm
class(process_t), intent(in), target :: process
pcm => process%pcm
end function process_get_pcm_ptr
@ %def process_get_pcm_ptr
<<Process: process: TBP>>=
generic :: component_can_be_integrated => component_can_be_integrated_single
generic :: component_can_be_integrated => component_can_be_integrated_all
procedure :: component_can_be_integrated_single => &
process_component_can_be_integrated_single
<<Process: sub interfaces>>=
module function process_component_can_be_integrated_single &
(process, i_component) result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_component_can_be_integrated_single
<<Process: procedures>>=
module function process_component_can_be_integrated_single &
(process, i_component) result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
logical :: combined_integration
select type (pcm => process%pcm)
type is (pcm_nlo_t)
combined_integration = pcm%settings%combined_integration
class default
combined_integration = .false.
end select
associate (component => process%component(i_component))
active = component%can_be_integrated ()
if (combined_integration) &
active = active .and. component%component_type <= COMP_MASTER
end associate
end function process_component_can_be_integrated_single
@ %def process_component_can_be_integrated_single
@
<<Process: process: TBP>>=
procedure :: component_can_be_integrated_all => &
process_component_can_be_integrated_all
<<Process: sub interfaces>>=
module function process_component_can_be_integrated_all &
(process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
end function process_component_can_be_integrated_all
<<Process: procedures>>=
module function process_component_can_be_integrated_all (process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
integer :: i
allocate (val (size (process%component)))
do i = 1, size (process%component)
val(i) = process%component_can_be_integrated (i)
end do
end function process_component_can_be_integrated_all
@ %def process_component_can_be_integrated_all
@
<<Process: process: TBP>>=
procedure :: reset_selected_cores => process_reset_selected_cores
<<Process: sub interfaces>>=
pure module subroutine process_reset_selected_cores (process)
class(process_t), intent(inout) :: process
end subroutine process_reset_selected_cores
<<Process: procedures>>=
pure module subroutine process_reset_selected_cores (process)
class(process_t), intent(inout) :: process
process%pcm%component_selected = .false.
end subroutine process_reset_selected_cores
@ %def process_reset_selected_cores
@
<<Process: process: TBP>>=
procedure :: select_components => process_select_components
<<Process: sub interfaces>>=
pure module subroutine process_select_components (process, indices)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: indices
end subroutine process_select_components
<<Process: procedures>>=
pure module subroutine process_select_components (process, indices)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: indices
associate (pcm => process%pcm)
pcm%component_selected(indices) = .true.
end associate
end subroutine process_select_components
@ %def process_select_components
@
<<Process: process: TBP>>=
procedure :: component_is_selected => process_component_is_selected
<<Process: sub interfaces>>=
pure module function process_component_is_selected &
(process, index) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: index
end function process_component_is_selected
<<Process: procedures>>=
pure module function process_component_is_selected &
(process, index) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: index
associate (pcm => process%pcm)
val = pcm%component_selected(index)
end associate
end function process_component_is_selected
@ %def process_component_is_selected
@
<<Process: process: TBP>>=
procedure :: get_coupling_powers => process_get_coupling_powers
<<Process: sub interfaces>>=
pure module subroutine process_get_coupling_powers &
(process, alpha_power, alphas_power)
class(process_t), intent(in) :: process
integer, intent(out) :: alpha_power, alphas_power
end subroutine process_get_coupling_powers
<<Process: procedures>>=
pure module subroutine process_get_coupling_powers &
(process, alpha_power, alphas_power)
class(process_t), intent(in) :: process
integer, intent(out) :: alpha_power, alphas_power
call process%component(1)%config%get_coupling_powers &
(alpha_power, alphas_power)
end subroutine process_get_coupling_powers
@ %def process_get_coupling_powers
@
<<Process: process: TBP>>=
procedure :: get_real_component => process_get_real_component
<<Process: sub interfaces>>=
module function process_get_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
end function process_get_real_component
<<Process: procedures>>=
module function process_get_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer :: i_component
type(process_component_def_t), pointer :: config => null ()
i_real = 0
do i_component = 1, size (process%component)
config => process%get_component_def_ptr (i_component)
if (config%get_nlo_type () == NLO_REAL) then
i_real = i_component
exit
end if
end do
end function process_get_real_component
@ %def process_get_real_component
@
<<Process: process: TBP>>=
procedure :: extract_active_component_mci => &
process_extract_active_component_mci
<<Process: sub interfaces>>=
module function process_extract_active_component_mci &
(process) result (i_active)
integer :: i_active
class(process_t), intent(in) :: process
end function process_extract_active_component_mci
<<Process: procedures>>=
module function process_extract_active_component_mci &
(process) result (i_active)
integer :: i_active
class(process_t), intent(in) :: process
integer :: i_mci, j, i_component, n_active
call count_n_active ()
if (n_active /= 1) i_active = 0
contains
subroutine count_n_active ()
n_active = 0
do i_mci = 1, size (process%mci_entry)
associate (mci_entry => process%mci_entry(i_mci))
do j = 1, size (mci_entry%i_component)
i_component = mci_entry%i_component(j)
associate (component => process%component (i_component))
if (component%can_be_integrated ()) then
i_active = i_mci
n_active = n_active + 1
end if
end associate
end do
end associate
end do
end subroutine count_n_active
end function process_extract_active_component_mci
@ %def process_extract_active_component_mci
@
<<Process: process: TBP>>=
procedure :: uses_real_partition => process_uses_real_partition
<<Process: sub interfaces>>=
module function process_uses_real_partition (process) result (val)
logical :: val
class(process_t), intent(in) :: process
end function process_uses_real_partition
<<Process: procedures>>=
module function process_uses_real_partition (process) result (val)
logical :: val
class(process_t), intent(in) :: process
val = any (process%mci_entry%real_partition_type /= REAL_FULL)
end function process_uses_real_partition
@ %def process_uses_real_partition
@ Return the MD5 sums that summarize the process component
definitions. These values should be independent of parameters, beam
details, expressions, etc. They can be used for checking the
integrity of a process when reusing an old event file.
<<Process: process: TBP>>=
procedure :: get_md5sum_prc => process_get_md5sum_prc
<<Process: sub interfaces>>=
module function process_get_md5sum_prc &
(process, i_component) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_md5sum_prc
<<Process: procedures>>=
module function process_get_md5sum_prc (process, i_component) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
if (process%component(i_component)%active) then
md5sum = process%component(i_component)%config%get_md5sum ()
else
md5sum = ""
end if
end function process_get_md5sum_prc
@ %def process_get_md5sum_prc
@ Return the MD5 sums that summarize the state of the MCI integrators.
These values should encode all process data, integration and phase
space configuration, etc., and the integration results. They can thus
be used for checking the integrity of an event-generation setup when
reusing an old event file.
<<Process: process: TBP>>=
procedure :: get_md5sum_mci => process_get_md5sum_mci
<<Process: sub interfaces>>=
module function process_get_md5sum_mci (process, i_mci) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_get_md5sum_mci
<<Process: procedures>>=
module function process_get_md5sum_mci (process, i_mci) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
md5sum = process%mci_entry(i_mci)%get_md5sum ()
end function process_get_md5sum_mci
@ %def process_get_md5sum_mci
@ Return the MD5 sum of the process configuration. This should encode
the process setup, data, and expressions, but no integration results.
<<Process: process: TBP>>=
procedure :: get_md5sum_cfg => process_get_md5sum_cfg
<<Process: sub interfaces>>=
module function process_get_md5sum_cfg (process) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
end function process_get_md5sum_cfg
<<Process: procedures>>=
module function process_get_md5sum_cfg (process) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
md5sum = process%config%md5sum
end function process_get_md5sum_cfg
@ %def process_get_md5sum_cfg
@
<<Process: process: TBP>>=
procedure :: get_n_cores => process_get_n_cores
<<Process: sub interfaces>>=
module function process_get_n_cores (process) result (n)
integer :: n
class(process_t), intent(in) :: process
end function process_get_n_cores
<<Process: procedures>>=
module function process_get_n_cores (process) result (n)
integer :: n
class(process_t), intent(in) :: process
n = process%pcm%n_cores
end function process_get_n_cores
@ %def process_get_n_cores
@
<<Process: process: TBP>>=
procedure :: get_base_i_term => process_get_base_i_term
<<Process: sub interfaces>>=
module function process_get_base_i_term &
(process, i_component) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_base_i_term
<<Process: procedures>>=
module function process_get_base_i_term (process, i_component) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
i_term = process%component(i_component)%i_term(1)
end function process_get_base_i_term
@ %def process_get_base_i_term
@
<<Process: process: TBP>>=
procedure :: get_core_term => process_get_core_term
<<Process: sub interfaces>>=
module function process_get_core_term (process, i_term) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
end function process_get_core_term
<<Process: procedures>>=
module function process_get_core_term (process, i_term) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
integer :: i_core
i_core = process%term(i_term)%i_core
core => process%core_entry(i_core)%get_core_ptr ()
end function process_get_core_term
@ %def process_get_core_term
@
<<Process: process: TBP>>=
procedure :: get_core_ptr => process_get_core_ptr
<<Process: sub interfaces>>=
module function process_get_core_ptr (process, i_core) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
integer, intent(in) :: i_core
end function process_get_core_ptr
<<Process: procedures>>=
module function process_get_core_ptr (process, i_core) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
integer, intent(in) :: i_core
if (allocated (process%core_entry)) then
core => process%core_entry(i_core)%get_core_ptr ()
else
core => null ()
end if
end function process_get_core_ptr
@ %def process_get_core_ptr
@
<<Process: process: TBP>>=
procedure :: get_term_ptr => process_get_term_ptr
<<Process: sub interfaces>>=
module function process_get_term_ptr (process, i) result (term)
type(process_term_t), pointer :: term
class(process_t), intent(in), target :: process
integer, intent(in) :: i
end function process_get_term_ptr
<<Process: procedures>>=
module function process_get_term_ptr (process, i) result (term)
type(process_term_t), pointer :: term
class(process_t), intent(in), target :: process
integer, intent(in) :: i
term => process%term(i)
end function process_get_term_ptr
@ %def process_get_term_ptr
@
<<Process: process: TBP>>=
procedure :: get_i_term => process_get_i_term
<<Process: sub interfaces>>=
module function process_get_i_term (process, i_core) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
end function process_get_i_term
<<Process: procedures>>=
module function process_get_i_term (process, i_core) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
do i_term = 1, process%get_n_terms ()
if (process%term(i_term)%i_core == i_core) return
end do
i_term = -1
end function process_get_i_term
@ %def process_get_i_term
@
<<Process: process: TBP>>=
procedure :: get_i_core => process_get_i_core
<<Process: sub interfaces>>=
module function process_get_i_core (process, i_term) result (i_core)
class(process_t), intent(in) :: process
integer, intent(in) :: i_term
integer :: i_core
end function process_get_i_core
<<Process: procedures>>=
module function process_get_i_core (process, i_term) result (i_core)
class(process_t), intent(in) :: process
integer, intent(in) :: i_term
integer :: i_core
i_core = process%term(i_term)%i_core
end function process_get_i_core
@ %def process_get_i_core
@
<<Process: process: TBP>>=
procedure :: set_i_mci_work => process_set_i_mci_work
<<Process: sub interfaces>>=
module subroutine process_set_i_mci_work (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
end subroutine process_set_i_mci_work
<<Process: procedures>>=
module subroutine process_set_i_mci_work (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
process%mci_entry(i_mci)%i_mci = i_mci
end subroutine process_set_i_mci_work
@ %def process_set_i_mci_work
@
<<Process: process: TBP>>=
procedure :: get_i_mci_work => process_get_i_mci_work
<<Process: sub interfaces>>=
pure module function process_get_i_mci_work &
(process, i_mci) result (i_mci_work)
integer :: i_mci_work
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_get_i_mci_work
<<Process: procedures>>=
pure module function process_get_i_mci_work &
(process, i_mci) result (i_mci_work)
integer :: i_mci_work
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
i_mci_work = process%mci_entry(i_mci)%i_mci
end function process_get_i_mci_work
@ %def process_get_i_mci_work
@
<<Process: process: TBP>>=
procedure :: get_i_sub => process_get_i_sub
<<Process: sub interfaces>>=
elemental module function process_get_i_sub (process, i_term) result (i_sub)
integer :: i_sub
class(process_t), intent(in) :: process
integer, intent(in) :: i_term
end function process_get_i_sub
<<Process: procedures>>=
elemental module function process_get_i_sub (process, i_term) result (i_sub)
integer :: i_sub
class(process_t), intent(in) :: process
integer, intent(in) :: i_term
i_sub = process%term(i_term)%i_sub
end function process_get_i_sub
@ %def process_get_i_sub
@
<<Process: process: TBP>>=
procedure :: get_i_term_virtual => process_get_i_term_virtual
<<Process: sub interfaces>>=
elemental module function process_get_i_term_virtual &
(process) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
end function process_get_i_term_virtual
<<Process: procedures>>=
elemental module function process_get_i_term_virtual (process) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer :: i_component
i_term = 0
do i_component = 1, size (process%component)
if (process%component(i_component)%get_nlo_type () == NLO_VIRTUAL) &
i_term = process%component(i_component)%i_term(1)
end do
end function process_get_i_term_virtual
@ %def process_get_i_term_virtual
@
<<Process: process: TBP>>=
generic :: component_is_active => component_is_active_single
procedure :: component_is_active_single => process_component_is_active_single
<<Process: sub interfaces>>=
elemental module function process_component_is_active_single &
(process, i_comp) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_comp
end function process_component_is_active_single
<<Process: procedures>>=
elemental module function process_component_is_active_single &
(process, i_comp) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_comp
val = process%component(i_comp)%is_active ()
end function process_component_is_active_single
@ %def process_component_is_active_single
@
<<Process: process: TBP>>=
generic :: component_is_active => component_is_active_all
procedure :: component_is_active_all => process_component_is_active_all
<<Process: sub interfaces>>=
pure module function process_component_is_active_all (process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
end function process_component_is_active_all
<<Process: procedures>>=
pure module function process_component_is_active_all (process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
allocate (val (size (process%component)))
val = process%component%is_active ()
end function process_component_is_active_all
@ %def process_component_is_active_all
@
\subsection{Default iterations}
If the user does not specify the passes and iterations for
integration, we should be able to give reasonable defaults. These
depend on the process, therefore we implement the following procedures
as methods of the process object. The algorithm is not very
sophisticated yet, it may be improved by looking at the process in
more detail.
We investigate only the first process component, assuming that it
characterizes the complexity of the process reasonable well.
The number of passes is limited to two: one for adaption, one for
integration.
<<Process: process: TBP>>=
procedure :: get_n_pass_default => process_get_n_pass_default
procedure :: adapt_grids_default => process_adapt_grids_default
procedure :: adapt_weights_default => process_adapt_weights_default
<<Process: sub interfaces>>=
module function process_get_n_pass_default (process) result (n_pass)
class(process_t), intent(in) :: process
integer :: n_pass
end function process_get_n_pass_default
module function process_adapt_grids_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
end function process_adapt_grids_default
module function process_adapt_weights_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
end function process_adapt_weights_default
<<Process: procedures>>=
module function process_get_n_pass_default (process) result (n_pass)
class(process_t), intent(in) :: process
integer :: n_pass
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
n_pass = 1
case default
n_pass = 2
end select
end function process_get_n_pass_default
module function process_adapt_grids_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
flag = .false.
case default
select case (pass)
case (1); flag = .true.
case (2); flag = .false.
case default
call msg_bug ("adapt grids default: impossible pass index")
end select
end select
end function process_adapt_grids_default
module function process_adapt_weights_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
flag = .false.
case default
select case (pass)
case (1); flag = .true.
case (2); flag = .false.
case default
call msg_bug ("adapt weights default: impossible pass index")
end select
end select
end function process_adapt_weights_default
@ %def process_get_n_pass_default
@ %def process_adapt_grids_default
@ %def process_adapt_weights_default
@ The number of iterations and calls per iteration depends on the
number of outgoing particles.
<<Process: process: TBP>>=
procedure :: get_n_it_default => process_get_n_it_default
procedure :: get_n_calls_default => process_get_n_calls_default
<<Process: sub interfaces>>=
module function process_get_n_it_default (process, pass) result (n_it)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_it
end function process_get_n_it_default
module function process_get_n_calls_default (process, pass) result (n_calls)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_calls
end function process_get_n_calls_default
<<Process: procedures>>=
module function process_get_n_it_default (process, pass) result (n_it)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_it
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (pass)
case (1)
select case (n_eff)
case (1); n_it = 1
case (2); n_it = 3
case (3); n_it = 5
case (4:5); n_it = 10
case (6); n_it = 15
case (7:); n_it = 20
end select
case (2)
select case (n_eff)
case (:3); n_it = 3
case (4:); n_it = 5
end select
end select
end function process_get_n_it_default
module function process_get_n_calls_default (process, pass) result (n_calls)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_calls
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (pass)
case (1)
select case (n_eff)
case (1); n_calls = 100
case (2); n_calls = 1000
case (3); n_calls = 5000
case (4); n_calls = 10000
case (5); n_calls = 20000
case (6:); n_calls = 50000
end select
case (2)
select case (n_eff)
case (:3); n_calls = 10000
case (4); n_calls = 20000
case (5); n_calls = 50000
case (6); n_calls = 100000
case (7:); n_calls = 200000
end select
end select
end function process_get_n_calls_default
@ %def process_get_n_it_default
@ %def process_get_n_calls_default
@
\subsection{Constant process data}
Manually set the Run ID (unit test only).
<<Process: process: TBP>>=
procedure :: set_run_id => process_set_run_id
<<Process: sub interfaces>>=
module subroutine process_set_run_id (process, run_id)
class(process_t), intent(inout) :: process
type(string_t), intent(in) :: run_id
end subroutine process_set_run_id
<<Process: procedures>>=
module subroutine process_set_run_id (process, run_id)
class(process_t), intent(inout) :: process
type(string_t), intent(in) :: run_id
process%meta%run_id = run_id
end subroutine process_set_run_id
@ %def process_set_run_id
@
The following methods return basic process data that stay constant
after initialization.
The process and IDs.
<<Process: process: TBP>>=
procedure :: get_id => process_get_id
procedure :: get_num_id => process_get_num_id
procedure :: get_run_id => process_get_run_id
procedure :: get_library_name => process_get_library_name
<<Process: sub interfaces>>=
module function process_get_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
end function process_get_id
module function process_get_num_id (process) result (id)
class(process_t), intent(in) :: process
integer :: id
end function process_get_num_id
module function process_get_run_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
end function process_get_run_id
module function process_get_library_name (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
end function process_get_library_name
<<Process: procedures>>=
module function process_get_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%id
end function process_get_id
module function process_get_num_id (process) result (id)
class(process_t), intent(in) :: process
integer :: id
id = process%meta%num_id
end function process_get_num_id
module function process_get_run_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%run_id
end function process_get_run_id
module function process_get_library_name (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%lib_name
end function process_get_library_name
@ %def process_get_id process_get_num_id
@ %def process_get_run_id process_get_library_name
@ The number of incoming particles.
<<Process: process: TBP>>=
procedure :: get_n_in => process_get_n_in
<<Process: sub interfaces>>=
module function process_get_n_in (process) result (n)
class(process_t), intent(in) :: process
integer :: n
end function process_get_n_in
<<Process: procedures>>=
module function process_get_n_in (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_in
end function process_get_n_in
@ %def process_get_n_in
@ The number of MCI data sets.
<<Process: process: TBP>>=
procedure :: get_n_mci => process_get_n_mci
<<Process: sub interfaces>>=
module function process_get_n_mci (process) result (n)
class(process_t), intent(in) :: process
integer :: n
end function process_get_n_mci
<<Process: procedures>>=
module function process_get_n_mci (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_mci
end function process_get_n_mci
@ %def process_get_n_mci
@ The number of process components, total.
<<Process: process: TBP>>=
procedure :: get_n_components => process_get_n_components
<<Process: sub interfaces>>=
module function process_get_n_components (process) result (n)
class(process_t), intent(in) :: process
integer :: n
end function process_get_n_components
<<Process: procedures>>=
module function process_get_n_components (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%meta%n_components
end function process_get_n_components
@ %def process_get_n_components
@ The number of process terms, total.
<<Process: process: TBP>>=
procedure :: get_n_terms => process_get_n_terms
<<Process: sub interfaces>>=
module function process_get_n_terms (process) result (n)
class(process_t), intent(in) :: process
integer :: n
end function process_get_n_terms
<<Process: procedures>>=
module function process_get_n_terms (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_terms
end function process_get_n_terms
@ %def process_get_n_terms
@ Return the indices of the components that belong to a
specific MCI entry.
<<Process: process: TBP>>=
procedure :: get_i_component => process_get_i_component
<<Process: sub interfaces>>=
module subroutine process_get_i_component (process, i_mci, i_component)
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer, dimension(:), intent(out), allocatable :: i_component
end subroutine process_get_i_component
<<Process: procedures>>=
module subroutine process_get_i_component (process, i_mci, i_component)
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer, dimension(:), intent(out), allocatable :: i_component
associate (mci_entry => process%mci_entry(i_mci))
allocate (i_component (size (mci_entry%i_component)))
i_component = mci_entry%i_component
end associate
end subroutine process_get_i_component
@ %def process_get_i_component
@ Return the ID of a specific component.
<<Process: process: TBP>>=
procedure :: get_component_id => process_get_component_id
<<Process: sub interfaces>>=
module function process_get_component_id (process, i_component) result (id)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t) :: id
end function process_get_component_id
<<Process: procedures>>=
module function process_get_component_id (process, i_component) result (id)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t) :: id
id = process%meta%component_id(i_component)
end function process_get_component_id
@ %def process_get_component_id
@ Return a pointer to the definition of a specific component.
<<Process: process: TBP>>=
procedure :: get_component_def_ptr => process_get_component_def_ptr
<<Process: sub interfaces>>=
module function process_get_component_def_ptr &
(process, i_component) result (ptr)
type(process_component_def_t), pointer :: ptr
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_component_def_ptr
<<Process: procedures>>=
module function process_get_component_def_ptr &
(process, i_component) result (ptr)
type(process_component_def_t), pointer :: ptr
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
ptr => process%config%process_def%get_component_def_ptr (i_component)
end function process_get_component_def_ptr
@ %def process_get_component_def_ptr
@ These procedures extract and restore (by transferring the
allocation) the process core. This is useful for changing process
parameters from outside this module.
<<Process: process: TBP>>=
procedure :: extract_core => process_extract_core
procedure :: restore_core => process_restore_core
<<Process: sub interfaces>>=
module subroutine process_extract_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
end subroutine process_extract_core
module subroutine process_restore_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
end subroutine process_restore_core
<<Process: procedures>>=
module subroutine process_extract_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
integer :: i_core
i_core = process%term(i_term)%i_core
call move_alloc (from = process%core_entry(i_core)%core, to = core)
end subroutine process_extract_core
module subroutine process_restore_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
integer :: i_core
i_core = process%term(i_term)%i_core
call move_alloc (from = core, to = process%core_entry(i_core)%core)
end subroutine process_restore_core
@ %def process_extract_core
@ %def process_restore_core
@ The block of process constants.
<<Process: process: TBP>>=
procedure :: get_constants => process_get_constants
<<Process: sub interfaces>>=
module function process_get_constants (process, i_core) result (data)
type(process_constants_t) :: data
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
end function process_get_constants
<<Process: procedures>>=
module function process_get_constants (process, i_core) result (data)
type(process_constants_t) :: data
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
data = process%core_entry(i_core)%core%data
end function process_get_constants
@ %def process_get_constants
@
<<Process: process: TBP>>=
procedure :: get_config => process_get_config
<<Process: sub interfaces>>=
module function process_get_config (process) result (config)
type(process_config_data_t) :: config
class(process_t), intent(in) :: process
end function process_get_config
<<Process: procedures>>=
module function process_get_config (process) result (config)
type(process_config_data_t) :: config
class(process_t), intent(in) :: process
config = process%config
end function process_get_config
@ %def process_get_config
@
Construct an MD5 sum for the constant data, including the NLO type.
For the NLO type [[NLO_MISMATCH]], we pretend that this was
[[NLO_SUBTRACTION]] instead.
TODO wk 2018: should not depend explicitly on NLO data.
<<Process: process: TBP>>=
procedure :: get_md5sum_constants => process_get_md5sum_constants
<<Process: sub interfaces>>=
module function process_get_md5sum_constants (process, i_component, &
type_string, nlo_type) result (this_md5sum)
character(32) :: this_md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t), intent(in) :: type_string
integer, intent(in) :: nlo_type
end function process_get_md5sum_constants
<<Process: procedures>>=
module function process_get_md5sum_constants (process, i_component, &
type_string, nlo_type) result (this_md5sum)
character(32) :: this_md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t), intent(in) :: type_string
integer, intent(in) :: nlo_type
type(process_constants_t) :: data
integer :: unit
call process%env%fill_process_constants (process%meta%id, i_component, data)
unit = data%fill_unit_for_md5sum (.false.)
write (unit, '(A)') char(type_string)
select case (nlo_type)
case (NLO_MISMATCH)
write (unit, '(I0)') NLO_SUBTRACTION
case default
write (unit, '(I0)') nlo_type
end select
rewind (unit)
this_md5sum = md5sum (unit)
close (unit)
end function process_get_md5sum_constants
@ %def process_get_md5sum_constants
@ Return the set of outgoing flavors that are associated with a particular
term. We deduce this from the effective interaction.
<<Process: process: TBP>>=
procedure :: get_term_flv_out => process_get_term_flv_out
<<Process: sub interfaces>>=
module subroutine process_get_term_flv_out (process, i_term, flv)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
end subroutine process_get_term_flv_out
<<Process: procedures>>=
module subroutine process_get_term_flv_out (process, i_term, flv)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
type(interaction_t), pointer :: int
int => process%term(i_term)%int_eff
if (.not. associated (int)) int => process%term(i_term)%int
call int%get_flv_out (flv)
end subroutine process_get_term_flv_out
@ %def process_get_term_flv_out
@ Return true if there is any unstable particle in any of the process
terms. We decide this based on the provided model instance, not the
one that is stored in the process object.
<<Process: process: TBP>>=
procedure :: contains_unstable => process_contains_unstable
<<Process: sub interfaces>>=
module function process_contains_unstable (process, model) result (flag)
class(process_t), intent(in) :: process
class(model_data_t), intent(in), target :: model
logical :: flag
end function process_contains_unstable
<<Process: procedures>>=
module function process_contains_unstable (process, model) result (flag)
class(process_t), intent(in) :: process
class(model_data_t), intent(in), target :: model
logical :: flag
integer :: i_term
type(flavor_t), dimension(:,:), allocatable :: flv
flag = .false.
do i_term = 1, process%get_n_terms ()
call process%get_term_flv_out (i_term, flv)
call flv%set_model (model)
flag = .not. all (flv%is_stable ())
deallocate (flv)
if (flag) return
end do
end function process_contains_unstable
@ %def process_contains_unstable
@ The nominal process energy.
<<Process: process: TBP>>=
procedure :: get_sqrts => process_get_sqrts
<<Process: sub interfaces>>=
module function process_get_sqrts (process) result (sqrts)
class(process_t), intent(in) :: process
real(default) :: sqrts
end function process_get_sqrts
<<Process: procedures>>=
module function process_get_sqrts (process) result (sqrts)
class(process_t), intent(in) :: process
real(default) :: sqrts
sqrts = process%beam_config%data%get_sqrts ()
end function process_get_sqrts
@ %def process_get_sqrts
@ The lab-frame beam energy/energies..
<<Process: process: TBP>>=
procedure :: get_energy => process_get_energy
<<Process: sub interfaces>>=
module function process_get_energy (process) result (e)
class(process_t), intent(in) :: process
real(default), dimension(:), allocatable :: e
end function process_get_energy
<<Process: procedures>>=
module function process_get_energy (process) result (e)
class(process_t), intent(in) :: process
real(default), dimension(:), allocatable :: e
e = process%beam_config%data%get_energy ()
end function process_get_energy
@ %def process_get_energy
@ The beam polarization in case of simple degrees.
<<Process: process: TBP>>=
procedure :: get_polarization => process_get_polarization
<<Process: sub interfaces>>=
module function process_get_polarization (process) result (pol)
class(process_t), intent(in) :: process
real(default), dimension(process%beam_config%data%n) :: pol
end function process_get_polarization
<<Process: procedures>>=
module function process_get_polarization (process) result (pol)
class(process_t), intent(in) :: process
real(default), dimension(process%beam_config%data%n) :: pol
pol = process%beam_config%data%get_polarization ()
end function process_get_polarization
@ %def process_get_polarization
@
<<Process: process: TBP>>=
procedure :: get_meta => process_get_meta
<<Process: sub interfaces>>=
module function process_get_meta (process) result (meta)
type(process_metadata_t) :: meta
class(process_t), intent(in) :: process
end function process_get_meta
<<Process: procedures>>=
module function process_get_meta (process) result (meta)
type(process_metadata_t) :: meta
class(process_t), intent(in) :: process
meta = process%meta
end function process_get_meta
@ %def process_get_meta
<<Process: process: TBP>>=
procedure :: has_matrix_element => process_has_matrix_element
<<Process: sub interfaces>>=
module function process_has_matrix_element &
(process, i, is_term_index) result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in), optional :: i
logical, intent(in), optional :: is_term_index
end function process_has_matrix_element
<<Process: procedures>>=
module function process_has_matrix_element &
(process, i, is_term_index) result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in), optional :: i
logical, intent(in), optional :: is_term_index
integer :: i_component
logical :: is_term
is_term = .false.
if (present (i)) then
if (present (is_term_index)) is_term = is_term_index
if (is_term) then
i_component = process%term(i)%i_component
else
i_component = i
end if
active = process%component(i_component)%active
else
active = any (process%component%active)
end if
end function process_has_matrix_element
@ %def process_has_matrix_element
@ Pointer to the beam data object.
<<Process: process: TBP>>=
procedure :: get_beam_data_ptr => process_get_beam_data_ptr
<<Process: sub interfaces>>=
module function process_get_beam_data_ptr (process) result (beam_data)
class(process_t), intent(in), target :: process
type(beam_data_t), pointer :: beam_data
end function process_get_beam_data_ptr
<<Process: procedures>>=
module function process_get_beam_data_ptr (process) result (beam_data)
class(process_t), intent(in), target :: process
type(beam_data_t), pointer :: beam_data
beam_data => process%beam_config%data
end function process_get_beam_data_ptr
@ %def process_get_beam_data_ptr
@
<<Process: process: TBP>>=
procedure :: get_beam_config => process_get_beam_config
<<Process: sub interfaces>>=
module function process_get_beam_config (process) result (beam_config)
type(process_beam_config_t) :: beam_config
class(process_t), intent(in) :: process
end function process_get_beam_config
<<Process: procedures>>=
module function process_get_beam_config (process) result (beam_config)
type(process_beam_config_t) :: beam_config
class(process_t), intent(in) :: process
beam_config = process%beam_config
end function process_get_beam_config
@ %def process_get_beam_config
@
<<Process: process: TBP>>=
procedure :: get_beam_config_ptr => process_get_beam_config_ptr
<<Process: sub interfaces>>=
module function process_get_beam_config_ptr (process) result (beam_config)
type(process_beam_config_t), pointer :: beam_config
class(process_t), intent(in), target :: process
end function process_get_beam_config_ptr
<<Process: procedures>>=
module function process_get_beam_config_ptr (process) result (beam_config)
type(process_beam_config_t), pointer :: beam_config
class(process_t), intent(in), target :: process
beam_config => process%beam_config
end function process_get_beam_config_ptr
@ %def process_get_beam_config_ptr
@ Get the PDF set currently in use, if any.
<<Process: process: TBP>>=
procedure :: get_pdf_set => process_get_pdf_set
<<Process: sub interfaces>>=
module function process_get_pdf_set (process) result (pdf_set)
class(process_t), intent(in) :: process
integer :: pdf_set
end function process_get_pdf_set
<<Process: procedures>>=
module function process_get_pdf_set (process) result (pdf_set)
class(process_t), intent(in) :: process
integer :: pdf_set
pdf_set = process%beam_config%get_pdf_set ()
end function process_get_pdf_set
@ %def process_get_pdf_set
@
<<Process: process: TBP>>=
procedure :: pcm_contains_pdfs => process_pcm_contains_pdfs
<<Process: sub interfaces>>=
module function process_pcm_contains_pdfs (process) result (has_pdfs)
logical :: has_pdfs
class(process_t), intent(in) :: process
end function process_pcm_contains_pdfs
<<Process: procedures>>=
module function process_pcm_contains_pdfs (process) result (has_pdfs)
logical :: has_pdfs
class(process_t), intent(in) :: process
has_pdfs = process%pcm%has_pdfs
end function process_pcm_contains_pdfs
@ %def process_pcm_contains_pdfs
@ Get the beam spectrum file currently in use, if any.
<<Process: process: TBP>>=
procedure :: get_beam_file => process_get_beam_file
<<Process: sub interfaces>>=
module function process_get_beam_file (process) result (file)
class(process_t), intent(in) :: process
type(string_t) :: file
end function process_get_beam_file
<<Process: procedures>>=
module function process_get_beam_file (process) result (file)
class(process_t), intent(in) :: process
type(string_t) :: file
file = process%beam_config%get_beam_file ()
end function process_get_beam_file
@ %def process_get_beam_file
@ Pointer to the process variable list.
<<Process: process: TBP>>=
procedure :: get_var_list_ptr => process_get_var_list_ptr
<<Process: sub interfaces>>=
module function process_get_var_list_ptr (process) result (ptr)
class(process_t), intent(in), target :: process
type(var_list_t), pointer :: ptr
end function process_get_var_list_ptr
<<Process: procedures>>=
module function process_get_var_list_ptr (process) result (ptr)
class(process_t), intent(in), target :: process
type(var_list_t), pointer :: ptr
ptr => process%env%get_var_list_ptr ()
end function process_get_var_list_ptr
@ %def process_get_var_list_ptr
@ Pointer to the common model.
<<Process: process: TBP>>=
procedure :: get_model_ptr => process_get_model_ptr
<<Process: sub interfaces>>=
module function process_get_model_ptr (process) result (ptr)
class(process_t), intent(in) :: process
class(model_data_t), pointer :: ptr
end function process_get_model_ptr
<<Process: procedures>>=
module function process_get_model_ptr (process) result (ptr)
class(process_t), intent(in) :: process
class(model_data_t), pointer :: ptr
ptr => process%config%model
end function process_get_model_ptr
@ %def process_get_model_ptr
@ Use the embedded RNG factory to spawn a new random-number generator
instance. (This modifies the state of the factory.)
<<Process: process: TBP>>=
procedure :: make_rng => process_make_rng
<<Process: sub interfaces>>=
module subroutine process_make_rng (process, rng)
class(process_t), intent(inout) :: process
class(rng_t), intent(out), allocatable :: rng
end subroutine process_make_rng
<<Process: procedures>>=
module subroutine process_make_rng (process, rng)
class(process_t), intent(inout) :: process
class(rng_t), intent(out), allocatable :: rng
if (allocated (process%rng_factory)) then
call process%rng_factory%make (rng)
else
call msg_bug ("Process: make rng: factory not allocated")
end if
end subroutine process_make_rng
@ %def process_make_rng
@
\subsection{Compute an amplitude}
Each process variant should allow for computing an amplitude value
directly, without generating a process instance.
The process component is selected by the index [[i]]. The term within the
process component is selected by [[j]]. The momentum
combination is transferred as the array [[p]]. The function sets the specific
quantum state via the indices of a flavor [[f]], helicity [[h]], and color
[[c]] combination. Each index refers to the list of flavor, helicity, and
color states, respectively, as stored in the process data.
Optionally, we may set factorization and renormalization scale. If unset, the
partonic c.m.\ energy is inserted.
The function checks arguments for validity.
For invalid arguments (quantum states), we return zero.
<<Process: process: TBP>>=
procedure :: compute_amplitude => process_compute_amplitude
<<Process: sub interfaces>>=
module function process_compute_amplitude (process, i_core, i, j, p, &
f, h, c, fac_scale, ren_scale, alpha_qcd_forced) result (amp)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_core
integer, intent(in) :: i, j
type(vector4_t), dimension(:), intent(in) :: p
integer, intent(in) :: f, h, c
real(default), intent(in), optional :: fac_scale, ren_scale
real(default), intent(in), allocatable, optional :: alpha_qcd_forced
complex(default) :: amp
end function process_compute_amplitude
<<Process: procedures>>=
module function process_compute_amplitude (process, i_core, i, j, p, &
f, h, c, fac_scale, ren_scale, alpha_qcd_forced) result (amp)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_core
integer, intent(in) :: i, j
type(vector4_t), dimension(:), intent(in) :: p
integer, intent(in) :: f, h, c
real(default), intent(in), optional :: fac_scale, ren_scale
real(default), intent(in), allocatable, optional :: alpha_qcd_forced
real(default) :: fscale, rscale
real(default), allocatable :: aqcd_forced
complex(default) :: amp
class(prc_core_t), pointer :: core
amp = 0
if (0 < i .and. i <= process%meta%n_components) then
if (process%component(i)%active) then
associate (core => process%core_entry(i_core)%core)
associate (data => core%data)
if (size (p) == data%n_in + data%n_out &
.and. 0 < f .and. f <= data%n_flv &
.and. 0 < h .and. h <= data%n_hel &
.and. 0 < c .and. c <= data%n_col) then
if (present (fac_scale)) then
fscale = fac_scale
else
fscale = sum (p(data%n_in+1:)) ** 1
end if
if (present (ren_scale)) then
rscale = ren_scale
else
rscale = fscale
end if
if (present (alpha_qcd_forced)) then
if (allocated (alpha_qcd_forced)) &
allocate (aqcd_forced, source = alpha_qcd_forced)
end if
amp = core%compute_amplitude (j, p, f, h, c, &
fscale, rscale, aqcd_forced)
end if
end associate
end associate
else
amp = 0
end if
end if
end function process_compute_amplitude
@ %def process_compute_amplitude
@ Sanity check for the process library. We abort the program if it
has changed after process initialization.
<<Process: process: TBP>>=
procedure :: check_library_sanity => process_check_library_sanity
<<Process: sub interfaces>>=
module subroutine process_check_library_sanity (process)
class(process_t), intent(in) :: process
end subroutine process_check_library_sanity
<<Process: procedures>>=
module subroutine process_check_library_sanity (process)
class(process_t), intent(in) :: process
call process%env%check_lib_sanity (process%meta)
end subroutine process_check_library_sanity
@ %def process_check_library_sanity
@ Reset the association to a process library.
<<Process: process: TBP>>=
procedure :: reset_library_ptr => process_reset_library_ptr
<<Process: sub interfaces>>=
module subroutine process_reset_library_ptr (process)
class(process_t), intent(inout) :: process
end subroutine process_reset_library_ptr
<<Process: procedures>>=
module subroutine process_reset_library_ptr (process)
class(process_t), intent(inout) :: process
call process%env%reset_lib_ptr ()
end subroutine process_reset_library_ptr
@ %def process_reset_library_ptr
@
<<Process: process: TBP>>=
procedure :: set_counter_mci_entry => process_set_counter_mci_entry
<<Process: sub interfaces>>=
module subroutine process_set_counter_mci_entry (process, i_mci, counter)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(process_counter_t), intent(in) :: counter
end subroutine process_set_counter_mci_entry
<<Process: procedures>>=
module subroutine process_set_counter_mci_entry (process, i_mci, counter)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(process_counter_t), intent(in) :: counter
process%mci_entry(i_mci)%counter = counter
end subroutine process_set_counter_mci_entry
@ %def process_set_counter_mci_entry
@ This is for suppression of numerical noise in the integration results
stored in the [[process_mci_entry]] type. As the error and efficiency
enter the MD5 sum, we recompute it.
<<Process: process: TBP>>=
procedure :: pacify => process_pacify
<<Process: sub interfaces>>=
module subroutine process_pacify (process, efficiency_reset, error_reset)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: efficiency_reset, error_reset
end subroutine process_pacify
<<Process: procedures>>=
module subroutine process_pacify (process, efficiency_reset, error_reset)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: efficiency_reset, error_reset
logical :: eff_reset, err_reset
integer :: i
eff_reset = .false.
err_reset = .false.
if (present (efficiency_reset)) eff_reset = efficiency_reset
if (present (error_reset)) err_reset = error_reset
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
call process%mci_entry(i)%results%pacify (efficiency_reset)
if (allocated (process%mci_entry(i)%mci)) then
associate (mci => process%mci_entry(i)%mci)
if (process%mci_entry(i)%mci%error_known &
.and. err_reset) &
mci%error = 0
if (process%mci_entry(i)%mci%efficiency_known &
.and. eff_reset) &
mci%efficiency = 1
call mci%pacify (efficiency_reset, error_reset)
call mci%compute_md5sum ()
end associate
end if
end do
end if
end subroutine process_pacify
@ %def process_pacify
@ The following methods are used only in the unit tests; the access
process internals directly that would otherwise be hidden.
<<Process: process: TBP>>=
procedure :: test_allocate_sf_channels
procedure :: test_set_component_sf_channel
procedure :: test_get_mci_ptr
<<Process: sub interfaces>>=
module subroutine test_allocate_sf_channels (process, n)
class(process_t), intent(inout) :: process
integer, intent(in) :: n
end subroutine test_allocate_sf_channels
module subroutine test_set_component_sf_channel (process, c)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: c
end subroutine test_set_component_sf_channel
module subroutine test_get_mci_ptr (process, mci)
class(process_t), intent(in), target :: process
class(mci_t), intent(out), pointer :: mci
end subroutine test_get_mci_ptr
<<Process: procedures>>=
module subroutine test_allocate_sf_channels (process, n)
class(process_t), intent(inout) :: process
integer, intent(in) :: n
call process%beam_config%allocate_sf_channels (n)
end subroutine test_allocate_sf_channels
module subroutine test_set_component_sf_channel (process, c)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: c
call process%component(1)%phs_config%set_sf_channel (c)
end subroutine test_set_component_sf_channel
module subroutine test_get_mci_ptr (process, mci)
class(process_t), intent(in), target :: process
class(mci_t), intent(out), pointer :: mci
mci => process%mci_entry(1)%mci
end subroutine test_get_mci_ptr
@ %def test_allocate_sf_channels
@ %def test_set_component_sf_channel
@ %def test_get_mci_ptr
@
<<Process: process: TBP>>=
procedure :: init_mci_work => process_init_mci_work
<<Process: sub interfaces>>=
module subroutine process_init_mci_work (process, mci_work, i)
class(process_t), intent(in), target :: process
type(mci_work_t), intent(out) :: mci_work
integer, intent(in) :: i
end subroutine process_init_mci_work
<<Process: procedures>>=
module subroutine process_init_mci_work (process, mci_work, i)
class(process_t), intent(in), target :: process
type(mci_work_t), intent(out) :: mci_work
integer, intent(in) :: i
call mci_work%init (process%mci_entry(i))
end subroutine process_init_mci_work
@ %def process_init_mci_work
@
Prepare the process core with type [[test_me]], or otherwise the externally
provided [[type_string]] version. The toy dispatchers as a procedure
argument come handy, knowing that we need to support only the [[test_me]] and
[[template]] matrix-element types.
Gfortran 7/8/9 bug, has to remain in the main module:
<<Process: process: TBP>>=
procedure :: setup_test_cores => process_setup_test_cores
<<Process: main procedures>>=
subroutine dispatch_test_me_core (core, core_def, model, &
helicity_selection, qcd, use_color_factors, has_beam_pol)
use prc_test_core, only: test_t
class(prc_core_t), allocatable, intent(inout) :: core
class(prc_core_def_t), intent(in) :: core_def
class(model_data_t), intent(in), target, optional :: model
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(qcd_t), intent(in), optional :: qcd
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
allocate (test_t :: core)
end subroutine dispatch_test_me_core
subroutine dispatch_template_core (core, core_def, model, &
helicity_selection, qcd, use_color_factors, has_beam_pol)
use prc_template_me, only: prc_template_me_t
class(prc_core_t), allocatable, intent(inout) :: core
class(prc_core_def_t), intent(in) :: core_def
class(model_data_t), intent(in), target, optional :: model
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(qcd_t), intent(in), optional :: qcd
logical, intent(in), optional :: use_color_factors
logical, intent(in), optional :: has_beam_pol
allocate (prc_template_me_t :: core)
select type (core)
type is (prc_template_me_t)
call core%set_parameters (model)
end select
end subroutine dispatch_template_core
subroutine process_setup_test_cores (process, type_string)
class(process_t), intent(inout) :: process
class(prc_core_t), allocatable :: core
type(string_t), intent(in), optional :: type_string
if (present (type_string)) then
select case (char (type_string))
case ("template")
call process%setup_cores (dispatch_template_core)
case ("test_me")
call process%setup_cores (dispatch_test_me_core)
case default
call msg_bug ("process setup test cores: unsupported type string")
end select
else
call process%setup_cores (dispatch_test_me_core)
end if
end subroutine process_setup_test_cores
@ %def process_setup_test_cores
@
<<Process: process: TBP>>=
procedure :: get_connected_states => process_get_connected_states
<<Process: sub interfaces>>=
module function process_get_connected_states (process, i_component, &
connected_terms) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(connected_state_t), dimension(:), intent(in) :: connected_terms
end function process_get_connected_states
<<Process: procedures>>=
module function process_get_connected_states (process, i_component, &
connected_terms) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(connected_state_t), dimension(:), intent(in) :: connected_terms
integer :: i, i_conn
integer :: n_conn
n_conn = 0
do i = 1, process%get_n_terms ()
if (process%term(i)%i_component == i_component) then
n_conn = n_conn + 1
end if
end do
allocate (connected (n_conn))
i_conn = 1
do i = 1, process%get_n_terms ()
if (process%term(i)%i_component == i_component) then
connected (i_conn) = connected_terms(i)
i_conn = i_conn + 1
end if
end do
end function process_get_connected_states
@ %def process_get_connected_states
@
\subsection{NLO specifics}
These subroutines (and the NLO specific properties they work on) could
potentially be moved to [[pcm_nlo_t]] and used more generically in
[[process_t]] with an appropriate interface in [[pcm_t]]
TODO wk 2018: This is used only by event initialization, which deals
with an incomplete process object.
<<Process: process: TBP>>=
procedure :: init_nlo_settings => process_init_nlo_settings
<<Process: sub interfaces>>=
module subroutine process_init_nlo_settings (process, var_list)
class(process_t), intent(inout) :: process
type(var_list_t), intent(in), target :: var_list
end subroutine process_init_nlo_settings
<<Process: procedures>>=
module subroutine process_init_nlo_settings (process, var_list)
class(process_t), intent(inout) :: process
type(var_list_t), intent(in), target :: var_list
select type (pcm => process%pcm)
type is (pcm_nlo_t)
call pcm%init_nlo_settings (var_list)
if (debug_active (D_SUBTRACTION) .or. debug_active (D_VIRTUAL)) &
call pcm%settings%write ()
class default
call msg_fatal ("Attempt to set nlo_settings with a non-NLO pcm!")
end select
end subroutine process_init_nlo_settings
@ %def process_init_nlo_settings
@
<<Process: process: TBP>>=
generic :: get_nlo_type_component => get_nlo_type_component_single
procedure :: get_nlo_type_component_single => &
process_get_nlo_type_component_single
<<Process: sub interfaces>>=
elemental module function process_get_nlo_type_component_single &
(process, i_component) result (val)
integer :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_nlo_type_component_single
<<Process: procedures>>=
elemental module function process_get_nlo_type_component_single &
(process, i_component) result (val)
integer :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
val = process%component(i_component)%get_nlo_type ()
end function process_get_nlo_type_component_single
@ %def process_get_nlo_type_component_single
@
<<Process: process: TBP>>=
generic :: get_nlo_type_component => get_nlo_type_component_all
procedure :: get_nlo_type_component_all => process_get_nlo_type_component_all
<<Process: sub interfaces>>=
pure module function process_get_nlo_type_component_all &
(process) result (val)
integer, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
end function process_get_nlo_type_component_all
<<Process: procedures>>=
pure module function process_get_nlo_type_component_all (process) result (val)
integer, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
allocate (val (size (process%component)))
val = process%component%get_nlo_type ()
end function process_get_nlo_type_component_all
@ %def process_get_nlo_type_component_all
@
<<Process: process: TBP>>=
procedure :: is_nlo_calculation => process_is_nlo_calculation
<<Process: sub interfaces>>=
module function process_is_nlo_calculation (process) result (nlo)
logical :: nlo
class(process_t), intent(in) :: process
end function process_is_nlo_calculation
<<Process: procedures>>=
module function process_is_nlo_calculation (process) result (nlo)
logical :: nlo
class(process_t), intent(in) :: process
select type (pcm => process%pcm)
type is (pcm_nlo_t)
nlo = .true.
class default
nlo = .false.
end select
end function process_is_nlo_calculation
@ %def process_is_nlo_calculation
@
<<Process: process: TBP>>=
procedure :: get_negative_sf => process_get_negative_sf
<<Process: sub interfaces>>=
module function process_get_negative_sf (process) result (neg_sf)
logical :: neg_sf
class(process_t), intent(in) :: process
end function process_get_negative_sf
<<Process: procedures>>=
module function process_get_negative_sf (process) result (neg_sf)
logical :: neg_sf
class(process_t), intent(in) :: process
neg_sf = process%config%process_def%get_negative_sf ()
end function process_get_negative_sf
@ %def process_get_negative_sf
@
<<Process: process: TBP>>=
procedure :: is_combined_nlo_integration &
=> process_is_combined_nlo_integration
<<Process: sub interfaces>>=
module function process_is_combined_nlo_integration &
(process) result (combined)
logical :: combined
class(process_t), intent(in) :: process
end function process_is_combined_nlo_integration
<<Process: procedures>>=
module function process_is_combined_nlo_integration &
(process) result (combined)
logical :: combined
class(process_t), intent(in) :: process
select type (pcm => process%pcm)
type is (pcm_nlo_t)
combined = pcm%settings%combined_integration
class default
combined = .false.
end select
end function process_is_combined_nlo_integration
@ %def process_is_combined_nlo_integration
@
<<Process: process: TBP>>=
procedure :: component_is_real_finite => process_component_is_real_finite
<<Process: sub interfaces>>=
pure module function process_component_is_real_finite &
(process, i_component) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_component_is_real_finite
<<Process: procedures>>=
pure module function process_component_is_real_finite &
(process, i_component) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
val = process%component(i_component)%component_type == COMP_REAL_FIN
end function process_component_is_real_finite
@ %def process_component_is_real_finite
@ Return nlo data of a process component
<<Process: process: TBP>>=
procedure :: get_component_nlo_type => process_get_component_nlo_type
<<Process: sub interfaces>>=
elemental module function process_get_component_nlo_type &
(process, i_component) result (nlo_type)
integer :: nlo_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_component_nlo_type
<<Process: procedures>>=
elemental module function process_get_component_nlo_type &
(process, i_component) result (nlo_type)
integer :: nlo_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
nlo_type = process%component(i_component)%config%get_nlo_type ()
end function process_get_component_nlo_type
@ %def process_get_component_nlo_type
@ Return a pointer to the core that belongs to a component.
<<Process: process: TBP>>=
procedure :: get_component_core_ptr => process_get_component_core_ptr
<<Process: sub interfaces>>=
module function process_get_component_core_ptr &
(process, i_component) result (core)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_component
class(prc_core_t), pointer :: core
end function process_get_component_core_ptr
<<Process: procedures>>=
module function process_get_component_core_ptr &
(process, i_component) result (core)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_component
class(prc_core_t), pointer :: core
integer :: i_core
i_core = process%pcm%get_i_core(i_component)
core => process%core_entry(i_core)%core
end function process_get_component_core_ptr
@ %def process_get_component_core_ptr
@
<<Process: process: TBP>>=
procedure :: get_component_associated_born &
=> process_get_component_associated_born
<<Process: sub interfaces>>=
module function process_get_component_associated_born &
(process, i_component) result (i_born)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
integer :: i_born
end function process_get_component_associated_born
<<Process: procedures>>=
module function process_get_component_associated_born &
(process, i_component) result (i_born)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
integer :: i_born
i_born = process%component(i_component)%config%get_associated_born ()
end function process_get_component_associated_born
@ %def process_get_component_associated_born
@
<<Process: process: TBP>>=
procedure :: get_first_real_component => process_get_first_real_component
<<Process: sub interfaces>>=
module function process_get_first_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
end function process_get_first_real_component
<<Process: procedures>>=
module function process_get_first_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
i_real = process%component(1)%config%get_associated_real ()
end function process_get_first_real_component
@ %def process_get_first_real_component
@
<<Process: process: TBP>>=
procedure :: get_first_real_term => process_get_first_real_term
<<Process: sub interfaces>>=
module function process_get_first_real_term (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer :: i_component, i_term
end function process_get_first_real_term
<<Process: procedures>>=
module function process_get_first_real_term (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer :: i_component, i_term
i_component = process%component(1)%config%get_associated_real ()
i_real = 0
do i_term = 1, size (process%term)
if (process%term(i_term)%i_component == i_component) then
i_real = i_term
exit
end if
end do
if (i_real == 0) call msg_fatal ("Did not find associated real term!")
end function process_get_first_real_term
@ %def process_get_first_real_term
@
<<Process: process: TBP>>=
procedure :: get_associated_real_fin => process_get_associated_real_fin
<<Process: sub interfaces>>=
elemental module function process_get_associated_real_fin &
(process, i_component) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
end function process_get_associated_real_fin
<<Process: procedures>>=
elemental module function process_get_associated_real_fin &
(process, i_component) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
i_real = process%component(i_component)%config%get_associated_real_fin ()
end function process_get_associated_real_fin
@ %def process_get_associated_real_fin
@
<<Process: process: TBP>>=
procedure :: select_i_term => process_select_i_term
<<Process: sub interfaces>>=
pure module function process_select_i_term (process, i_mci) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
end function process_select_i_term
<<Process: procedures>>=
pure module function process_select_i_term (process, i_mci) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer :: i_component, i_sub
i_component = process%mci_entry(i_mci)%i_component(1)
i_term = process%component(i_component)%i_term(1)
i_sub = process%term(i_term)%i_sub
if (i_sub > 0) &
i_term = process%term(i_sub)%i_term_global
end function process_select_i_term
@ %def process_select_i_term
@ Would be better to do this at the level of the writer of the core but
one has to bring NLO information there.
<<Process: process: TBP>>=
procedure :: prepare_any_external_code &
=> process_prepare_any_external_code
<<Process: sub interfaces>>=
module subroutine process_prepare_any_external_code (process)
class(process_t), intent(inout), target :: process
end subroutine process_prepare_any_external_code
<<Process: procedures>>=
module subroutine process_prepare_any_external_code (process)
class(process_t), intent(inout), target :: process
integer :: i
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_prepare_external_code")
associate (pcm => process%pcm)
do i = 1, pcm%n_cores
call pcm%prepare_any_external_code ( &
process%core_entry(i), i, &
process%get_library_name (), &
process%config%model, &
process%env%get_var_list_ptr ())
end do
end associate
end subroutine process_prepare_any_external_code
@ %def process_prepare_any_external_code
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process config}
<<[[process_config.f90]]>>=
<<File header>>
module process_config
<<Use kinds>>
<<Use strings>>
use os_interface
use sf_base
use sf_mappings
use mappings, only: mapping_defaults_t
use phs_forests, only: phs_parameters_t
use sm_qcd
use integration_results
use flavors
use interactions
use model_data
use models
use process_libraries
use process_constants
use prc_core
use beams
use mci_base
use beam_structures
use dispatch_beams, only: dispatch_qcd
use phs_base
use expr_base
use variables
<<Standard module head>>
<<Process config: public>>
<<Process config: parameters>>
<<Process config: types>>
interface
<<Process config: sub interfaces>>
end interface
contains
<<Process config: main procedures>>
end module process_config
@ %def process_config
@
<<[[process_config_sub.f90]]>>=
<<File header>>
submodule (process_config) process_config_s
use format_utils, only: write_separator
use io_units
use diagnostics
use md5
use physics_defs
use helicities
use colors
use quantum_numbers
use state_matrices
use prc_external
use prc_openloops, only: prc_openloops_t
use prc_threshold, only: prc_threshold_t
use blha_olp_interfaces, only: prc_blha_t
implicit none
contains
<<Process config: procedures>>
end submodule process_config_s
@ %def process_config_s
@ Identifiers for the NLO setup.
<<Process config: parameters>>=
integer, parameter, public :: COMP_DEFAULT = 0
integer, parameter, public :: COMP_REAL_FIN = 1
integer, parameter, public :: COMP_MASTER = 2
integer, parameter, public :: COMP_VIRT = 3
integer, parameter, public :: COMP_REAL = 4
integer, parameter, public :: COMP_REAL_SING = 5
integer, parameter, public :: COMP_MISMATCH = 6
integer, parameter, public :: COMP_PDF = 7
integer, parameter, public :: COMP_SUB = 8
integer, parameter, public :: COMP_RESUM = 9
@
\subsection{Output selection flags}
We declare a number of identifiers for write methods, so they only
displays selected parts. The identifiers can be supplied to the [[vlist]]
array argument of the standard F2008 derived-type writer call.
<<Process config: parameters>>=
integer, parameter, public :: F_PACIFY = 1
integer, parameter, public :: F_SHOW_VAR_LIST = 11
integer, parameter, public :: F_SHOW_EXPRESSIONS = 12
integer, parameter, public :: F_SHOW_LIB = 13
integer, parameter, public :: F_SHOW_MODEL = 14
integer, parameter, public :: F_SHOW_QCD = 15
integer, parameter, public :: F_SHOW_OS_DATA = 16
integer, parameter, public :: F_SHOW_RNG = 17
integer, parameter, public :: F_SHOW_BEAMS = 18
@ %def SHOW_VAR_LIST
@ %def SHOW_EXPRESSIONS
@
This is a simple function that returns true if a flag value is present in
[[v_list]], but not its negative. If neither is present, it returns
[[default]].
<<Process config: public>>=
public :: flagged
<<Process config: sub interfaces>>=
module function flagged (v_list, id, def) result (flag)
logical :: flag
integer, dimension(:), intent(in) :: v_list
integer, intent(in) :: id
logical, intent(in), optional :: def
end function flagged
<<Process config: procedures>>=
module function flagged (v_list, id, def) result (flag)
logical :: flag
integer, dimension(:), intent(in) :: v_list
integer, intent(in) :: id
logical, intent(in), optional :: def
logical :: default_result
default_result = .false.; if (present (def)) default_result = def
if (default_result) then
flag = all (v_list /= -id)
else
flag = all (v_list /= -id) .and. any (v_list == id)
end if
end function flagged
@ %def flagged
@
Related: if flag is set (unset), append [[value]] (its negative) to the
[[v_list]], respectively. [[v_list]] must be allocated.
<<Process config: public>>=
public :: set_flag
<<Process config: sub interfaces>>=
module subroutine set_flag (v_list, value, flag)
integer, dimension(:), intent(inout), allocatable :: v_list
integer, intent(in) :: value
logical, intent(in), optional :: flag
end subroutine set_flag
<<Process config: procedures>>=
module subroutine set_flag (v_list, value, flag)
integer, dimension(:), intent(inout), allocatable :: v_list
integer, intent(in) :: value
logical, intent(in), optional :: flag
if (present (flag)) then
if (flag) then
v_list = [v_list, value]
else
v_list = [v_list, -value]
end if
end if
end subroutine set_flag
@ %def set_flag
@
\subsection{Generic configuration data}
This information concerns physical and technical properties of the
process. It is fixed upon initialization, using data from the
process specification and the variable list.
The number [[n_in]] is the number of incoming beam particles,
simultaneously the number of incoming partons, 1 for a decay and 2 for
a scattering process. (The number of outgoing partons may depend on
the process component.)
The number [[n_components]] is the number of components that constitute
the current process.
The number [[n_terms]] is the number of distinct contributions to the
scattering matrix that constitute the current process. Each component
may generate several terms.
The number [[n_mci]] is the number of independent MC
integration configurations that this process uses. Distinct process
components that share a MCI configuration may be combined pointwise.
(Nevertheless, a given MC variable set may correspond to several
``nearby'' kinematical configurations.) This is also the number of
distinct sampling-function results that this process can generate.
Process components that use distinct variable sets are added only once
after an integration pass has completed.
The [[model]] pointer identifies the physics model and its
parameters. This is a pointer to an external object.
Various [[parse_node_t]] objects are taken from the SINDARIN input.
They encode expressions for evaluating cuts and scales. The
workspaces for evaluating those expressions are set up in the
[[effective_state]] subobjects. Note that these are really pointers,
so the actual nodes are not stored inside the process object.
The [[md5sum]] is taken and used to verify the process configuration
when re-reading data from file.
<<Process config: public>>=
public :: process_config_data_t
<<Process config: types>>=
type :: process_config_data_t
class(process_def_t), pointer :: process_def => null ()
integer :: n_in = 0
integer :: n_components = 0
integer :: n_terms = 0
integer :: n_mci = 0
type(string_t) :: model_name
class(model_data_t), pointer :: model => null ()
type(qcd_t) :: qcd
class(expr_factory_t), allocatable :: ef_cuts
class(expr_factory_t), allocatable :: ef_scale
class(expr_factory_t), allocatable :: ef_fac_scale
class(expr_factory_t), allocatable :: ef_ren_scale
class(expr_factory_t), allocatable :: ef_weight
character(32) :: md5sum = ""
contains
<<Process config: process config data: TBP>>
end type process_config_data_t
@ %def process_config_data_t
@ Here, we may compress the expressions for cuts etc.
<<Process config: process config data: TBP>>=
procedure :: write => process_config_data_write
<<Process config: sub interfaces>>=
module subroutine process_config_data_write &
(config, u, counters, model, expressions)
class(process_config_data_t), intent(in) :: config
integer, intent(in) :: u
logical, intent(in) :: counters
logical, intent(in) :: model
logical, intent(in) :: expressions
end subroutine process_config_data_write
<<Process config: procedures>>=
module subroutine process_config_data_write &
(config, u, counters, model, expressions)
class(process_config_data_t), intent(in) :: config
integer, intent(in) :: u
logical, intent(in) :: counters
logical, intent(in) :: model
logical, intent(in) :: expressions
write (u, "(1x,A)") "Configuration data:"
if (counters) then
write (u, "(3x,A,I0)") "Number of incoming particles = ", &
config%n_in
write (u, "(3x,A,I0)") "Number of process components = ", &
config%n_components
write (u, "(3x,A,I0)") "Number of process terms = ", &
config%n_terms
write (u, "(3x,A,I0)") "Number of MCI configurations = ", &
config%n_mci
end if
if (associated (config%model)) then
write (u, "(3x,A,A)") "Model = ", char (config%model_name)
if (model) then
call write_separator (u)
call config%model%write (u)
call write_separator (u)
end if
else
write (u, "(3x,A,A,A)") "Model = ", char (config%model_name), &
" [not associated]"
end if
call config%qcd%write (u, show_md5sum = .false.)
call write_separator (u)
if (expressions) then
if (allocated (config%ef_cuts)) then
call write_separator (u)
write (u, "(3x,A)") "Cut expression:"
call config%ef_cuts%write (u)
end if
if (allocated (config%ef_scale)) then
call write_separator (u)
write (u, "(3x,A)") "Scale expression:"
call config%ef_scale%write (u)
end if
if (allocated (config%ef_fac_scale)) then
call write_separator (u)
write (u, "(3x,A)") "Factorization scale expression:"
call config%ef_fac_scale%write (u)
end if
if (allocated (config%ef_ren_scale)) then
call write_separator (u)
write (u, "(3x,A)") "Renormalization scale expression:"
call config%ef_ren_scale%write (u)
end if
if (allocated (config%ef_weight)) then
call write_separator (u)
write (u, "(3x,A)") "Weight expression:"
call config%ef_weight%write (u)
end if
else
call write_separator (u)
write (u, "(3x,A)") "Expressions (cut, scales, weight): [not shown]"
end if
if (config%md5sum /= "") then
call write_separator (u)
write (u, "(3x,A,A,A)") "MD5 sum (config) = '", config%md5sum, "'"
end if
end subroutine process_config_data_write
@ %def process_config_data_write
@ Initialize. We use information from the process metadata and from
the process library, given the process ID. We also store the
currently active OS data set.
The model pointer references the model data within the [[env]] record. That
should be an instance of the global model.
We initialize the QCD object, unless the environment information is unavailable
(unit tests).
The RNG factory object is imported by moving the allocation.
Gfortran 7/8/9 bug: has to remain in the main module:
<<Process config: process config data: TBP>>=
procedure :: init => process_config_data_init
<<Process config: main procedures>>=
subroutine process_config_data_init (config, meta, env)
class(process_config_data_t), intent(out) :: config
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
config%process_def => env%lib%get_process_def_ptr (meta%id)
config%n_in = config%process_def%get_n_in ()
config%n_components = size (meta%component_id)
config%model => env%get_model_ptr ()
config%model_name = config%model%get_name ()
if (env%got_var_list ()) then
call dispatch_qcd &
(config%qcd, env%get_var_list_ptr (), env%get_os_data ())
end if
end subroutine process_config_data_init
@ %def process_config_data_init
@ Current implementation: nothing to finalize.
<<Process config: process config data: TBP>>=
procedure :: final => process_config_data_final
<<Process config: sub interfaces>>=
module subroutine process_config_data_final (config)
class(process_config_data_t), intent(inout) :: config
end subroutine process_config_data_final
<<Process config: procedures>>=
module subroutine process_config_data_final (config)
class(process_config_data_t), intent(inout) :: config
end subroutine process_config_data_final
@ %def process_config_data_final
@ Return a copy of the QCD data block.
<<Process config: process config data: TBP>>=
procedure :: get_qcd => process_config_data_get_qcd
<<Process config: sub interfaces>>=
module function process_config_data_get_qcd (config) result (qcd)
class(process_config_data_t), intent(in) :: config
type(qcd_t) :: qcd
end function process_config_data_get_qcd
<<Process config: procedures>>=
module function process_config_data_get_qcd (config) result (qcd)
class(process_config_data_t), intent(in) :: config
type(qcd_t) :: qcd
qcd = config%qcd
end function process_config_data_get_qcd
@ %def process_config_data_get_qcd
@ Compute the MD5 sum of the configuration data. This encodes, in
particular, the model and the expressions for cut, scales, weight,
etc. It should not contain the IDs and number of components, etc.,
since the MD5 sum should be useful for integrating individual
components.
This is done only once. If the MD5 sum is nonempty, the calculation
is skipped.
<<Process config: process config data: TBP>>=
procedure :: compute_md5sum => process_config_data_compute_md5sum
<<Process config: sub interfaces>>=
module subroutine process_config_data_compute_md5sum (config)
class(process_config_data_t), intent(inout) :: config
end subroutine process_config_data_compute_md5sum
<<Process config: procedures>>=
module subroutine process_config_data_compute_md5sum (config)
class(process_config_data_t), intent(inout) :: config
integer :: u
if (config%md5sum == "") then
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call config%write (u, counters = .false., &
model = .true., expressions = .true.)
rewind (u)
config%md5sum = md5sum (u)
close (u)
end if
end subroutine process_config_data_compute_md5sum
@ %def process_config_data_compute_md5sum
@
<<Process config: process config data: TBP>>=
procedure :: get_md5sum => process_config_data_get_md5sum
<<Process config: sub interfaces>>=
pure module function process_config_data_get_md5sum (config) result (md5)
character(32) :: md5
class(process_config_data_t), intent(in) :: config
end function process_config_data_get_md5sum
<<Process config: procedures>>=
pure module function process_config_data_get_md5sum (config) result (md5)
character(32) :: md5
class(process_config_data_t), intent(in) :: config
md5 = config%md5sum
end function process_config_data_get_md5sum
@ %def process_config_data_get_md5sum
@
\subsection{Environment}
This record stores a snapshot of the process environment at the point where
the process object is created.
Model and variable list are implemented as pointer, so they always have the
[[target]] attribute.
For unit-testing purposes, setting the var list is optional. If not set, the
pointer is null.
<<Process config: public>>=
public :: process_environment_t
<<Process config: types>>=
type :: process_environment_t
private
type(model_t), pointer :: model => null ()
type(var_list_t), pointer :: var_list => null ()
logical :: var_list_is_set = .false.
type(process_library_t), pointer :: lib => null ()
type(beam_structure_t) :: beam_structure
type(os_data_t) :: os_data
contains
<<Process config: process environment: TBP>>
end type process_environment_t
@ %def process_environment_t
@ Model and local var list are snapshots and need a finalizer.
<<Process config: process environment: TBP>>=
procedure :: final => process_environment_final
<<Process config: sub interfaces>>=
module subroutine process_environment_final (env)
class(process_environment_t), intent(inout) :: env
end subroutine process_environment_final
<<Process config: procedures>>=
module subroutine process_environment_final (env)
class(process_environment_t), intent(inout) :: env
if (associated (env%model)) then
call env%model%final ()
deallocate (env%model)
end if
if (associated (env%var_list)) then
call env%var_list%final (follow_link=.true.)
deallocate (env%var_list)
end if
end subroutine process_environment_final
@ %def process_environment_final
@ Output, DTIO compatible.
<<Process config: process environment: TBP>>=
procedure :: write => process_environment_write
procedure :: write_formatted => process_environment_write_formatted
! generic :: write (formatted) => write_formatted
<<Process config: sub interfaces>>=
module subroutine process_environment_write (env, unit, &
show_var_list, show_model, show_lib, show_beams, show_os_data)
class(process_environment_t), intent(in) :: env
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_var_list
logical, intent(in), optional :: show_model
logical, intent(in), optional :: show_lib
logical, intent(in), optional :: show_beams
logical, intent(in), optional :: show_os_data
end subroutine process_environment_write
<<Process config: procedures>>=
module subroutine process_environment_write (env, unit, &
show_var_list, show_model, show_lib, show_beams, show_os_data)
class(process_environment_t), intent(in) :: env
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_var_list
logical, intent(in), optional :: show_model
logical, intent(in), optional :: show_lib
logical, intent(in), optional :: show_beams
logical, intent(in), optional :: show_os_data
integer :: u, iostat
integer, dimension(:), allocatable :: v_list
character(0) :: iomsg
u = given_output_unit (unit)
allocate (v_list (0))
call set_flag (v_list, F_SHOW_VAR_LIST, show_var_list)
call set_flag (v_list, F_SHOW_MODEL, show_model)
call set_flag (v_list, F_SHOW_LIB, show_lib)
call set_flag (v_list, F_SHOW_BEAMS, show_beams)
call set_flag (v_list, F_SHOW_OS_DATA, show_os_data)
call env%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
end subroutine process_environment_write
@ %def process_environment_write
@ DTIO standard write.
<<Process config: sub interfaces>>=
module subroutine process_environment_write_formatted &
(dtv, unit, iotype, v_list, iostat, iomsg)
class(process_environment_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
end subroutine process_environment_write_formatted
<<Process config: procedures>>=
module subroutine process_environment_write_formatted &
(dtv, unit, iotype, v_list, iostat, iomsg)
class(process_environment_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
associate (env => dtv)
if (flagged (v_list, F_SHOW_VAR_LIST, .true.)) then
write (unit, "(1x,A)") "Variable list:"
if (associated (env%var_list)) then
call write_separator (unit)
call env%var_list%write (unit)
else
write (unit, "(3x,A)") "[not allocated]"
end if
call write_separator (unit)
end if
if (flagged (v_list, F_SHOW_MODEL, .true.)) then
write (unit, "(1x,A)") "Model:"
if (associated (env%model)) then
call write_separator (unit)
call env%model%write (unit)
else
write (unit, "(3x,A)") "[not allocated]"
end if
call write_separator (unit)
end if
if (flagged (v_list, F_SHOW_LIB, .true.)) then
write (unit, "(1x,A)") "Process library:"
if (associated (env%lib)) then
call write_separator (unit)
call env%lib%write (unit)
else
write (unit, "(3x,A)") "[not allocated]"
end if
end if
if (flagged (v_list, F_SHOW_BEAMS, .true.)) then
call write_separator (unit)
call env%beam_structure%write (unit)
end if
if (flagged (v_list, F_SHOW_OS_DATA, .true.)) then
write (unit, "(1x,A)") "Operating-system data:"
call write_separator (unit)
call env%os_data%write (unit)
end if
end associate
iostat = 0
end subroutine process_environment_write_formatted
@ %def process_environment_write_formatted
@ Initialize: Make a snapshot of the provided model. Make a link to the
current process library.
Also make a snapshot of the variable list, if provided. If none is
provided, there is an empty variable list nevertheless, so a pointer
lookup does not return null.
If no beam structure is provided, the beam-structure member is empty and will
yield a number of zero beams when queried.
<<Process config: process environment: TBP>>=
procedure :: init => process_environment_init
<<Process config: sub interfaces>>=
module subroutine process_environment_init &
(env, model, lib, os_data, var_list, beam_structure)
class(process_environment_t), intent(out) :: env
type(model_t), intent(in), target :: model
type(process_library_t), intent(in), target :: lib
type(os_data_t), intent(in) :: os_data
type(var_list_t), intent(in), target, optional :: var_list
type(beam_structure_t), intent(in), optional :: beam_structure
end subroutine process_environment_init
<<Process config: procedures>>=
module subroutine process_environment_init &
(env, model, lib, os_data, var_list, beam_structure)
class(process_environment_t), intent(out) :: env
type(model_t), intent(in), target :: model
type(process_library_t), intent(in), target :: lib
type(os_data_t), intent(in) :: os_data
type(var_list_t), intent(in), target, optional :: var_list
type(beam_structure_t), intent(in), optional :: beam_structure
allocate (env%model)
call env%model%init_instance (model)
env%lib => lib
env%os_data = os_data
allocate (env%var_list)
if (present (var_list)) then
call env%var_list%init_snapshot (var_list, follow_link=.true.)
env%var_list_is_set = .true.
end if
if (present (beam_structure)) then
env%beam_structure = beam_structure
end if
end subroutine process_environment_init
@ %def process_environment_init
@ Indicate whether a variable list has been provided upon initialization.
<<Process config: process environment: TBP>>=
procedure :: got_var_list => process_environment_got_var_list
<<Process config: sub interfaces>>=
module function process_environment_got_var_list (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
end function process_environment_got_var_list
<<Process config: procedures>>=
module function process_environment_got_var_list (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
flag = env%var_list_is_set
end function process_environment_got_var_list
@ %def process_environment_got_var_list
@ Return a pointer to the variable list.
<<Process config: process environment: TBP>>=
procedure :: get_var_list_ptr => process_environment_get_var_list_ptr
<<Process config: sub interfaces>>=
module function process_environment_get_var_list_ptr (env) result (var_list)
class(process_environment_t), intent(in) :: env
type(var_list_t), pointer :: var_list
end function process_environment_get_var_list_ptr
<<Process config: procedures>>=
module function process_environment_get_var_list_ptr (env) result (var_list)
class(process_environment_t), intent(in) :: env
type(var_list_t), pointer :: var_list
var_list => env%var_list
end function process_environment_get_var_list_ptr
@ %def process_environment_get_var_list_ptr
@ Return a pointer to the model, if it exists.
<<Process config: process environment: TBP>>=
procedure :: get_model_ptr => process_environment_get_model_ptr
<<Process config: sub interfaces>>=
module function process_environment_get_model_ptr (env) result (model)
class(process_environment_t), intent(in) :: env
type(model_t), pointer :: model
end function process_environment_get_model_ptr
<<Process config: procedures>>=
module function process_environment_get_model_ptr (env) result (model)
class(process_environment_t), intent(in) :: env
type(model_t), pointer :: model
model => env%model
end function process_environment_get_model_ptr
@ %def process_environment_get_model_ptr
@ Return the process library pointer.
<<Process config: process environment: TBP>>=
procedure :: get_lib_ptr => process_environment_get_lib_ptr
<<Process config: sub interfaces>>=
module function process_environment_get_lib_ptr (env) result (lib)
class(process_environment_t), intent(inout) :: env
type(process_library_t), pointer :: lib
end function process_environment_get_lib_ptr
<<Process config: procedures>>=
module function process_environment_get_lib_ptr (env) result (lib)
class(process_environment_t), intent(inout) :: env
type(process_library_t), pointer :: lib
lib => env%lib
end function process_environment_get_lib_ptr
@ %def process_environment_get_lib_ptr
@ Clear the process library pointer, in case the library is deleted.
<<Process config: process environment: TBP>>=
procedure :: reset_lib_ptr => process_environment_reset_lib_ptr
<<Process config: sub interfaces>>=
module subroutine process_environment_reset_lib_ptr (env)
class(process_environment_t), intent(inout) :: env
end subroutine process_environment_reset_lib_ptr
<<Process config: procedures>>=
module subroutine process_environment_reset_lib_ptr (env)
class(process_environment_t), intent(inout) :: env
env%lib => null ()
end subroutine process_environment_reset_lib_ptr
@ %def process_environment_reset_lib_ptr
@ Check whether the process library has changed, in case the library is
recompiled, etc.
<<Process config: process environment: TBP>>=
procedure :: check_lib_sanity => process_environment_check_lib_sanity
<<Process config: sub interfaces>>=
module subroutine process_environment_check_lib_sanity (env, meta)
class(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
end subroutine process_environment_check_lib_sanity
<<Process config: procedures>>=
module subroutine process_environment_check_lib_sanity (env, meta)
class(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
if (associated (env%lib)) then
if (env%lib%get_update_counter () /= meta%lib_update_counter) then
call msg_fatal ("Process '" // char (meta%id) &
// "': library has been recompiled after integration")
end if
end if
end subroutine process_environment_check_lib_sanity
@ %def process_environment_check_lib_sanity
@ Fill the [[data]] block using the appropriate process-library access entry.
<<Process config: process environment: TBP>>=
procedure :: fill_process_constants => &
process_environment_fill_process_constants
<<Process config: sub interfaces>>=
module subroutine process_environment_fill_process_constants &
(env, id, i_component, data)
class(process_environment_t), intent(in) :: env
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
type(process_constants_t), intent(out) :: data
end subroutine process_environment_fill_process_constants
<<Process config: procedures>>=
module subroutine process_environment_fill_process_constants &
(env, id, i_component, data)
class(process_environment_t), intent(in) :: env
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
type(process_constants_t), intent(out) :: data
call env%lib%fill_constants (id, i_component, data)
end subroutine process_environment_fill_process_constants
@ %def process_environment_fill_process_constants
@ Return the entire beam structure.
<<Process config: process environment: TBP>>=
procedure :: get_beam_structure => process_environment_get_beam_structure
<<Process config: sub interfaces>>=
module function process_environment_get_beam_structure &
(env) result (beam_structure)
class(process_environment_t), intent(in) :: env
type(beam_structure_t) :: beam_structure
end function process_environment_get_beam_structure
<<Process config: procedures>>=
module function process_environment_get_beam_structure &
(env) result (beam_structure)
class(process_environment_t), intent(in) :: env
type(beam_structure_t) :: beam_structure
beam_structure = env%beam_structure
end function process_environment_get_beam_structure
@ %def process_environment_get_beam_structure
@ Check the beam structure for PDFs.
<<Process config: process environment: TBP>>=
procedure :: has_pdfs => process_environment_has_pdfs
<<Process config: sub interfaces>>=
module function process_environment_has_pdfs (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
end function process_environment_has_pdfs
<<Process config: procedures>>=
module function process_environment_has_pdfs (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
flag = env%beam_structure%has_pdf ()
end function process_environment_has_pdfs
@ %def process_environment_has_pdfs
@ Check the beam structure for polarized beams.
<<Process config: process environment: TBP>>=
procedure :: has_polarized_beams => process_environment_has_polarized_beams
<<Process config: sub interfaces>>=
module function process_environment_has_polarized_beams (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
end function process_environment_has_polarized_beams
<<Process config: procedures>>=
module function process_environment_has_polarized_beams (env) result (flag)
class(process_environment_t), intent(in) :: env
logical :: flag
flag = env%beam_structure%has_polarized_beams ()
end function process_environment_has_polarized_beams
@ %def process_environment_has_polarized_beams
@ Return a copy of the OS data block.
<<Process config: process environment: TBP>>=
procedure :: get_os_data => process_environment_get_os_data
<<Process config: sub interfaces>>=
module function process_environment_get_os_data (env) result (os_data)
class(process_environment_t), intent(in) :: env
type(os_data_t) :: os_data
end function process_environment_get_os_data
<<Process config: procedures>>=
module function process_environment_get_os_data (env) result (os_data)
class(process_environment_t), intent(in) :: env
type(os_data_t) :: os_data
os_data = env%os_data
end function process_environment_get_os_data
@ %def process_environment_get_os_data
@
\subsection{Metadata}
This information describes the process. It is fixed upon initialization.
The [[id]] string is the name of the process object, as given by the
user. The matrix element generator will use this string for naming
Fortran procedures and types, so it should qualify as a Fortran name.
The [[num_id]] is meaningful if nonzero. It is used for communication
with external programs or file standards which do not support string IDs.
The [[run_id]] string distinguishes among several runs for the same
process. It identifies process instances with respect to adapted
integration grids and similar run-specific data. The run ID is kept
when copying processes for creating instances, however, so it does not
distinguish event samples.
The [[lib_name]] identifies the process library where the process
definition and the process driver are located.
The [[lib_index]] is the index of entry in the process library that
corresponds to the current process.
The [[component_id]] array identifies the individual process components.
The [[component_description]] is an array of human-readable strings
that characterize the process components, for instance [[a, b => c, d]].
The [[active]] mask array marks those components which are active. The others
are skipped.
<<Process config: public>>=
public :: process_metadata_t
<<Process config: types>>=
type :: process_metadata_t
integer :: type = PRC_UNKNOWN
type(string_t) :: id
integer :: num_id = 0
type(string_t) :: run_id
type(string_t), allocatable :: lib_name
integer :: lib_update_counter = 0
integer :: lib_index = 0
integer :: n_components = 0
type(string_t), dimension(:), allocatable :: component_id
type(string_t), dimension(:), allocatable :: component_description
logical, dimension(:), allocatable :: active
contains
<<Process config: process metadata: TBP>>
end type process_metadata_t
@ %def process_metadata_t
@ Output: ID and run ID.
We write the variable list only upon request.
<<Process config: process metadata: TBP>>=
procedure :: write => process_metadata_write
<<Process config: sub interfaces>>=
module subroutine process_metadata_write (meta, u, screen)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
logical, intent(in) :: screen
end subroutine process_metadata_write
<<Process config: procedures>>=
module subroutine process_metadata_write (meta, u, screen)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
logical, intent(in) :: screen
integer :: i
select case (meta%type)
case (PRC_UNKNOWN)
if (screen) then
write (msg_buffer, "(A)") "Process [undefined]"
else
write (u, "(1x,A)") "Process [undefined]"
end if
return
case (PRC_DECAY)
if (screen) then
write (msg_buffer, "(A,1x,A,A,A)") "Process [decay]:", &
"'", char (meta%id), "'"
else
write (u, "(1x,A)", advance="no") "Process [decay]:"
end if
case (PRC_SCATTERING)
if (screen) then
write (msg_buffer, "(A,1x,A,A,A)") "Process [scattering]:", &
"'", char (meta%id), "'"
else
write (u, "(1x,A)", advance="no") "Process [scattering]:"
end if
case default
call msg_bug ("process_write: undefined process type")
end select
if (screen) then
call msg_message ()
else
write (u, "(1x,A,A,A)") "'", char (meta%id), "'"
end if
if (meta%num_id /= 0) then
if (screen) then
write (msg_buffer, "(2x,A,I0)") "ID (num) = ", meta%num_id
call msg_message ()
else
write (u, "(3x,A,I0)") "ID (num) = ", meta%num_id
end if
end if
if (screen) then
if (meta%run_id /= "") then
write (msg_buffer, "(2x,A,A,A)") "Run ID = '", &
char (meta%run_id), "'"
call msg_message ()
end if
else
write (u, "(3x,A,A,A)") "Run ID = '", char (meta%run_id), "'"
end if
if (allocated (meta%lib_name)) then
if (screen) then
write (msg_buffer, "(2x,A,A,A)") "Library name = '", &
char (meta%lib_name), "'"
call msg_message ()
else
write (u, "(3x,A,A,A)") "Library name = '", &
char (meta%lib_name), "'"
end if
else
if (screen) then
write (msg_buffer, "(2x,A)") "Library name = [not associated]"
call msg_message ()
else
write (u, "(3x,A)") "Library name = [not associated]"
end if
end if
if (screen) then
write (msg_buffer, "(2x,A,I0)") "Process index = ", meta%lib_index
call msg_message ()
else
write (u, "(3x,A,I0)") "Process index = ", meta%lib_index
end if
if (allocated (meta%component_id)) then
if (screen) then
if (any (meta%active)) then
write (msg_buffer, "(2x,A)") "Process components:"
else
write (msg_buffer, "(2x,A)") "Process components: [none]"
end if
call msg_message ()
else
write (u, "(3x,A)") "Process components:"
end if
do i = 1, size (meta%component_id)
if (.not. meta%active(i)) cycle
if (screen) then
write (msg_buffer, "(4x,I0,9A)") i, ": '", &
char (meta%component_id (i)), "': ", &
char (meta%component_description (i))
call msg_message ()
else
write (u, "(5x,I0,9A)") i, ": '", &
char (meta%component_id (i)), "': ", &
char (meta%component_description (i))
end if
end do
end if
if (screen) then
write (msg_buffer, "(A)") repeat ("-", 72)
call msg_message ()
else
call write_separator (u)
end if
end subroutine process_metadata_write
@ %def process_metadata_write
@ Short output: list components.
<<Process config: process metadata: TBP>>=
procedure :: show => process_metadata_show
<<Process config: sub interfaces>>=
module subroutine process_metadata_show (meta, u, model_name)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
type(string_t), intent(in) :: model_name
end subroutine process_metadata_show
<<Process config: procedures>>=
module subroutine process_metadata_show (meta, u, model_name)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
type(string_t), intent(in) :: model_name
integer :: i
select case (meta%type)
case (PRC_UNKNOWN)
write (u, "(A)") "Process: [undefined]"
return
case default
write (u, "(A)", advance="no") "Process:"
end select
write (u, "(1x,A)", advance="no") char (meta%id)
select case (meta%num_id)
case (0)
case default
write (u, "(1x,'(',I0,')')", advance="no") meta%num_id
end select
select case (char (model_name))
case ("")
case default
write (u, "(1x,'[',A,']')", advance="no") char (model_name)
end select
write (u, *)
if (allocated (meta%component_id)) then
do i = 1, size (meta%component_id)
if (meta%active(i)) then
write (u, "(2x,I0,':',1x,A)") i, &
char (meta%component_description (i))
end if
end do
end if
end subroutine process_metadata_show
@ %def process_metadata_show
@ Initialize. Find process ID and run ID.
Also find the process ID in the process library and retrieve some metadata from
there.
<<Process config: process metadata: TBP>>=
procedure :: init => process_metadata_init
<<Process config: sub interfaces>>=
module subroutine process_metadata_init (meta, id, lib, var_list)
class(process_metadata_t), intent(out) :: meta
type(string_t), intent(in) :: id
type(process_library_t), intent(in), target :: lib
type(var_list_t), intent(in) :: var_list
end subroutine process_metadata_init
<<Process config: procedures>>=
module subroutine process_metadata_init (meta, id, lib, var_list)
class(process_metadata_t), intent(out) :: meta
type(string_t), intent(in) :: id
type(process_library_t), intent(in), target :: lib
type(var_list_t), intent(in) :: var_list
select case (lib%get_n_in (id))
case (1); meta%type = PRC_DECAY
case (2); meta%type = PRC_SCATTERING
case default
call msg_bug ("Process '" // char (id) // "': impossible n_in")
end select
meta%id = id
meta%run_id = var_list%get_sval (var_str ("$run_id"))
allocate (meta%lib_name)
meta%lib_name = lib%get_name ()
meta%lib_update_counter = lib%get_update_counter ()
if (lib%contains (id)) then
meta%lib_index = lib%get_entry_index (id)
meta%num_id = lib%get_num_id (id)
call lib%get_component_list (id, meta%component_id)
meta%n_components = size (meta%component_id)
call lib%get_component_description_list &
(id, meta%component_description)
allocate (meta%active (meta%n_components), source = .true.)
else
call msg_fatal ("Process library does not contain process '" &
// char (id) // "'")
end if
if (.not. lib%is_active ()) then
call msg_bug ("Process init: inactive library not handled yet")
end if
end subroutine process_metadata_init
@ %def process_metadata_init
@ Mark a component as inactive.
<<Process config: process metadata: TBP>>=
procedure :: deactivate_component => process_metadata_deactivate_component
<<Process config: sub interfaces>>=
module subroutine process_metadata_deactivate_component (meta, i)
class(process_metadata_t), intent(inout) :: meta
integer, intent(in) :: i
end subroutine process_metadata_deactivate_component
<<Process config: procedures>>=
module subroutine process_metadata_deactivate_component (meta, i)
class(process_metadata_t), intent(inout) :: meta
integer, intent(in) :: i
call msg_message ("Process component '" &
// char (meta%component_id(i)) // "': matrix element vanishes")
meta%active(i) = .false.
end subroutine process_metadata_deactivate_component
@ %def process_metadata_deactivate_component
@
\subsection{Phase-space configuration}
A process can have a number of independent phase-space configuration entries,
depending on the process definition and evaluation algorithm. Each entry
holds various configuration-parameter data and the actual [[phs_config_t]]
record, which can vary in concrete type.
<<Process config: public>>=
public :: process_phs_config_t
<<Process config: types>>=
type :: process_phs_config_t
type(phs_parameters_t) :: phs_par
type(mapping_defaults_t) :: mapping_defs
class(phs_config_t), allocatable :: phs_config
contains
<<Process config: process phs config: TBP>>
end type process_phs_config_t
@ %def process_phs_config_t
@ Output, DTIO compatible.
<<Process config: process phs config: TBP>>=
procedure :: write => process_phs_config_write
procedure :: write_formatted => process_phs_config_write_formatted
! generic :: write (formatted) => write_formatted
<<Process config: sub interfaces>>=
module subroutine process_phs_config_write (phs_config, unit)
class(process_phs_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
end subroutine process_phs_config_write
<<Process config: procedures>>=
module subroutine process_phs_config_write (phs_config, unit)
class(process_phs_config_t), intent(in) :: phs_config
integer, intent(in), optional :: unit
integer :: u, iostat
integer, dimension(:), allocatable :: v_list
character(0) :: iomsg
u = given_output_unit (unit)
allocate (v_list (0))
call phs_config%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
end subroutine process_phs_config_write
@ %def process_phs_config_write
@ DTIO standard write.
<<Process config: sub interfaces>>=
module subroutine process_phs_config_write_formatted &
(dtv, unit, iotype, v_list, iostat, iomsg)
class(process_phs_config_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
end subroutine process_phs_config_write_formatted
<<Process config: procedures>>=
module subroutine process_phs_config_write_formatted &
(dtv, unit, iotype, v_list, iostat, iomsg)
class(process_phs_config_t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
associate (phs_config => dtv)
write (unit, "(1x, A)") "Phase-space configuration entry:"
call phs_config%phs_par%write (unit)
call phs_config%mapping_defs%write (unit)
end associate
iostat = 0
end subroutine process_phs_config_write_formatted
@ %def process_phs_config_write_formatted
@
\subsection{Beam configuration}
The object [[data]] holds all details about the initial beam
configuration. The allocatable array [[sf]] holds the structure-function
configuration blocks. There are [[n_strfun]] entries in the
structure-function chain (not counting the initial beam object). We
maintain [[n_channel]] independent parameterizations of this chain.
If this is greater than zero, we need a multi-channel sampling
algorithm, where for each point one channel is selected to generate
kinematics.
The number of parameters that are required for generating a
structure-function chain is [[n_sfpar]].
The flag [[azimuthal_dependence]] tells whether the process setup is
symmetric about the beam axis in the c.m.\ system. This implies that
there is no transversal beam polarization. The flag [[lab_is_cm]] is
obvious.
<<Process config: public>>=
public :: process_beam_config_t
<<Process config: types>>=
type :: process_beam_config_t
type(beam_data_t) :: data
integer :: n_strfun = 0
integer :: n_channel = 1
integer :: n_sfpar = 0
type(sf_config_t), dimension(:), allocatable :: sf
type(sf_channel_t), dimension(:), allocatable :: sf_channel
logical :: azimuthal_dependence = .false.
logical :: lab_is_cm = .true.
character(32) :: md5sum = ""
logical :: sf_trace = .false.
type(string_t) :: sf_trace_file
contains
<<Process config: process beam config: TBP>>
end type process_beam_config_t
@ %def process_beam_config_t
@ Here we write beam data only if they are actually used.
The [[verbose]] flag is passed to the beam-data writer.
<<Process config: process beam config: TBP>>=
procedure :: write => process_beam_config_write
<<Process config: sub interfaces>>=
module subroutine process_beam_config_write (object, unit, verbose)
class(process_beam_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine process_beam_config_write
<<Process config: procedures>>=
module subroutine process_beam_config_write (object, unit, verbose)
class(process_beam_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i, c
u = given_output_unit (unit)
call object%data%write (u, verbose = verbose)
if (object%data%initialized) then
write (u, "(3x,A,L1)") "Azimuthal dependence = ", &
object%azimuthal_dependence
write (u, "(3x,A,L1)") "Lab frame is c.m. frame = ", &
object%lab_is_cm
if (object%md5sum /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (beams/strf) = '", &
object%md5sum, "'"
end if
if (allocated (object%sf)) then
do i = 1, size (object%sf)
call object%sf(i)%write (u)
end do
if (any_sf_channel_has_mapping (object%sf_channel)) then
write (u, "(1x,A,L1)") "Structure-function mappings per channel:"
do c = 1, object%n_channel
write (u, "(3x,I0,':')", advance="no") c
call object%sf_channel(c)%write (u)
end do
end if
end if
end if
end subroutine process_beam_config_write
@ %def process_beam_config_write
@ The beam data have a finalizer. We assume that there is none for the
structure-function data.
<<Process config: process beam config: TBP>>=
procedure :: final => process_beam_config_final
<<Process config: sub interfaces>>=
module subroutine process_beam_config_final (object)
class(process_beam_config_t), intent(inout) :: object
end subroutine process_beam_config_final
<<Process config: procedures>>=
module subroutine process_beam_config_final (object)
class(process_beam_config_t), intent(inout) :: object
call object%data%final ()
end subroutine process_beam_config_final
@ %def process_beam_config_final
@ Initialize the beam setup with a given beam structure object.
<<Process config: process beam config: TBP>>=
procedure :: init_beam_structure => process_beam_config_init_beam_structure
<<Process config: sub interfaces>>=
module subroutine process_beam_config_init_beam_structure &
(beam_config, beam_structure, sqrts, model, decay_rest_frame)
class(process_beam_config_t), intent(out) :: beam_config
type(beam_structure_t), intent(in) :: beam_structure
logical, intent(in), optional :: decay_rest_frame
real(default), intent(in) :: sqrts
class(model_data_t), intent(in), target :: model
end subroutine process_beam_config_init_beam_structure
<<Process config: procedures>>=
module subroutine process_beam_config_init_beam_structure &
(beam_config, beam_structure, sqrts, model, decay_rest_frame)
class(process_beam_config_t), intent(out) :: beam_config
type(beam_structure_t), intent(in) :: beam_structure
logical, intent(in), optional :: decay_rest_frame
real(default), intent(in) :: sqrts
class(model_data_t), intent(in), target :: model
call beam_config%data%init_structure (beam_structure, &
sqrts, model, decay_rest_frame)
beam_config%lab_is_cm = beam_config%data%lab_is_cm
end subroutine process_beam_config_init_beam_structure
@ %def process_beam_config_init_beam_structure
@ Initialize the beam setup for a scattering process with specified
flavor combination, other properties taken from the beam structure
object (if any).
<<Process config: process beam config: TBP>>=
procedure :: init_scattering => process_beam_config_init_scattering
<<Process config: sub interfaces>>=
module subroutine process_beam_config_init_scattering &
(beam_config, flv_in, sqrts, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(2), intent(in) :: flv_in
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
end subroutine process_beam_config_init_scattering
<<Process config: procedures>>=
module subroutine process_beam_config_init_scattering &
(beam_config, flv_in, sqrts, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(2), intent(in) :: flv_in
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
if (present (beam_structure)) then
if (beam_structure%polarized ()) then
call beam_config%data%init_sqrts (sqrts, flv_in, &
beam_structure%get_smatrix (), beam_structure%get_pol_f ())
else
call beam_config%data%init_sqrts (sqrts, flv_in)
end if
else
call beam_config%data%init_sqrts (sqrts, flv_in)
end if
end subroutine process_beam_config_init_scattering
@ %def process_beam_config_init_scattering
@ Initialize the beam setup for a decay process with specified flavor,
other properties taken from the beam structure object (if present).
For a cascade decay, we set
[[rest_frame]] to false, indicating a event-wise varying momentum.
The beam data itself are initialized for the particle at rest.
<<Process config: process beam config: TBP>>=
procedure :: init_decay => process_beam_config_init_decay
<<Process config: sub interfaces>>=
module subroutine process_beam_config_init_decay &
(beam_config, flv_in, rest_frame, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(1), intent(in) :: flv_in
logical, intent(in), optional :: rest_frame
type(beam_structure_t), intent(in), optional :: beam_structure
end subroutine process_beam_config_init_decay
<<Process config: procedures>>=
module subroutine process_beam_config_init_decay &
(beam_config, flv_in, rest_frame, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(1), intent(in) :: flv_in
logical, intent(in), optional :: rest_frame
type(beam_structure_t), intent(in), optional :: beam_structure
if (present (beam_structure)) then
if (beam_structure%polarized ()) then
call beam_config%data%init_decay (flv_in, &
beam_structure%get_smatrix (), beam_structure%get_pol_f (), &
rest_frame = rest_frame)
else
call beam_config%data%init_decay (flv_in, rest_frame = rest_frame)
end if
else
call beam_config%data%init_decay (flv_in, &
rest_frame = rest_frame)
end if
beam_config%lab_is_cm = beam_config%data%lab_is_cm
end subroutine process_beam_config_init_decay
@ %def process_beam_config_init_decay
@ Print an informative message.
<<Process config: process beam config: TBP>>=
procedure :: startup_message => process_beam_config_startup_message
<<Process config: sub interfaces>>=
module subroutine process_beam_config_startup_message &
(beam_config, unit, beam_structure)
class(process_beam_config_t), intent(in) :: beam_config
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
end subroutine process_beam_config_startup_message
<<Process config: procedures>>=
module subroutine process_beam_config_startup_message &
(beam_config, unit, beam_structure)
class(process_beam_config_t), intent(in) :: beam_config
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
integer :: u
u = free_unit ()
open (u, status="scratch", action="readwrite")
if (present (beam_structure)) then
call beam_structure%write (u)
end if
call beam_config%data%write (u)
rewind (u)
do
read (u, "(1x,A)", end=1) msg_buffer
call msg_message ()
end do
1 continue
close (u)
end subroutine process_beam_config_startup_message
@ %def process_beam_config_startup_message
@ Allocate the structure-function array.
<<Process config: process beam config: TBP>>=
procedure :: init_sf_chain => process_beam_config_init_sf_chain
<<Process config: sub interfaces>>=
module subroutine process_beam_config_init_sf_chain &
(beam_config, sf_config, sf_trace_file)
class(process_beam_config_t), intent(inout) :: beam_config
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
end subroutine process_beam_config_init_sf_chain
<<Process config: procedures>>=
module subroutine process_beam_config_init_sf_chain &
(beam_config, sf_config, sf_trace_file)
class(process_beam_config_t), intent(inout) :: beam_config
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
integer :: i
beam_config%n_strfun = size (sf_config)
allocate (beam_config%sf (beam_config%n_strfun))
do i = 1, beam_config%n_strfun
associate (sf => sf_config(i))
call beam_config%sf(i)%init (sf%i, sf%data)
if (.not. sf%data%is_generator ()) then
beam_config%n_sfpar = beam_config%n_sfpar + sf%data%get_n_par ()
end if
end associate
end do
if (present (sf_trace_file)) then
beam_config%sf_trace = .true.
beam_config%sf_trace_file = sf_trace_file
end if
end subroutine process_beam_config_init_sf_chain
@ %def process_beam_config_init_sf_chain
@ Allocate the structure-function mapping channel array, given the
requested number of channels.
<<Process config: process beam config: TBP>>=
procedure :: allocate_sf_channels => process_beam_config_allocate_sf_channels
<<Process config: sub interfaces>>=
module subroutine process_beam_config_allocate_sf_channels &
(beam_config, n_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: n_channel
end subroutine process_beam_config_allocate_sf_channels
<<Process config: procedures>>=
module subroutine process_beam_config_allocate_sf_channels &
(beam_config, n_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: n_channel
beam_config%n_channel = n_channel
call allocate_sf_channels (beam_config%sf_channel, &
n_channel = n_channel, &
n_strfun = beam_config%n_strfun)
end subroutine process_beam_config_allocate_sf_channels
@ %def process_beam_config_allocate_sf_channels
@ Set a structure-function mapping channel for an array of
structure-function entries, for a single channel. (The default is no mapping.)
<<Process config: process beam config: TBP>>=
procedure :: set_sf_channel => process_beam_config_set_sf_channel
<<Process config: sub interfaces>>=
module subroutine process_beam_config_set_sf_channel &
(beam_config, c, sf_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
end subroutine process_beam_config_set_sf_channel
<<Process config: procedures>>=
module subroutine process_beam_config_set_sf_channel &
(beam_config, c, sf_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
beam_config%sf_channel(c) = sf_channel
end subroutine process_beam_config_set_sf_channel
@ %def process_beam_config_set_sf_channel
@ Print an informative startup message.
<<Process config: process beam config: TBP>>=
procedure :: sf_startup_message => process_beam_config_sf_startup_message
<<Process config: sub interfaces>>=
module subroutine process_beam_config_sf_startup_message &
(beam_config, sf_string, unit)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
end subroutine process_beam_config_sf_startup_message
<<Process config: procedures>>=
module subroutine process_beam_config_sf_startup_message &
(beam_config, sf_string, unit)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
if (beam_config%n_strfun > 0) then
call msg_message ("Beam structure: " // char (sf_string), unit = unit)
write (msg_buffer, "(A,3(1x,I0,1x,A))") &
"Beam structure:", &
beam_config%n_channel, "channels,", &
beam_config%n_sfpar, "dimensions"
call msg_message (unit = unit)
if (beam_config%sf_trace) then
call msg_message ("Beam structure: tracing &
&values in '" // char (beam_config%sf_trace_file) // "'")
end if
end if
end subroutine process_beam_config_sf_startup_message
@ %def process_beam_config_startup_message
@ Return the PDF set currently in use, if any. This should be unique,
so we scan the structure functions until we get a nonzero number.
(This implies that if the PDF set is not unique (e.g., proton and
photon structure used together), this does not work correctly.)
<<Process config: process beam config: TBP>>=
procedure :: get_pdf_set => process_beam_config_get_pdf_set
<<Process config: sub interfaces>>=
module function process_beam_config_get_pdf_set &
(beam_config) result (pdf_set)
class(process_beam_config_t), intent(in) :: beam_config
integer :: pdf_set
end function process_beam_config_get_pdf_set
<<Process config: procedures>>=
module function process_beam_config_get_pdf_set (beam_config) result (pdf_set)
class(process_beam_config_t), intent(in) :: beam_config
integer :: pdf_set
integer :: i
pdf_set = 0
if (allocated (beam_config%sf)) then
do i = 1, size (beam_config%sf)
pdf_set = beam_config%sf(i)%get_pdf_set ()
if (pdf_set /= 0) return
end do
end if
end function process_beam_config_get_pdf_set
@ %def process_beam_config_get_pdf_set
@ Return the beam file.
<<Process config: process beam config: TBP>>=
procedure :: get_beam_file => process_beam_config_get_beam_file
<<Process config: sub interfaces>>=
module function process_beam_config_get_beam_file &
(beam_config) result (file)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t) :: file
end function process_beam_config_get_beam_file
<<Process config: procedures>>=
module function process_beam_config_get_beam_file (beam_config) result (file)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t) :: file
integer :: i
file = ""
if (allocated (beam_config%sf)) then
do i = 1, size (beam_config%sf)
file = beam_config%sf(i)%get_beam_file ()
if (file /= "") return
end do
end if
end function process_beam_config_get_beam_file
@ %def process_beam_config_get_beam_file
@ Compute the MD5 sum for the complete beam setup. We rely on the
default output of [[write]] to contain all relevant data.
This is done only once, when the MD5 sum is still empty.
<<Process config: process beam config: TBP>>=
procedure :: compute_md5sum => process_beam_config_compute_md5sum
<<Process config: sub interfaces>>=
module subroutine process_beam_config_compute_md5sum (beam_config)
class(process_beam_config_t), intent(inout) :: beam_config
end subroutine process_beam_config_compute_md5sum
<<Process config: procedures>>=
module subroutine process_beam_config_compute_md5sum (beam_config)
class(process_beam_config_t), intent(inout) :: beam_config
integer :: u
if (beam_config%md5sum == "") then
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call beam_config%write (u, verbose=.true.)
rewind (u)
beam_config%md5sum = md5sum (u)
close (u)
end if
end subroutine process_beam_config_compute_md5sum
@ %def process_beam_config_compute_md5sum
@
<<Process config: process beam config: TBP>>=
procedure :: get_md5sum => process_beam_config_get_md5sum
<<Process config: sub interfaces>>=
pure module function process_beam_config_get_md5sum &
(beam_config) result (md5)
character(32) :: md5
class(process_beam_config_t), intent(in) :: beam_config
end function process_beam_config_get_md5sum
<<Process config: procedures>>=
pure module function process_beam_config_get_md5sum (beam_config) result (md5)
character(32) :: md5
class(process_beam_config_t), intent(in) :: beam_config
md5 = beam_config%md5sum
end function process_beam_config_get_md5sum
@ %def process_beam_config_get_md5sum
@
<<Process config: process beam config: TBP>>=
procedure :: has_structure_function => &
process_beam_config_has_structure_function
<<Process config: sub interfaces>>=
pure module function process_beam_config_has_structure_function &
(beam_config) result (has_sf)
logical :: has_sf
class(process_beam_config_t), intent(in) :: beam_config
end function process_beam_config_has_structure_function
<<Process config: procedures>>=
pure module function process_beam_config_has_structure_function &
(beam_config) result (has_sf)
logical :: has_sf
class(process_beam_config_t), intent(in) :: beam_config
has_sf = beam_config%n_strfun > 0
end function process_beam_config_has_structure_function
@ %def process_beam_config_has_structure_function
@
\subsection{Process components}
A process component is an individual contribution to a process
(scattering or decay) which needs not be physical. The sum over all
components should be physical.
The [[index]] indentifies this component within its parent process.
The actual process component is stored in the [[core]] subobject. We
use a polymorphic subobject instead of an extension of
[[process_component_t]], because the individual entries in the array
of process components can have different types. In short,
[[process_component_t]] is a wrapper for the actual process variants.
If the [[active]] flag is false, we should skip this component. This happens
if the associated process has vanishing matrix element.
The index array [[i_term]] points to the individual terms generated by
this component. The indices refer to the parent process.
The index [[i_mci]] is the index of the MC integrator and parameter set which
are associated to this process component.
<<Process config: public>>=
public :: process_component_t
<<Process config: types>>=
type :: process_component_t
type(process_component_def_t), pointer :: config => null ()
integer :: index = 0
logical :: active = .false.
integer, dimension(:), allocatable :: i_term
integer :: i_mci = 0
class(phs_config_t), allocatable :: phs_config
character(32) :: md5sum_phs = ""
integer :: component_type = COMP_DEFAULT
contains
<<Process config: process component: TBP>>
end type process_component_t
@ %def process_component_t
@ Finalizer. The MCI template may (potentially) need a finalizer. The process
configuration finalizer may include closing an open scratch file.
<<Process config: process component: TBP>>=
procedure :: final => process_component_final
<<Process config: sub interfaces>>=
module subroutine process_component_final (object)
class(process_component_t), intent(inout) :: object
end subroutine process_component_final
<<Process config: procedures>>=
module subroutine process_component_final (object)
class(process_component_t), intent(inout) :: object
if (allocated (object%phs_config)) then
call object%phs_config%final ()
end if
end subroutine process_component_final
@ %def process_component_final
@ The meaning of [[verbose]] depends on the process variant.
<<Process config: process component: TBP>>=
procedure :: write => process_component_write
<<Process config: sub interfaces>>=
module subroutine process_component_write (object, unit)
class(process_component_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine process_component_write
<<Process config: procedures>>=
module subroutine process_component_write (object, unit)
class(process_component_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (associated (object%config)) then
write (u, "(1x,A,I0)") "Component #", object%index
call object%config%write (u)
if (object%md5sum_phs /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (phs) = '", &
object%md5sum_phs, "'"
end if
else
write (u, "(1x,A)") "Process component: [not allocated]"
end if
if (.not. object%active) then
write (u, "(1x,A)") "[Inactive]"
return
end if
write (u, "(1x,A)") "Referenced data:"
if (allocated (object%i_term)) then
write (u, "(3x,A,999(1x,I0))") "Terms =", &
object%i_term
else
write (u, "(3x,A)") "Terms = [undefined]"
end if
if (object%i_mci /= 0) then
write (u, "(3x,A,I0)") "MC dataset = ", object%i_mci
else
write (u, "(3x,A)") "MC dataset = [undefined]"
end if
if (allocated (object%phs_config)) then
call object%phs_config%write (u)
end if
end subroutine process_component_write
@ %def process_component_write
@ Initialize the component.
<<Process config: process component: TBP>>=
procedure :: init => process_component_init
<<Process config: sub interfaces>>=
module subroutine process_component_init (component, &
i_component, env, meta, config, &
active, &
phs_config_template)
class(process_component_t), intent(out) :: component
integer, intent(in) :: i_component
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
logical, intent(in) :: active
class(phs_config_t), intent(in), allocatable :: phs_config_template
end subroutine process_component_init
<<Process config: procedures>>=
module subroutine process_component_init (component, &
i_component, env, meta, config, &
active, &
phs_config_template)
class(process_component_t), intent(out) :: component
integer, intent(in) :: i_component
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
logical, intent(in) :: active
class(phs_config_t), intent(in), allocatable :: phs_config_template
type(process_constants_t) :: data
component%index = i_component
component%config => &
config%process_def%get_component_def_ptr (i_component)
component%active = active
if (component%active) then
allocate (component%phs_config, source = phs_config_template)
call env%fill_process_constants (meta%id, i_component, data)
call component%phs_config%init (data, config%model)
end if
end subroutine process_component_init
@ %def process_component_init
@
<<Process config: process component: TBP>>=
procedure :: is_active => process_component_is_active
<<Process config: sub interfaces>>=
elemental module function process_component_is_active &
(component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
end function process_component_is_active
<<Process config: procedures>>=
elemental module function process_component_is_active &
(component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
active = component%active
end function process_component_is_active
@ %def process_component_is_active
@ Finalize the phase-space configuration.
<<Process config: process component: TBP>>=
procedure :: configure_phs => process_component_configure_phs
<<Process config: sub interfaces>>=
module subroutine process_component_configure_phs &
(component, sqrts, beam_config, rebuild, &
ignore_mismatch, subdir)
class(process_component_t), intent(inout) :: component
real(default), intent(in) :: sqrts
type(process_beam_config_t), intent(in) :: beam_config
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
type(string_t), intent(in), optional :: subdir
end subroutine process_component_configure_phs
<<Process config: procedures>>=
module subroutine process_component_configure_phs &
(component, sqrts, beam_config, rebuild, &
ignore_mismatch, subdir)
class(process_component_t), intent(inout) :: component
real(default), intent(in) :: sqrts
type(process_beam_config_t), intent(in) :: beam_config
logical, intent(in), optional :: rebuild
logical, intent(in), optional :: ignore_mismatch
type(string_t), intent(in), optional :: subdir
logical :: no_strfun
integer :: nlo_type
no_strfun = beam_config%n_strfun == 0
nlo_type = component%config%get_nlo_type ()
call component%phs_config%configure (sqrts, &
azimuthal_dependence = beam_config%azimuthal_dependence, &
sqrts_fixed = no_strfun, &
lab_is_cm = beam_config%lab_is_cm .and. no_strfun, &
rebuild = rebuild, ignore_mismatch = ignore_mismatch, &
nlo_type = nlo_type, &
subdir = subdir)
end subroutine process_component_configure_phs
@ %def process_component_configure_phs
@ The process component possesses two MD5 sums: the checksum of the
component definition, which should be available when the component is
initialized, and the phase-space MD5 sum, which is available after
configuration.
<<Process config: process component: TBP>>=
procedure :: compute_md5sum => process_component_compute_md5sum
<<Process config: sub interfaces>>=
module subroutine process_component_compute_md5sum (component)
class(process_component_t), intent(inout) :: component
end subroutine process_component_compute_md5sum
<<Process config: procedures>>=
module subroutine process_component_compute_md5sum (component)
class(process_component_t), intent(inout) :: component
component%md5sum_phs = component%phs_config%get_md5sum ()
end subroutine process_component_compute_md5sum
@ %def process_component_compute_md5sum
@ Match phase-space channels with structure-function channels, where
applicable.
This calls a method of the [[phs_config]] phase-space implementation.
<<Process config: process component: TBP>>=
procedure :: collect_channels => process_component_collect_channels
<<Process config: sub interfaces>>=
module subroutine process_component_collect_channels (component, coll)
class(process_component_t), intent(inout) :: component
type(phs_channel_collection_t), intent(inout) :: coll
end subroutine process_component_collect_channels
<<Process config: procedures>>=
module subroutine process_component_collect_channels (component, coll)
class(process_component_t), intent(inout) :: component
type(phs_channel_collection_t), intent(inout) :: coll
call component%phs_config%collect_channels (coll)
end subroutine process_component_collect_channels
@ %def process_component_collect_channels
@
<<Process config: process component: TBP>>=
procedure :: get_config => process_component_get_config
<<Process config: sub interfaces>>=
module function process_component_get_config (component) &
result (config)
type(process_component_def_t) :: config
class(process_component_t), intent(in) :: component
end function process_component_get_config
<<Process config: procedures>>=
module function process_component_get_config (component) &
result (config)
type(process_component_def_t) :: config
class(process_component_t), intent(in) :: component
config = component%config
end function process_component_get_config
@ %def process_component_get_config
@
<<Process config: process component: TBP>>=
procedure :: get_md5sum => process_component_get_md5sum
<<Process config: sub interfaces>>=
pure module function process_component_get_md5sum (component) result (md5)
type(string_t) :: md5
class(process_component_t), intent(in) :: component
end function process_component_get_md5sum
<<Process config: procedures>>=
pure module function process_component_get_md5sum (component) result (md5)
type(string_t) :: md5
class(process_component_t), intent(in) :: component
md5 = component%config%get_md5sum () // component%md5sum_phs
end function process_component_get_md5sum
@ %def process_component_get_md5sum
@ Return the number of phase-space parameters.
<<Process config: process component: TBP>>=
procedure :: get_n_phs_par => process_component_get_n_phs_par
<<Process config: sub interfaces>>=
module function process_component_get_n_phs_par (component) result (n_par)
class(process_component_t), intent(in) :: component
integer :: n_par
end function process_component_get_n_phs_par
<<Process config: procedures>>=
module function process_component_get_n_phs_par (component) result (n_par)
class(process_component_t), intent(in) :: component
integer :: n_par
n_par = component%phs_config%get_n_par ()
end function process_component_get_n_phs_par
@ %def process_component_get_n_phs_par
@
<<Process config: process component: TBP>>=
procedure :: get_phs_config => process_component_get_phs_config
<<Process config: sub interfaces>>=
module subroutine process_component_get_phs_config (component, phs_config)
class(process_component_t), intent(in), target :: component
class(phs_config_t), intent(out), pointer :: phs_config
end subroutine process_component_get_phs_config
<<Process config: procedures>>=
module subroutine process_component_get_phs_config (component, phs_config)
class(process_component_t), intent(in), target :: component
class(phs_config_t), intent(out), pointer :: phs_config
phs_config => component%phs_config
end subroutine process_component_get_phs_config
@ %def process_component_get_phs_config
@
<<Process config: process component: TBP>>=
procedure :: get_nlo_type => process_component_get_nlo_type
<<Process config: sub interfaces>>=
elemental module function process_component_get_nlo_type &
(component) result (nlo_type)
integer :: nlo_type
class(process_component_t), intent(in) :: component
end function process_component_get_nlo_type
<<Process config: procedures>>=
elemental module function process_component_get_nlo_type &
(component) result (nlo_type)
integer :: nlo_type
class(process_component_t), intent(in) :: component
nlo_type = component%config%get_nlo_type ()
end function process_component_get_nlo_type
@ %def process_component_get_nlo_type
@
<<Process config: process component: TBP>>=
procedure :: needs_mci_entry => process_component_needs_mci_entry
<<Process config: sub interfaces>>=
module function process_component_needs_mci_entry &
(component, combined_integration) result (value)
logical :: value
class(process_component_t), intent(in) :: component
logical, intent(in), optional :: combined_integration
end function process_component_needs_mci_entry
<<Process config: procedures>>=
module function process_component_needs_mci_entry &
(component, combined_integration) result (value)
logical :: value
class(process_component_t), intent(in) :: component
logical, intent(in), optional :: combined_integration
value = component%active
if (present (combined_integration)) then
if (combined_integration) &
value = value .and. component%component_type <= COMP_MASTER
end if
end function process_component_needs_mci_entry
@ %def process_component_needs_mci_entry
@
<<Process config: process component: TBP>>=
procedure :: can_be_integrated => process_component_can_be_integrated
<<Process config: sub interfaces>>=
elemental module function process_component_can_be_integrated &
(component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
end function process_component_can_be_integrated
<<Process config: procedures>>=
elemental module function process_component_can_be_integrated &
(component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
active = component%config%can_be_integrated ()
end function process_component_can_be_integrated
@ %def process_component_can_be_integrated
@
\subsection{Process terms}
For straightforward tree-level calculations, each process component
corresponds to a unique elementary interaction. However, in the case
of NLO calculations with subtraction terms, a process component may
split into several separate contributions to the scattering, which are
qualified by interactions with distinct kinematics and particle
content. We represent their configuration as [[process_term_t]]
objects, the actual instances will be introduced below as
[[term_instance_t]]. In any case, the process term contains an
elementary interaction with a definite quantum-number and momentum
content.
The index [[i_term_global]] identifies the term relative to the
process.
The index [[i_component]] identifies the process component which
generates this term, relative to the parent process.
The index [[i_term]] identifies the term relative to the process
component (not the process).
The [[data]] subobject holds all process constants.
The number of allowed flavor/helicity/color combinations is stored as
[[n_allowed]]. This is the total number of independent entries in the
density matrix. For each combination, the index of the flavor,
helicity, and color state is stored in the arrays [[flv]], [[hel]],
and [[col]], respectively.
The flag [[rearrange]] is true if we need to rearrange the particles of the
hard interaction, to obtain the effective parton state.
The interaction [[int]] holds the quantum state for the (resolved) hard
interaction, the parent-child relations of the particles, and their momenta.
The momenta are not filled yet; this is postponed to copies of [[int]] which
go into the process instances.
If recombination is in effect, we should allocate [[int_eff]] to describe the
rearranged partonic state.
This type is public only for use in a unit test.
<<Process config: public>>=
public :: process_term_t
<<Process config: types>>=
type :: process_term_t
integer :: i_term_global = 0
integer :: i_component = 0
integer :: i_term = 0
integer :: i_sub = 0
integer :: i_core = 0
integer :: n_allowed = 0
type(process_constants_t) :: data
real(default) :: alpha_s = 0
integer, dimension(:), allocatable :: flv, hel, col
integer :: n_sub, n_sub_color, n_sub_spin
type(interaction_t) :: int
type(interaction_t), pointer :: int_eff => null ()
contains
<<Process config: process term: TBP>>
end type process_term_t
@ %def process_term_t
@ For the output, we skip the process constants and the tables of
allowed quantum numbers. Those can also be read off from the
interaction object.
<<Process config: process term: TBP>>=
procedure :: write => process_term_write
<<Process config: sub interfaces>>=
module subroutine process_term_write (term, unit)
class(process_term_t), intent(in) :: term
integer, intent(in), optional :: unit
end subroutine process_term_write
<<Process config: procedures>>=
module subroutine process_term_write (term, unit)
class(process_term_t), intent(in) :: term
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A,I0)") "Term #", term%i_term_global
write (u, "(3x,A,I0)") "Process component index = ", &
term%i_component
write (u, "(3x,A,I0)") "Term index w.r.t. component = ", &
term%i_term
call write_separator (u)
write (u, "(1x,A)") "Hard interaction:"
call write_separator (u)
call term%int%basic_write (u)
end subroutine process_term_write
@ %def process_term_write
@ Write an account of all quantum number states and their current status.
<<Process config: process term: TBP>>=
procedure :: write_state_summary => process_term_write_state_summary
<<Process config: sub interfaces>>=
module subroutine process_term_write_state_summary (term, core, unit)
class(process_term_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
integer, intent(in), optional :: unit
end subroutine process_term_write_state_summary
<<Process config: procedures>>=
module subroutine process_term_write_state_summary (term, core, unit)
class(process_term_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
integer, intent(in), optional :: unit
integer :: u, i, f, h, c
type(state_iterator_t) :: it
character :: sgn
u = given_output_unit (unit)
write (u, "(1x,A,I0)") "Term #", term%i_term_global
call it%init (term%int%get_state_matrix_ptr ())
do while (it%is_valid ())
i = it%get_me_index ()
f = term%flv(i)
h = term%hel(i)
if (allocated (term%col)) then
c = term%col(i)
else
c = 1
end if
if (core%is_allowed (term%i_term, f, h, c)) then
sgn = "+"
else
sgn = " "
end if
write (u, "(1x,A1,1x,I0,2x)", advance="no") sgn, i
call quantum_numbers_write (it%get_quantum_numbers (), u)
write (u, *)
call it%advance ()
end do
end subroutine process_term_write_state_summary
@ %def process_term_write_state_summary
@ Finalizer: the [[int]] and potentially [[int_eff]] components have a
finalizer that we must call.
<<Process config: process term: TBP>>=
procedure :: final => process_term_final
<<Process config: sub interfaces>>=
module subroutine process_term_final (term)
class(process_term_t), intent(inout) :: term
end subroutine process_term_final
<<Process config: procedures>>=
module subroutine process_term_final (term)
class(process_term_t), intent(inout) :: term
call term%int%final ()
end subroutine process_term_final
@ %def process_term_final
@ Initialize the term. We copy the process constants from the [[core]]
object and set up the [[int]] hard interaction accordingly.
The [[alpha_s]] value is useful for writing external event records. This is
the constant value which may be overridden by an event-specific running value.
If the model does not contain the strong coupling, the value is zero.
The [[rearrange]] part is commented out; this or something equivalent
could become relevant for NLO algorithms.
<<Process config: process term: TBP>>=
procedure :: init => process_term_init
<<Process config: sub interfaces>>=
module subroutine process_term_init &
(term, i_term_global, i_component, i_term, core, model, &
nlo_type, use_beam_pol, subtraction_method, &
has_pdfs, n_emitters)
class(process_term_t), intent(inout), target :: term
integer, intent(in) :: i_term_global
integer, intent(in) :: i_component
integer, intent(in) :: i_term
class(prc_core_t), intent(inout) :: core
class(model_data_t), intent(in), target :: model
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: use_beam_pol
type(string_t), intent(in), optional :: subtraction_method
logical, intent(in), optional :: has_pdfs
integer, intent(in), optional :: n_emitters
end subroutine process_term_init
<<Process config: procedures>>=
module subroutine process_term_init &
(term, i_term_global, i_component, i_term, core, model, &
nlo_type, use_beam_pol, subtraction_method, &
has_pdfs, n_emitters)
class(process_term_t), intent(inout), target :: term
integer, intent(in) :: i_term_global
integer, intent(in) :: i_component
integer, intent(in) :: i_term
class(prc_core_t), intent(inout) :: core
class(model_data_t), intent(in), target :: model
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: use_beam_pol
type(string_t), intent(in), optional :: subtraction_method
logical, intent(in), optional :: has_pdfs
integer, intent(in), optional :: n_emitters
class(modelpar_data_t), pointer :: alpha_s_ptr
logical :: use_internal_color
term%i_term_global = i_term_global
term%i_component = i_component
term%i_term = i_term
call core%get_constants (term%data, i_term)
alpha_s_ptr => model%get_par_data_ptr (var_str ("alphas"))
if (associated (alpha_s_ptr)) then
term%alpha_s = alpha_s_ptr%get_real ()
else
term%alpha_s = -1
end if
use_internal_color = .false.
if (present (subtraction_method)) &
use_internal_color = (char (subtraction_method) == 'omega') &
.or. (char (subtraction_method) == 'threshold')
call term%setup_interaction (core, model, nlo_type = nlo_type, &
pol_beams = use_beam_pol, use_internal_color = use_internal_color, &
has_pdfs = has_pdfs, n_emitters = n_emitters)
end subroutine process_term_init
@ %def process_term_init
@ We fetch the process constants which determine the quantum numbers and
use those to create the interaction. The interaction contains
incoming and outgoing particles, no virtuals. The incoming particles
are parents of the outgoing ones.
Keeping previous \whizard\ conventions, we invert the color assignment
(but not flavor or helicity) for the incoming particles. When the
color-flow square matrix is evaluated, this inversion is done again,
so in the color-flow sequence we get the color assignments of the
matrix element.
\textbf{Why are these four subtraction entries for structure-function
aware interactions?} Taking the soft or collinear limit of the real-emission
matrix element, the behavior of the parton energy fractions has to be
taken into account. In the pure real case, $x_\oplus$ and $x_\ominus$
are given by
\begin{equation*}
x_\oplus = \frac{\bar{x}_\oplus}{\sqrt{1-\xi}}
\sqrt{\frac{2 - \xi(1-y)}{2 - \xi(1+y)}},
\quad
x_\ominus = \frac{\bar{x}_\ominus}{\sqrt{1-\xi}}
\sqrt{\frac{2 - \xi(1+y)}{2 - \xi(1-y)}}.
\end{equation*}
In the soft limit, $\xi \to 0$, this yields $x_\oplus = \bar{x}_\oplus$
and $x_\ominus = \bar{x}_\ominus$. In the collinear limit, $y \to 1$,
it is $x_\oplus = \bar{x}_\oplus / (1 - \xi)$ and $x_\ominus = \bar{x}_\ominus$.
Likewise, in the anti-collinear limit $y \to -1$, the inverse relation holds.
We therefore have to distinguish four cases with the PDF assignments
$f(x_\oplus) \cdot f(x_\ominus)$, $f(\bar{x}_\oplus) \cdot f(\bar{x}_\ominus)$,
$f\left(\bar{x}_\oplus / (1-\xi)\right) \cdot f(\bar{x}_\ominus)$ and
$f(\bar{x}_\oplus) \cdot f\left(\bar{x}_\ominus / (1-\xi)\right)$.
The [[n_emitters]] optional argument is provided by the caller if this term
requires spin-correlated matrix elements, and thus involves additional
subtractions.
<<Process config: process term: TBP>>=
procedure :: setup_interaction => process_term_setup_interaction
<<Process config: sub interfaces>>=
module subroutine process_term_setup_interaction (term, core, model, &
nlo_type, pol_beams, has_pdfs, use_internal_color, n_emitters)
class(process_term_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
class(model_data_t), intent(in), target :: model
logical, intent(in), optional :: pol_beams
logical, intent(in), optional :: has_pdfs
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: use_internal_color
integer, intent(in), optional :: n_emitters
end subroutine process_term_setup_interaction
<<Process config: procedures>>=
module subroutine process_term_setup_interaction (term, core, model, &
nlo_type, pol_beams, has_pdfs, use_internal_color, n_emitters)
class(process_term_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
class(model_data_t), intent(in), target :: model
logical, intent(in), optional :: pol_beams
logical, intent(in), optional :: has_pdfs
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: use_internal_color
integer, intent(in), optional :: n_emitters
integer :: n, n_tot
type(flavor_t), dimension(:), allocatable :: flv
type(color_t), dimension(:), allocatable :: col
type(helicity_t), dimension(:), allocatable :: hel
type(quantum_numbers_t), dimension(:), allocatable :: qn
logical :: is_pol, use_color
integer :: nlo_t, n_sub
is_pol = .false.; if (present (pol_beams)) is_pol = pol_beams
nlo_t = BORN; if (present (nlo_type)) nlo_t = nlo_type
n_tot = term%data%n_in + term%data%n_out
call count_number_of_states ()
term%n_allowed = n
call compute_n_sub (n_emitters, has_pdfs)
call fill_quantum_numbers ()
call term%int%basic_init &
(term%data%n_in, 0, term%data%n_out, set_relations = .true.)
select type (core)
class is (prc_blha_t)
call setup_states_blha_olp ()
type is (prc_threshold_t)
call setup_states_threshold ()
class is (prc_external_t)
call setup_states_other_prc_external ()
class default
call setup_states_omega ()
end select
call term%int%freeze ()
contains
subroutine count_number_of_states ()
integer :: f, h, c
n = 0
select type (core)
class is (prc_external_t)
do f = 1, term%data%n_flv
do h = 1, term%data%n_hel
do c = 1, term%data%n_col
n = n + 1
end do
end do
end do
class default !!! Omega and all test cores
do f = 1, term%data%n_flv
do h = 1, term%data%n_hel
do c = 1, term%data%n_col
if (core%is_allowed (term%i_term, f, h, c)) n = n + 1
end do
end do
end do
end select
end subroutine count_number_of_states
subroutine compute_n_sub (n_emitters, has_pdfs)
integer, intent(in), optional :: n_emitters
logical, intent(in), optional :: has_pdfs
logical :: can_have_sub
integer :: n_sub_color, n_sub_spin
use_color = .false.; if (present (use_internal_color)) &
use_color = use_internal_color
can_have_sub = nlo_t == NLO_VIRTUAL .or. &
(nlo_t == NLO_REAL .and. term%i_term_global == term%i_sub) .or. &
nlo_t == NLO_MISMATCH .or. nlo_t == NLO_DGLAP
n_sub_color = 0; n_sub_spin = 0
if (can_have_sub) then
if (.not. use_color) n_sub_color = n_tot * (n_tot - 1) / 2
if (nlo_t == NLO_REAL) then
if (present (n_emitters)) then
n_sub_spin = 6 * n_emitters
end if
end if
end if
n_sub = n_sub_color + n_sub_spin
!!! For the virtual subtraction we also need the finite virtual contribution
!!! corresponding to the $\epsilon^0$-pole
if (nlo_t == NLO_VIRTUAL) n_sub = n_sub + 1
if (present (has_pdfs)) then
if (has_pdfs &
.and. ((nlo_t == NLO_REAL .and. can_have_sub) &
.or. nlo_t == NLO_DGLAP)) then
!!! necessary dummy, needs refactoring,
!!! c.f. [[term_instance_evaluate_interaction_external_tree]]
n_sub = n_sub + n_beams_rescaled
end if
end if
term%n_sub = n_sub
term%n_sub_color = n_sub_color
term%n_sub_spin = n_sub_spin
end subroutine compute_n_sub
subroutine fill_quantum_numbers ()
integer :: nn
logical :: can_have_sub
select type (core)
class is (prc_external_t)
can_have_sub = nlo_t == NLO_VIRTUAL .or. &
(nlo_t == NLO_REAL .and. term%i_term_global == term%i_sub) .or. &
nlo_t == NLO_MISMATCH .or. nlo_t == NLO_DGLAP
if (can_have_sub) then
nn = (n_sub + 1) * n
else
nn = n
end if
class default
nn = n
end select
allocate (term%flv (nn), term%col (nn), term%hel (nn))
allocate (flv (n_tot), col (n_tot), hel (n_tot))
allocate (qn (n_tot))
end subroutine fill_quantum_numbers
subroutine setup_states_blha_olp ()
integer :: s, f, c, h, i
i = 0
associate (data => term%data)
do s = 0, n_sub
do f = 1, data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
i = i + 1
term%flv(i) = f
term%hel(i) = h
!!! Dummy-initialization of color
term%col(i) = c
call flv%init (data%flv_state (:,f), model)
call color_init_from_array (col, &
data%col_state(:,:,c), data%ghost_flag(:,c))
call col(1:data%n_in)%invert ()
if (is_pol) then
select type (core)
type is (prc_openloops_t)
call hel%init (data%hel_state (:,h))
call qn%init (flv, hel, col, s)
class default
call msg_fatal ("Polarized beams only supported by OpenLoops")
end select
else
call qn%init (flv, col, s)
end if
call qn%tag_hard_process ()
call term%int%add_state (qn)
end do
end do
end do
end do
end associate
end subroutine setup_states_blha_olp
subroutine setup_states_threshold ()
integer :: s, f, c, h, i
i = 0
n_sub = 0; if (nlo_t == NLO_VIRTUAL) n_sub = 1
associate (data => term%data)
do s = 0, n_sub
do f = 1, term%data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
i = i + 1
term%flv(i) = f
term%hel(i) = h
!!! Dummy-initialization of color
term%col(i) = 1
call flv%init (term%data%flv_state (:,f), model)
if (is_pol) then
call hel%init (data%hel_state (:,h))
call qn%init (flv, hel, s)
else
call qn%init (flv, s)
end if
call qn%tag_hard_process ()
call term%int%add_state (qn)
end do
end do
end do
end do
end associate
end subroutine setup_states_threshold
subroutine setup_states_other_prc_external ()
integer :: s, f, i, c, h
if (is_pol) &
call msg_fatal ("Polarized beams only supported by OpenLoops")
i = 0
!!! n_sub = 0; if (nlo_t == NLO_VIRTUAL) n_sub = 1
associate (data => term%data)
do s = 0, n_sub
do f = 1, data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
i = i + 1
term%flv(i) = f
term%hel(i) = h
!!! Dummy-initialization of color
term%col(i) = c
call flv%init (data%flv_state (:,f), model)
call color_init_from_array (col, &
data%col_state(:,:,c), data%ghost_flag(:,c))
call col(1:data%n_in)%invert ()
call qn%init (flv, col, s)
call qn%tag_hard_process ()
call term%int%add_state (qn)
end do
end do
end do
end do
end associate
end subroutine setup_states_other_prc_external
subroutine setup_states_omega ()
integer :: f, h, c, i
i = 0
associate (data => term%data)
do f = 1, data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
if (core%is_allowed (term%i_term, f, h, c)) then
i = i + 1
term%flv(i) = f
term%hel(i) = h
term%col(i) = c
call flv%init (data%flv_state(:,f), model)
call color_init_from_array (col, &
data%col_state(:,:,c), &
data%ghost_flag(:,c))
call col(:data%n_in)%invert ()
call hel%init (data%hel_state(:,h))
call qn%init (flv, col, hel)
call qn%tag_hard_process ()
call term%int%add_state (qn)
end if
end do
end do
end do
end associate
end subroutine setup_states_omega
end subroutine process_term_setup_interaction
@ %def process_term_setup_interaction
@
<<Process config: process term: TBP>>=
procedure :: get_process_constants => process_term_get_process_constants
<<Process config: sub interfaces>>=
module subroutine process_term_get_process_constants &
(term, prc_constants)
class(process_term_t), intent(inout) :: term
type(process_constants_t), intent(out) :: prc_constants
end subroutine process_term_get_process_constants
<<Process config: procedures>>=
module subroutine process_term_get_process_constants &
(term, prc_constants)
class(process_term_t), intent(inout) :: term
type(process_constants_t), intent(out) :: prc_constants
prc_constants = term%data
end subroutine process_term_get_process_constants
@ %def process_term_get_process_constants
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process call statistics}
Very simple object for statistics. Could be moved to a more basic chapter.
<<[[process_counter.f90]]>>=
<<File header>>
module process_counter
<<Standard module head>>
<<Process counter: public>>
<<Process counter: parameters>>
<<Process counter: types>>
interface
<<Process counter: sub interfaces>>
end interface
end module process_counter
@ %def process_counter
@ This object can record process calls, categorized by evaluation
status. It is a part of the [[mci_entry]] component below.
<<Process counter: public>>=
public :: process_counter_t
<<Process counter: types>>=
type :: process_counter_t
integer :: total = 0
integer :: failed_kinematics = 0
integer :: failed_cuts = 0
integer :: has_passed = 0
integer :: evaluated = 0
integer :: complete = 0
contains
<<Process counter: process counter: TBP>>
end type process_counter_t
@ %def process_counter_t
@ Here are the corresponding numeric codes:
<<Process counter: parameters>>=
integer, parameter, public :: STAT_UNDEFINED = 0
integer, parameter, public :: STAT_INITIAL = 1
integer, parameter, public :: STAT_ACTIVATED = 2
integer, parameter, public :: STAT_BEAM_MOMENTA = 3
integer, parameter, public :: STAT_FAILED_KINEMATICS = 4
integer, parameter, public :: STAT_SEED_KINEMATICS = 5
integer, parameter, public :: STAT_HARD_KINEMATICS = 6
integer, parameter, public :: STAT_EFF_KINEMATICS = 7
integer, parameter, public :: STAT_FAILED_CUTS = 8
integer, parameter, public :: STAT_PASSED_CUTS = 9
integer, parameter, public :: STAT_EVALUATED_TRACE = 10
integer, parameter, public :: STAT_EVENT_COMPLETE = 11
@ %def STAT_UNDEFINED STAT_INITIAL STAT_ACTIVATED
@ %def STAT_BEAM_MOMENTA STAT_FAILED_KINEMATICS
@ %def STAT_SEED_KINEMATICS STAT_HARD_KINEMATICS STAT_EFF_KINEMATICS
@ %def STAT_EVALUATED_TRACE STAT_EVENT_COMPLETE
@ Output.
<<Process counter: process counter: TBP>>=
procedure :: write => process_counter_write
<<Process counter: sub interfaces>>=
module subroutine process_counter_write (object, unit)
class(process_counter_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine process_counter_write
<<Process counter: procedures>>=
module subroutine process_counter_write (object, unit)
class(process_counter_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (object%total > 0) then
write (u, "(1x,A)") "Call statistics (current run):"
write (u, "(3x,A,I0)") "total = ", object%total
write (u, "(3x,A,I0)") "failed kin. = ", object%failed_kinematics
write (u, "(3x,A,I0)") "failed cuts = ", object%failed_cuts
write (u, "(3x,A,I0)") "passed cuts = ", object%has_passed
write (u, "(3x,A,I0)") "evaluated = ", object%evaluated
else
write (u, "(1x,A)") "Call statistics (current run): [no calls]"
end if
end subroutine process_counter_write
@ %def process_counter_write
@
<<[[process_counter_sub.f90]]>>=
<<File header>>
submodule (process_counter) process_counter_s
use io_units
implicit none
contains
<<Process counter: procedures>>
end submodule process_counter_s
@ %def process_counter_s
@ Reset. Just enforce default initialization.
<<Process counter: process counter: TBP>>=
procedure :: reset => process_counter_reset
<<Process counter: sub interfaces>>=
module subroutine process_counter_reset (counter)
class(process_counter_t), intent(out) :: counter
end subroutine process_counter_reset
<<Process counter: procedures>>=
module subroutine process_counter_reset (counter)
class(process_counter_t), intent(out) :: counter
counter%total = 0
counter%failed_kinematics = 0
counter%failed_cuts = 0
counter%has_passed = 0
counter%evaluated = 0
counter%complete = 0
end subroutine process_counter_reset
@ %def process_counter_reset
@ We record an event according to the lowest status code greater or
equal to the actual status. This is actually done by the process
instance; the process object just copies the instance counter.
<<Process counter: process counter: TBP>>=
procedure :: record => process_counter_record
<<Process counter: sub interfaces>>=
module subroutine process_counter_record (counter, status)
class(process_counter_t), intent(inout) :: counter
integer, intent(in) :: status
end subroutine process_counter_record
<<Process counter: procedures>>=
module subroutine process_counter_record (counter, status)
class(process_counter_t), intent(inout) :: counter
integer, intent(in) :: status
if (status <= STAT_FAILED_KINEMATICS) then
counter%failed_kinematics = counter%failed_kinematics + 1
else if (status <= STAT_FAILED_CUTS) then
counter%failed_cuts = counter%failed_cuts + 1
else if (status <= STAT_PASSED_CUTS) then
counter%has_passed = counter%has_passed + 1
else
counter%evaluated = counter%evaluated + 1
end if
counter%total = counter%total + 1
end subroutine process_counter_record
@ %def process_counter_record
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Multi-channel integration}
<<[[process_mci.f90]]>>=
<<File header>>
module process_mci
<<Use kinds>>
<<Use strings>>
use cputime
use rng_base
use mci_base
use variables
use integration_results
use process_libraries
use phs_base
use process_counter
use process_config
<<Standard module head>>
<<Process mci: public>>
<<Process mci: parameters>>
<<Process mci: types>>
interface
<<Process mci: sub interfaces>>
end interface
end module process_mci
@ %def process_mci
@
<<[[process_mci_sub.f90]]>>=
<<File header>>
submodule (process_mci) process_mci_s
<<Use debug>>
use io_units
use diagnostics
use physics_defs
use md5
implicit none
contains
<<Process mci: procedures>>
end submodule process_mci_s
@ %def process_mci_s
\subsection{Process MCI entry}
The [[process_mci_entry_t]] block contains, for each process component that is
integrated independently, the configuration data for its MC input parameters.
Each input parameter set is handled by a [[mci_t]] integrator.
The MC input parameter set is broken down into the parameters required by the
structure-function chain and the parameters required by the phase space of the
elementary process.
The MD5 sum collects all information about the associated processes
that may affect the integration. It does not contain the MCI object
itself or integration results.
MC integration is organized in passes. Each pass may consist of
several iterations, and for each iteration there is a number of
calls. We store explicitly the values that apply to the current
pass. Previous values are archived in the [[results]] object.
The [[counter]] receives the counter statistics from the associated
process instance, for diagnostics.
The [[results]] object records results, broken down in passes and iterations.
<<Process mci: public>>=
public :: process_mci_entry_t
<<Process mci: types>>=
type :: process_mci_entry_t
integer :: i_mci = 0
integer, dimension(:), allocatable :: i_component
integer :: process_type = PRC_UNKNOWN
integer :: n_par = 0
integer :: n_par_sf = 0
integer :: n_par_phs = 0
character(32) :: md5sum = ""
integer :: pass = 0
integer :: n_it = 0
integer :: n_calls = 0
logical :: activate_timer = .false.
real(default) :: error_threshold = 0
class(mci_t), allocatable :: mci
type(process_counter_t) :: counter
type(integration_results_t) :: results
logical :: negative_weights = .false.
logical :: combined_integration = .false.
integer :: real_partition_type = REAL_FULL
contains
<<Process mci: process mci entry: TBP>>
end type process_mci_entry_t
@ %def process_mci_entry_t
@ Finalizer for the [[mci]] component.
<<Process mci: process mci entry: TBP>>=
procedure :: final => process_mci_entry_final
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_final (object)
class(process_mci_entry_t), intent(inout) :: object
end subroutine process_mci_entry_final
<<Process mci: procedures>>=
module subroutine process_mci_entry_final (object)
class(process_mci_entry_t), intent(inout) :: object
if (allocated (object%mci)) call object%mci%final ()
end subroutine process_mci_entry_final
@ %def process_mci_entry_final
@ Output. Write pass/iteration information only if set (the pass
index is nonzero). Write the MCI block only if it exists (for some
self-tests it does not). Write results only if there are any.
<<Process mci: process mci entry: TBP>>=
procedure :: write => process_mci_entry_write
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_write (object, unit, pacify)
class(process_mci_entry_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
end subroutine process_mci_entry_write
<<Process mci: procedures>>=
module subroutine process_mci_entry_write (object, unit, pacify)
class(process_mci_entry_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,I0)") "Associated components = ", object%i_component
write (u, "(3x,A,I0)") "MC input parameters = ", object%n_par
write (u, "(3x,A,I0)") "MC parameters (SF) = ", object%n_par_sf
write (u, "(3x,A,I0)") "MC parameters (PHS) = ", object%n_par_phs
if (object%pass > 0) then
write (u, "(3x,A,I0)") "Current pass = ", object%pass
write (u, "(3x,A,I0)") "Number of iterations = ", object%n_it
write (u, "(3x,A,I0)") "Number of calls = ", object%n_calls
end if
if (object%md5sum /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (components) = '", object%md5sum, "'"
end if
if (allocated (object%mci)) then
call object%mci%write (u)
end if
call object%counter%write (u)
if (object%results%exist ()) then
call object%results%write (u, suppress = pacify)
call object%results%write_chain_weights (u)
end if
end subroutine process_mci_entry_write
@ %def process_mci_entry_write
@ Configure the MCI entry. This is intent(inout) since some specific settings
may be done before this. The actual [[mci_t]] object is an instance of the
[[mci_template]] argument, which determines the concrete types.
In a unit-test context, the [[mci_template]] argument may be unallocated.
We obtain the number of channels and the number of parameters separately for
the structure-function chain and for the associated process component. We
assume that the phase-space object has already been configured.
We assume that there is only one process component directly associated with an
MCI entry.
<<Process mci: process mci entry: TBP>>=
procedure :: configure => process_mci_entry_configure
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_configure (mci_entry, mci_template, &
process_type, i_mci, i_component, component, &
n_sfpar, rng_factory)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_t), intent(in), allocatable :: mci_template
integer, intent(in) :: process_type
integer, intent(in) :: i_mci
integer, intent(in) :: i_component
type(process_component_t), intent(in), target :: component
integer, intent(in) :: n_sfpar
class(rng_factory_t), intent(inout) :: rng_factory
end subroutine process_mci_entry_configure
<<Process mci: procedures>>=
module subroutine process_mci_entry_configure (mci_entry, mci_template, &
process_type, i_mci, i_component, component, &
n_sfpar, rng_factory)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_t), intent(in), allocatable :: mci_template
integer, intent(in) :: process_type
integer, intent(in) :: i_mci
integer, intent(in) :: i_component
type(process_component_t), intent(in), target :: component
integer, intent(in) :: n_sfpar
class(rng_factory_t), intent(inout) :: rng_factory
class(rng_t), allocatable :: rng
associate (phs_config => component%phs_config)
mci_entry%i_mci = i_mci
call mci_entry%create_component_list (i_component, component%get_config ())
mci_entry%n_par_sf = n_sfpar
mci_entry%n_par_phs = phs_config%get_n_par ()
mci_entry%n_par = mci_entry%n_par_sf + mci_entry%n_par_phs
mci_entry%process_type = process_type
if (allocated (mci_template)) then
allocate (mci_entry%mci, source = mci_template)
call mci_entry%mci%record_index (mci_entry%i_mci)
call mci_entry%mci%set_dimensions &
(mci_entry%n_par, phs_config%get_n_channel ())
call mci_entry%mci%declare_flat_dimensions &
(phs_config%get_flat_dimensions ())
if (phs_config%provides_equivalences) then
call mci_entry%mci%declare_equivalences &
(phs_config%channel, mci_entry%n_par_sf)
end if
if (phs_config%provides_chains) then
call mci_entry%mci%declare_chains (phs_config%chain)
end if
call rng_factory%make (rng)
call mci_entry%mci%import_rng (rng)
end if
call mci_entry%results%init (process_type)
end associate
end subroutine process_mci_entry_configure
@ %def process_mci_entry_configure
@
<<Process mci: parameters>>=
integer, parameter, public :: REAL_FULL = 0
integer, parameter, public :: REAL_SINGULAR = 1
integer, parameter, public :: REAL_FINITE = 2
@
<<Process mci: process mci entry: TBP>>=
procedure :: create_component_list => &
process_mci_entry_create_component_list
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_create_component_list (mci_entry, &
i_component, component_config)
class (process_mci_entry_t), intent(inout) :: mci_entry
integer, intent(in) :: i_component
type(process_component_def_t), intent(in) :: component_config
end subroutine process_mci_entry_create_component_list
<<Process mci: procedures>>=
module subroutine process_mci_entry_create_component_list (mci_entry, &
i_component, component_config)
class (process_mci_entry_t), intent(inout) :: mci_entry
integer, intent(in) :: i_component
type(process_component_def_t), intent(in) :: component_config
integer, dimension(:), allocatable :: i_list
integer :: n
integer, save :: i_rfin_offset = 0
if (debug_on) call msg_debug &
(D_PROCESS_INTEGRATION, "process_mci_entry_create_component_list")
if (mci_entry%combined_integration) then
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
"mci_entry%real_partition_type", mci_entry%real_partition_type)
n = get_n_components (mci_entry%real_partition_type)
allocate (i_list (n))
select case (mci_entry%real_partition_type)
case (REAL_FULL)
i_list = component_config%get_association_list ()
allocate (mci_entry%i_component (size (i_list)))
mci_entry%i_component = i_list
case (REAL_SINGULAR)
i_list = component_config%get_association_list (ASSOCIATED_REAL_FIN)
allocate (mci_entry%i_component (size(i_list)))
mci_entry%i_component = i_list
case (REAL_FINITE)
allocate (mci_entry%i_component (1))
mci_entry%i_component(1) = &
component_config%get_associated_real_fin () + i_rfin_offset
i_rfin_offset = i_rfin_offset + 1
end select
else
allocate (mci_entry%i_component (1))
mci_entry%i_component(1) = i_component
end if
contains
function get_n_components (real_partition_type) result (n_components)
integer :: n_components
integer, intent(in) :: real_partition_type
select case (real_partition_type)
case (REAL_FULL)
n_components = size (component_config%get_association_list ())
case (REAL_SINGULAR)
n_components = size (component_config%get_association_list &
(ASSOCIATED_REAL_FIN))
end select
if (debug_on) call msg_debug &
(D_PROCESS_INTEGRATION, "n_components", n_components)
end function get_n_components
end subroutine process_mci_entry_create_component_list
@ %def process_mci_entry_create_component_list
@ Set some additional parameters.
<<Process mci: process mci entry: TBP>>=
procedure :: set_parameters => process_mci_entry_set_parameters
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_set_parameters (mci_entry, var_list)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(var_list_t), intent(in) :: var_list
end subroutine process_mci_entry_set_parameters
<<Process mci: procedures>>=
module subroutine process_mci_entry_set_parameters (mci_entry, var_list)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(var_list_t), intent(in) :: var_list
integer :: integration_results_verbosity
real(default) :: error_threshold
integration_results_verbosity = &
var_list%get_ival (var_str ("integration_results_verbosity"))
error_threshold = &
var_list%get_rval (var_str ("error_threshold"))
mci_entry%activate_timer = &
var_list%get_lval (var_str ("?integration_timer"))
call mci_entry%results%set_verbosity (integration_results_verbosity)
call mci_entry%results%set_error_threshold (error_threshold)
end subroutine process_mci_entry_set_parameters
@ %def process_mci_entry_set_parameters
@ Compute an MD5 sum that summarizes all information that could
influence integration results, for the associated process components.
We take the process-configuration MD5 sum which represents parameters,
cuts, etc., the MD5 sums for the process component definitions and
their phase space objects (which should be configured), and the beam
configuration MD5 sum. (The QCD setup is included in the process
configuration data MD5 sum.)
Done only once, when the MD5 sum is still empty.
<<Process mci: process mci entry: TBP>>=
procedure :: compute_md5sum => process_mci_entry_compute_md5sum
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_compute_md5sum (mci_entry, &
config, component, beam_config)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(process_config_data_t), intent(in) :: config
type(process_component_t), dimension(:), intent(in) :: component
type(process_beam_config_t), intent(in) :: beam_config
end subroutine process_mci_entry_compute_md5sum
<<Process mci: procedures>>=
module subroutine process_mci_entry_compute_md5sum (mci_entry, &
config, component, beam_config)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(process_config_data_t), intent(in) :: config
type(process_component_t), dimension(:), intent(in) :: component
type(process_beam_config_t), intent(in) :: beam_config
type(string_t) :: buffer
integer :: i
if (mci_entry%md5sum == "") then
buffer = config%get_md5sum () // beam_config%get_md5sum ()
do i = 1, size (component)
if (component(i)%is_active ()) then
buffer = buffer // component(i)%get_md5sum ()
end if
end do
mci_entry%md5sum = md5sum (char (buffer))
end if
if (allocated (mci_entry%mci)) then
call mci_entry%mci%set_md5sum (mci_entry%md5sum)
end if
end subroutine process_mci_entry_compute_md5sum
@ %def process_mci_entry_compute_md5sum
@ Test the MCI sampler by calling it a given number of time, discarding the
results. The instance should be initialized.
The [[mci_entry]] is [[intent(inout)]] because the integrator contains
the random-number state.
<<Process mci: process mci entry: TBP>>=
procedure :: sampler_test => process_mci_entry_sampler_test
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_sampler_test &
(mci_entry, mci_sampler, n_calls)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_sampler_t), intent(inout), target :: mci_sampler
integer, intent(in) :: n_calls
end subroutine process_mci_entry_sampler_test
<<Process mci: procedures>>=
module subroutine process_mci_entry_sampler_test &
(mci_entry, mci_sampler, n_calls)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_sampler_t), intent(inout), target :: mci_sampler
integer, intent(in) :: n_calls
call mci_entry%mci%sampler_test (mci_sampler, n_calls)
end subroutine process_mci_entry_sampler_test
@ %def process_mci_entry_sampler_test
@ Integrate.
The [[integrate]] method counts as an integration pass; the pass count is
increased by one. We transfer the pass parameters (number of iterations and
number of calls) to the actual integration routine.
The [[mci_entry]] is [[intent(inout)]] because the integrator contains
the random-number state.
Note: The results are written to screen and to logfile. This behavior
is hardcoded.
<<Process mci: process mci entry: TBP>>=
procedure :: integrate => process_mci_entry_integrate
procedure :: final_integration => process_mci_entry_final_integration
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_integrate (mci_entry, mci_instance, &
mci_sampler, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify, &
nlo_type)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
integer, intent(in), optional :: nlo_type
end subroutine process_mci_entry_integrate
module subroutine process_mci_entry_final_integration (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
end subroutine process_mci_entry_final_integration
<<Process mci: procedures>>=
module subroutine process_mci_entry_integrate (mci_entry, mci_instance, &
mci_sampler, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify, &
nlo_type)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
integer, intent(in), optional :: nlo_type
integer :: u_log
u_log = logfile_unit ()
mci_entry%pass = mci_entry%pass + 1
mci_entry%n_it = n_it
mci_entry%n_calls = n_calls
if (mci_entry%pass == 1) &
call mci_entry%mci%startup_message (n_calls = n_calls)
call mci_entry%mci%set_timer (active = mci_entry%activate_timer)
call mci_entry%results%display_init (screen = .true., unit = u_log)
call mci_entry%results%new_pass ()
if (present (nlo_type)) then
select case (nlo_type)
case (NLO_VIRTUAL, NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
mci_instance%negative_weights = .true.
end select
end if
call mci_entry%mci%add_pass (adapt_grids, adapt_weights, final)
call mci_entry%mci%start_timer ()
call mci_entry%mci%integrate (mci_instance, mci_sampler, n_it, &
n_calls, mci_entry%results, pacify = pacify)
call mci_entry%mci%stop_timer ()
if (signal_is_pending ()) return
end subroutine process_mci_entry_integrate
module subroutine process_mci_entry_final_integration (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
call mci_entry%results%display_final ()
call mci_entry%time_message ()
end subroutine process_mci_entry_final_integration
@ %def process_mci_entry_integrate
@ %def process_mci_entry_final_integration
@ If appropriate, issue an informative message about the expected time
for an event sample.
<<Process mci: process mci entry: TBP>>=
procedure :: get_time => process_mci_entry_get_time
procedure :: time_message => process_mci_entry_time_message
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_get_time (mci_entry, time, sample)
class(process_mci_entry_t), intent(in) :: mci_entry
type(time_t), intent(out) :: time
integer, intent(in) :: sample
end subroutine process_mci_entry_get_time
module subroutine process_mci_entry_time_message (mci_entry)
class(process_mci_entry_t), intent(in) :: mci_entry
end subroutine process_mci_entry_time_message
<<Process mci: procedures>>=
module subroutine process_mci_entry_get_time (mci_entry, time, sample)
class(process_mci_entry_t), intent(in) :: mci_entry
type(time_t), intent(out) :: time
integer, intent(in) :: sample
real(default) :: time_last_pass, efficiency, calls
time_last_pass = mci_entry%mci%get_time ()
calls = mci_entry%results%get_n_calls ()
efficiency = mci_entry%mci%get_efficiency ()
if (time_last_pass > 0 .and. calls > 0 .and. efficiency > 0) then
time = nint (time_last_pass / calls / efficiency * sample)
end if
end subroutine process_mci_entry_get_time
module subroutine process_mci_entry_time_message (mci_entry)
class(process_mci_entry_t), intent(in) :: mci_entry
type(time_t) :: time
integer :: sample
sample = 10000
call mci_entry%get_time (time, sample)
if (time%is_known ()) then
call msg_message ("Time estimate for generating 10000 events: " &
// char (time%to_string_dhms ()))
end if
end subroutine process_mci_entry_time_message
@ %def process_mci_entry_time_message
@ Prepare event generation. (For the test integrator, this does nothing. It
is relevant for the VAMP integrator.)
<<Process mci: process mci entry: TBP>>=
procedure :: prepare_simulation => process_mci_entry_prepare_simulation
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_prepare_simulation (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
end subroutine process_mci_entry_prepare_simulation
<<Process mci: procedures>>=
module subroutine process_mci_entry_prepare_simulation (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
call mci_entry%mci%prepare_simulation ()
end subroutine process_mci_entry_prepare_simulation
@ %def process_mci_entry_prepare_simulation
@ Generate an event. The instance should be initialized,
otherwise event generation is directed by the [[mci]] integrator
subobject. The integrator instance is contained in a [[mci_work]]
subobject of the process instance, which simultaneously serves as the
sampler object. (We avoid the anti-aliasing rules if we assume that
the sampling itself does not involve the integrator instance contained in the
process instance.)
Regarding weighted events, we only take events which are valid, which
means that they have valid kinematics and have passed cuts.
Therefore, we have a rejection loop. For unweighted events, the
unweighting routine should already take care of this.
The [[keep_failed]] flag determines whether events which failed cuts
are nevertheless produced, to be recorded with zero weight.
Alternatively, failed events are dropped, and this fact is recorded by
the counter [[n_dropped]].
<<Process mci: process mci entry: TBP>>=
procedure :: generate_weighted_event => &
process_mci_entry_generate_weighted_event
procedure :: generate_unweighted_event => &
process_mci_entry_generate_unweighted_event
<<Process mci: sub interfaces>>=
module subroutine process_mci_entry_generate_weighted_event (mci_entry, &
mci_instance, mci_sampler, keep_failed)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed
end subroutine process_mci_entry_generate_weighted_event
module subroutine process_mci_entry_generate_unweighted_event &
(mci_entry, mci_instance, mci_sampler)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
end subroutine process_mci_entry_generate_unweighted_event
<<Process mci: procedures>>=
module subroutine process_mci_entry_generate_weighted_event (mci_entry, &
mci_instance, mci_sampler, keep_failed)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed
logical :: generate_new
generate_new = .true.
call mci_instance%reset_n_event_dropped ()
REJECTION: do while (generate_new)
call mci_entry%mci%generate_weighted_event (mci_instance, mci_sampler)
if (signal_is_pending ()) return
if (.not. mci_sampler%is_valid()) then
if (keep_failed) then
generate_new = .false.
else
call mci_instance%record_event_dropped ()
generate_new = .true.
end if
else
generate_new = .false.
end if
end do REJECTION
end subroutine process_mci_entry_generate_weighted_event
module subroutine process_mci_entry_generate_unweighted_event &
(mci_entry, mci_instance, mci_sampler)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
call mci_entry%mci%generate_unweighted_event (mci_instance, mci_sampler)
end subroutine process_mci_entry_generate_unweighted_event
@ %def process_mci_entry_generate_weighted_event
@ %def process_mci_entry_generate_unweighted_event
@ Extract results.
<<Process mci: process mci entry: TBP>>=
procedure :: has_integral => process_mci_entry_has_integral
procedure :: get_integral => process_mci_entry_get_integral
procedure :: get_error => process_mci_entry_get_error
procedure :: get_accuracy => process_mci_entry_get_accuracy
procedure :: get_chi2 => process_mci_entry_get_chi2
procedure :: get_efficiency => process_mci_entry_get_efficiency
<<Process mci: sub interfaces>>=
module function process_mci_entry_has_integral (mci_entry) result (flag)
class(process_mci_entry_t), intent(in) :: mci_entry
logical :: flag
end function process_mci_entry_has_integral
module function process_mci_entry_get_integral (mci_entry) result (integral)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: integral
end function process_mci_entry_get_integral
module function process_mci_entry_get_error (mci_entry) result (error)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: error
end function process_mci_entry_get_error
module function process_mci_entry_get_accuracy (mci_entry) result (accuracy)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: accuracy
end function process_mci_entry_get_accuracy
module function process_mci_entry_get_chi2 (mci_entry) result (chi2)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: chi2
end function process_mci_entry_get_chi2
module function process_mci_entry_get_efficiency &
(mci_entry) result (efficiency)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: efficiency
end function process_mci_entry_get_efficiency
<<Process mci: procedures>>=
module function process_mci_entry_has_integral (mci_entry) result (flag)
class(process_mci_entry_t), intent(in) :: mci_entry
logical :: flag
flag = mci_entry%results%exist ()
end function process_mci_entry_has_integral
module function process_mci_entry_get_integral (mci_entry) result (integral)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: integral
integral = mci_entry%results%get_integral ()
end function process_mci_entry_get_integral
module function process_mci_entry_get_error (mci_entry) result (error)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: error
error = mci_entry%results%get_error ()
end function process_mci_entry_get_error
module function process_mci_entry_get_accuracy (mci_entry) result (accuracy)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: accuracy
accuracy = mci_entry%results%get_accuracy ()
end function process_mci_entry_get_accuracy
module function process_mci_entry_get_chi2 (mci_entry) result (chi2)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: chi2
chi2 = mci_entry%results%get_chi2 ()
end function process_mci_entry_get_chi2
module function process_mci_entry_get_efficiency &
(mci_entry) result (efficiency)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: efficiency
efficiency = mci_entry%results%get_efficiency ()
end function process_mci_entry_get_efficiency
@ %def process_mci_entry_get_integral process_mci_entry_get_error
@ %def process_mci_entry_get_accuracy process_mci_entry_get_chi2
@ %def process_mci_entry_get_efficiency
@ Return the MCI checksum. This may be the one used for
configuration, but may also incorporate results, if they change the
state of the integrator (adaptation).
<<Process mci: process mci entry: TBP>>=
procedure :: get_md5sum => process_mci_entry_get_md5sum
<<Process mci: sub interfaces>>=
pure module function process_mci_entry_get_md5sum (entry) result (md5sum)
class(process_mci_entry_t), intent(in) :: entry
character(32) :: md5sum
end function process_mci_entry_get_md5sum
<<Process mci: procedures>>=
pure module function process_mci_entry_get_md5sum (entry) result (md5sum)
class(process_mci_entry_t), intent(in) :: entry
character(32) :: md5sum
md5sum = entry%mci%get_md5sum ()
end function process_mci_entry_get_md5sum
@ %def process_mci_entry_get_md5sum
@
\subsection{MC parameter set and MCI instance}
For each process component that is associated with a multi-channel integration
(MCI) object, the [[mci_work_t]] object contains the currently active
parameter set. It also holds the implementation of the [[mci_instance_t]]
that the integrator needs for doing its work.
<<Process mci: public>>=
public :: mci_work_t
<<Process mci: types>>=
type :: mci_work_t
type(process_mci_entry_t), pointer :: config => null ()
real(default), dimension(:), allocatable :: x
class(mci_instance_t), pointer :: mci => null ()
type(process_counter_t) :: counter
logical :: keep_failed_events = .false.
integer :: n_event_dropped = 0
contains
<<Process mci: mci work: TBP>>
end type mci_work_t
@ %def mci_work_t
@ First write configuration data, then the current values.
<<Process mci: mci work: TBP>>=
procedure :: write => mci_work_write
<<Process mci: sub interfaces>>=
module subroutine mci_work_write (mci_work, unit, testflag)
class(mci_work_t), intent(in) :: mci_work
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine mci_work_write
<<Process mci: procedures>>=
module subroutine mci_work_write (mci_work, unit, testflag)
class(mci_work_t), intent(in) :: mci_work
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A,I0,A)") "Active MCI instance #", &
mci_work%config%i_mci, " ="
write (u, "(2x)", advance="no")
do i = 1, mci_work%config%n_par
write (u, "(1x,F7.5)", advance="no") mci_work%x(i)
if (i == mci_work%config%n_par_sf) &
write (u, "(1x,'|')", advance="no")
end do
write (u, *)
if (associated (mci_work%mci)) then
call mci_work%mci%write (u, pacify = testflag)
call mci_work%counter%write (u)
end if
end subroutine mci_work_write
@ %def mci_work_write
@ The [[mci]] component may require finalization.
<<Process mci: mci work: TBP>>=
procedure :: final => mci_work_final
<<Process mci: sub interfaces>>=
module subroutine mci_work_final (mci_work)
class(mci_work_t), intent(inout) :: mci_work
end subroutine mci_work_final
<<Process mci: procedures>>=
module subroutine mci_work_final (mci_work)
class(mci_work_t), intent(inout) :: mci_work
if (associated (mci_work%mci)) then
call mci_work%mci%final ()
deallocate (mci_work%mci)
end if
end subroutine mci_work_final
@ %def mci_work_final
@ Initialize with the maximum length that we will need. Contents are
not initialized.
The integrator inside the [[mci_entry]] object is responsible for
allocating and initializing its own instance, which is referred to by
a pointer in the [[mci_work]] object.
<<Process mci: mci work: TBP>>=
procedure :: init => mci_work_init
<<Process mci: sub interfaces>>=
module subroutine mci_work_init (mci_work, mci_entry)
class(mci_work_t), intent(out) :: mci_work
type(process_mci_entry_t), intent(in), target :: mci_entry
end subroutine mci_work_init
<<Process mci: procedures>>=
module subroutine mci_work_init (mci_work, mci_entry)
class(mci_work_t), intent(out) :: mci_work
type(process_mci_entry_t), intent(in), target :: mci_entry
mci_work%config => mci_entry
allocate (mci_work%x (mci_entry%n_par))
if (allocated (mci_entry%mci)) then
call mci_entry%mci%allocate_instance (mci_work%mci)
call mci_work%mci%init (mci_entry%mci)
end if
end subroutine mci_work_init
@ %def mci_work_init
@ Set parameters explicitly, either all at once, or separately for the
structure-function and process parts.
<<Process mci: mci work: TBP>>=
procedure :: set => mci_work_set
procedure :: set_x_strfun => mci_work_set_x_strfun
procedure :: set_x_process => mci_work_set_x_process
<<Process mci: sub interfaces>>=
module subroutine mci_work_set (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
end subroutine mci_work_set
module subroutine mci_work_set_x_strfun (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
end subroutine mci_work_set_x_strfun
module subroutine mci_work_set_x_process (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
end subroutine mci_work_set_x_process
<<Process mci: procedures>>=
module subroutine mci_work_set (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x = x
end subroutine mci_work_set
module subroutine mci_work_set_x_strfun (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x(1 : mci_work%config%n_par_sf) = x
end subroutine mci_work_set_x_strfun
module subroutine mci_work_set_x_process (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par) = x
end subroutine mci_work_set_x_process
@ %def mci_work_set
@ %def mci_work_set_x_strfun
@ %def mci_work_set_x_process
@ Return the array of active components, i.e., those that correspond
to the currently selected MC parameter set.
<<Process mci: mci work: TBP>>=
procedure :: get_active_components => mci_work_get_active_components
<<Process mci: sub interfaces>>=
module function mci_work_get_active_components &
(mci_work) result (i_component)
class(mci_work_t), intent(in) :: mci_work
integer, dimension(:), allocatable :: i_component
end function mci_work_get_active_components
<<Process mci: procedures>>=
module function mci_work_get_active_components (mci_work) result (i_component)
class(mci_work_t), intent(in) :: mci_work
integer, dimension(:), allocatable :: i_component
allocate (i_component (size (mci_work%config%i_component)))
i_component = mci_work%config%i_component
end function mci_work_get_active_components
@ %def mci_work_get_active_components
@ Return the active parameters as a simple array with correct length.
Do this separately for the structure-function parameters and the
process parameters.
<<Process mci: mci work: TBP>>=
procedure :: get_x_strfun => mci_work_get_x_strfun
procedure :: get_x_process => mci_work_get_x_process
<<Process mci: sub interfaces>>=
pure module function mci_work_get_x_strfun (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_sf) :: x
end function mci_work_get_x_strfun
pure module function mci_work_get_x_process (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_phs) :: x
end function mci_work_get_x_process
<<Process mci: procedures>>=
pure module function mci_work_get_x_strfun (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_sf) :: x
x = mci_work%x(1 : mci_work%config%n_par_sf)
end function mci_work_get_x_strfun
pure module function mci_work_get_x_process (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_phs) :: x
x = mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par)
end function mci_work_get_x_process
@ %def mci_work_get_x_strfun
@ %def mci_work_get_x_process
@ Initialize and finalize event generation for the specified MCI
entry. This also resets the counter.
<<Process mci: mci work: TBP>>=
procedure :: init_simulation => mci_work_init_simulation
procedure :: final_simulation => mci_work_final_simulation
<<Process mci: sub interfaces>>=
module subroutine mci_work_final_simulation (mci_work)
class(mci_work_t), intent(inout) :: mci_work
end subroutine mci_work_final_simulation
module subroutine mci_work_init_simulation &
(mci_work, safety_factor, keep_failed_events)
class(mci_work_t), intent(inout) :: mci_work
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
end subroutine mci_work_init_simulation
<<Process mci: procedures>>=
module subroutine mci_work_init_simulation &
(mci_work, safety_factor, keep_failed_events)
class(mci_work_t), intent(inout) :: mci_work
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
call mci_work%mci%init_simulation (safety_factor)
call mci_work%counter%reset ()
if (present (keep_failed_events)) &
mci_work%keep_failed_events = keep_failed_events
end subroutine mci_work_init_simulation
module subroutine mci_work_final_simulation (mci_work)
class(mci_work_t), intent(inout) :: mci_work
call mci_work%mci%final_simulation ()
end subroutine mci_work_final_simulation
@ %def mci_work_init_simulation
@ %def mci_work_final_simulation
@ Counter.
<<Process mci: mci work: TBP>>=
procedure :: reset_counter => mci_work_reset_counter
procedure :: record_call => mci_work_record_call
procedure :: get_counter => mci_work_get_counter
<<Process mci: sub interfaces>>=
module subroutine mci_work_reset_counter (mci_work)
class(mci_work_t), intent(inout) :: mci_work
end subroutine mci_work_reset_counter
module subroutine mci_work_record_call (mci_work, status)
class(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: status
end subroutine mci_work_record_call
pure module function mci_work_get_counter (mci_work) result (counter)
class(mci_work_t), intent(in) :: mci_work
type(process_counter_t) :: counter
end function mci_work_get_counter
<<Process mci: procedures>>=
module subroutine mci_work_reset_counter (mci_work)
class(mci_work_t), intent(inout) :: mci_work
call mci_work%counter%reset ()
end subroutine mci_work_reset_counter
module subroutine mci_work_record_call (mci_work, status)
class(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: status
call mci_work%counter%record (status)
end subroutine mci_work_record_call
pure module function mci_work_get_counter (mci_work) result (counter)
class(mci_work_t), intent(in) :: mci_work
type(process_counter_t) :: counter
counter = mci_work%counter
end function mci_work_get_counter
@ %def mci_work_reset_counter
@ %def mci_work_record_call
@ %def mci_work_get_counter
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process component manager}
<<[[pcm.f90]]>>=
<<File header>>
module pcm
<<Use kinds>>
<<Use strings>>
use lorentz
use model_data, only: model_data_t
use models, only: model_t
use quantum_numbers, only: quantum_numbers_t, quantum_numbers_mask_t
use variables, only: var_list_t
use nlo_data, only: nlo_settings_t
use nlo_data, only: fks_template_t
use nlo_data, only: FKS_DEFAULT, FKS_RESONANCES
use mci_base, only: mci_t
use phs_base, only: phs_config_t
use mappings, only: mapping_defaults_t
use phs_forests, only: phs_parameters_t
use phs_fks, only: isr_kinematics_t, real_kinematics_t
use phs_fks, only: phs_identifier_t
use fks_regions, only: region_data_t
use phs_fks, only: phs_fks_generator_t
use phs_fks, only: dalitz_plot_t
use phs_fks, only: phs_fks_config_t, get_filtered_resonance_histories
use dispatch_phase_space, only: dispatch_phs
use real_subtraction, only: real_subtraction_t, soft_mismatch_t
- use real_subtraction, only: FIXED_ORDER_EVENTS, POWHEG
+ use real_subtraction, only: INTEGRATION, FIXED_ORDER_EVENTS
use real_subtraction, only: real_partition_t, powheg_damping_simple_t
use real_subtraction, only: real_partition_fixed_order_t
use virtual, only: virtual_t
use dglap_remnant, only: dglap_remnant_t
use blha_config, only: blha_master_t
use pcm_base
use process_config
use process_mci, only: process_mci_entry_t
use process_mci, only: REAL_SINGULAR, REAL_FINITE
<<Standard module head>>
<<PCM: public>>
<<PCM: types>>
interface
<<PCM: sub interfaces>>
end interface
contains
<<PCM: main procedures>>
end module pcm
@ %def pcm
@
<<[[pcm_sub.f90]]>>=
<<File header>>
submodule (pcm) pcm_s
<<Use debug>>
use constants, only: zero, two
use diagnostics
use phs_points, only: assignment(=)
use io_units, only: free_unit
use os_interface
use process_constants, only: process_constants_t
use physics_defs
use flavors, only: flavor_t
use interactions, only: interaction_t
use dispatch_fks, only: dispatch_fks_setup
use process_libraries, only: process_component_def_t
use resonances, only: resonance_history_t, resonance_history_set_t
use prc_threshold, only: threshold_def_t
use blha_olp_interfaces, only: prc_blha_t
implicit none
contains
<<PCM: procedures>>
end submodule pcm_s
@ %def pcm_s
@
\subsection{Default process component manager}
This is the configuration object which has the duty of allocating the
corresponding instance. The default version is trivial.
<<PCM: public>>=
public :: pcm_default_t
<<PCM: types>>=
type, extends (pcm_t) :: pcm_default_t
contains
<<PCM: pcm default: TBP>>
end type pcm_default_t
@ %def pcm_default_t
Gfortran 7/8/9 bug, has to remain in the main module:
<<PCM: pcm default: TBP>>=
procedure :: allocate_workspace => pcm_default_allocate_workspace
<<PCM: main procedures>>=
subroutine pcm_default_allocate_workspace (pcm, work)
class(pcm_default_t), intent(in) :: pcm
class(pcm_workspace_t), intent(inout), allocatable :: work
allocate (pcm_default_workspace_t :: work)
end subroutine pcm_default_allocate_workspace
@ %def pcm_default_allocate_workspace
@
Finalizer: apply to core manager.
<<PCM: pcm default: TBP>>=
procedure :: final => pcm_default_final
<<PCM: sub interfaces>>=
module subroutine pcm_default_final (pcm)
class(pcm_default_t), intent(inout) :: pcm
end subroutine pcm_default_final
<<PCM: procedures>>=
module subroutine pcm_default_final (pcm)
class(pcm_default_t), intent(inout) :: pcm
end subroutine pcm_default_final
@ %def pcm_default_final
@
<<PCM: pcm default: TBP>>=
procedure :: is_nlo => pcm_default_is_nlo
<<PCM: sub interfaces>>=
module function pcm_default_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_default_t), intent(in) :: pcm
end function pcm_default_is_nlo
<<PCM: procedures>>=
module function pcm_default_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_default_t), intent(in) :: pcm
is_nlo = .false.
end function pcm_default_is_nlo
@ %def pcm_default_is_nlo
@
Initialize configuration data, using environment variables.
<<PCM: pcm default: TBP>>=
procedure :: init => pcm_default_init
<<PCM: sub interfaces>>=
module subroutine pcm_default_init (pcm, env, meta)
class(pcm_default_t), intent(out) :: pcm
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
end subroutine pcm_default_init
<<PCM: procedures>>=
module subroutine pcm_default_init (pcm, env, meta)
class(pcm_default_t), intent(out) :: pcm
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
pcm%has_pdfs = env%has_pdfs ()
call pcm%set_blha_defaults &
(env%has_polarized_beams (), env%get_var_list_ptr ())
pcm%os_data = env%get_os_data ()
end subroutine pcm_default_init
@ %def pcm_default_init
@
<<PCM: types>>=
type, extends (pcm_workspace_t) :: pcm_default_workspace_t
contains
<<PCM: pcm instance default: TBP>>
end type pcm_default_workspace_t
@ %def pcm_default_workspace_t
@
<<PCM: pcm instance default: TBP>>=
procedure :: final => pcm_default_workspace_final
<<PCM: sub interfaces>>=
module subroutine pcm_default_workspace_final (pcm_work)
class(pcm_default_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_default_workspace_final
<<PCM: procedures>>=
module subroutine pcm_default_workspace_final (pcm_work)
class(pcm_default_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_default_workspace_final
@ %def pcm_default_workspace_final
@
<<PCM: pcm instance default: TBP>>=
procedure :: is_nlo => pcm_default_workspace_is_nlo
<<PCM: sub interfaces>>=
module function pcm_default_workspace_is_nlo (pcm_work) result (is_nlo)
logical :: is_nlo
class(pcm_default_workspace_t), intent(inout) :: pcm_work
end function pcm_default_workspace_is_nlo
<<PCM: procedures>>=
module function pcm_default_workspace_is_nlo (pcm_work) result (is_nlo)
logical :: is_nlo
class(pcm_default_workspace_t), intent(inout) :: pcm_work
is_nlo = .false.
end function pcm_default_workspace_is_nlo
@ %def pcm_default_workspace_is_nlo
@
\subsection{Implementations for the default manager}
Categorize components. Nothing to do here, all components are of Born type.
<<PCM: pcm default: TBP>>=
procedure :: categorize_components => pcm_default_categorize_components
<<PCM: sub interfaces>>=
module subroutine pcm_default_categorize_components (pcm, config)
class(pcm_default_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
end subroutine pcm_default_categorize_components
<<PCM: procedures>>=
module subroutine pcm_default_categorize_components (pcm, config)
class(pcm_default_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
end subroutine pcm_default_categorize_components
@ %def pcm_default_categorize_components
@
\subsubsection{Phase-space configuration}
Default setup for tree processes: a single phase-space configuration that is
valid for all components.
<<PCM: pcm default: TBP>>=
procedure :: init_phs_config => pcm_default_init_phs_config
<<PCM: sub interfaces>>=
module subroutine pcm_default_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
class(pcm_default_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
end subroutine pcm_default_init_phs_config
<<PCM: procedures>>=
module subroutine pcm_default_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
class(pcm_default_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
allocate (phs_entry (1))
allocate (pcm%i_phs_config (pcm%n_components), source=1)
call dispatch_phs (phs_entry(1)%phs_config, &
env%get_var_list_ptr (), &
env%get_os_data (), &
meta%id, &
mapping_defs, phs_par)
end subroutine pcm_default_init_phs_config
@ %def pcm_default_init_phs_config
@
\subsubsection{Core management}
The default component manager assigns one core per component. We allocate and
configure the core objects, using the process-component configuration data.
<<PCM: pcm default: TBP>>=
procedure :: allocate_cores => pcm_default_allocate_cores
<<PCM: sub interfaces>>=
module subroutine pcm_default_allocate_cores (pcm, config, core_entry)
class(pcm_default_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
end subroutine pcm_default_allocate_cores
<<PCM: procedures>>=
module subroutine pcm_default_allocate_cores (pcm, config, core_entry)
class(pcm_default_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
type(process_component_def_t), pointer :: component_def
integer :: i
allocate (pcm%i_core (pcm%n_components), source = 0)
pcm%n_cores = pcm%n_components
allocate (core_entry (pcm%n_cores))
do i = 1, pcm%n_cores
pcm%i_core(i) = i
core_entry(i)%i_component = i
component_def => config%process_def%get_component_def_ptr (i)
core_entry(i)%core_def => component_def%get_core_def_ptr ()
core_entry(i)%active = component_def%can_be_integrated ()
end do
end subroutine pcm_default_allocate_cores
@ %def pcm_default_allocate_cores
@ Extra code is required for certain core types (threshold) or if BLHA uses an
external OLP (Born only, this case) for getting its matrix elements.
<<PCM: pcm default: TBP>>=
procedure :: prepare_any_external_code => &
pcm_default_prepare_any_external_code
<<PCM: sub interfaces>>=
module subroutine pcm_default_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
end subroutine pcm_default_prepare_any_external_code
<<PCM: procedures>>=
module subroutine pcm_default_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
if (core_entry%active) then
associate (core => core_entry%core)
if (core%needs_external_code ()) then
call core%prepare_external_code &
(core%data%flv_state, &
var_list, pcm%os_data, libname, model, i_core, .false.)
end if
call core%set_equivalent_flv_hel_indices ()
end associate
end if
end subroutine pcm_default_prepare_any_external_code
@ %def pcm_default_prepare_any_external_code
@ Allocate and configure the BLHA record for a specific core, assuming that
the core type requires it. In the default case, this is a Born
configuration.
<<PCM: pcm default: TBP>>=
procedure :: setup_blha => pcm_default_setup_blha
<<PCM: sub interfaces>>=
module subroutine pcm_default_setup_blha (pcm, core_entry)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
end subroutine pcm_default_setup_blha
<<PCM: procedures>>=
module subroutine pcm_default_setup_blha (pcm, core_entry)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
allocate (core_entry%blha_config, source = pcm%blha_defaults)
call core_entry%blha_config%set_born ()
end subroutine pcm_default_setup_blha
@ %def pcm_default_setup_blha
@ Apply the configuration, using [[pcm]] data.
<<PCM: pcm default: TBP>>=
procedure :: prepare_blha_core => pcm_default_prepare_blha_core
<<PCM: sub interfaces>>=
module subroutine pcm_default_prepare_blha_core (pcm, core_entry, model)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
end subroutine pcm_default_prepare_blha_core
<<PCM: procedures>>=
module subroutine pcm_default_prepare_blha_core (pcm, core_entry, model)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
integer :: n_in
integer :: n_legs
integer :: n_flv
integer :: n_hel
select type (core => core_entry%core)
class is (prc_blha_t)
associate (blha_config => core_entry%blha_config)
n_in = core%data%n_in
n_legs = core%data%get_n_tot ()
n_flv = core%data%n_flv
n_hel = blha_config%get_n_hel (core%data%flv_state (1:n_in,1), model)
call core%init_blha (blha_config, n_in, n_legs, n_flv, n_hel)
call core%init_driver (pcm%os_data)
end associate
end select
end subroutine pcm_default_prepare_blha_core
@ %def pcm_default_prepare_blha_core
@ Read the method settings from the variable list and store them in the BLHA
master. This version: no NLO flag.
<<PCM: pcm default: TBP>>=
procedure :: set_blha_methods => pcm_default_set_blha_methods
<<PCM: sub interfaces>>=
module subroutine pcm_default_set_blha_methods (pcm, blha_master, var_list)
class(pcm_default_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
end subroutine pcm_default_set_blha_methods
<<PCM: procedures>>=
module subroutine pcm_default_set_blha_methods (pcm, blha_master, var_list)
class(pcm_default_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
call blha_master%set_methods (.false., var_list)
end subroutine pcm_default_set_blha_methods
@ %def pcm_default_set_blha_methods
@ Produce the LO and NLO flavor-state tables (as far as available), as
appropriate for BLHA configuration.
The default version looks at the first process core only, to get the Born
data. (Multiple cores are thus unsupported.) The NLO flavor table is left
unallocated.
<<PCM: pcm default: TBP>>=
procedure :: get_blha_flv_states => pcm_default_get_blha_flv_states
<<PCM: sub interfaces>>=
module subroutine pcm_default_get_blha_flv_states &
(pcm, core_entry, flv_born, flv_real)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
end subroutine pcm_default_get_blha_flv_states
<<PCM: procedures>>=
module subroutine pcm_default_get_blha_flv_states &
(pcm, core_entry, flv_born, flv_real)
class(pcm_default_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
flv_born = core_entry(1)%core%data%flv_state
end subroutine pcm_default_get_blha_flv_states
@ %def pcm_default_get_blha_flv_states
@ Allocate and configure the MCI (multi-channel integrator) records. There is
one record per active process component. Second procedure: call the MCI
dispatcher with default-setup arguments.
<<PCM: pcm default: TBP>>=
procedure :: setup_mci => pcm_default_setup_mci
procedure :: call_dispatch_mci => pcm_default_call_dispatch_mci
<<PCM: sub interfaces>>=
module subroutine pcm_default_setup_mci (pcm, mci_entry)
class(pcm_default_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
end subroutine pcm_default_setup_mci
module subroutine pcm_default_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
class(pcm_default_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), allocatable, intent(out) :: mci_template
end subroutine pcm_default_call_dispatch_mci
<<PCM: procedures>>=
module subroutine pcm_default_setup_mci (pcm, mci_entry)
class(pcm_default_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
class(mci_t), allocatable :: mci_template
integer :: i, i_mci
pcm%n_mci = count (pcm%component_active)
allocate (pcm%i_mci (pcm%n_components), source = 0)
i_mci = 0
do i = 1, pcm%n_components
if (pcm%component_active(i)) then
i_mci = i_mci + 1
pcm%i_mci(i) = i_mci
end if
end do
allocate (mci_entry (pcm%n_mci))
end subroutine pcm_default_setup_mci
module subroutine pcm_default_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
class(pcm_default_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), allocatable, intent(out) :: mci_template
call dispatch_mci (mci_template, var_list, process_id)
end subroutine pcm_default_call_dispatch_mci
@ %def pcm_default_setup_mci
@ %def pcm_default_call_dispatch_mci
@ Nothing left to do for the default algorithm.
<<PCM: pcm default: TBP>>=
procedure :: complete_setup => pcm_default_complete_setup
<<PCM: sub interfaces>>=
module subroutine pcm_default_complete_setup &
(pcm, core_entry, component, model)
class(pcm_default_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
end subroutine pcm_default_complete_setup
<<PCM: procedures>>=
module subroutine pcm_default_complete_setup &
(pcm, core_entry, component, model)
class(pcm_default_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
end subroutine pcm_default_complete_setup
@ %def pcm_default_complete_setup
@
\subsubsection{Component management}
Initialize a single component. We require all process-configuration blocks,
and specific templates for the phase-space and integrator configuration.
We also provide the current component index [[i]] and the [[active]] flag.
In the default mode, all components are marked as master components.
<<PCM: pcm default: TBP>>=
procedure :: init_component => pcm_default_init_component
<<PCM: sub interfaces>>=
module subroutine pcm_default_init_component (pcm, component, i, active, &
phs_config, env, meta, config)
class(pcm_default_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
end subroutine pcm_default_init_component
<<PCM: procedures>>=
module subroutine pcm_default_init_component (pcm, component, i, active, &
phs_config, env, meta, config)
class(pcm_default_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
call component%init (i, &
env, meta, config, &
active, &
phs_config)
component%component_type = COMP_MASTER
end subroutine pcm_default_init_component
@ %def pcm_default_init_component
@
\subsection{NLO process component manager}
The NLO-aware version of the process-component manager.
This is the configuration object, which has the duty of allocating the
corresponding instance. This is the nontrivial NLO version.
<<PCM: public>>=
public :: pcm_nlo_t
<<PCM: types>>=
type, extends (pcm_t) :: pcm_nlo_t
type(string_t) :: id
logical :: combined_integration = .false.
logical :: vis_fks_regions = .false.
integer, dimension(:), allocatable :: nlo_type
integer, dimension(:), allocatable :: nlo_type_core
integer, dimension(:), allocatable :: component_type
integer :: i_born = 0
integer :: i_real = 0
integer :: i_sub = 0
type(nlo_settings_t) :: settings
type(region_data_t) :: region_data
logical :: use_real_partition = .false.
logical :: use_real_singular = .false.
real(default) :: real_partition_scale = 0
class(real_partition_t), allocatable :: real_partition
type(dalitz_plot_t) :: dalitz_plot
type(quantum_numbers_t), dimension(:,:), allocatable :: qn_real, qn_born
contains
<<PCM: pcm nlo: TBP>>
end type pcm_nlo_t
@ %def pcm_nlo_t
@
Initialize configuration data, using environment variables.
<<PCM: pcm nlo: TBP>>=
procedure :: init => pcm_nlo_init
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_init (pcm, env, meta)
class(pcm_nlo_t), intent(out) :: pcm
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
end subroutine pcm_nlo_init
<<PCM: procedures>>=
module subroutine pcm_nlo_init (pcm, env, meta)
class(pcm_nlo_t), intent(out) :: pcm
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(var_list_t), pointer :: var_list
type(fks_template_t) :: fks_template
pcm%id = meta%id
pcm%has_pdfs = env%has_pdfs ()
var_list => env%get_var_list_ptr ()
call dispatch_fks_setup (fks_template, var_list)
call pcm%settings%init (var_list, fks_template)
pcm%combined_integration = &
var_list%get_lval (var_str ('?combined_nlo_integration'))
select case (char (var_list%get_sval (var_str ("$real_partition_mode"))))
case ("default", "off")
pcm%use_real_partition = .false.
pcm%use_real_singular = .false.
case ("all", "on", "singular")
pcm%use_real_partition = .true.
pcm%use_real_singular = .true.
case ("finite")
pcm%use_real_partition = .true.
pcm%use_real_singular = .false.
case default
call msg_fatal ("The real partition mode can only be " // &
"default, off, all, on, singular or finite.")
end select
pcm%real_partition_scale = &
var_list%get_rval (var_str ("real_partition_scale"))
pcm%vis_fks_regions = &
var_list%get_lval (var_str ("?vis_fks_regions"))
call pcm%set_blha_defaults &
(env%has_polarized_beams (), env%get_var_list_ptr ())
pcm%os_data = env%get_os_data ()
end subroutine pcm_nlo_init
@ %def pcm_nlo_init
@ Init/rewrite NLO settings without the FKS template.
<<PCM: pcm nlo: TBP>>=
procedure :: init_nlo_settings => pcm_nlo_init_nlo_settings
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_init_nlo_settings (pcm, var_list)
class(pcm_nlo_t), intent(inout) :: pcm
type(var_list_t), intent(in), target :: var_list
end subroutine pcm_nlo_init_nlo_settings
<<PCM: procedures>>=
module subroutine pcm_nlo_init_nlo_settings (pcm, var_list)
class(pcm_nlo_t), intent(inout) :: pcm
type(var_list_t), intent(in), target :: var_list
call pcm%settings%init (var_list)
end subroutine pcm_nlo_init_nlo_settings
@ %def pcm_nlo_init_nlo_settings
@
As appropriate for the NLO/FKS algorithm, the category defined by the
process, is called [[nlo_type]]. We refine this by setting the component
category [[component_type]] separately.
The component types [[COMP_MISMATCH]], [[COMP_PDF]], [[COMP_SUB]] are set only
if the algorithm uses combined integration. Otherwise, they are set to
[[COMP_DEFAULT]].
The component type [[COMP_REAL]] is further distinguished between
[[COMP_REAL_SING]] or [[COMP_REAL_FIN]], if the algorithm uses real
partitions. The former acts as a reference component for the latter, and we
always assume that it is the first real component.
Each component is assigned its own core. Exceptions: the finite-real
component gets the same core as the singular-real component. The mismatch
component gets the same core as the subtraction component.
TODO wk 2018: this convention for real components can be improved.
Check whether all component types should be assigned, not just for combined
integration.
<<PCM: pcm nlo: TBP>>=
procedure :: categorize_components => pcm_nlo_categorize_components
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_categorize_components (pcm, config)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
end subroutine pcm_nlo_categorize_components
<<PCM: procedures>>=
module subroutine pcm_nlo_categorize_components (pcm, config)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(process_component_def_t), pointer :: component_def
integer :: i
allocate (pcm%nlo_type (pcm%n_components), source = COMPONENT_UNDEFINED)
allocate (pcm%component_type (pcm%n_components), source = COMP_DEFAULT)
do i = 1, pcm%n_components
component_def => config%process_def%get_component_def_ptr (i)
pcm%nlo_type(i) = component_def%get_nlo_type ()
if (pcm%combined_integration) then
select case (pcm%nlo_type(i))
case (BORN)
pcm%i_born = i
pcm%component_type(i) = COMP_MASTER
case (NLO_REAL)
pcm%component_type(i) = COMP_REAL
case (NLO_VIRTUAL)
pcm%component_type(i) = COMP_VIRT
case (NLO_MISMATCH)
pcm%component_type(i) = COMP_MISMATCH
case (NLO_DGLAP)
pcm%component_type(i) = COMP_PDF
case (NLO_SUBTRACTION)
pcm%component_type(i) = COMP_SUB
pcm%i_sub = i
end select
else
select case (pcm%nlo_type(i))
case (BORN)
pcm%i_born = i
pcm%component_type(i) = COMP_MASTER
case (NLO_REAL)
pcm%component_type(i) = COMP_REAL
case (NLO_VIRTUAL)
pcm%component_type(i) = COMP_VIRT
case (NLO_MISMATCH)
pcm%component_type(i) = COMP_MISMATCH
case (NLO_SUBTRACTION)
pcm%i_sub = i
end select
end if
end do
call refine_real_type ( &
pack ([(i, i=1, pcm%n_components)], &
pcm%component_type==COMP_REAL))
contains
subroutine refine_real_type (i_real)
integer, dimension(:), intent(in) :: i_real
pcm%i_real = i_real(1)
if (pcm%use_real_partition) then
pcm%component_type (i_real(1)) = COMP_REAL_SING
pcm%component_type (i_real(2:)) = COMP_REAL_FIN
end if
end subroutine refine_real_type
end subroutine pcm_nlo_categorize_components
@ %def pcm_nlo_categorize_components
@
\subsubsection{Phase-space initial configuration}
Setup for the NLO/PHS processes: two phase-space configurations, (1)
Born/wood, (2) real correction/FKS. All components use either one of these
two configurations.
TODO wk 2018: The [[first_real_component]] identifier is really ugly.
Nothing should rely on the ordering.
<<PCM: pcm nlo: TBP>>=
procedure :: init_phs_config => pcm_nlo_init_phs_config
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
end subroutine pcm_nlo_init_phs_config
<<PCM: procedures>>=
module subroutine pcm_nlo_init_phs_config &
(pcm, phs_entry, meta, env, phs_par, mapping_defs)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_phs_config_t), &
dimension(:), allocatable, intent(out) :: phs_entry
type(process_metadata_t), intent(in) :: meta
type(process_environment_t), intent(in) :: env
type(mapping_defaults_t), intent(in) :: mapping_defs
type(phs_parameters_t), intent(in) :: phs_par
integer :: i
logical :: first_real_component
allocate (phs_entry (2))
call dispatch_phs (phs_entry(1)%phs_config, &
env%get_var_list_ptr (), &
env%get_os_data (), &
meta%id, &
mapping_defs, phs_par, &
var_str ("wood"))
call dispatch_phs (phs_entry(2)%phs_config, &
env%get_var_list_ptr (), &
env%get_os_data (), &
meta%id, &
mapping_defs, phs_par, &
var_str ("fks"))
allocate (pcm%i_phs_config (pcm%n_components), source=0)
first_real_component = .true.
do i = 1, pcm%n_components
select case (pcm%nlo_type(i))
case (BORN, NLO_VIRTUAL, NLO_SUBTRACTION)
pcm%i_phs_config(i) = 1
case (NLO_REAL)
if (pcm%use_real_partition) then
if (pcm%use_real_singular) then
if (first_real_component) then
pcm%i_phs_config(i) = 2
first_real_component = .false.
else
pcm%i_phs_config(i) = 1
end if
else
pcm%i_phs_config(i) = 1
end if
else
pcm%i_phs_config(i) = 2
end if
case (NLO_MISMATCH, NLO_DGLAP, GKS)
pcm%i_phs_config(i) = 2
end select
end do
end subroutine pcm_nlo_init_phs_config
@ %def pcm_nlo_init_phs_config
@
\subsubsection{Core management}
Allocate the core (matrix-element interface) objects that we will need for
evaluation. Every component gets an associated core, except for the
real-finite and mismatch components (if any). Those components are associated
with their previous corresponding real-singular and subtraction cores,
respectively.
After cores are allocated, configure the region-data block that is maintained
by the NLO process-component manager.
<<PCM: pcm nlo: TBP>>=
procedure :: allocate_cores => pcm_nlo_allocate_cores
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_allocate_cores (pcm, config, core_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
end subroutine pcm_nlo_allocate_cores
<<PCM: procedures>>=
module subroutine pcm_nlo_allocate_cores (pcm, config, core_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_config_data_t), intent(in) :: config
type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
type(process_component_def_t), pointer :: component_def
integer :: i, i_core
allocate (pcm%i_core (pcm%n_components), source = 0)
pcm%n_cores = pcm%n_components &
- count (pcm%component_type(:) == COMP_REAL_FIN) &
- count (pcm%component_type(:) == COMP_MISMATCH)
allocate (core_entry (pcm%n_cores))
allocate (pcm%nlo_type_core (pcm%n_cores), source = BORN)
i_core = 0
do i = 1, pcm%n_components
select case (pcm%component_type(i))
case default
i_core = i_core + 1
pcm%i_core(i) = i_core
pcm%nlo_type_core(i_core) = pcm%nlo_type(i)
core_entry(i_core)%i_component = i
component_def => config%process_def%get_component_def_ptr (i)
core_entry(i_core)%core_def => component_def%get_core_def_ptr ()
select case (pcm%nlo_type(i))
case default
core_entry(i)%active = component_def%can_be_integrated ()
case (NLO_REAL, NLO_SUBTRACTION)
core_entry(i)%active = .true.
end select
case (COMP_REAL_FIN)
pcm%i_core(i) = pcm%i_core(pcm%i_real)
case (COMP_MISMATCH)
pcm%i_core(i) = pcm%i_core(pcm%i_sub)
end select
end do
end subroutine pcm_nlo_allocate_cores
@ %def pcm_nlo_allocate_cores
@ Extra code is required for certain core types (threshold) or if BLHA uses an
external OLP for getting its matrix elements. OMega matrix elements, by
definition, do not need extra code. NLO-virtual or subtraction
matrix elements always need extra code.
More precisely: for the Born and virtual matrix element, the extra code is
accessed only if the component is active. The radiation (real) and the
subtraction corrections (singular and finite), extra code is accessed in any
case.
The flavor state is taken from the [[region_data]] table in the [[pcm]]
record. We use the Born and real flavor-state tables as appropriate.
<<PCM: pcm nlo: TBP>>=
procedure :: prepare_any_external_code => &
pcm_nlo_prepare_any_external_code
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
end subroutine pcm_nlo_prepare_any_external_code
<<PCM: procedures>>=
module subroutine pcm_nlo_prepare_any_external_code &
(pcm, core_entry, i_core, libname, model, var_list)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
integer, intent(in) :: i_core
type(string_t), intent(in) :: libname
type(model_data_t), intent(in), target :: model
type(var_list_t), intent(in) :: var_list
integer, dimension(:,:), allocatable :: flv_born, flv_real
integer :: i
call pcm%region_data%get_all_flv_states (flv_born, flv_real)
if (core_entry%active) then
associate (core => core_entry%core)
if (core%needs_external_code ()) then
select case (pcm%nlo_type (core_entry%i_component))
case default
call core%data%set_flv_state (flv_born)
case (NLO_REAL)
call core%data%set_flv_state (flv_real)
end select
call core%prepare_external_code &
(core%data%flv_state, &
var_list, pcm%os_data, libname, model, i_core, .true.)
end if
call core%set_equivalent_flv_hel_indices ()
end associate
end if
end subroutine pcm_nlo_prepare_any_external_code
@ %def pcm_nlo_prepare_any_external_code
@ Allocate and configure the BLHA record for a specific core, assuming that
the core type requires it. The configuration depends on the NLO type of the
core.
<<PCM: pcm nlo: TBP>>=
procedure :: setup_blha => pcm_nlo_setup_blha
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_setup_blha (pcm, core_entry)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
end subroutine pcm_nlo_setup_blha
<<PCM: procedures>>=
module subroutine pcm_nlo_setup_blha (pcm, core_entry)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
allocate (core_entry%blha_config, source = pcm%blha_defaults)
select case (pcm%nlo_type(core_entry%i_component))
case (BORN)
call core_entry%blha_config%set_born ()
case (NLO_REAL)
call core_entry%blha_config%set_real_trees ()
case (NLO_VIRTUAL)
call core_entry%blha_config%set_loop ()
case (NLO_SUBTRACTION)
call core_entry%blha_config%set_subtraction ()
call core_entry%blha_config%set_internal_color_correlations ()
case (NLO_DGLAP)
call core_entry%blha_config%set_dglap ()
end select
end subroutine pcm_nlo_setup_blha
@ %def pcm_nlo_setup_blha
@ After phase-space configuration data and core entries are available, we fill
tables and compute the remaining NLO data that will steer the integration
and subtraction algorithm.
There are three parts: recognize a threshold-type process core (if it exists),
prepare the region-data tables (always), and prepare for real partitioning (if
requested).
The real-component phase space acts as the source for resonance-history
information, required for the region data.
<<PCM: pcm nlo: TBP>>=
procedure :: complete_setup => pcm_nlo_complete_setup
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_complete_setup (pcm, core_entry, component, model)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
end subroutine pcm_nlo_complete_setup
<<PCM: procedures>>=
module subroutine pcm_nlo_complete_setup (pcm, core_entry, component, model)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
type(process_component_t), dimension(:), intent(inout) :: component
type(model_t), intent(in), target :: model
integer :: alpha_power, alphas_power
call pcm%handle_threshold_core (core_entry)
call component(1)%config%get_coupling_powers (alpha_power, alphas_power)
call pcm%setup_region_data (core_entry, &
component(pcm%i_real)%phs_config, model, alpha_power, alphas_power)
call pcm%setup_real_partition ()
end subroutine pcm_nlo_complete_setup
@ %def pcm_nlo_complete_setup
@ Apply the BLHA configuration to a core object, using the region data from
[[pcm]] for determining the particle content.
<<PCM: pcm nlo: TBP>>=
procedure :: prepare_blha_core => pcm_nlo_prepare_blha_core
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_prepare_blha_core (pcm, core_entry, model)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
end subroutine pcm_nlo_prepare_blha_core
<<PCM: procedures>>=
module subroutine pcm_nlo_prepare_blha_core (pcm, core_entry, model)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), intent(inout) :: core_entry
class(model_data_t), intent(in), target :: model
integer :: n_in
integer :: n_legs
integer :: n_flv
integer :: n_hel
select type (core => core_entry%core)
class is (prc_blha_t)
associate (blha_config => core_entry%blha_config)
n_in = core%data%n_in
select case (pcm%nlo_type(core_entry%i_component))
case (NLO_REAL)
n_legs = pcm%region_data%get_n_legs_real ()
n_flv = pcm%region_data%get_n_flv_real ()
case default
n_legs = pcm%region_data%get_n_legs_born ()
n_flv = pcm%region_data%get_n_flv_born ()
end select
n_hel = blha_config%get_n_hel (core%data%flv_state (1:n_in,1), model)
call core%init_blha (blha_config, n_in, n_legs, n_flv, n_hel)
call core%init_driver (pcm%os_data)
end associate
end select
end subroutine pcm_nlo_prepare_blha_core
@ %def pcm_nlo_prepare_blha_core
@ Read the method settings from the variable list and store them in the BLHA
master. This version: NLO flag set.
<<PCM: pcm nlo: TBP>>=
procedure :: set_blha_methods => pcm_nlo_set_blha_methods
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_set_blha_methods (pcm, blha_master, var_list)
class(pcm_nlo_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
end subroutine pcm_nlo_set_blha_methods
<<PCM: procedures>>=
module subroutine pcm_nlo_set_blha_methods (pcm, blha_master, var_list)
class(pcm_nlo_t), intent(inout) :: pcm
type(blha_master_t), intent(inout) :: blha_master
type(var_list_t), intent(in) :: var_list
call blha_master%set_methods (.true., var_list)
call pcm%blha_defaults%set_loop_method (blha_master)
end subroutine pcm_nlo_set_blha_methods
@ %def pcm_nlo_set_blha_methods
@ Produce the LO and NLO flavor-state tables (as far as available), as
appropriate for BLHA configuration.
The NLO version copies the tables from the region data inside [[pcm]]. The
core array is not needed.
<<PCM: pcm nlo: TBP>>=
procedure :: get_blha_flv_states => pcm_nlo_get_blha_flv_states
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_get_blha_flv_states &
(pcm, core_entry, flv_born, flv_real)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
end subroutine pcm_nlo_get_blha_flv_states
<<PCM: procedures>>=
module subroutine pcm_nlo_get_blha_flv_states &
(pcm, core_entry, flv_born, flv_real)
class(pcm_nlo_t), intent(in) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer, dimension(:,:), allocatable, intent(out) :: flv_born
integer, dimension(:,:), allocatable, intent(out) :: flv_real
call pcm%region_data%get_all_flv_states (flv_born, flv_real)
end subroutine pcm_nlo_get_blha_flv_states
@ %def pcm_nlo_get_blha_flv_states
@ Allocate and configure the MCI (multi-channel integrator) records. The
relation depends on the [[combined_integration]] setting. If we integrate
components separately, each component gets its own record, except for the
subtraction component. If we do the combination, there is one record for
the master (Born) component and a second one for the real-finite component,
if present.
Each entry acquires some NLO-specific initialization. Generic configuration
follows later.
Second procedure: call the MCI dispatcher with NLO-setup arguments.
<<PCM: pcm nlo: TBP>>=
procedure :: setup_mci => pcm_nlo_setup_mci
procedure :: call_dispatch_mci => pcm_nlo_call_dispatch_mci
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_setup_mci (pcm, mci_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
end subroutine pcm_nlo_setup_mci
module subroutine pcm_nlo_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
class(pcm_nlo_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), allocatable, intent(out) :: mci_template
end subroutine pcm_nlo_call_dispatch_mci
<<PCM: procedures>>=
module subroutine pcm_nlo_setup_mci (pcm, mci_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_mci_entry_t), &
dimension(:), allocatable, intent(out) :: mci_entry
class(mci_t), allocatable :: mci_template
integer :: i, i_mci
if (pcm%combined_integration) then
pcm%n_mci = 1 &
+ count (pcm%component_active(:) &
& .and. pcm%component_type(:) == COMP_REAL_FIN)
allocate (pcm%i_mci (pcm%n_components), source = 0)
do i = 1, pcm%n_components
if (pcm%component_active(i)) then
select case (pcm%component_type(i))
case (COMP_MASTER)
pcm%i_mci(i) = 1
case (COMP_REAL_FIN)
pcm%i_mci(i) = 2
end select
end if
end do
else
pcm%n_mci = count (pcm%component_active(:) &
& .and. pcm%nlo_type(:) /= NLO_SUBTRACTION)
allocate (pcm%i_mci (pcm%n_components), source = 0)
i_mci = 0
do i = 1, pcm%n_components
if (pcm%component_active(i)) then
select case (pcm%nlo_type(i))
case default
i_mci = i_mci + 1
pcm%i_mci(i) = i_mci
case (NLO_SUBTRACTION)
end select
end if
end do
end if
allocate (mci_entry (pcm%n_mci))
mci_entry(:)%combined_integration = pcm%combined_integration
if (pcm%use_real_partition) then
do i = 1, pcm%n_components
i_mci = pcm%i_mci(i)
if (i_mci > 0) then
select case (pcm%component_type(i))
case (COMP_REAL_FIN)
mci_entry(i_mci)%real_partition_type = REAL_FINITE
case default
mci_entry(i_mci)%real_partition_type = REAL_SINGULAR
end select
end if
end do
end if
end subroutine pcm_nlo_setup_mci
module subroutine pcm_nlo_call_dispatch_mci (pcm, &
dispatch_mci, var_list, process_id, mci_template)
class(pcm_nlo_t), intent(inout) :: pcm
procedure(dispatch_mci_proc) :: dispatch_mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
class(mci_t), allocatable, intent(out) :: mci_template
call dispatch_mci (mci_template, var_list, process_id, is_nlo = .true.)
end subroutine pcm_nlo_call_dispatch_mci
@ %def pcm_nlo_setup_mci
@ %def pcm_nlo_call_dispatch_mci
@ Check for a threshold core and adjust the configuration accordingly, before
singular region data are considered.
<<PCM: pcm nlo: TBP>>=
procedure :: handle_threshold_core => pcm_nlo_handle_threshold_core
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_handle_threshold_core (pcm, core_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
end subroutine pcm_nlo_handle_threshold_core
<<PCM: procedures>>=
module subroutine pcm_nlo_handle_threshold_core (pcm, core_entry)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
integer :: i
do i = 1, size (core_entry)
select type (core => core_entry(i)%core_def)
type is (threshold_def_t)
pcm%settings%factorization_mode = FACTORIZATION_THRESHOLD
return
end select
end do
end subroutine pcm_nlo_handle_threshold_core
@ %def pcm_nlo_handle_threshold_core
@ Configure the singular-region tables based on the process data for the Born
and Real (singular) cores, using also the appropriate FKS phase-space
configuration object.
In passing, we may create a table of resonance histories that are relevant for
the singular-region configuration.
TODO wk 2018: check whether [[phs_entry]] needs to be intent(inout).
<<PCM: pcm nlo: TBP>>=
procedure :: setup_region_data => pcm_nlo_setup_region_data
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_setup_region_data &
(pcm, core_entry, phs_config, model, alpha_power, alphas_power)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
class(phs_config_t), intent(inout) :: phs_config
type(model_t), intent(in), target :: model
integer, intent(in) :: alpha_power, alphas_power
end subroutine pcm_nlo_setup_region_data
<<PCM: procedures>>=
module subroutine pcm_nlo_setup_region_data &
(pcm, core_entry, phs_config, model, alpha_power, alphas_power)
class(pcm_nlo_t), intent(inout) :: pcm
type(core_entry_t), dimension(:), intent(in) :: core_entry
class(phs_config_t), intent(inout) :: phs_config
type(model_t), intent(in), target :: model
integer, intent(in) :: alpha_power, alphas_power
type(process_constants_t) :: data_born, data_real
integer, dimension (:,:), allocatable :: flavor_born, flavor_real
type(resonance_history_t), dimension(:), allocatable :: resonance_histories
type(var_list_t), pointer :: var_list
logical :: success
data_born = core_entry(pcm%i_core(pcm%i_born))%core%data
data_real = core_entry(pcm%i_core(pcm%i_real))%core%data
call data_born%get_flv_state (flavor_born)
call data_real%get_flv_state (flavor_real)
call pcm%region_data%init &
(data_born%n_in, model, flavor_born, flavor_real, &
pcm%settings%nlo_correction_type, alpha_power, alphas_power)
associate (template => pcm%settings%fks_template)
if (template%mapping_type == FKS_RESONANCES) then
select type (phs_config)
type is (phs_fks_config_t)
call get_filtered_resonance_histories (phs_config, &
data_born%n_in, flavor_born, model, &
template%excluded_resonances, &
resonance_histories, success)
end select
if (.not. success) template%mapping_type = FKS_DEFAULT
end if
call pcm%region_data%setup_fks_mappings (template, data_born%n_in)
!!! Check again, mapping_type might have changed
if (template%mapping_type == FKS_RESONANCES) then
call pcm%region_data%set_resonance_mappings (resonance_histories)
call pcm%region_data%init_resonance_information ()
pcm%settings%use_resonance_mappings = .true.
end if
end associate
if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
call pcm%region_data%set_isr_pseudo_regions ()
call pcm%region_data%split_up_interference_regions_for_threshold ()
end if
call pcm%region_data%compute_number_of_phase_spaces ()
call pcm%region_data%set_i_phs_to_i_con ()
call pcm%region_data%write_to_file &
(pcm%id, pcm%vis_fks_regions, pcm%os_data)
if (debug_active (D_SUBTRACTION)) &
call pcm%region_data%check_consistency (.true.)
end subroutine pcm_nlo_setup_region_data
@ %def pcm_nlo_setup_region_data
@ After region data are set up, we allocate and configure the
[[real_partition]] objects, if requested.
Gfortran 7/8/9 bug, has to remain in the main module:
<<PCM: pcm nlo: TBP>>=
procedure :: setup_real_partition => pcm_nlo_setup_real_partition
<<PCM: main procedures>>=
subroutine pcm_nlo_setup_real_partition (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (pcm%use_real_partition) then
if (.not. allocated (pcm%real_partition)) then
allocate (real_partition_fixed_order_t :: pcm%real_partition)
select type (partition => pcm%real_partition)
type is (real_partition_fixed_order_t)
call pcm%region_data%get_all_ftuples (partition%fks_pairs)
partition%scale = pcm%real_partition_scale
end select
end if
end if
end subroutine pcm_nlo_setup_real_partition
@ %def pcm_nlo_setup_real_partition
@
Initialize a single component. We require all process-configuration blocks,
and specific templates for the phase-space and integrator configuration.
We also provide the current component index [[i]] and the [[active]] flag.
For a subtraction component, the [[active]] flag is overridden.
In the nlo mode, the component types have been determined before.
TODO wk 2018: the component type need not be stored in the component; we may remove
this when everything is controlled by [[pcm]].
<<PCM: pcm nlo: TBP>>=
procedure :: init_component => pcm_nlo_init_component
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_init_component (pcm, component, i, active, &
phs_config, env, meta, config)
class(pcm_nlo_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
end subroutine pcm_nlo_init_component
<<PCM: procedures>>=
module subroutine pcm_nlo_init_component (pcm, component, i, active, &
phs_config, env, meta, config)
class(pcm_nlo_t), intent(in) :: pcm
type(process_component_t), intent(out) :: component
integer, intent(in) :: i
logical, intent(in) :: active
class(phs_config_t), allocatable, intent(in) :: phs_config
type(process_environment_t), intent(in) :: env
type(process_metadata_t), intent(in) :: meta
type(process_config_data_t), intent(in) :: config
logical :: activate
select case (pcm%nlo_type(i))
case default; activate = active
case (NLO_SUBTRACTION); activate = .false.
end select
call component%init (i, &
env, meta, config, &
activate, &
phs_config)
component%component_type = pcm%component_type(i)
end subroutine pcm_nlo_init_component
@ %def pcm_nlo_init_component
@
Override the base method: record the active components in the PCM object, and
report inactive components (except for the subtraction component).
<<PCM: pcm nlo: TBP>>=
procedure :: record_inactive_components => pcm_nlo_record_inactive_components
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_record_inactive_components (pcm, component, meta)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_component_t), dimension(:), intent(in) :: component
type(process_metadata_t), intent(inout) :: meta
end subroutine pcm_nlo_record_inactive_components
<<PCM: procedures>>=
module subroutine pcm_nlo_record_inactive_components (pcm, component, meta)
class(pcm_nlo_t), intent(inout) :: pcm
type(process_component_t), dimension(:), intent(in) :: component
type(process_metadata_t), intent(inout) :: meta
integer :: i
pcm%component_active = component%active
do i = 1, pcm%n_components
select case (pcm%nlo_type(i))
case (NLO_SUBTRACTION)
case default
if (.not. component(i)%active) call meta%deactivate_component (i)
end select
end do
end subroutine pcm_nlo_record_inactive_components
@ %def pcm_nlo_record_inactive_components
@
<<PCM: pcm nlo: TBP>>=
procedure :: core_is_radiation => pcm_nlo_core_is_radiation
<<PCM: sub interfaces>>=
module function pcm_nlo_core_is_radiation (pcm, i_core) result (is_rad)
logical :: is_rad
class(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_core
end function pcm_nlo_core_is_radiation
<<PCM: procedures>>=
module function pcm_nlo_core_is_radiation (pcm, i_core) result (is_rad)
logical :: is_rad
class(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_core
is_rad = pcm%nlo_type(i_core) == NLO_REAL ! .and. .not. pcm%cm%sub(i_core)
end function pcm_nlo_core_is_radiation
@ %def pcm_nlo_core_is_radiation
@
<<PCM: pcm nlo: TBP>>=
procedure :: get_n_flv_born => pcm_nlo_get_n_flv_born
<<PCM: sub interfaces>>=
module function pcm_nlo_get_n_flv_born (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
end function pcm_nlo_get_n_flv_born
<<PCM: procedures>>=
module function pcm_nlo_get_n_flv_born (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
n_flv = pcm_nlo%region_data%n_flv_born
end function pcm_nlo_get_n_flv_born
@ %def pcm_nlo_get_n_flv_born
@
<<PCM: pcm nlo: TBP>>=
procedure :: get_n_flv_real => pcm_nlo_get_n_flv_real
<<PCM: sub interfaces>>=
module function pcm_nlo_get_n_flv_real (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
end function pcm_nlo_get_n_flv_real
<<PCM: procedures>>=
module function pcm_nlo_get_n_flv_real (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
n_flv = pcm_nlo%region_data%n_flv_real
end function pcm_nlo_get_n_flv_real
@ %def pcm_nlo_get_n_flv_real
@
<<PCM: pcm nlo: TBP>>=
procedure :: get_n_alr => pcm_nlo_get_n_alr
<<PCM: sub interfaces>>=
module function pcm_nlo_get_n_alr (pcm) result (n_alr)
integer :: n_alr
class(pcm_nlo_t), intent(in) :: pcm
end function pcm_nlo_get_n_alr
<<PCM: procedures>>=
module function pcm_nlo_get_n_alr (pcm) result (n_alr)
integer :: n_alr
class(pcm_nlo_t), intent(in) :: pcm
n_alr = pcm%region_data%n_regions
end function pcm_nlo_get_n_alr
@ %def pcm_nlo_get_n_alr
@
<<PCM: pcm nlo: TBP>>=
procedure :: get_flv_states => pcm_nlo_get_flv_states
<<PCM: sub interfaces>>=
module function pcm_nlo_get_flv_states (pcm, born) result (flv)
integer, dimension(:,:), allocatable :: flv
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
end function pcm_nlo_get_flv_states
<<PCM: procedures>>=
module function pcm_nlo_get_flv_states (pcm, born) result (flv)
integer, dimension(:,:), allocatable :: flv
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
if (born) then
flv = pcm%region_data%get_flv_states_born ()
else
flv = pcm%region_data%get_flv_states_real ()
end if
end function pcm_nlo_get_flv_states
@ %def pcm_nlo_get_flv_states
@
<<PCM: pcm nlo: TBP>>=
procedure :: get_qn => pcm_nlo_get_qn
<<PCM: sub interfaces>>=
module function pcm_nlo_get_qn (pcm, born) result (qn)
type(quantum_numbers_t), dimension(:,:), allocatable :: qn
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
end function pcm_nlo_get_qn
<<PCM: procedures>>=
module function pcm_nlo_get_qn (pcm, born) result (qn)
type(quantum_numbers_t), dimension(:,:), allocatable :: qn
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
if (born) then
qn = pcm%qn_born
else
qn = pcm%qn_real
end if
end function pcm_nlo_get_qn
@ %def pcm_nlo_get_qn
@ Check if there are massive emitters. Since the mass-structure of all
underlying Born configurations have to be the same (\textbf{This does
not have to be the case when different components are generated at LO})
, we just use the first one to determine this.
<<PCM: pcm nlo: TBP>>=
procedure :: has_massive_emitter => pcm_nlo_has_massive_emitter
<<PCM: sub interfaces>>=
module function pcm_nlo_has_massive_emitter (pcm) result (val)
logical :: val
class(pcm_nlo_t), intent(in) :: pcm
end function pcm_nlo_has_massive_emitter
<<PCM: procedures>>=
module function pcm_nlo_has_massive_emitter (pcm) result (val)
logical :: val
class(pcm_nlo_t), intent(in) :: pcm
integer :: i
val = .false.
associate (reg_data => pcm%region_data)
do i = reg_data%n_in + 1, reg_data%n_legs_born
if (any (i == reg_data%emitters)) &
val = val .or. reg_data%flv_born(1)%massive(i)
end do
end associate
end function pcm_nlo_has_massive_emitter
@ %def pcm_nlo_has_massive_emitter
@ Returns an array which specifies if the particle at position [[i]] is massive.
<<PCM: pcm nlo: TBP>>=
procedure :: get_mass_info => pcm_nlo_get_mass_info
<<PCM: sub interfaces>>=
module function pcm_nlo_get_mass_info (pcm, i_flv) result (massive)
class(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
logical, dimension(:), allocatable :: massive
end function pcm_nlo_get_mass_info
<<PCM: procedures>>=
module function pcm_nlo_get_mass_info (pcm, i_flv) result (massive)
class(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
logical, dimension(:), allocatable :: massive
allocate (massive (size (pcm%region_data%flv_born(i_flv)%massive)))
massive = pcm%region_data%flv_born(i_flv)%massive
end function pcm_nlo_get_mass_info
@ %def pcm_nlo_get_mass_info
@ Gfortran 7/8/9 bug, has to remain in the main module:
<<PCM: pcm nlo: TBP>>=
procedure :: allocate_workspace => pcm_nlo_allocate_workspace
<<PCM: main procedures>>=
subroutine pcm_nlo_allocate_workspace (pcm, work)
class(pcm_nlo_t), intent(in) :: pcm
class(pcm_workspace_t), intent(inout), allocatable :: work
allocate (pcm_nlo_workspace_t :: work)
end subroutine pcm_nlo_allocate_workspace
@ %def pcm_nlo_allocate_workspace
@
<<PCM: pcm nlo: TBP>>=
procedure :: init_qn => pcm_nlo_init_qn
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_init_qn (pcm, model)
class(pcm_nlo_t), intent(inout) :: pcm
class(model_data_t), intent(in) :: model
end subroutine pcm_nlo_init_qn
<<PCM: procedures>>=
module subroutine pcm_nlo_init_qn (pcm, model)
class(pcm_nlo_t), intent(inout) :: pcm
class(model_data_t), intent(in) :: model
integer, dimension(:,:), allocatable :: flv_states
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
type(quantum_numbers_t), dimension(:), allocatable :: qn
allocate (flv_states (pcm%region_data%n_legs_born, &
pcm%region_data%n_flv_born))
flv_states = pcm%get_flv_states (.true.)
allocate (pcm%qn_born (size (flv_states, dim = 1), &
size (flv_states, dim = 2)))
allocate (flv (size (flv_states, dim = 1)))
allocate (qn (size (flv_states, dim = 1)))
do i = 1, pcm%get_n_flv_born ()
call flv%init (flv_states (:,i), model)
call qn%init (flv)
pcm%qn_born(:,i) = qn
end do
deallocate (flv); deallocate (qn)
deallocate (flv_states)
allocate (flv_states (pcm%region_data%n_legs_real, pcm%region_data%n_flv_real))
flv_states = pcm%get_flv_states (.false.)
allocate (pcm%qn_real (size (flv_states, dim = 1), size (flv_states, dim = 2)))
allocate (flv (size (flv_states, dim = 1)))
allocate (qn (size (flv_states, dim = 1)))
do i = 1, pcm%get_n_flv_real ()
call flv%init (flv_states (:,i), model)
call qn%init (flv)
pcm%qn_real(:,i) = qn
end do
end subroutine pcm_nlo_init_qn
@ %def pcm_nlo_init_qn
@ Gfortran 7/8/9 bug, has to remain in the main module:
<<PCM: pcm nlo: TBP>>=
procedure :: allocate_ps_matching => pcm_nlo_allocate_ps_matching
<<PCM: main procedures>>=
subroutine pcm_nlo_allocate_ps_matching (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (.not. allocated (pcm%real_partition)) then
allocate (powheg_damping_simple_t :: pcm%real_partition)
end if
end subroutine pcm_nlo_allocate_ps_matching
@ %def pcm_nlo_allocate_ps_matching
@
<<PCM: pcm nlo: TBP>>=
procedure :: activate_dalitz_plot => pcm_nlo_activate_dalitz_plot
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_activate_dalitz_plot (pcm, filename)
class(pcm_nlo_t), intent(inout) :: pcm
type(string_t), intent(in) :: filename
end subroutine pcm_nlo_activate_dalitz_plot
<<PCM: procedures>>=
module subroutine pcm_nlo_activate_dalitz_plot (pcm, filename)
class(pcm_nlo_t), intent(inout) :: pcm
type(string_t), intent(in) :: filename
call pcm%dalitz_plot%init (free_unit (), filename, .false.)
call pcm%dalitz_plot%write_header ()
end subroutine pcm_nlo_activate_dalitz_plot
@ %def pcm_nlo_activate_dalitz_plot
@
<<PCM: pcm nlo: TBP>>=
procedure :: register_dalitz_plot => pcm_nlo_register_dalitz_plot
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_register_dalitz_plot (pcm, emitter, p)
class(pcm_nlo_t), intent(inout) :: pcm
integer, intent(in) :: emitter
type(vector4_t), intent(in), dimension(:) :: p
end subroutine pcm_nlo_register_dalitz_plot
<<PCM: procedures>>=
module subroutine pcm_nlo_register_dalitz_plot (pcm, emitter, p)
class(pcm_nlo_t), intent(inout) :: pcm
integer, intent(in) :: emitter
type(vector4_t), intent(in), dimension(:) :: p
real(default) :: k0_n, k0_np1
k0_n = p(emitter)%p(0)
k0_np1 = p(size(p))%p(0)
call pcm%dalitz_plot%register (k0_n, k0_np1)
end subroutine pcm_nlo_register_dalitz_plot
@ %def pcm_nlo_register_dalitz_plot
@
<<PCM: pcm nlo: TBP>>=
procedure :: setup_phs_generator => pcm_nlo_setup_phs_generator
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_setup_phs_generator (pcm, pcm_work, generator, &
sqrts, mode, singular_jacobian)
class(pcm_nlo_t), intent(in) :: pcm
type(phs_fks_generator_t), intent(inout) :: generator
type(pcm_nlo_workspace_t), intent(in), target :: pcm_work
real(default), intent(in) :: sqrts
integer, intent(in), optional:: mode
logical, intent(in), optional :: singular_jacobian
end subroutine pcm_nlo_setup_phs_generator
<<PCM: procedures>>=
module subroutine pcm_nlo_setup_phs_generator (pcm, pcm_work, generator, &
sqrts, mode, singular_jacobian)
class(pcm_nlo_t), intent(in) :: pcm
type(phs_fks_generator_t), intent(inout) :: generator
type(pcm_nlo_workspace_t), intent(in), target :: pcm_work
real(default), intent(in) :: sqrts
integer, intent(in), optional:: mode
logical, intent(in), optional :: singular_jacobian
logical :: yorn
yorn = .false.; if (present (singular_jacobian)) yorn = singular_jacobian
call generator%connect_kinematics (pcm_work%isr_kinematics, &
pcm_work%real_kinematics, pcm%has_massive_emitter ())
generator%n_in = pcm%region_data%n_in
call generator%set_sqrts_hat (sqrts)
call generator%set_emitters (pcm%region_data%emitters)
call generator%setup_masses (pcm%region_data%n_legs_born)
generator%is_massive = pcm%get_mass_info (1)
generator%singular_jacobian = yorn
if (present (mode)) generator%mode = mode
call generator%set_xi_and_y_bounds (pcm%settings%fks_template%xi_min, &
pcm%settings%fks_template%y_max)
end subroutine pcm_nlo_setup_phs_generator
@ %def pcm_nlo_setup_phs_generator
@
<<PCM: pcm nlo: TBP>>=
procedure :: final => pcm_nlo_final
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_final (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
end subroutine pcm_nlo_final
<<PCM: procedures>>=
module subroutine pcm_nlo_final (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (allocated (pcm%real_partition)) deallocate (pcm%real_partition)
call pcm%dalitz_plot%final ()
end subroutine pcm_nlo_final
@ %def pcm_nlo_final
@
<<PCM: pcm nlo: TBP>>=
procedure :: is_nlo => pcm_nlo_is_nlo
<<PCM: sub interfaces>>=
module function pcm_nlo_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_nlo_t), intent(in) :: pcm
end function pcm_nlo_is_nlo
<<PCM: procedures>>=
module function pcm_nlo_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_nlo_t), intent(in) :: pcm
is_nlo = .true.
end function pcm_nlo_is_nlo
@ %def pcm_nlo_is_nlo
@ As a first implementation, it acts as a wrapper for the NLO controller
object and the squared matrix-element collector.
<<PCM: public>>=
public :: pcm_nlo_workspace_t
<<PCM: types>>=
type, extends (pcm_workspace_t) :: pcm_nlo_workspace_t
type(real_kinematics_t), pointer :: real_kinematics => null ()
type(isr_kinematics_t), pointer :: isr_kinematics => null ()
type(real_subtraction_t) :: real_sub
type(virtual_t) :: virtual
type(soft_mismatch_t) :: soft_mismatch
type(dglap_remnant_t) :: dglap_remnant
integer, dimension(:), allocatable :: i_mci_to_real_component
contains
<<PCM: pcm instance: TBP>>
end type pcm_nlo_workspace_t
@ %def pcm_nlo_workspace_t
@
<<PCM: pcm instance: TBP>>=
procedure :: set_radiation_event => pcm_nlo_workspace_set_radiation_event
procedure :: set_subtraction_event => pcm_nlo_workspace_set_subtraction_event
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_set_radiation_event (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_nlo_workspace_set_radiation_event
module subroutine pcm_nlo_workspace_set_subtraction_event (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_nlo_workspace_set_subtraction_event
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_set_radiation_event (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
pcm_work%real_sub%radiation_event = .true.
pcm_work%real_sub%subtraction_event = .false.
end subroutine pcm_nlo_workspace_set_radiation_event
module subroutine pcm_nlo_workspace_set_subtraction_event (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
pcm_work%real_sub%radiation_event = .false.
pcm_work%real_sub%subtraction_event = .true.
end subroutine pcm_nlo_workspace_set_subtraction_event
@ %def pcm_nlo_workspace_set_radiation_event
@ %def pcm_nlo_workspace_set_subtraction_event
<<PCM: pcm instance: TBP>>=
procedure :: disable_subtraction => pcm_nlo_workspace_disable_subtraction
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_disable_subtraction (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_nlo_workspace_disable_subtraction
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_disable_subtraction (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
pcm_work%real_sub%subtraction_deactivated = .true.
end subroutine pcm_nlo_workspace_disable_subtraction
@ %def pcm_nlo_workspace_disable_subtraction
@
<<PCM: pcm instance: TBP>>=
procedure :: init_config => pcm_nlo_workspace_init_config
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_init_config (pcm_work, pcm, &
active_components, nlo_types, energy, i_real_fin, model)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
logical, intent(in), dimension(:) :: active_components
integer, intent(in), dimension(:) :: nlo_types
real(default), intent(in), dimension(:) :: energy
integer, intent(in) :: i_real_fin
class(model_data_t), intent(in) :: model
end subroutine pcm_nlo_workspace_init_config
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_init_config (pcm_work, pcm, &
active_components, nlo_types, energy, i_real_fin, model)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
logical, intent(in), dimension(:) :: active_components
integer, intent(in), dimension(:) :: nlo_types
real(default), intent(in), dimension(:) :: energy
integer, intent(in) :: i_real_fin
class(model_data_t), intent(in) :: model
integer :: i_component
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
"pcm_nlo_workspace_init_config")
call pcm_work%init_real_and_isr_kinematics (pcm, energy)
select type (pcm)
type is (pcm_nlo_t)
do i_component = 1, size (active_components)
if (active_components(i_component) .or. &
pcm%settings%combined_integration) then
select case (nlo_types(i_component))
case (NLO_REAL)
if (i_component /= i_real_fin) then
call pcm_work%setup_real_component (pcm, &
pcm%settings%fks_template%subtraction_disabled)
end if
case (NLO_VIRTUAL)
call pcm_work%init_virtual (pcm, model)
case (NLO_MISMATCH)
call pcm_work%init_soft_mismatch (pcm)
case (NLO_DGLAP)
call pcm_work%init_dglap_remnant (pcm)
end select
end if
end do
end select
end subroutine pcm_nlo_workspace_init_config
@ %def pcm_nlo_workspace_init_config
@
<<PCM: pcm instance: TBP>>=
procedure :: setup_real_component => pcm_nlo_workspace_setup_real_component
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_setup_real_component (pcm_work, pcm, &
subtraction_disabled)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
class(pcm_t), intent(in) :: pcm
logical, intent(in) :: subtraction_disabled
end subroutine pcm_nlo_workspace_setup_real_component
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_setup_real_component (pcm_work, pcm, &
subtraction_disabled)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
class(pcm_t), intent(in) :: pcm
logical, intent(in) :: subtraction_disabled
select type (pcm)
type is (pcm_nlo_t)
call pcm_work%init_real_subtraction (pcm)
if (subtraction_disabled) call pcm_work%disable_subtraction ()
end select
end subroutine pcm_nlo_workspace_setup_real_component
@ %def pcm_nlo_workspace_setup_real_component
@
<<PCM: pcm instance: TBP>>=
procedure :: init_real_and_isr_kinematics => &
pcm_nlo_workspace_init_real_and_isr_kinematics
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_init_real_and_isr_kinematics &
(pcm_work, pcm, energy)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
real(default), dimension(:), intent(in) :: energy
end subroutine pcm_nlo_workspace_init_real_and_isr_kinematics
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_init_real_and_isr_kinematics &
(pcm_work, pcm, energy)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
real(default), dimension(:), intent(in) :: energy
integer :: n_contr
allocate (pcm_work%real_kinematics)
allocate (pcm_work%isr_kinematics)
select type (pcm)
type is (pcm_nlo_t)
associate (region_data => pcm%region_data)
if (allocated (region_data%alr_contributors)) then
n_contr = size (region_data%alr_contributors)
else if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
n_contr = 2
else
n_contr = 1
end if
call pcm_work%real_kinematics%init &
(region_data%n_legs_real, region_data%n_phs, &
region_data%n_regions, n_contr)
if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) &
call pcm_work%real_kinematics%init_onshell &
(region_data%n_legs_real, region_data%n_phs)
pcm_work%isr_kinematics%n_in = region_data%n_in
end associate
end select
pcm_work%isr_kinematics%beam_energy = energy
end subroutine pcm_nlo_workspace_init_real_and_isr_kinematics
@ %def pcm_nlo_workspace_init_real_and_isr_kinematics
@
<<PCM: pcm instance: TBP>>=
procedure :: set_real_and_isr_kinematics => &
pcm_nlo_workspace_set_real_and_isr_kinematics
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_set_real_and_isr_kinematics &
(pcm_work, phs_identifiers, sqrts)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
real(default), intent(in) :: sqrts
end subroutine pcm_nlo_workspace_set_real_and_isr_kinematics
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_set_real_and_isr_kinematics &
(pcm_work, phs_identifiers, sqrts)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
real(default), intent(in) :: sqrts
call pcm_work%real_sub%set_real_kinematics &
(pcm_work%real_kinematics)
call pcm_work%real_sub%set_isr_kinematics &
(pcm_work%isr_kinematics)
end subroutine pcm_nlo_workspace_set_real_and_isr_kinematics
@ %def pcm_nlo_workspace_set_real_and_isr_kinematics
@
<<PCM: pcm instance: TBP>>=
procedure :: init_real_subtraction => pcm_nlo_workspace_init_real_subtraction
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_init_real_subtraction (pcm_work, pcm)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
class(pcm_t), intent(in) :: pcm
end subroutine pcm_nlo_workspace_init_real_subtraction
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_init_real_subtraction (pcm_work, pcm)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
class(pcm_t), intent(in) :: pcm
select type (pcm)
type is (pcm_nlo_t)
associate (region_data => pcm%region_data)
call pcm_work%real_sub%init (region_data, pcm%settings)
if (allocated (pcm%settings%selected_alr)) then
associate (selected_alr => pcm%settings%selected_alr)
if (any (selected_alr < 0)) then
call msg_fatal ("Fixed alpha region must be non-negative!")
else if (any (selected_alr > region_data%n_regions)) then
call msg_fatal ("Fixed alpha region is larger than the"&
&" total number of singular regions!")
else
allocate (pcm_work%real_sub%selected_alr &
(size (selected_alr)))
pcm_work%real_sub%selected_alr = selected_alr
end if
end associate
end if
end associate
end select
end subroutine pcm_nlo_workspace_init_real_subtraction
@ %def pcm_nlo_workspace_init_real_subtraction
@
<<PCM: pcm instance: TBP>>=
procedure :: set_momenta_and_scales_virtual => &
pcm_nlo_workspace_set_momenta_and_scales_virtual
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual &
(pcm_work, p, ren_scale, fac_scale, es_scale)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
type(vector4_t), intent(in), dimension(:) :: p
real(default), allocatable, intent(in) :: ren_scale
real(default), intent(in) :: fac_scale
real(default), allocatable, intent(in) :: es_scale
end subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual &
(pcm_work, p, ren_scale, fac_scale, es_scale)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
type(vector4_t), intent(in), dimension(:) :: p
real(default), allocatable, intent(in) :: ren_scale
real(default), intent(in) :: fac_scale
real(default), allocatable, intent(in) :: es_scale
associate (virtual => pcm_work%virtual)
call virtual%set_ren_scale (ren_scale)
call virtual%set_fac_scale (p, fac_scale)
call virtual%set_ellis_sexton_scale (es_scale)
end associate
end subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual
@ %def pcm_nlo_workspace_set_momenta_and_scales_virtual
@
<<PCM: pcm instance: TBP>>=
procedure :: set_fac_scale => pcm_nlo_workspace_set_fac_scale
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_set_fac_scale (pcm_work, fac_scale)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
real(default), intent(in) :: fac_scale
end subroutine pcm_nlo_workspace_set_fac_scale
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_set_fac_scale (pcm_work, fac_scale)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
real(default), intent(in) :: fac_scale
pcm_work%isr_kinematics%fac_scale = fac_scale
end subroutine pcm_nlo_workspace_set_fac_scale
@ %def pcm_nlo_workspace_set_fac_scale
@
<<PCM: pcm instance: TBP>>=
procedure :: set_momenta => pcm_nlo_workspace_set_momenta
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_set_momenta (pcm_work, &
p_born, p_real, i_phs, cms)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
type(vector4_t), dimension(:), intent(in) :: p_born, p_real
integer, intent(in) :: i_phs
logical, intent(in), optional :: cms
end subroutine pcm_nlo_workspace_set_momenta
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_set_momenta (pcm_work, &
p_born, p_real, i_phs, cms)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
type(vector4_t), dimension(:), intent(in) :: p_born, p_real
integer, intent(in) :: i_phs
logical, intent(in), optional :: cms
logical :: yorn
yorn = .false.; if (present (cms)) yorn = cms
associate (kinematics => pcm_work%real_kinematics)
if (yorn) then
if (.not. kinematics%p_born_cms%initialized) &
call kinematics%p_born_cms%init (size (p_born), 1)
if (.not. kinematics%p_real_cms%initialized) &
call kinematics%p_real_cms%init (size (p_real), 1)
kinematics%p_born_cms%phs_point(1) = p_born
kinematics%p_real_cms%phs_point(i_phs) = p_real
else
if (.not. kinematics%p_born_lab%initialized) &
call kinematics%p_born_lab%init (size (p_born), 1)
if (.not. kinematics%p_real_lab%initialized) &
call kinematics%p_real_lab%init (size (p_real), 1)
kinematics%p_born_lab%phs_point(1) = p_born
kinematics%p_real_lab%phs_point(i_phs) = p_real
end if
end associate
end subroutine pcm_nlo_workspace_set_momenta
@ %def pcm_nlo_workspace_set_momenta
@
<<PCM: pcm instance: TBP>>=
procedure :: get_momenta => pcm_nlo_workspace_get_momenta
<<PCM: sub interfaces>>=
module function pcm_nlo_workspace_get_momenta (pcm_work, pcm, &
i_phs, born_phsp, cms) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(pcm_nlo_workspace_t), intent(in) :: pcm_work
class(pcm_t), intent(in) :: pcm
integer, intent(in) :: i_phs
logical, intent(in) :: born_phsp
logical, intent(in), optional :: cms
end function pcm_nlo_workspace_get_momenta
<<PCM: procedures>>=
module function pcm_nlo_workspace_get_momenta (pcm_work, pcm, &
i_phs, born_phsp, cms) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(pcm_nlo_workspace_t), intent(in) :: pcm_work
class(pcm_t), intent(in) :: pcm
integer, intent(in) :: i_phs
logical, intent(in) :: born_phsp
logical, intent(in), optional :: cms
logical :: yorn
yorn = .false.; if (present (cms)) yorn = cms
select type (pcm)
type is (pcm_nlo_t)
if (born_phsp) then
if (yorn) then
p = pcm_work%real_kinematics%p_born_cms%phs_point(1)
else
p = pcm_work%real_kinematics%p_born_lab%phs_point(1)
end if
else
if (yorn) then
p = pcm_work%real_kinematics%p_real_cms%phs_point(i_phs)
else
p = pcm_work%real_kinematics%p_real_lab%phs_point(i_phs)
end if
end if
end select
end function pcm_nlo_workspace_get_momenta
@ %def pcm_nlo_workspace_get_momenta
@
<<PCM: pcm instance: TBP>>=
procedure :: get_xi_max => pcm_nlo_workspace_get_xi_max
<<PCM: sub interfaces>>=
module function pcm_nlo_workspace_get_xi_max (pcm_work, alr) result (xi_max)
real(default) :: xi_max
class(pcm_nlo_workspace_t), intent(in) :: pcm_work
integer, intent(in) :: alr
end function pcm_nlo_workspace_get_xi_max
<<PCM: procedures>>=
module function pcm_nlo_workspace_get_xi_max (pcm_work, alr) result (xi_max)
real(default) :: xi_max
class(pcm_nlo_workspace_t), intent(in) :: pcm_work
integer, intent(in) :: alr
integer :: i_phs
i_phs = pcm_work%real_kinematics%alr_to_i_phs (alr)
xi_max = pcm_work%real_kinematics%xi_max (i_phs)
end function pcm_nlo_workspace_get_xi_max
@ %def pcm_nlo_workspace_get_xi_max
@
<<PCM: pcm instance: TBP>>=
procedure :: set_x_rad => pcm_nlo_workspace_set_x_rad
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_set_x_rad (pcm_work, x_tot)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
real(default), intent(in), dimension(:) :: x_tot
end subroutine pcm_nlo_workspace_set_x_rad
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_set_x_rad (pcm_work, x_tot)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
real(default), intent(in), dimension(:) :: x_tot
integer :: n_par
n_par = size (x_tot)
if (n_par < 3) then
pcm_work%real_kinematics%x_rad = zero
else
pcm_work%real_kinematics%x_rad = x_tot (n_par - 2 : n_par)
end if
end subroutine pcm_nlo_workspace_set_x_rad
@ %def pcm_nlo_workspace_set_x_rad
@
<<PCM: pcm instance: TBP>>=
procedure :: init_virtual => pcm_nlo_workspace_init_virtual
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_init_virtual (pcm_work, pcm, model)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
class(pcm_t), intent(in) :: pcm
class(model_data_t), intent(in) :: model
end subroutine pcm_nlo_workspace_init_virtual
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_init_virtual (pcm_work, pcm, model)
class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
class(pcm_t), intent(in) :: pcm
class(model_data_t), intent(in) :: model
select type (pcm)
type is (pcm_nlo_t)
associate (region_data => pcm%region_data)
call pcm_work%virtual%init (region_data%get_flv_states_born (), &
region_data%n_in, pcm%settings, model, pcm%has_pdfs)
end associate
end select
end subroutine pcm_nlo_workspace_init_virtual
@ %def pcm_nlo_workspace_init_virtual
@
<<PCM: pcm instance: TBP>>=
procedure :: disable_virtual_subtraction => &
pcm_nlo_workspace_disable_virtual_subtraction
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_disable_virtual_subtraction (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_nlo_workspace_disable_virtual_subtraction
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_disable_virtual_subtraction (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_nlo_workspace_disable_virtual_subtraction
@ %def pcm_nlo_workspace_disable_virtual_subtraction
@
<<PCM: pcm instance: TBP>>=
procedure :: compute_sqme_virt => pcm_nlo_workspace_compute_sqme_virt
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_compute_sqme_virt (pcm_work, pcm, p, &
alpha_coupling, separate_uborns, sqme_virt)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
type(vector4_t), intent(in), dimension(:) :: p
real(default), dimension(2), intent(in) :: alpha_coupling
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_virt
end subroutine pcm_nlo_workspace_compute_sqme_virt
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_compute_sqme_virt (pcm_work, pcm, p, &
alpha_coupling, separate_uborns, sqme_virt)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
type(vector4_t), intent(in), dimension(:) :: p
real(default), dimension(2), intent(in) :: alpha_coupling
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_virt
type(vector4_t), dimension(:), allocatable :: pp
associate (virtual => pcm_work%virtual)
allocate (pp (size (p)))
if (virtual%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
pp = pcm_work%real_kinematics%p_born_onshell%get_momenta (1)
else
pp = p
end if
select type (pcm)
type is (pcm_nlo_t)
if (separate_uborns) then
allocate (sqme_virt (pcm%get_n_flv_born ()))
else
allocate (sqme_virt (1))
end if
sqme_virt = zero
call virtual%evaluate (pcm%region_data, &
alpha_coupling, pp, separate_uborns, sqme_virt)
end select
end associate
end subroutine pcm_nlo_workspace_compute_sqme_virt
@ %def pcm_nlo_workspace_compute_sqme_virt
@
<<PCM: pcm instance: TBP>>=
procedure :: compute_sqme_mismatch => pcm_nlo_workspace_compute_sqme_mismatch
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_compute_sqme_mismatch (pcm_work, pcm, &
alpha_s, separate_uborns, sqme_mism)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
real(default), intent(in) :: alpha_s
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_mism
end subroutine pcm_nlo_workspace_compute_sqme_mismatch
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_compute_sqme_mismatch (pcm_work, pcm, &
alpha_s, separate_uborns, sqme_mism)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
real(default), intent(in) :: alpha_s
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_mism
select type (pcm)
type is (pcm_nlo_t)
if (separate_uborns) then
allocate (sqme_mism (pcm%get_n_flv_born ()))
else
allocate (sqme_mism (1))
end if
sqme_mism = zero
sqme_mism = pcm_work%soft_mismatch%evaluate (alpha_s)
end select
end subroutine pcm_nlo_workspace_compute_sqme_mismatch
@ %def pcm_nlo_workspace_compute_sqme_mismatch
@
<<PCM: pcm instance: TBP>>=
procedure :: compute_sqme_dglap_remnant => &
pcm_nlo_workspace_compute_sqme_dglap_remnant
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant (pcm_work, &
pcm, alpha_coupling, separate_uborns, sqme_dglap)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
real(default), dimension(2), intent(in) :: alpha_coupling
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_dglap
end subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant (pcm_work, &
pcm, alpha_coupling, separate_uborns, sqme_dglap)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
real(default), dimension(2), intent(in) :: alpha_coupling
logical, intent(in) :: separate_uborns
real(default), dimension(:), allocatable, intent(inout) :: sqme_dglap
select type (pcm)
type is (pcm_nlo_t)
if (separate_uborns) then
allocate (sqme_dglap (pcm%get_n_flv_born ()))
else
allocate (sqme_dglap (1))
end if
end select
sqme_dglap = zero
call pcm_work%dglap_remnant%evaluate (alpha_coupling, &
separate_uborns, sqme_dglap)
end subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant
@ %def pcm_nlo_workspace_compute_sqme_dglap_remnant
@
<<PCM: pcm instance: TBP>>=
procedure :: set_fixed_order_event_mode => &
pcm_nlo_workspace_set_fixed_order_event_mode
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_set_fixed_order_event_mode (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_nlo_workspace_set_fixed_order_event_mode
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_set_fixed_order_event_mode (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
pcm_work%real_sub%purpose = FIXED_ORDER_EVENTS
end subroutine pcm_nlo_workspace_set_fixed_order_event_mode
-<<PCM: pcm instance: TBP>>=
- procedure :: set_powheg_mode => pcm_nlo_workspace_set_powheg_mode
-<<PCM: sub interfaces>>=
- module subroutine pcm_nlo_workspace_set_powheg_mode (pcm_work)
- class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
- end subroutine pcm_nlo_workspace_set_powheg_mode
-<<PCM: procedures>>=
- module subroutine pcm_nlo_workspace_set_powheg_mode (pcm_work)
- class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
- pcm_work%real_sub%purpose = POWHEG
- end subroutine pcm_nlo_workspace_set_powheg_mode
-
@ %def pcm_nlo_workspace_set_fixed_order_event_mode
-@ %def pcm_nlo_workspace_set_powheg_mode
@
<<PCM: pcm instance: TBP>>=
procedure :: init_soft_mismatch => pcm_nlo_workspace_init_soft_mismatch
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_init_soft_mismatch (pcm_work, pcm)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
end subroutine pcm_nlo_workspace_init_soft_mismatch
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_init_soft_mismatch (pcm_work, pcm)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
select type (pcm)
type is (pcm_nlo_t)
call pcm_work%soft_mismatch%init (pcm%region_data, &
pcm_work%real_kinematics, pcm%settings%factorization_mode)
end select
end subroutine pcm_nlo_workspace_init_soft_mismatch
@ %def pcm_nlo_workspace_init_soft_mismatch
@
<<PCM: pcm instance: TBP>>=
procedure :: init_dglap_remnant => pcm_nlo_workspace_init_dglap_remnant
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_init_dglap_remnant (pcm_work, pcm)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
end subroutine pcm_nlo_workspace_init_dglap_remnant
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_init_dglap_remnant (pcm_work, pcm)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
class(pcm_t), intent(in) :: pcm
select type (pcm)
type is (pcm_nlo_t)
call pcm_work%dglap_remnant%init ( &
pcm%settings, &
pcm%region_data, &
pcm_work%isr_kinematics)
end select
end subroutine pcm_nlo_workspace_init_dglap_remnant
@ %def pcm_nlo_workspace_init_dglap_remnant
@
<<PCM: pcm instance: TBP>>=
procedure :: is_fixed_order_nlo_events &
=> pcm_nlo_workspace_is_fixed_order_nlo_events
<<PCM: sub interfaces>>=
module function pcm_nlo_workspace_is_fixed_order_nlo_events &
(pcm_work) result (is_fnlo)
logical :: is_fnlo
class(pcm_nlo_workspace_t), intent(in) :: pcm_work
end function pcm_nlo_workspace_is_fixed_order_nlo_events
<<PCM: procedures>>=
module function pcm_nlo_workspace_is_fixed_order_nlo_events &
(pcm_work) result (is_fnlo)
logical :: is_fnlo
class(pcm_nlo_workspace_t), intent(in) :: pcm_work
is_fnlo = pcm_work%real_sub%purpose == FIXED_ORDER_EVENTS
end function pcm_nlo_workspace_is_fixed_order_nlo_events
@ %def pcm_nlo_workspace_is_fixed_order_nlo_events
@
<<PCM: pcm instance: TBP>>=
procedure :: final => pcm_nlo_workspace_final
<<PCM: sub interfaces>>=
module subroutine pcm_nlo_workspace_final (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end subroutine pcm_nlo_workspace_final
<<PCM: procedures>>=
module subroutine pcm_nlo_workspace_final (pcm_work)
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
call pcm_work%real_sub%final ()
call pcm_work%virtual%final ()
call pcm_work%soft_mismatch%final ()
call pcm_work%dglap_remnant%final ()
if (associated (pcm_work%real_kinematics)) then
call pcm_work%real_kinematics%final ()
nullify (pcm_work%real_kinematics)
end if
if (associated (pcm_work%isr_kinematics)) then
nullify (pcm_work%isr_kinematics)
end if
end subroutine pcm_nlo_workspace_final
@ %def pcm_nlo_workspace_final
@
<<PCM: pcm instance: TBP>>=
procedure :: is_nlo => pcm_nlo_workspace_is_nlo
<<PCM: sub interfaces>>=
module function pcm_nlo_workspace_is_nlo (pcm_work) result (is_nlo)
logical :: is_nlo
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
end function pcm_nlo_workspace_is_nlo
<<PCM: procedures>>=
module function pcm_nlo_workspace_is_nlo (pcm_work) result (is_nlo)
logical :: is_nlo
class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
is_nlo = .true.
end function pcm_nlo_workspace_is_nlo
@ %def pcm_nlo_workspace_is_nlo
+@ This routine modifies the kinematic factors applied to the real matrix element
+for use with POWHEG matching. We need to divide the real matrix element by [[xi_max]] to
+cancel a factor of [[xi_max]] applied in [[apply_kinematic_factors_radiation]].
+It comes from the fact that we sample $\tilde\xi \in [0,1]$ when integrating
+but $\xi \in [p_T^2,\xi_\text{max}]$ for POWHEG matching.
+Thus, we are taking into account that $d\xi = d\tilde\xi
+\frac{\xi}{\tilde\xi} = d\tilde\xi \xi_\text{max}$.
+Additionally, we need to cancel the Jacobian from the random number mapping.
+We only want the physical part of the Jacobian in our Sudakov splitting function.
+Furthermore, the real matrix element lacks its flux factor
+$\frac{1}{2 \hat s_{\mathcal{R}}}$ and the real Jacobian lacks a factor of
+$\frac{1}{1-\xi}$. Together, this is a factor of $\frac{1}{2 \hat s_{\mathcal{B}}}$,
+i.e. the same as the flux factor of the Born matrix element. We do not correct
+any of both here, as only the ratio of both will be relevant for the Sudakov.
+<<PCM: pcm instance: TBP>>=
+procedure :: powheg_kinematic_factors_real => &
+ pcm_nlo_workspace_powheg_kinematic_factors_real
+<<PCM: sub interfaces>>=
+ module function pcm_nlo_workspace_powheg_kinematic_factors_real &
+ (pcm_work, sqme_real, alr) result (sqme_real_corr)
+ real(default) :: sqme_real_corr
+ class(pcm_nlo_workspace_t), intent(in) :: pcm_work
+ real(default), intent(in) :: sqme_real
+ integer, intent(in) :: alr
+ end function pcm_nlo_workspace_powheg_kinematic_factors_real
+<<PCM: procedures>>=
+ module function pcm_nlo_workspace_powheg_kinematic_factors_real &
+ (pcm_work, sqme_real, alr) result (sqme_real_corr)
+ real(default) :: sqme_real_corr
+ class(pcm_nlo_workspace_t), intent(in) :: pcm_work
+ real(default), intent(in) :: sqme_real
+ integer, intent(in) :: alr
+ real(default) :: xi_max, jac_rand
+ integer :: i_phs
+ xi_max = pcm_work%get_xi_max (alr)
+ i_phs = pcm_work%real_kinematics%alr_to_i_phs (alr)
+ jac_rand = pcm_work%real_kinematics%jac_rand (i_phs)
+ sqme_real_corr = sqme_real / xi_max / jac_rand
+ end function pcm_nlo_workspace_powheg_kinematic_factors_real
+
+@ %def pcm_nlo_workspace_powheg_kinematic_factors_real
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Kinematics instance}
In this data type we combine all objects (instances) necessary for
generating (or recovering) a kinematical configuration. The
components work together as an implementation of multi-channel phase
space.
[[sf_chain]] is an instance of the structure-function chain. It is
used both for generating kinematics and, after the proper scale has
been determined, evaluating the structure function entries.
[[phs]] is an instance of the phase space for the elementary process.
The array [[f]] contains the products of the Jacobians that originate
from parameter mappings in the structure-function chain or in the
phase space. We allocate this explicitly if either [[sf_chain]] or
[[phs]] are explicitly allocated, otherwise we can take over a pointer.
All components are implemented as pointers to (anonymous) targets.
For each component, there is a flag that tells whether this component
is to be regarded as a proper component (`owned' by the object) or as
a pointer.
@
<<[[kinematics.f90]]>>=
<<File header>>
module kinematics
<<Use kinds>>
use lorentz
use physics_defs
use sf_base
use phs_base
use fks_regions
use mci_base
use process_config
use process_mci
use pcm_base, only: pcm_t, pcm_workspace_t
use pcm, only: pcm_nlo_t, pcm_nlo_workspace_t
<<Standard module head>>
<<Kinematics: public>>
<<Kinematics: types>>
interface
<<Kinematics: sub interfaces>>
end interface
end module kinematics
@ %def kinematics
@
<<[[kinematics_sub.f90]]>>=
<<File header>>
submodule (kinematics) kinematics_s
<<Use debug>>
use format_utils, only: write_separator
use diagnostics
use io_units
use phs_points, only: assignment(=), size
use interactions
use phs_fks
use ttv_formfactors, only: m1s_to_mpole
implicit none
contains
<<Kinematics: procedures>>
end submodule kinematics_s
@ %def kinematics_s
@
<<Kinematics: public>>=
public :: kinematics_t
<<Kinematics: types>>=
type :: kinematics_t
integer :: n_in = 0
integer :: n_channel = 0
integer :: selected_channel = 0
type(sf_chain_instance_t), pointer :: sf_chain => null ()
class(phs_t), pointer :: phs => null ()
real(default), dimension(:), pointer :: f => null ()
real(default) :: phs_factor
logical :: sf_chain_allocated = .false.
logical :: phs_allocated = .false.
logical :: f_allocated = .false.
integer :: emitter = -1
integer :: i_phs = 0
integer :: i_con = 0
logical :: only_cm_frame = .false.
logical :: new_seed = .true.
logical :: threshold = .false.
contains
<<Kinematics: kinematics: TBP>>
end type kinematics_t
@ %def kinematics_t
@ Output. Show only those components which are marked as owned.
<<Kinematics: kinematics: TBP>>=
procedure :: write => kinematics_write
<<Kinematics: sub interfaces>>=
module subroutine kinematics_write (object, unit)
class(kinematics_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine kinematics_write
<<Kinematics: procedures>>=
module subroutine kinematics_write (object, unit)
class(kinematics_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, c
u = given_output_unit (unit)
if (object%f_allocated) then
write (u, "(1x,A)") "Flux * PHS volume:"
write (u, "(2x,ES19.12)") object%phs_factor
write (u, "(1x,A)") "Jacobian factors per channel:"
do c = 1, size (object%f)
write (u, "(3x,I0,':',1x,ES14.7)", advance="no") c, object%f(c)
if (c == object%selected_channel) then
write (u, "(1x,A)") "[selected]"
else
write (u, *)
end if
end do
end if
if (object%sf_chain_allocated) then
call write_separator (u)
call object%sf_chain%write (u)
end if
if (object%phs_allocated) then
call write_separator (u)
call object%phs%write (u)
end if
end subroutine kinematics_write
@ %def kinematics_write
@ Finalizer. Delete only those components which are marked as owned.
<<Kinematics: kinematics: TBP>>=
procedure :: final => kinematics_final
<<Kinematics: sub interfaces>>=
module subroutine kinematics_final (object)
class(kinematics_t), intent(inout) :: object
end subroutine kinematics_final
<<Kinematics: procedures>>=
module subroutine kinematics_final (object)
class(kinematics_t), intent(inout) :: object
if (object%sf_chain_allocated) then
call object%sf_chain%final ()
deallocate (object%sf_chain)
object%sf_chain_allocated = .false.
end if
if (object%phs_allocated) then
call object%phs%final ()
deallocate (object%phs)
object%phs_allocated = .false.
end if
if (object%f_allocated) then
deallocate (object%f)
object%f_allocated = .false.
end if
end subroutine kinematics_final
@ %def kinematics_final
@ Configure the kinematics object. This consists of several
configuration steps which correspond to individual procedures. In
essence, we configure the structure-function part, the partonic
phase-space part, and various NLO items.
TODO wk 19-03-01: This includes some region-data setup within [[pcm]],
hence [[pcm]] is intent(inout). This should be moved elsewhere, so
[[pcm]] can become strictly intent(in).
<<Kinematics: kinematics: TBP>>=
procedure :: configure => kinematics_configure
<<Kinematics: sub interfaces>>=
module subroutine kinematics_configure (kin, pcm, pcm_work, &
sf_chain, beam_config, phs_config, nlo_type, is_i_sub)
class(kinematics_t), intent(out) :: kin
class(pcm_t), intent(inout) :: pcm
class(pcm_workspace_t), intent(in) :: pcm_work
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in), target :: beam_config
class(phs_config_t), intent(in), target :: phs_config
integer, intent(in) :: nlo_type
logical, intent(in) :: is_i_sub
end subroutine kinematics_configure
<<Kinematics: procedures>>=
module subroutine kinematics_configure (kin, pcm, pcm_work, &
sf_chain, beam_config, phs_config, nlo_type, is_i_sub)
class(kinematics_t), intent(out) :: kin
class(pcm_t), intent(inout) :: pcm
class(pcm_workspace_t), intent(in) :: pcm_work
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in), target :: beam_config
class(phs_config_t), intent(in), target :: phs_config
integer, intent(in) :: nlo_type
logical, intent(in) :: is_i_sub
logical :: extended_sf
extended_sf = nlo_type == NLO_DGLAP .or. &
(nlo_type == NLO_REAL .and. is_i_sub)
call kin%init_sf_chain (sf_chain, beam_config, &
extended_sf = pcm%has_pdfs .and. extended_sf)
!!! Add one for additional Born matrix element
call kin%init_phs (phs_config)
call kin%set_nlo_info (nlo_type)
select type (phs => kin%phs)
type is (phs_fks_t)
call phs%allocate_momenta (phs_config, .not. (nlo_type == NLO_REAL))
select type (pcm)
type is (pcm_nlo_t)
call pcm%region_data%init_phs_identifiers (phs%phs_identifiers)
!!! The triple select type pyramid of doom
select type (pcm_work)
type is (pcm_nlo_workspace_t)
if (allocated (pcm_work%real_kinematics%alr_to_i_phs)) &
call pcm%region_data%set_alr_to_i_phs (phs%phs_identifiers, &
pcm_work%real_kinematics%alr_to_i_phs)
end select
end select
end select
end subroutine kinematics_configure
@ %def kinematics_configure
@ Set the flags indicating whether the phase space shall be set up for the calculation of the real contribution. For this case, also set the emitter.
<<Kinematics: kinematics: TBP>>=
procedure :: set_nlo_info => kinematics_set_nlo_info
<<Kinematics: sub interfaces>>=
module subroutine kinematics_set_nlo_info (k, nlo_type)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: nlo_type
end subroutine kinematics_set_nlo_info
<<Kinematics: procedures>>=
module subroutine kinematics_set_nlo_info (k, nlo_type)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: nlo_type
if (nlo_type == NLO_VIRTUAL) k%only_cm_frame = .true.
end subroutine kinematics_set_nlo_info
@ %def kinematics_set_nlo_info
@
<<Kinematics: kinematics: TBP>>=
procedure :: set_threshold => kinematics_set_threshold
<<Kinematics: sub interfaces>>=
module subroutine kinematics_set_threshold (kin, factorization_mode)
class(kinematics_t), intent(inout) :: kin
integer, intent(in) :: factorization_mode
- end subroutine kinematics_set_threshold
+ end subroutine kinematics_set_threshold
<<Kinematics: procedures>>=
module subroutine kinematics_set_threshold (kin, factorization_mode)
class(kinematics_t), intent(inout) :: kin
integer, intent(in) :: factorization_mode
kin%threshold = factorization_mode == FACTORIZATION_THRESHOLD
end subroutine kinematics_set_threshold
@ %def kinematics_set_threshold
@ Allocate the structure-function chain instance, initialize it as a
copy of the [[sf_chain]] template, and prepare it for evaluation.
The [[sf_chain]] remains a target because the (usually constant) beam momenta
are taken from there.
<<Kinematics: kinematics: TBP>>=
procedure :: init_sf_chain => kinematics_init_sf_chain
<<Kinematics: sub interfaces>>=
module subroutine kinematics_init_sf_chain &
(k, sf_chain, config, extended_sf)
class(kinematics_t), intent(inout) :: k
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in) :: config
logical, intent(in), optional :: extended_sf
end subroutine kinematics_init_sf_chain
<<Kinematics: procedures>>=
module subroutine kinematics_init_sf_chain (k, sf_chain, config, extended_sf)
class(kinematics_t), intent(inout) :: k
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in) :: config
logical, intent(in), optional :: extended_sf
integer :: n_strfun, n_channel
integer :: c
k%n_in = config%data%get_n_in ()
n_strfun = config%n_strfun
n_channel = config%n_channel
allocate (k%sf_chain)
k%sf_chain_allocated = .true.
call k%sf_chain%init (sf_chain, n_channel)
if (n_strfun /= 0) then
do c = 1, n_channel
call k%sf_chain%set_channel (c, config%sf_channel(c))
end do
end if
call k%sf_chain%link_interactions ()
call k%sf_chain%exchange_mask ()
call k%sf_chain%init_evaluators (extended_sf = extended_sf)
end subroutine kinematics_init_sf_chain
@ %def kinematics_init_sf_chain
@ Allocate and initialize the phase-space part and the array of
Jacobian factors.
<<Kinematics: kinematics: TBP>>=
procedure :: init_phs => kinematics_init_phs
<<Kinematics: sub interfaces>>=
module subroutine kinematics_init_phs (k, config)
class(kinematics_t), intent(inout) :: k
class(phs_config_t), intent(in), target :: config
end subroutine kinematics_init_phs
<<Kinematics: procedures>>=
module subroutine kinematics_init_phs (k, config)
class(kinematics_t), intent(inout) :: k
class(phs_config_t), intent(in), target :: config
k%n_channel = config%get_n_channel ()
call config%allocate_instance (k%phs)
call k%phs%init (config)
k%phs_allocated = .true.
allocate (k%f (k%n_channel))
k%f = 0
k%f_allocated = .true.
end subroutine kinematics_init_phs
@ %def kinematics_init_phs
@
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_radiation_kinematics => &
kinematics_evaluate_radiation_kinematics
<<Kinematics: sub interfaces>>=
module subroutine kinematics_evaluate_radiation_kinematics (k, r_in)
class(kinematics_t), intent(inout) :: k
real(default), intent(in), dimension(:) :: r_in
end subroutine kinematics_evaluate_radiation_kinematics
<<Kinematics: procedures>>=
module subroutine kinematics_evaluate_radiation_kinematics (k, r_in)
class(kinematics_t), intent(inout) :: k
real(default), intent(in), dimension(:) :: r_in
select type (phs => k%phs)
type is (phs_fks_t)
if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) then
call phs%generate_radiation_variables &
(r_in(phs%n_r_born + 1 : phs%n_r_born + 3), &
threshold = k%threshold)
call phs%compute_cms_energy ()
end if
end select
end subroutine kinematics_evaluate_radiation_kinematics
@ %def kinematics_evaluate_radiation_kinematics
@
<<Kinematics: kinematics: TBP>>=
procedure :: generate_fsr_in => kinematics_generate_fsr_in
<<Kinematics: sub interfaces>>=
module subroutine kinematics_generate_fsr_in (kin)
class(kinematics_t), intent(inout) :: kin
end subroutine kinematics_generate_fsr_in
<<Kinematics: procedures>>=
module subroutine kinematics_generate_fsr_in (kin)
class(kinematics_t), intent(inout) :: kin
select type (phs => kin%phs)
type is (phs_fks_t)
call phs%generate_fsr_in ()
end select
end subroutine kinematics_generate_fsr_in
@ %def kinematics_generate_fsr_in
@
<<Kinematics: kinematics: TBP>>=
procedure :: compute_xi_ref_momenta => kinematics_compute_xi_ref_momenta
<<Kinematics: sub interfaces>>=
module subroutine kinematics_compute_xi_ref_momenta (k, reg_data, nlo_type)
class(kinematics_t), intent(inout) :: k
type(region_data_t), intent(in) :: reg_data
integer, intent(in) :: nlo_type
end subroutine kinematics_compute_xi_ref_momenta
<<Kinematics: procedures>>=
module subroutine kinematics_compute_xi_ref_momenta (k, reg_data, nlo_type)
class(kinematics_t), intent(inout) :: k
type(region_data_t), intent(in) :: reg_data
integer, intent(in) :: nlo_type
logical :: use_contributors
use_contributors = allocated (reg_data%alr_contributors)
select type (phs => k%phs)
type is (phs_fks_t)
if (use_contributors) then
call phs%compute_xi_ref_momenta (contributors = reg_data%alr_contributors)
else if (k%threshold) then
if (.not. is_subtraction_component (k%emitter, nlo_type)) &
call phs%compute_xi_ref_momenta_threshold ()
else
call phs%compute_xi_ref_momenta ()
end if
end select
end subroutine kinematics_compute_xi_ref_momenta
@ %def kinematics_compute_xi_ref_momenta
@ Generate kinematics, given a phase-space channel and a MC
parameter set. The main result is the momentum array [[p]], but we
also fill the momentum entries in the structure-function chain and the
Jacobian-factor array [[f]]. Regarding phase space, we fill only the
parameter arrays for the selected channel.
<<Kinematics: kinematics: TBP>>=
procedure :: compute_selected_channel => kinematics_compute_selected_channel
<<Kinematics: sub interfaces>>=
module subroutine kinematics_compute_selected_channel &
(k, mci_work, phs_channel, p, success)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(out) :: p
logical, intent(out) :: success
end subroutine kinematics_compute_selected_channel
<<Kinematics: procedures>>=
module subroutine kinematics_compute_selected_channel &
(k, mci_work, phs_channel, p, success)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(out) :: p
logical, intent(out) :: success
integer :: sf_channel
k%selected_channel = phs_channel
sf_channel = k%phs%config%get_sf_channel (phs_channel)
call k%sf_chain%compute_kinematics (sf_channel, mci_work%get_x_strfun ())
call k%sf_chain%get_out_momenta (p(1:k%n_in))
call k%phs%set_incoming_momenta (p(1:k%n_in))
call k%phs%compute_flux ()
call k%phs%select_channel (phs_channel)
call k%phs%evaluate_selected_channel (phs_channel, &
mci_work%get_x_process ())
select type (phs => k%phs)
type is (phs_fks_t)
if (debug_on) call msg_debug2 (D_REAL, "phase space is phs_FKS")
if (phs%q_defined) then
call phs%get_born_momenta (p)
if (debug_on) then
call msg_debug2 (D_REAL, "q is defined")
call msg_debug2 (D_REAL, "get_born_momenta called")
end if
k%phs_factor = phs%get_overall_factor ()
success = .true.
else
k%phs_factor = 0
success = .false.
end if
class default
if (phs%q_defined) then
call k%phs%get_outgoing_momenta (p(k%n_in + 1 :))
k%phs_factor = k%phs%get_overall_factor ()
success = .true.
else
k%phs_factor = 0
success = .false.
end if
end select
end subroutine kinematics_compute_selected_channel
@ %def kinematics_compute_selected_channel
@
<<Kinematics: kinematics: TBP>>=
procedure :: redo_sf_chain => kinematics_redo_sf_chain
<<Kinematics: sub interfaces>>=
module subroutine kinematics_redo_sf_chain (kin, mci_work, phs_channel)
class(kinematics_t), intent(inout) :: kin
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
end subroutine kinematics_redo_sf_chain
<<Kinematics: procedures>>=
module subroutine kinematics_redo_sf_chain (kin, mci_work, phs_channel)
class(kinematics_t), intent(inout) :: kin
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
real(default), dimension(:), allocatable :: x
integer :: sf_channel, n
real(default) :: xi, y
n = size (mci_work%get_x_strfun ())
if (n > 0) then
allocate (x(n))
x = mci_work%get_x_strfun ()
sf_channel = kin%phs%config%get_sf_channel (phs_channel)
call kin%sf_chain%compute_kinematics (sf_channel, x)
end if
end subroutine kinematics_redo_sf_chain
@ %def kinematics_redo_sf_chain
@ Complete kinematics by filling the non-selected phase-space parameter
arrays.
<<Kinematics: kinematics: TBP>>=
procedure :: compute_other_channels => kinematics_compute_other_channels
<<Kinematics: sub interfaces>>=
module subroutine kinematics_compute_other_channels &
(k, mci_work, phs_channel)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
end subroutine kinematics_compute_other_channels
<<Kinematics: procedures>>=
module subroutine kinematics_compute_other_channels (k, mci_work, phs_channel)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
integer :: c, c_sf
call k%phs%evaluate_other_channels (phs_channel)
do c = 1, k%n_channel
c_sf = k%phs%config%get_sf_channel (c)
k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
end do
end subroutine kinematics_compute_other_channels
@ %def kinematics_compute_other_channels
@ Just fetch the outgoing momenta of the [[sf_chain]] subobject, which
become the incoming (seed) momenta of the hard interaction.
This is a stripped down-version of the above which we use when
recovering kinematics. Momenta are known, but no MC parameters yet.
(We do not use the [[get_out_momenta]] method of the chain, since this
relies on the structure-function interactions, which are not necessary
filled here. We do rely on the momenta of the last evaluator in the
chain, however.)
<<Kinematics: kinematics: TBP>>=
procedure :: get_incoming_momenta => kinematics_get_incoming_momenta
<<Kinematics: sub interfaces>>=
module subroutine kinematics_get_incoming_momenta (k, p)
class(kinematics_t), intent(in) :: k
type(vector4_t), dimension(:), intent(out) :: p
end subroutine kinematics_get_incoming_momenta
<<Kinematics: procedures>>=
module subroutine kinematics_get_incoming_momenta (k, p)
class(kinematics_t), intent(in) :: k
type(vector4_t), dimension(:), intent(out) :: p
type(interaction_t), pointer :: int
integer :: i
int => k%sf_chain%get_out_int_ptr ()
do i = 1, k%n_in
p(i) = int%get_momentum (k%sf_chain%get_out_i (i))
end do
end subroutine kinematics_get_incoming_momenta
@ %def kinematics_get_incoming_momenta
@
<<Kinematics: kinematics: TBP>>=
procedure :: get_boost_to_lab => kinematics_get_boost_to_lab
<<Kinematics: sub interfaces>>=
module function kinematics_get_boost_to_lab (kin) result (lt)
type(lorentz_transformation_t) :: lt
class(kinematics_t), intent(in) :: kin
- end function kinematics_get_boost_to_lab
+ end function kinematics_get_boost_to_lab
<<Kinematics: procedures>>=
module function kinematics_get_boost_to_lab (kin) result (lt)
type(lorentz_transformation_t) :: lt
class(kinematics_t), intent(in) :: kin
lt = kin%phs%get_lorentz_transformation ()
end function kinematics_get_boost_to_lab
@ %def kinematics_get_boost_to_lab
@
<<Kinematics: kinematics: TBP>>=
procedure :: get_boost_to_cms => kinematics_get_boost_to_cms
<<Kinematics: sub interfaces>>=
module function kinematics_get_boost_to_cms (kin) result (lt)
type(lorentz_transformation_t) :: lt
class(kinematics_t), intent(in) :: kin
end function kinematics_get_boost_to_cms
<<Kinematics: procedures>>=
module function kinematics_get_boost_to_cms (kin) result (lt)
type(lorentz_transformation_t) :: lt
class(kinematics_t), intent(in) :: kin
lt = inverse (kin%phs%get_lorentz_transformation ())
end function kinematics_get_boost_to_cms
@ %def kinematics_get_boost_to_cms
@ This inverts the remainder of the above [[compute]] method. We know
the momenta and recover the rest, as far as needed. If we select a
channel, we can complete the inversion and reconstruct the
MC parameter set.
<<Kinematics: kinematics: TBP>>=
procedure :: recover_mcpar => kinematics_recover_mcpar
<<Kinematics: sub interfaces>>=
module subroutine kinematics_recover_mcpar (k, mci_work, phs_channel, p)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(in) :: p
end subroutine kinematics_recover_mcpar
<<Kinematics: procedures>>=
module subroutine kinematics_recover_mcpar (k, mci_work, phs_channel, p)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(in) :: p
integer :: c, c_sf
real(default), dimension(:), allocatable :: x_sf, x_phs
c = phs_channel
c_sf = k%phs%config%get_sf_channel (c)
k%selected_channel = c
call k%sf_chain%recover_kinematics (c_sf)
call k%phs%set_incoming_momenta (p(1:k%n_in))
call k%phs%compute_flux ()
call k%phs%set_outgoing_momenta (p(k%n_in+1:))
call k%phs%inverse ()
do c = 1, k%n_channel
c_sf = k%phs%config%get_sf_channel (c)
k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
end do
k%phs_factor = k%phs%get_overall_factor ()
c = phs_channel
c_sf = k%phs%config%get_sf_channel (c)
allocate (x_sf (k%sf_chain%config%get_n_bound ()))
allocate (x_phs (k%phs%config%get_n_par ()))
call k%phs%select_channel (c)
call k%sf_chain%get_mcpar (c_sf, x_sf)
call k%phs%get_mcpar (c, x_phs)
call mci_work%set_x_strfun (x_sf)
call mci_work%set_x_process (x_phs)
end subroutine kinematics_recover_mcpar
@ %def kinematics_recover_mcpar
@ This first part of [[recover_mcpar]]: just handle the sfchain.
<<Kinematics: kinematics: TBP>>=
procedure :: recover_sfchain => kinematics_recover_sfchain
<<Kinematics: sub interfaces>>=
module subroutine kinematics_recover_sfchain (k, channel, p)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: channel
type(vector4_t), dimension(:), intent(in) :: p
end subroutine kinematics_recover_sfchain
<<Kinematics: procedures>>=
module subroutine kinematics_recover_sfchain (k, channel, p)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: channel
type(vector4_t), dimension(:), intent(in) :: p
k%selected_channel = channel
call k%sf_chain%recover_kinematics (channel)
end subroutine kinematics_recover_sfchain
@ %def kinematics_recover_sfchain
@ Retrieve the MC input parameter array for a specific channel. We assume
that the kinematics is complete, so this is known for all channels.
<<Kinematics: kinematics: TBP>>=
procedure :: get_mcpar => kinematics_get_mcpar
<<Kinematics: sub interfaces>>=
module subroutine kinematics_get_mcpar (k, phs_channel, r)
class(kinematics_t), intent(in) :: k
integer, intent(in) :: phs_channel
real(default), dimension(:), intent(out) :: r
end subroutine kinematics_get_mcpar
<<Kinematics: procedures>>=
module subroutine kinematics_get_mcpar (k, phs_channel, r)
class(kinematics_t), intent(in) :: k
integer, intent(in) :: phs_channel
real(default), dimension(:), intent(out) :: r
integer :: sf_channel, n_par_sf, n_par_phs
sf_channel = k%phs%config%get_sf_channel (phs_channel)
n_par_phs = k%phs%config%get_n_par ()
n_par_sf = k%sf_chain%config%get_n_bound ()
if (n_par_sf > 0) then
call k%sf_chain%get_mcpar (sf_channel, r(1:n_par_sf))
end if
if (n_par_phs > 0) then
call k%phs%get_mcpar (phs_channel, r(n_par_sf+1:))
end if
end subroutine kinematics_get_mcpar
@ %def kinematics_get_mcpar
@ Evaluate the structure function chain, assuming that kinematics is known.
The status must be precisely [[SF_DONE_KINEMATICS]]. We thus avoid
evaluating the chain twice via different pointers to the same target.
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_sf_chain => kinematics_evaluate_sf_chain
<<Kinematics: sub interfaces>>=
module subroutine kinematics_evaluate_sf_chain &
(k, fac_scale, negative_sf, sf_rescale)
class(kinematics_t), intent(inout) :: k
real(default), intent(in) :: fac_scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(inout), optional :: sf_rescale
- end subroutine kinematics_evaluate_sf_chain
+ end subroutine kinematics_evaluate_sf_chain
<<Kinematics: procedures>>=
module subroutine kinematics_evaluate_sf_chain &
(k, fac_scale, negative_sf, sf_rescale)
class(kinematics_t), intent(inout) :: k
real(default), intent(in) :: fac_scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(inout), optional :: sf_rescale
select case (k%sf_chain%get_status ())
case (SF_DONE_KINEMATICS)
call k%sf_chain%evaluate (fac_scale, negative_sf = negative_sf, &
sf_rescale = sf_rescale)
end select
end subroutine kinematics_evaluate_sf_chain
@ %def kinematics_evaluate_sf_chain
@ Recover beam momenta, i.e., return the beam momenta stored in the
current [[sf_chain]] to their source. This is a side effect.
<<Kinematics: kinematics: TBP>>=
procedure :: return_beam_momenta => kinematics_return_beam_momenta
<<Kinematics: sub interfaces>>=
module subroutine kinematics_return_beam_momenta (k)
class(kinematics_t), intent(in) :: k
- end subroutine kinematics_return_beam_momenta
+ end subroutine kinematics_return_beam_momenta
<<Kinematics: procedures>>=
module subroutine kinematics_return_beam_momenta (k)
class(kinematics_t), intent(in) :: k
call k%sf_chain%return_beam_momenta ()
end subroutine kinematics_return_beam_momenta
@ %def kinematics_return_beam_momenta
@ Check wether the phase space is configured in the center-of-mass frame.
Relevant for using the proper momenta input for BLHA matrix elements.
<<Kinematics: kinematics: TBP>>=
procedure :: lab_is_cm => kinematics_lab_is_cm
<<Kinematics: sub interfaces>>=
module function kinematics_lab_is_cm (k) result (lab_is_cm)
logical :: lab_is_cm
class(kinematics_t), intent(in) :: k
end function kinematics_lab_is_cm
<<Kinematics: procedures>>=
module function kinematics_lab_is_cm (k) result (lab_is_cm)
logical :: lab_is_cm
class(kinematics_t), intent(in) :: k
lab_is_cm = k%phs%config%lab_is_cm
end function kinematics_lab_is_cm
@ %def kinematics_lab_is_cm
@
<<Kinematics: kinematics: TBP>>=
procedure :: modify_momenta_for_subtraction => &
kinematics_modify_momenta_for_subtraction
<<Kinematics: sub interfaces>>=
module subroutine kinematics_modify_momenta_for_subtraction (k, p_in, p_out)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
end subroutine kinematics_modify_momenta_for_subtraction
<<Kinematics: procedures>>=
module subroutine kinematics_modify_momenta_for_subtraction (k, p_in, p_out)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
allocate (p_out (size (p_in)))
if (k%threshold) then
select type (phs => k%phs)
type is (phs_fks_t)
p_out = phs%get_onshell_projected_momenta ()
end select
else
p_out = p_in
end if
end subroutine kinematics_modify_momenta_for_subtraction
@ %def kinematics_modify_momenta_for_subtraction
@
<<Kinematics: kinematics: TBP>>=
procedure :: threshold_projection => kinematics_threshold_projection
<<Kinematics: sub interfaces>>=
module subroutine kinematics_threshold_projection (k, pcm_work, nlo_type)
class(kinematics_t), intent(inout) :: k
type(pcm_nlo_workspace_t), intent(inout) :: pcm_work
integer, intent(in) :: nlo_type
end subroutine kinematics_threshold_projection
<<Kinematics: procedures>>=
module subroutine kinematics_threshold_projection (k, pcm_work, nlo_type)
class(kinematics_t), intent(inout) :: k
type(pcm_nlo_workspace_t), intent(inout) :: pcm_work
integer, intent(in) :: nlo_type
real(default) :: sqrts, mtop
type(lorentz_transformation_t) :: L_to_cms
type(vector4_t), dimension(:), allocatable :: p_tot, p_onshell
integer :: n_tot
n_tot = k%phs%get_n_tot ()
allocate (p_tot (size (pcm_work%real_kinematics%p_born_cms%phs_point(1))))
select type (phs => k%phs)
type is (phs_fks_t)
p_tot = pcm_work%real_kinematics%p_born_cms%phs_point(1)
class default
p_tot(1 : k%n_in) = phs%p
p_tot(k%n_in + 1 : n_tot) = phs%q
end select
sqrts = sum (p_tot (1:k%n_in))**1
mtop = m1s_to_mpole (sqrts)
L_to_cms = get_boost_for_threshold_projection (p_tot, sqrts, mtop)
call pcm_work%real_kinematics%p_born_cms%set_momenta (1, p_tot)
p_onshell = pcm_work%real_kinematics%p_born_onshell%phs_point(1)
call threshold_projection_born (mtop, L_to_cms, p_tot, p_onshell)
pcm_work%real_kinematics%p_born_onshell%phs_point(1) = p_onshell
if (debug2_active (D_THRESHOLD)) then
print *, 'On-shell projected Born: '
call vector4_write_set (p_onshell)
end if
end subroutine kinematics_threshold_projection
@ %def kinematics_threshold_projection
@
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_radiation => kinematics_evaluate_radiation
<<Kinematics: sub interfaces>>=
module subroutine kinematics_evaluate_radiation (k, p_in, p_out, success)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
logical, intent(out) :: success
end subroutine kinematics_evaluate_radiation
<<Kinematics: procedures>>=
module subroutine kinematics_evaluate_radiation (k, p_in, p_out, success)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
logical, intent(out) :: success
type(vector4_t), dimension(:), allocatable :: p_real
type(vector4_t), dimension(:), allocatable :: p_born
real(default) :: xi_max_offshell, xi_offshell, y_offshell, jac_rand_dummy, phi
select type (phs => k%phs)
type is (phs_fks_t)
allocate (p_born (size (p_in)))
if (k%threshold) then
p_born = phs%get_onshell_projected_momenta ()
else
p_born = p_in
end if
if (.not. k%phs%lab_is_cm () .and. .not. k%threshold) then
p_born = inverse (k%phs%lt_cm_to_lab) * p_born
end if
call phs%compute_xi_max (p_born, k%threshold)
if (k%emitter >= 0) then
allocate (p_real (size (p_born) + 1))
allocate (p_out (size (p_born) + 1))
if (k%emitter <= k%n_in) then
call phs%generate_isr (k%i_phs, p_real)
else
if (k%threshold) then
jac_rand_dummy = 1._default
call compute_y_from_emitter (phs%generator%real_kinematics%x_rad (I_Y), &
phs%generator%real_kinematics%p_born_cms%get_momenta(1), &
k%n_in, k%emitter, .false., phs%generator%y_max, jac_rand_dummy, &
y_offshell)
call phs%compute_xi_max (k%emitter, k%i_phs, y_offshell, &
phs%generator%real_kinematics%p_born_cms%get_momenta(1), &
xi_max_offshell)
xi_offshell = xi_max_offshell * phs%generator%real_kinematics%xi_tilde
phi = phs%generator%real_kinematics%phi
call phs%generate_fsr (k%emitter, k%i_phs, p_real, &
xi_y_phi = [xi_offshell, y_offshell, phi], no_jacobians = .true.)
call phs%generator%real_kinematics%p_real_cms%set_momenta (k%i_phs, p_real)
call phs%generate_fsr_threshold (k%emitter, k%i_phs, p_real)
if (debug2_active (D_SUBTRACTION)) &
call generate_fsr_threshold_for_other_emitters (k%emitter, k%i_phs)
else if (k%i_con > 0) then
call phs%generate_fsr (k%emitter, k%i_phs, p_real, k%i_con)
else
call phs%generate_fsr (k%emitter, k%i_phs, p_real)
end if
end if
success = check_scalar_products (p_real)
if (debug2_active (D_SUBTRACTION)) then
call msg_debug2 (D_SUBTRACTION, "Real phase-space: ")
call vector4_write_set (p_real)
end if
p_out = p_real
else
allocate (p_out (size (p_in))); p_out = p_in
success = .true.
end if
end select
contains
subroutine generate_fsr_threshold_for_other_emitters (emitter, i_phs)
integer, intent(in) :: emitter, i_phs
integer :: ii_phs, this_emitter
select type (phs => k%phs)
type is (phs_fks_t)
do ii_phs = 1, size (phs%phs_identifiers)
this_emitter = phs%phs_identifiers(ii_phs)%emitter
if (ii_phs /= i_phs .and. this_emitter /= emitter) &
call phs%generate_fsr_threshold (this_emitter, i_phs)
end do
end select
end subroutine
end subroutine kinematics_evaluate_radiation
@ %def kinematics_evaluate_radiation
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Instances}
<<[[instances.f90]]>>=
<<File header>>
module instances
<<Use kinds>>
<<Use strings>>
use lorentz
use mci_base
use particles
use sm_qcd, only: qcd_t
use quantum_numbers
use interactions
use model_data
use variables
use sf_base
use pdf, only: pdf_data_t
use physics_defs
use process_constants
use state_matrices
use phs_base
use prc_core, only: prc_core_t, prc_core_state_t
!!! local modules
use parton_states
use process_counter
use pcm_base
use pcm
use process_config
use process_mci
use process
use kinematics
<<Standard module head>>
<<Instances: public>>
<<Instances: types>>
<<Instances: interfaces>>
interface
<<Instances: sub interfaces>>
end interface
contains
<<Instances: main procedures>>
end module instances
@ %def instances
@
<<[[instances_sub.f90]]>>=
<<File header>>
submodule (instances) instances_s
<<Use debug>>
use io_units
use format_utils, only: write_separator
use constants
use diagnostics
use numeric_utils
use helicities
use flavors
use pdg_arrays, only: is_quark, is_charged_lepton, flv_eqv_expr_class
!!! We should depend less on these modules (move it to pcm_nlo_t e.g.)
use phs_wood, only: phs_wood_t
use phs_fks
use blha_olp_interfaces, only: prc_blha_t
use blha_config, only: BLHA_AMP_COLOR_C
use prc_external, only: prc_external_t, prc_external_state_t
use prc_threshold, only: prc_threshold_t
use blha_olp_interfaces, only: blha_result_array_size
use prc_openloops, only: prc_openloops_t, openloops_state_t
use prc_recola, only: prc_recola_t
use blha_olp_interfaces, only: blha_color_c_fill_offdiag, blha_color_c_fill_diag
use ttv_formfactors, only: m1s_to_mpole
implicit none
contains
<<Instances: procedures>>
end submodule instances_s
@ %def instances_s
@
\subsection{Term instance}
A [[term_instance_t]] object contains all data that describe a term. Each
process component consists of one or more distinct terms which may differ in
kinematics, but whose squared transition matrices have to be added pointwise.
The [[active]] flag is set when this term is connected to an active
process component. Inactive terms are skipped for kinematics and evaluation.
The [[amp]] array stores the amplitude values when we get them from evaluating
the associated matrix-element code.
The [[int_hard]] interaction describes the elementary hard process.
It receives the momenta and the amplitude entries for each sampling point.
The [[isolated]] object holds the effective parton state for the
elementary interaction. The amplitude entries are
computed from [[int_hard]].
The [[connected]] evaluator set
convolutes this scattering matrix with the beam (and possibly
structure-function) density matrix.
The [[checked]] flag is set once we have applied cuts on this term.
The result of this is stored in the [[passed]] flag.
Although each [[term_instance]] carries a [[weight]], this currently
always keeps the value $1$ and is only used to be given to routines
to fulfill their signature.
<<Instances: types>>=
type :: term_instance_t
type(process_term_t), pointer :: config => null ()
class(pcm_t), pointer :: pcm => null ()
class(pcm_workspace_t), pointer :: pcm_work => null ()
logical :: active = .false.
complex(default), dimension(:), allocatable :: amp
type(interaction_t) :: int_hard
type(isolated_state_t) :: isolated
type(connected_state_t) :: connected
class(prc_core_state_t), allocatable :: core_state
logical :: checked = .false.
logical :: passed = .false.
logical, dimension(:), allocatable :: passed_array
integer, dimension(:), allocatable :: i_flv_to_i_flv_rep
real(default) :: scale = 0
real(default), allocatable :: fac_scale
real(default), allocatable :: ren_scale
real(default), allocatable :: es_scale
real(default), allocatable :: alpha_qcd_forced
real(default) :: weight = 1
type(vector4_t), dimension(:), allocatable :: p_seed
type(vector4_t), dimension(:), allocatable :: p_hard
integer :: nlo_type = BORN
integer, dimension(:), allocatable :: same_kinematics
logical :: negative_sf = .false.
logical :: flv_dep_cut_eval = .false.
contains
<<Instances: term instance: TBP>>
end type term_instance_t
@ %def term_instance_t
@
<<Instances: term instance: TBP>>=
procedure :: write => term_instance_write
<<Instances: sub interfaces>>=
module subroutine term_instance_write &
(term, unit, kin, show_eff_state, testflag)
class(term_instance_t), intent(in) :: term
integer, intent(in), optional :: unit
type(kinematics_t), intent(in), optional :: kin
logical, intent(in), optional :: show_eff_state
logical, intent(in), optional :: testflag
end subroutine term_instance_write
<<Instances: procedures>>=
module subroutine term_instance_write &
(term, unit, kin, show_eff_state, testflag)
class(term_instance_t), intent(in) :: term
integer, intent(in), optional :: unit
type(kinematics_t), intent(in), optional :: kin
logical, intent(in), optional :: show_eff_state
logical, intent(in), optional :: testflag
real(default) :: fac_scale, ren_scale
integer :: u
logical :: state
u = given_output_unit (unit)
state = .true.; if (present (show_eff_state)) state = show_eff_state
if (term%active) then
if (associated (term%config)) then
write (u, "(1x,A,I0,A,I0,A)") "Term #", term%config%i_term, &
" (component #", term%config%i_component, ")"
else
write (u, "(1x,A)") "Term [undefined]"
end if
else
write (u, "(1x,A,I0,A)") "Term #", term%config%i_term, &
" [inactive]"
end if
if (term%checked) then
write (u, "(3x,A,L1)") "passed cuts = ", term%passed
end if
if (term%passed) then
write (u, "(3x,A,ES19.12)") "overall scale = ", term%scale
write (u, "(3x,A,ES19.12)") "factorization scale = ", term%get_fac_scale ()
write (u, "(3x,A,ES19.12)") "renormalization scale = ", term%get_ren_scale ()
if (allocated (term%alpha_qcd_forced)) then
write (u, "(3x,A,ES19.12)") "alpha(QCD) forced = ", &
term%alpha_qcd_forced
end if
write (u, "(3x,A,ES19.12)") "reweighting factor = ", term%weight
end if
!!! This used to be a member of term_instance
if (present (kin)) then
call kin%write (u)
end if
call write_separator (u)
write (u, "(1x,A)") "Amplitude (transition matrix of the &
&hard interaction):"
call write_separator (u)
call term%int_hard%basic_write (u, testflag = testflag)
if (state .and. term%isolated%has_trace) then
call write_separator (u)
write (u, "(1x,A)") "Evaluators for the hard interaction:"
call term%isolated%write (u, testflag = testflag)
end if
if (state .and. term%connected%has_trace) then
call write_separator (u)
write (u, "(1x,A)") "Evaluators for the connected process:"
call term%connected%write (u, testflag = testflag)
end if
end subroutine term_instance_write
@ %def term_instance_write
@ The interactions and evaluators must be finalized.
<<Instances: term instance: TBP>>=
procedure :: final => term_instance_final
<<Instances: sub interfaces>>=
module subroutine term_instance_final (term)
class(term_instance_t), intent(inout) :: term
end subroutine term_instance_final
<<Instances: procedures>>=
module subroutine term_instance_final (term)
class(term_instance_t), intent(inout) :: term
if (allocated (term%amp)) deallocate (term%amp)
if (allocated (term%core_state)) deallocate (term%core_state)
if (allocated (term%ren_scale)) deallocate (term%ren_scale)
if (allocated (term%fac_scale)) deallocate (term%fac_scale)
if (allocated (term%es_scale)) deallocate (term%es_scale)
if (allocated (term%alpha_qcd_forced)) &
deallocate (term%alpha_qcd_forced)
if (allocated (term%p_seed)) deallocate(term%p_seed)
if (allocated (term%p_hard)) deallocate (term%p_hard)
call term%connected%final ()
call term%isolated%final ()
call term%int_hard%final ()
term%pcm => null ()
term%pcm_work => null ()
end subroutine term_instance_final
@ %def term_instance_final
@ For a new term object, we configure the structure-function
interface, the phase space, the matrix-element (interaction)
interface, etc.
<<Instances: term instance: TBP>>=
procedure :: configure => term_instance_configure
<<Instances: sub interfaces>>=
module subroutine term_instance_configure &
(term_instance, process, i, pcm_work, sf_chain, kin)
class(term_instance_t), intent(out), target :: term_instance
type(process_t), intent(in), target :: process
integer, intent(in) :: i
class(pcm_workspace_t), intent(in), target :: pcm_work
type(sf_chain_t), intent(in), target :: sf_chain
type(kinematics_t), intent(inout), target :: kin
end subroutine term_instance_configure
<<Instances: procedures>>=
module subroutine term_instance_configure &
(term_instance, process, i, pcm_work, sf_chain, kin)
class(term_instance_t), intent(out), target :: term_instance
type(process_t), intent(in), target :: process
integer, intent(in) :: i
class(pcm_workspace_t), intent(in), target :: pcm_work
type(sf_chain_t), intent(in), target :: sf_chain
type(kinematics_t), intent(inout), target :: kin
type(process_term_t) :: term
integer :: i_component
logical :: requires_extended_sf
term = process%get_term_ptr (i)
i_component = term%i_component
if (i_component /= 0) then
call term_instance%init &
(process%get_pcm_ptr (), pcm_work, process%get_nlo_type_component (i_component))
requires_extended_sf = term_instance%nlo_type == NLO_DGLAP .or. &
(term_instance%nlo_type == NLO_REAL .and. process%get_i_sub (i) == i)
call term_instance%setup_dynamics (process, i, kin, &
real_finite = process%component_is_real_finite (i_component))
select type (phs => kin%phs)
type is (phs_fks_t)
call term_instance%set_emitter (kin)
call term_instance%setup_fks_kinematics (kin, &
process%get_var_list_ptr (), &
process%get_beam_config_ptr ())
end select
select type (pcm => term_instance%pcm)
type is (pcm_nlo_t)
call kin%set_threshold (pcm%settings%factorization_mode)
end select
call term_instance%setup_expressions (process%get_meta (), process%get_config ())
end if
end subroutine term_instance_configure
@ %def term_instance_configure
@ First part of term-instance configuration: initialize by assigning
pointers to the overall [[pcm]] and the associated [[pcm_workspace]]
objects.
<<Instances: term instance: TBP>>=
procedure :: init => term_instance_init
<<Instances: sub interfaces>>=
module subroutine term_instance_init &
(term_instance, pcm, pcm_work, nlo_type)
class(term_instance_t), intent(out) :: term_instance
class(pcm_t), intent(in), target :: pcm
class(pcm_workspace_t), intent(in), target :: pcm_work
integer, intent(in) :: nlo_type
end subroutine term_instance_init
<<Instances: procedures>>=
module subroutine term_instance_init (term_instance, pcm, pcm_work, nlo_type)
class(term_instance_t), intent(out) :: term_instance
class(pcm_t), intent(in), target :: pcm
class(pcm_workspace_t), intent(in), target :: pcm_work
integer, intent(in) :: nlo_type
term_instance%pcm => pcm
term_instance%pcm_work => pcm_work
term_instance%nlo_type = nlo_type
end subroutine term_instance_init
@ %def term_instance_init
@ The second part of term-instance configuration concerns dynamics, i.e., the
interface to the matrix-element (interaction), and the parton-state
objects that combine all kinematics and matrix-element data for evaluation.
The hard interaction (incoming momenta) is linked to the structure
function instance. In the isolated state, we either set pointers to
both, or we create modified copies ([[rearrange]]) as effective
structure-function chain and interaction, respectively.
Finally, we set up the [[subevt]] component that will be used for
evaluating observables, collecting particles from the trace evaluator
in the effective connected state. Their quantum numbers must be
determined by following back source links and set explicitly, since
they are already eliminated in that trace.
The [[rearrange]] parts are still commented out; they could become
relevant for a NLO algorithm.
<<Instances: term instance: TBP>>=
procedure :: setup_dynamics => term_instance_setup_dynamics
<<Instances: sub interfaces>>=
module subroutine term_instance_setup_dynamics &
(term, process, i_term, kin, real_finite)
class(term_instance_t), intent(inout), target :: term
type(process_t), intent(in), target:: process
integer, intent(in) :: i_term
type(kinematics_t), intent(in) :: kin
logical, intent(in), optional :: real_finite
end subroutine term_instance_setup_dynamics
<<Instances: procedures>>=
module subroutine term_instance_setup_dynamics &
(term, process, i_term, kin, real_finite)
class(term_instance_t), intent(inout), target :: term
type(process_t), intent(in), target:: process
integer, intent(in) :: i_term
type(kinematics_t), intent(in) :: kin
logical, intent(in), optional :: real_finite
class(prc_core_t), pointer :: core => null ()
type(process_beam_config_t) :: beam_config
type(interaction_t), pointer :: sf_chain_int
type(interaction_t), pointer :: src_int
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
type(state_matrix_t), pointer :: state_matrix
type(flavor_t), dimension(:), allocatable :: flv_int, flv_src, f_in, f_out
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(flavor_t), dimension(:,:), allocatable :: flv_pdf
type(quantum_numbers_t), dimension(:,:), allocatable :: qn_pdf
integer :: n_in, n_vir, n_out, n_tot, n_sub
integer :: n_flv_born, n_flv_real, n_flv_total
integer :: i, j
logical :: me_already_squared, keep_fs_flavors
logical :: decrease_n_tot
logical :: requires_extended_sf
me_already_squared = .false.
keep_fs_flavors = .false.
term%config => process%get_term_ptr (i_term)
term%int_hard = term%config%int
core => process%get_core_term (i_term)
term%negative_sf = process%get_negative_sf ()
call core%allocate_workspace (term%core_state)
select type (core)
class is (prc_external_t)
call reduce_interaction (term%int_hard, &
core%includes_polarization (), .true., .false.)
me_already_squared = .true.
allocate (term%amp (term%int_hard%get_n_matrix_elements ()))
class default
allocate (term%amp (term%config%n_allowed))
end select
if (allocated (term%core_state)) then
select type (core_state => term%core_state)
type is (openloops_state_t)
call core_state%init_threshold (process%get_model_ptr ())
end select
end if
term%amp = cmplx (0, 0, default)
decrease_n_tot = term%nlo_type == NLO_REAL .and. &
term%config%i_term_global /= term%config%i_sub
if (present (real_finite)) then
if (real_finite) decrease_n_tot = .false.
end if
if (decrease_n_tot) then
allocate (term%p_seed (term%int_hard%get_n_tot () - 1))
else
allocate (term%p_seed (term%int_hard%get_n_tot ()))
end if
allocate (term%p_hard (term%int_hard%get_n_tot ()))
sf_chain_int => kin%sf_chain%get_out_int_ptr ()
n_in = term%int_hard%get_n_in ()
do j = 1, n_in
i = kin%sf_chain%get_out_i (j)
call term%int_hard%set_source_link (j, sf_chain_int, i)
end do
call term%isolated%init (kin%sf_chain, term%int_hard)
allocate (mask_in (n_in))
mask_in = kin%sf_chain%get_out_mask ()
select type (phs => kin%phs)
type is (phs_wood_t)
if (me_already_squared) then
call term%isolated%setup_identity_trace &
(core, mask_in, .true., .false.)
else
call term%isolated%setup_square_trace &
(core, mask_in, term%config%col, .false.)
end if
type is (phs_fks_t)
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
if (me_already_squared) then
call term%isolated%setup_identity_trace &
(core, mask_in, .true., .false.)
else
keep_fs_flavors = term%config%data%n_flv > 1
call term%isolated%setup_square_trace &
(core, mask_in, term%config%col, &
keep_fs_flavors)
end if
case (PHS_MODE_COLLINEAR_REMNANT)
if (me_already_squared) then
call term%isolated%setup_identity_trace &
(core, mask_in, .true., .false.)
else
call term%isolated%setup_square_trace &
(core, mask_in, term%config%col, .false.)
end if
end select
class default
call term%isolated%setup_square_trace &
(core, mask_in, term%config%col, .false.)
end select
if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL .and. &
term%config%i_term_global == term%config%i_sub) .or. &
term%nlo_type == NLO_MISMATCH) then
n_sub = term%get_n_sub ()
else if (term%nlo_type == NLO_DGLAP) then
n_sub = n_beams_rescaled + term%get_n_sub ()
else
!!! No integration of real subtraction in interactions yet
n_sub = 0
end if
keep_fs_flavors = keep_fs_flavors .or. me_already_squared
requires_extended_sf = term%nlo_type == NLO_DGLAP .or. &
(term%is_subtraction () .and. process%pcm_contains_pdfs ())
call term%connected%setup_connected_trace (term%isolated, &
undo_helicities = undo_helicities (core, me_already_squared), &
keep_fs_flavors = keep_fs_flavors, &
requires_extended_sf = requires_extended_sf)
associate (int_eff => term%isolated%int_eff)
state_matrix => int_eff%get_state_matrix_ptr ()
n_tot = int_eff%get_n_tot ()
flv_int = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (1))
allocate (f_in (n_in))
f_in = flv_int(1:n_in)
deallocate (flv_int)
end associate
n_in = term%connected%trace%get_n_in ()
n_vir = term%connected%trace%get_n_vir ()
n_out = term%connected%trace%get_n_out ()
allocate (f_out (n_out))
do j = 1, n_out
call term%connected%trace%find_source &
(n_in + n_vir + j, src_int, i)
if (associated (src_int)) then
state_matrix => src_int%get_state_matrix_ptr ()
flv_src = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (1))
f_out(j) = flv_src(i)
deallocate (flv_src)
end if
end do
beam_config = process%get_beam_config ()
select type (pcm => term%pcm)
type is (pcm_nlo_t)
term%flv_dep_cut_eval = pcm%settings%nlo_correction_type == "EW" &
.and. pcm%region_data%alphas_power > 0 &
.and. any(is_charged_lepton(f_out%get_pdg()))
end select
call term%connected%setup_subevt (term%isolated%sf_chain_eff, &
beam_config%data%flv, f_in, f_out)
call term%connected%setup_var_list &
(process%get_var_list_ptr (), beam_config%data)
! Does connected%trace never have any helicity qn?
call term%init_interaction_qn_index (core, term%connected%trace, n_sub, &
process%get_model_ptr (), is_polarized = .false.)
call term%init_interaction_qn_index &
(core, term%int_hard, n_sub, process%get_model_ptr ())
call term%init_eqv_expr_classes ()
if (requires_extended_sf) then
select type (pcm => term%pcm)
type is (pcm_nlo_t)
n_in = pcm%region_data%get_n_in ()
flv_born = pcm%region_data%get_flv_states_born ()
flv_real = pcm%region_data%get_flv_states_real ()
n_flv_born = pcm%region_data%get_n_flv_born ()
n_flv_real = pcm%region_data%get_n_flv_real ()
n_flv_total = n_flv_born + n_flv_real
allocate (flv_pdf(n_in, n_flv_total), &
qn_pdf(n_in, n_flv_total))
call flv_pdf(:, :n_flv_born)%init (flv_born(:n_in, :))
call flv_pdf(:, n_flv_born + 1:n_flv_total)%init (flv_real(:n_in, :))
call qn_pdf%init (flv_pdf)
call sf_chain_int%init_qn_index (qn_pdf, n_flv_born, n_flv_real)
end select
end if
contains
function undo_helicities (core, me_squared) result (val)
logical :: val
class(prc_core_t), intent(in) :: core
logical, intent(in) :: me_squared
select type (core)
class is (prc_external_t)
val = me_squared .and. .not. core%includes_polarization ()
class default
val = .false.
end select
end function undo_helicities
subroutine reduce_interaction (int, polarized_beams, keep_fs_flavors, &
keep_colors)
type(interaction_t), intent(inout) :: int
logical, intent(in) :: polarized_beams
logical, intent(in) :: keep_fs_flavors, keep_colors
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
logical, dimension(:), allocatable :: mask_f, mask_c, mask_h
integer :: n_tot, n_in
n_in = int%get_n_in (); n_tot = int%get_n_tot ()
allocate (qn_mask (n_tot))
allocate (mask_f (n_tot), mask_c (n_tot), mask_h (n_tot))
mask_c = .not. keep_colors
mask_f (1 : n_in) = .false.
if (keep_fs_flavors) then
mask_f (n_in + 1 : ) = .false.
else
mask_f (n_in + 1 : ) = .true.
end if
if (polarized_beams) then
mask_h (1 : n_in) = .false.
else
mask_h (1 : n_in) = .true.
end if
mask_h (n_in + 1 : ) = .true.
call qn_mask%init (mask_f, mask_c, mask_h)
call int%reduce_state_matrix (qn_mask, keep_order = .true.)
end subroutine reduce_interaction
end subroutine term_instance_setup_dynamics
@ %def term_instance_setup_dynamics
@ Set up index mapping from state matrix to index pair [[i_flv]], [[i_sub]].
<<Instances: public>>=
public :: setup_interaction_qn_index
<<Instances: sub interfaces>>=
module subroutine setup_interaction_qn_index &
(int, data, qn_config, n_sub, is_polarized)
class(interaction_t), intent(inout) :: int
class(process_constants_t), intent(in) :: data
type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_config
integer, intent(in) :: n_sub
logical, intent(in) :: is_polarized
end subroutine setup_interaction_qn_index
<<Instances: procedures>>=
module subroutine setup_interaction_qn_index &
(int, data, qn_config, n_sub, is_polarized)
class(interaction_t), intent(inout) :: int
class(process_constants_t), intent(in) :: data
type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_config
integer, intent(in) :: n_sub
logical, intent(in) :: is_polarized
integer :: i
type(quantum_numbers_t), dimension(:, :), allocatable :: qn_hel
if (is_polarized) then
call setup_interaction_qn_hel (int, data, qn_hel)
call int%init_qn_index (qn_config, n_sub, qn_hel)
call int%set_qn_index_helicity_flip (.true.)
else
call int%init_qn_index (qn_config, n_sub)
end if
end subroutine setup_interaction_qn_index
@ %def setup_interaction_qn_index
@ Set up beam polarisation quantum numbers, if beam polarisation is required.
We retrieve the full helicity information from [[term%config%data]] and reduce
the information only to the inital state. Afterwards, we uniquify the initial
state polarization by a applying an index (hash) table.
The helicity information is fed into an array of quantum numbers to assign
flavor, helicity and subtraction indices correctly to their matrix element.
<<Instances: public>>=
public :: setup_interaction_qn_hel
<<Instances: sub interfaces>>=
module subroutine setup_interaction_qn_hel (int, data, qn_hel)
class(interaction_t), intent(in) :: int
class(process_constants_t), intent(in) :: data
type(quantum_numbers_t), dimension(:, :), allocatable, intent(out) :: &
qn_hel
end subroutine setup_interaction_qn_hel
<<Instances: procedures>>=
module subroutine setup_interaction_qn_hel (int, data, qn_hel)
class(interaction_t), intent(in) :: int
class(process_constants_t), intent(in) :: data
type(quantum_numbers_t), dimension(:, :), allocatable, intent(out) :: &
qn_hel
type(helicity_t), dimension(:), allocatable :: hel
integer, dimension(:), allocatable :: index_table
integer, dimension(:, :), allocatable :: hel_state
integer :: i, j, n_hel_unique
associate (n_in => int%get_n_in (), n_tot => int%get_n_tot ())
allocate (hel_state (n_tot, data%get_n_hel ()), &
source = data%hel_state)
allocate (index_table (data%get_n_hel ()), &
source = 0)
forall (j=1:data%get_n_hel (), i=n_in+1:n_tot) hel_state(i, j) = 0
n_hel_unique = 0
HELICITY: do i = 1, data%get_n_hel ()
do j = 1, data%get_n_hel ()
if (index_table (j) == 0) then
index_table(j) = i; n_hel_unique = n_hel_unique + 1
cycle HELICITY
else if (all (hel_state(:, i) == &
hel_state(:, index_table(j)))) then
cycle HELICITY
end if
end do
end do HELICITY
allocate (qn_hel (n_tot, n_hel_unique))
allocate (hel (n_tot))
do j = 1, n_hel_unique
call hel%init (hel_state(:, index_table(j)))
call qn_hel(:, j)%init (hel)
end do
end associate
end subroutine setup_interaction_qn_hel
@ %def setup_interaction_qn_hel
@ Initialization of equivalent cut expression classes.
Each flavor index [[i_flv]] here is assigned to the corresponding one
representative for an equivalent cut expression class. This class describes
the set of flavor quantum numbers for which the phase space cut expression
evaluation yield the same output. The representative [[i_flv]] for one class
correspond to the first flavor quantum numbers of that kind occuring in the
state matrix.
<<Instances: term instance: TBP>>=
procedure :: init_eqv_expr_classes => term_instance_init_eqv_expr_classes
<<Instances: sub interfaces>>=
module subroutine term_instance_init_eqv_expr_classes (term)
class(term_instance_t), intent(inout), target :: term
end subroutine term_instance_init_eqv_expr_classes
<<Instances: procedures>>=
module subroutine term_instance_init_eqv_expr_classes (term)
class(term_instance_t), intent(inout), target :: term
type(interaction_t), pointer :: src_int
type(state_matrix_t), pointer :: state_matrix
type(flavor_t), dimension(:), allocatable :: flv_src
logical, dimension(:,:,:), allocatable :: eqv_expr_class
logical, dimension (:), allocatable :: evaluated
integer :: n_in, n_vir, n_out
integer :: k, j, i
n_in = term%connected%trace%get_n_in ()
n_vir = term%connected%trace%get_n_vir ()
n_out = term%connected%trace%get_n_out ()
allocate (eqv_expr_class (3, n_out, &
term%connected%trace%get_qn_index_n_flv ()))
do k = 1, term%connected%trace%get_qn_index_n_flv ()
do j = 1, n_out
call term%connected%trace%find_source &
(n_in + n_vir + j, src_int, i)
if (associated (src_int)) then
state_matrix => src_int%get_state_matrix_ptr ()
flv_src = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (k))
eqv_expr_class (:, j, k) = flv_eqv_expr_class (flv_src(i)%get_pdg())
deallocate (flv_src)
end if
end do
end do
if (term%flv_dep_cut_eval) then
allocate (evaluated (term%connected%trace%get_qn_index_n_flv ()))
evaluated = .false.
allocate (term%i_flv_to_i_flv_rep (term%connected%trace%get_qn_index_n_flv ()))
do i = 1, term%connected%trace%get_qn_index_n_flv ()
if (.not. evaluated (i)) then
do k = i, term%connected%trace%get_qn_index_n_flv ()
if (same_eqv_expr_class(eqv_expr_class (:,:,i), eqv_expr_class (:,:,k))) then
term%i_flv_to_i_flv_rep (k) = i
evaluated (k) = .true.
end if
end do
end if
end do
end if
contains
function same_eqv_expr_class (flv_mask1, flv_mask2) result (same)
logical, dimension (:,:), intent(in) :: flv_mask1, flv_mask2
logical :: same
integer :: l
same = .true.
do l = 1, size (flv_mask1, dim = 2)
same = same .and. all (flv_mask1(:,l) .eqv. flv_mask2(:,l))
end do
end function same_eqv_expr_class
end subroutine term_instance_init_eqv_expr_classes
@ %def term_instance_init_eqv_expr_classes
@
<<Instances: term instance: TBP>>=
procedure :: init_interaction_qn_index => &
term_instance_init_interaction_qn_index
<<Instances: sub interfaces>>=
module subroutine term_instance_init_interaction_qn_index (term, core, &
int, n_sub, model, is_polarized)
class(term_instance_t), intent(inout), target :: term
class(prc_core_t), intent(in) :: core
class(interaction_t), intent(inout) :: int
integer, intent(in) :: n_sub
class(model_data_t), intent(in) :: model
logical, intent(in), optional :: is_polarized
end subroutine term_instance_init_interaction_qn_index
<<Instances: procedures>>=
module subroutine term_instance_init_interaction_qn_index (term, core, &
int, n_sub, model, is_polarized)
class(term_instance_t), intent(inout), target :: term
class(prc_core_t), intent(in) :: core
class(interaction_t), intent(inout) :: int
integer, intent(in) :: n_sub
class(model_data_t), intent(in) :: model
logical, intent(in), optional :: is_polarized
logical :: polarized
type(quantum_numbers_t), dimension(:, :), allocatable :: qn_config
integer, dimension(:,:), allocatable :: flv_born
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
select type (core)
class is (prc_external_t)
if (present (is_polarized)) then
polarized = is_polarized
else
polarized = core%includes_polarization ()
end if
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
associate (is_born => .not. (term%nlo_type == NLO_REAL .and. &
.not. term%is_subtraction ()))
select type (pcm => term%pcm)
type is (pcm_nlo_t)
qn_config = pcm%get_qn (is_born)
end select
call setup_interaction_qn_index (int, term%config%data, &
qn_config, n_sub, polarized)
end associate
class default
call term%config%data%get_flv_state (flv_born)
allocate (flv (size (flv_born, dim = 1)))
allocate (qn_config (size (flv_born, dim = 1), size (flv_born, dim = 2)))
do i = 1, core%data%n_flv
call flv%init (flv_born(:,i), model)
call qn_config(:, i)%init (flv)
end do
call setup_interaction_qn_index (int, term%config%data, &
qn_config, n_sub, polarized)
end select
class default
call int%init_qn_index ()
end select
end subroutine term_instance_init_interaction_qn_index
@ %def term_instance_init_interaction_qn_index
@
<<Instances: term instance: TBP>>=
procedure :: setup_fks_kinematics => term_instance_setup_fks_kinematics
<<Instances: sub interfaces>>=
module subroutine term_instance_setup_fks_kinematics &
(term, kin, var_list, beam_config)
class(term_instance_t), intent(inout), target :: term
type(kinematics_t), intent(inout) :: kin
type(var_list_t), intent(in) :: var_list
type(process_beam_config_t), intent(in) :: beam_config
end subroutine term_instance_setup_fks_kinematics
<<Instances: procedures>>=
module subroutine term_instance_setup_fks_kinematics &
(term, kin, var_list, beam_config)
class(term_instance_t), intent(inout), target :: term
type(kinematics_t), intent(inout) :: kin
type(var_list_t), intent(in) :: var_list
type(process_beam_config_t), intent(in) :: beam_config
integer :: mode
logical :: singular_jacobian
if (.not. (term%nlo_type == NLO_REAL .or. term%nlo_type == NLO_DGLAP .or. &
term%nlo_type == NLO_MISMATCH)) return
singular_jacobian = var_list%get_lval &
(var_str ("?powheg_use_singular_jacobian"))
if (term%nlo_type == NLO_REAL) then
mode = check_generator_mode (GEN_REAL_PHASE_SPACE)
else if (term%nlo_type == NLO_MISMATCH) then
mode = check_generator_mode (GEN_SOFT_MISMATCH)
else
mode = PHS_MODE_UNDEFINED
end if
select type (phs => kin%phs)
type is (phs_fks_t)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
call pcm%setup_phs_generator (pcm_work, &
phs%generator, phs%config%sqrts, mode, singular_jacobian)
if (beam_config%has_structure_function ()) then
pcm_work%isr_kinematics%isr_mode = SQRTS_VAR
else
pcm_work%isr_kinematics%isr_mode = SQRTS_FIXED
end if
if (debug_on) call msg_debug &
(D_PHASESPACE, "isr_mode: ", pcm_work%isr_kinematics%isr_mode)
end select
end select
class default
call msg_fatal ("Phase space should be an FKS phase space!")
end select
contains
function check_generator_mode (gen_mode_default) result (gen_mode)
integer :: gen_mode
integer, intent(in) :: gen_mode_default
select type (pcm => term%pcm)
type is (pcm_nlo_t)
associate (settings => pcm%settings)
if (settings%test_coll_limit .and. settings%test_anti_coll_limit) &
call msg_fatal ("You cannot check the collinear and anti-collinear limit "&
&"at the same time!")
if (settings%test_soft_limit .and. .not. settings%test_coll_limit &
.and. .not. settings%test_anti_coll_limit) then
gen_mode = GEN_SOFT_LIMIT_TEST
else if (.not. settings%test_soft_limit .and. settings%test_coll_limit) then
gen_mode = GEN_COLL_LIMIT_TEST
else if (.not. settings%test_soft_limit .and. settings%test_anti_coll_limit) then
gen_mode = GEN_ANTI_COLL_LIMIT_TEST
else if (settings%test_soft_limit .and. settings%test_coll_limit) then
gen_mode = GEN_SOFT_COLL_LIMIT_TEST
else if (settings%test_soft_limit .and. settings%test_anti_coll_limit) then
gen_mode = GEN_SOFT_ANTI_COLL_LIMIT_TEST
else
gen_mode = gen_mode_default
end if
end associate
end select
end function check_generator_mode
end subroutine term_instance_setup_fks_kinematics
@ %def term_instance_setup_fks_kinematics
@ Set up seed kinematics, starting from the MC parameter set given as
argument. As a result, the [[k_seed]] kinematics object is evaluated
(except for the structure-function matrix-element evaluation, which we
postpone until we know the factorization scale), and we have a valid
[[p_seed]] momentum array.
<<Instances: term instance: TBP>>=
procedure :: compute_seed_kinematics => term_instance_compute_seed_kinematics
<<Instances: sub interfaces>>=
module subroutine term_instance_compute_seed_kinematics &
(term, kin, mci_work, phs_channel, success)
class(term_instance_t), intent(inout), target :: term
type(kinematics_t), intent(inout) :: kin
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
logical, intent(out) :: success
end subroutine term_instance_compute_seed_kinematics
<<Instances: procedures>>=
module subroutine term_instance_compute_seed_kinematics &
(term, kin, mci_work, phs_channel, success)
class(term_instance_t), intent(inout), target :: term
type(kinematics_t), intent(inout) :: kin
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
logical, intent(out) :: success
call kin%compute_selected_channel &
(mci_work, phs_channel, term%p_seed, success)
end subroutine term_instance_compute_seed_kinematics
@ %def term_instance_compute_seed_kinematics
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_projections => term_instance_evaluate_projections
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_projections (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
end subroutine term_instance_evaluate_projections
<<Instances: procedures>>=
module subroutine term_instance_evaluate_projections (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
if (kin%threshold .and. term%nlo_type > BORN) then
if (debug2_active (D_THRESHOLD)) &
print *, 'Evaluate on-shell projection: ', &
char (component_status (term%nlo_type))
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
call kin%threshold_projection (pcm_work, term%nlo_type)
end select
end if
end subroutine term_instance_evaluate_projections
@ %def term_instance_evaluate_projections
@ Compute the momenta in the hard interactions, one for each term that
constitutes this process component. In simple cases this amounts to
just copying momenta. In more advanced cases, we may generate
distinct sets of momenta from the seed kinematics.
The interactions in the term instances are accessed individually. We may
choose to calculate all terms at once together with the seed kinematics, use
[[component%core_state]] for storage, and just fill the interactions here.
<<Instances: term instance: TBP>>=
procedure :: compute_hard_kinematics => &
term_instance_compute_hard_kinematics
<<Instances: sub interfaces>>=
module subroutine term_instance_compute_hard_kinematics &
(term, kin, recover, skip_term, success)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
integer, intent(in), optional :: skip_term
logical, intent(in), optional :: recover
logical, intent(out) :: success
end subroutine term_instance_compute_hard_kinematics
<<Instances: procedures>>=
module subroutine term_instance_compute_hard_kinematics &
(term, kin, recover, skip_term, success)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
integer, intent(in), optional :: skip_term
logical, intent(in), optional :: recover
logical, intent(out) :: success
type(vector4_t), dimension(:), allocatable :: p
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
if (present (skip_term)) then
if (term%config%i_term_global == skip_term) return
end if
if (present (recover)) then
if (recover) return
end if
if (term%nlo_type == NLO_REAL .and. kin%emitter >= 0) then
call kin%evaluate_radiation (term%p_seed, p, success)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (pcm%dalitz_plot%active) then
if (kin%emitter > kin%n_in) then
if (p(kin%emitter)**2 > tiny_07) &
call pcm%register_dalitz_plot (kin%emitter, p)
end if
end if
end select
else if (is_subtraction_component (kin%emitter, term%nlo_type)) then
call kin%modify_momenta_for_subtraction (term%p_seed, p)
success = .true.
else
allocate (p (size (term%p_seed))); p = term%p_seed
success = .true.
end if
call term%int_hard%set_momenta (p)
if (debug_on) then
call msg_debug2 (D_REAL, "inside compute_hard_kinematics")
if (debug2_active (D_REAL)) call vector4_write_set (p)
end if
end subroutine term_instance_compute_hard_kinematics
@ %def term_instance_compute_hard_kinematics
@ Here, we invert this. We fetch the incoming momenta which reside
in the appropriate [[sf_chain]] object, stored within the [[k_seed]]
subobject. On the other hand, we have the outgoing momenta of the
effective interaction. We rely on the process core to compute the
remaining seed momenta and to fill the momenta within the hard
interaction. (The latter is trivial if hard and effective interaction
coincide.)
After this is done, the incoming momenta in the trace evaluator that
corresponds to the hard (effective) interaction, are still
left undefined. We remedy this by calling [[receive_kinematics]] once.
<<Instances: term instance: TBP>>=
procedure :: recover_seed_kinematics => &
term_instance_recover_seed_kinematics
<<Instances: sub interfaces>>=
module subroutine term_instance_recover_seed_kinematics &
(term, kin, p_seed_ref)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(in) :: kin
type(vector4_t), dimension(:), intent(in), optional :: p_seed_ref
end subroutine term_instance_recover_seed_kinematics
<<Instances: procedures>>=
module subroutine term_instance_recover_seed_kinematics &
(term, kin, p_seed_ref)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(in) :: kin
integer :: n_in
type(vector4_t), dimension(:), intent(in), optional :: p_seed_ref
n_in = kin%n_in
call kin%get_incoming_momenta (term%p_seed(1:n_in))
associate (int_eff => term%isolated%int_eff)
call int_eff%set_momenta (term%p_seed(1:n_in), outgoing = .false.)
if (present (p_seed_ref)) then
term%p_seed(n_in + 1 : ) = p_seed_ref
else
term%p_seed(n_in + 1 : ) = int_eff%get_momenta (outgoing = .true.)
end if
end associate
call term%isolated%receive_kinematics ()
end subroutine term_instance_recover_seed_kinematics
@ %def term_instance_recover_seed_kinematics
@ Compute the integration parameters for all channels except the selected
one.
JRR: Obsolete now.
<<XXX Instances: term instance: TBP>>=
procedure :: compute_other_channels => &
term_instance_compute_other_channels
<<XXX Instances: procedures>>=
subroutine term_instance_compute_other_channels &
(term, mci_work, phs_channel)
class(term_instance_t), intent(inout), target :: term
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
call term%k_term%compute_other_channels (mci_work, phs_channel)
end subroutine term_instance_compute_other_channels
@ %def term_instance_compute_other_channels
@ Recover beam momenta, i.e., return the beam momenta as currently
stored in the kinematics subobject to their source. This is a side effect.
JRR: Obsolete now.
<<XXX Instances: term instance: TBP>>=
procedure :: return_beam_momenta => term_instance_return_beam_momenta
<<XXX Instances: procedures>>=
subroutine term_instance_return_beam_momenta (term)
class(term_instance_t), intent(in) :: term
call term%k_term%return_beam_momenta ()
end subroutine term_instance_return_beam_momenta
@ %def term_instance_return_beam_momenta
@
Applies the real partition by computing the real partition function $F(\Phi)$
and multiplying either $\mathcal{R}_\text{sin} = \mathcal{R} \cdot F$ or
$\mathcal{R}_\text{fin} = \mathcal{R} \cdot (1-F)$.
<<Instances: term instance: TBP>>=
procedure :: apply_real_partition => term_instance_apply_real_partition
<<Instances: sub interfaces>>=
module subroutine term_instance_apply_real_partition (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(in) :: kin
end subroutine term_instance_apply_real_partition
<<Instances: procedures>>=
module subroutine term_instance_apply_real_partition (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(in) :: kin
real(default) :: f, sqme
integer :: i_component
integer :: i_amp, n_amps, qn_index
logical :: is_subtraction
i_component = term%config%i_component
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (pcm%component_selected (i_component) .and. &
pcm%nlo_type (i_component) == NLO_REAL) then
is_subtraction = pcm%component_type (i_component) == &
COMP_REAL_SING .and. kin%emitter < 0
if (is_subtraction) return
select case (pcm%component_type (i_component))
case (COMP_REAL_FIN)
call term%connected%trace%set_duplicate_flv_zero()
end select
f = pcm%real_partition%get_f (term%p_hard)
n_amps = term%connected%trace%get_n_matrix_elements ()
do i_amp = 1, n_amps
qn_index = term%connected%trace%get_qn_index (i_amp, i_sub = 0)
if (term%passed_array(i_amp) .or. .not. term%passed) then
sqme = real (term%connected%trace%get_matrix_element (qn_index))
else
sqme = zero
end if
if (debug_on) call msg_debug2 &
(D_PROCESS_INTEGRATION, "term_instance_apply_real_partition")
select case (pcm%component_type (i_component))
case (COMP_REAL_FIN)
if (debug_on) call msg_debug2 &
(D_PROCESS_INTEGRATION, "Real finite")
sqme = sqme * (one - f)
case (COMP_REAL_SING)
if (debug_on) call msg_debug2 &
(D_PROCESS_INTEGRATION, "Real singular")
sqme = sqme * f
end select
if (debug_on) call msg_debug2 &
(D_PROCESS_INTEGRATION, "apply_damping: sqme", sqme)
call term%connected%trace%set_matrix_element &
(qn_index, cmplx (sqme, zero, default))
end do
end if
end select
end subroutine term_instance_apply_real_partition
@ %def term_instance_apply_real_partition
@
<<Instances: term instance: TBP>>=
procedure :: get_p_hard => term_instance_get_p_hard
<<Instances: sub interfaces>>=
pure module function term_instance_get_p_hard &
(term_instance) result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(term_instance_t), intent(in) :: term_instance
end function term_instance_get_p_hard
<<Instances: procedures>>=
pure module function term_instance_get_p_hard (term_instance) result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(term_instance_t), intent(in) :: term_instance
allocate (p_hard (size (term_instance%p_hard)))
p_hard = term_instance%p_hard
end function term_instance_get_p_hard
@ %def term_instance_get_p_hard
@
<<Instances: term instance: TBP>>=
procedure :: set_emitter => term_instance_set_emitter
<<Instances: sub interfaces>>=
module subroutine term_instance_set_emitter (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
end subroutine term_instance_set_emitter
<<Instances: procedures>>=
module subroutine term_instance_set_emitter (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
integer :: i_phs
logical :: set_emitter
select type (pcm => term%pcm)
type is (pcm_nlo_t)
select type (phs => kin%phs)
type is (phs_fks_t)
!!! Without resonances, i_alr = i_phs
i_phs = term%config%i_term
kin%i_phs = i_phs
set_emitter = i_phs <= pcm%region_data%n_phs .and. &
term%nlo_type == NLO_REAL
if (set_emitter) then
kin%emitter = phs%phs_identifiers(i_phs)%emitter
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (allocated (pcm%region_data%i_phs_to_i_con)) &
kin%i_con = pcm%region_data%i_phs_to_i_con (i_phs)
end select
end if
end select
end select
end subroutine term_instance_set_emitter
@ %def term_instance_set_emitter
@ For initializing the expressions, we need the local variable list and the
parse trees.
<<Instances: term instance: TBP>>=
procedure :: setup_expressions => term_instance_setup_expressions
<<Instances: sub interfaces>>=
module subroutine term_instance_setup_expressions (term, meta, config)
class(term_instance_t), intent(inout), target :: term
type(process_metadata_t), intent(in), target :: meta
type(process_config_data_t), intent(in) :: config
end subroutine term_instance_setup_expressions
<<Instances: procedures>>=
module subroutine term_instance_setup_expressions (term, meta, config)
class(term_instance_t), intent(inout), target :: term
type(process_metadata_t), intent(in), target :: meta
type(process_config_data_t), intent(in) :: config
if (allocated (config%ef_cuts)) &
call term%connected%setup_cuts (config%ef_cuts)
if (allocated (config%ef_scale)) &
call term%connected%setup_scale (config%ef_scale)
if (allocated (config%ef_fac_scale)) &
call term%connected%setup_fac_scale (config%ef_fac_scale)
if (allocated (config%ef_ren_scale)) &
call term%connected%setup_ren_scale (config%ef_ren_scale)
if (allocated (config%ef_weight)) &
call term%connected%setup_weight (config%ef_weight)
end subroutine term_instance_setup_expressions
@ %def term_instance_setup_expressions
@ Prepare the extra evaluators that we need for processing events.
The matrix elements we get from OpenLoops and GoSam are already squared
and summed over color and helicity. They should not be squared again.
<<Instances: term instance: TBP>>=
procedure :: setup_event_data => term_instance_setup_event_data
<<Instances: sub interfaces>>=
module subroutine term_instance_setup_event_data (term, kin, core, model)
class(term_instance_t), intent(inout), target :: term
type(kinematics_t), intent(in) :: kin
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
end subroutine term_instance_setup_event_data
<<Instances: procedures>>=
module subroutine term_instance_setup_event_data (term, kin, core, model)
class(term_instance_t), intent(inout), target :: term
type(kinematics_t), intent(in) :: kin
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
integer :: n_in
logical :: mask_color
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
n_in = term%int_hard%get_n_in ()
allocate (mask_in (n_in))
mask_in = kin%sf_chain%get_out_mask ()
call setup_isolated (term%isolated, core, model, mask_in, term%config%col)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
mask_color = pcm_work%is_fixed_order_nlo_events ()
class default
mask_color = .false.
end select
call setup_connected (term%connected, term%isolated, core, &
term%nlo_type, mask_color)
contains
subroutine setup_isolated (isolated, core, model, mask, color)
type(isolated_state_t), intent(inout), target :: isolated
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), intent(in), dimension(:) :: mask
integer, intent(in), dimension(:) :: color
select type (core)
class is (prc_blha_t)
call isolated%matrix%init_identity(isolated%int_eff)
isolated%has_matrix = .true.
class default
call isolated%setup_square_matrix (core, model, mask, color)
end select
!!! TODO (PS-09-10-20) We should not square the flows
!!! if they come from BLHA either
call isolated%setup_square_flows (core, model, mask)
end subroutine setup_isolated
subroutine setup_connected (connected, isolated, core, nlo_type, mask_color)
type(connected_state_t), intent(inout), target :: connected
type(isolated_state_t), intent(in), target :: isolated
class(prc_core_t), intent(in) :: core
integer, intent(in) :: nlo_type
logical, intent(in) :: mask_color
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
call connected%setup_connected_matrix (isolated)
if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL &
.and. term%config%i_term_global == term%config%i_sub) &
.or. term%nlo_type == NLO_DGLAP) then
!!! We do not care about the subtraction matrix elements in
!!! connected%matrix, because all entries there are supposed
!!! to be squared. To be able to match with flavor quantum numbers,
!!! we remove the subtraction quantum entries from the state matrix.
allocate (mask (connected%matrix%get_n_tot()))
call mask%set_sub (1)
call connected%matrix%reduce_state_matrix (mask, keep_order = .true.)
end if
call term%init_interaction_qn_index (core, connected%matrix, 0, model, &
is_polarized = .false.)
select type (core)
class is (prc_blha_t)
call connected%setup_connected_flows &
(isolated, mask_color = mask_color)
class default
call connected%setup_connected_flows (isolated)
end select
call connected%setup_state_flv (isolated%get_n_out ())
end subroutine setup_connected
end subroutine term_instance_setup_event_data
@ %def term_instance_setup_event_data
@ Color-correlated matrix elements should be obtained from
the external BLHA provider. According to the standard, the
matrix elements output is a one-dimensional array. For FKS
subtraction, we require the matrix $B_{ij}$. BLHA prescribes
a mapping $(i, j) \to k$, where $k$ is the index of the matrix
element in the output array. It focusses on the off-diagonal entries,
i.e. $i \neq j$. The subroutine [[blha_color_c_fill_offdiag]] realizes
this mapping. The diagonal entries can simply be obtained as
the product of the Born matrix element and either $C_A$ or $C_F$,
which is achieved by [[blha_color_c_fill_diag]].
For simple processes, i.e. those with only one color line, it is
$B_{ij} = C_F \cdot B$. For those, we keep the possibility of computing
color correlations by a multiplication of the Born matrix element with $C_F$.
It is triggered by the [[use_internal_color_correlations]] flag and should
be used only for testing purposes. However, it is also used for
the threshold computation where the process is well-defined and fixed.
<<Instances: term instance: TBP>>=
procedure :: evaluate_color_correlations => &
term_instance_evaluate_color_correlations
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_color_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
end subroutine term_instance_evaluate_color_correlations
<<Instances: procedures>>=
module subroutine term_instance_evaluate_color_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv_born
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (debug_on) call msg_debug2 (D_SUBTRACTION, &
"term_instance_evaluate_color_correlations: " // &
"use_internal_color_correlations:", &
pcm%settings%use_internal_color_correlations)
if (debug_on) call msg_debug2 (D_SUBTRACTION, "fac_scale", term%get_fac_scale ())
do i_flv_born = 1, pcm%region_data%n_flv_born
select case (term%nlo_type)
case (NLO_REAL)
call transfer_me_array_to_bij (pcm, i_flv_born, &
pcm_work%real_sub%sqme_born (i_flv_born), &
pcm_work%real_sub%sqme_born_color_c (:, :, i_flv_born))
case (NLO_MISMATCH)
call transfer_me_array_to_bij (pcm, i_flv_born, &
pcm_work%soft_mismatch%sqme_born (i_flv_born), &
pcm_work%soft_mismatch%sqme_born_color_c (:, :, i_flv_born))
case (NLO_VIRTUAL)
!!! This is just a copy of the above with a different offset and can for sure be unified
call transfer_me_array_to_bij (pcm, i_flv_born, &
-one, pcm_work%virtual%sqme_color_c (:, :, i_flv_born))
case (NLO_DGLAP)
call transfer_me_array_to_bij (pcm, i_flv_born, &
pcm_work%dglap_remnant%sqme_born (i_flv_born), &
pcm_work%dglap_remnant%sqme_color_c_extra (:, :, i_flv_born))
end select
end do
end select
end select
contains
function get_trivial_cf_factors (n_tot, flv, factorization_mode) result (beta_ij)
integer, intent(in) :: n_tot, factorization_mode
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
if (factorization_mode == NO_FACTORIZATION) then
beta_ij = get_trivial_cf_factors_default (n_tot, flv)
else
beta_ij = get_trivial_cf_factors_threshold (n_tot, flv)
end if
end function get_trivial_cf_factors
function get_trivial_cf_factors_default (n_tot, flv) result (beta_ij)
integer, intent(in) :: n_tot
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
integer :: i, j
beta_ij = zero
if (count (is_quark (flv)) == 2) then
do i = 1, n_tot
do j = 1, n_tot
if (is_quark(flv(i)) .and. is_quark(flv(j))) then
if (i == j) then
beta_ij(i,j)= -cf
else
beta_ij(i,j) = cf
end if
end if
end do
end do
end if
end function get_trivial_cf_factors_default
function get_trivial_cf_factors_threshold (n_tot, flv) result (beta_ij)
integer, intent(in) :: n_tot
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
integer :: i
beta_ij = zero
do i = 1, 4
beta_ij(i,i) = -cf
end do
beta_ij(1,2) = cf; beta_ij(2,1) = cf
beta_ij(3,4) = cf; beta_ij(4,3) = cf
end function get_trivial_cf_factors_threshold
subroutine transfer_me_array_to_bij (pcm, i_flv, &
sqme_born, sqme_color_c)
type(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
real(default), intent(in) :: sqme_born
real(default), dimension(:,:), intent(inout) :: sqme_color_c
logical :: special_case_interferences
integer :: i_color_c, i_sub, n_offset, i_qn
real(default), dimension(:), allocatable :: sqme
real(default) :: sqme_born_c
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "transfer_me_array_to_bij")
if (pcm%settings%use_internal_color_correlations) then
!!! A negative value for sqme_born indicates that the Born matrix
!!! element is multiplied at a different place, e.g. in the case
!!! of the virtual component
sqme_color_c = get_trivial_cf_factors &
(pcm%region_data%get_n_legs_born (), &
pcm%region_data%get_flv_states_born (i_flv), &
pcm%settings%factorization_mode)
if (sqme_born > zero) then
sqme_color_c = sqme_born * sqme_color_c
else if (sqme_born == zero) then
sqme_color_c = zero
end if
else
special_case_interferences = &
pcm%region_data%nlo_correction_type == "EW"
n_offset = 0
if (term%nlo_type == NLO_VIRTUAL) then
n_offset = 1
else if (pcm%has_pdfs .and. (term%is_subtraction () &
.or. term%nlo_type == NLO_DGLAP)) then
n_offset = n_beams_rescaled
end if
allocate (sqme (term%get_n_sub_color ()), source = zero)
do i_sub = 1, term%get_n_sub_color ()
i_qn = term%connected%trace%get_qn_index (i_flv, i_sub = i_sub + n_offset)
if (term%passed_array(i_flv) .or. .not. term%passed) then
sqme(i_sub) = real(term%connected%trace%get_matrix_element (i_qn), default)
else
sqme(i_sub) = zero
end if
end do
call blha_color_c_fill_offdiag (pcm%region_data%n_legs_born, &
sqme, sqme_color_c)
i_qn = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
if (term%passed_array(i_flv) .or. .not. term%passed) then
sqme_born_c = real(term%connected%trace%get_matrix_element (i_qn), default)
else
sqme_born_c = zero
end if
call blha_color_c_fill_diag (sqme_born_c, &
pcm%region_data%get_flv_states_born (i_flv), &
sqme_color_c, special_case_interferences)
end if
end subroutine transfer_me_array_to_bij
end subroutine term_instance_evaluate_color_correlations
@ %def term_instance_evaluate_color_correlations
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_charge_correlations => &
term_instance_evaluate_charge_correlations
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_charge_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
end subroutine term_instance_evaluate_charge_correlations
<<Instances: procedures>>=
module subroutine term_instance_evaluate_charge_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv_born
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
do i_flv_born = 1, pcm%region_data%n_flv_born
select case (term%nlo_type)
case (NLO_REAL)
call transfer_me_array_to_bij (pcm, i_flv_born, &
pcm_work%real_sub%sqme_born (i_flv_born), &
pcm_work%real_sub%sqme_born_charge_c (:, :, i_flv_born))
case (NLO_MISMATCH)
call transfer_me_array_to_bij (pcm, i_flv_born, &
pcm_work%soft_mismatch%sqme_born (i_flv_born), &
pcm_work%soft_mismatch%sqme_born_charge_c (:, :, i_flv_born))
case (NLO_VIRTUAL)
call transfer_me_array_to_bij (pcm, i_flv_born, &
one, pcm_work%virtual%sqme_charge_c (:, :, i_flv_born))
end select
end do
end select
end select
contains
subroutine transfer_me_array_to_bij (pcm, i_flv, sqme_born, sqme_charge_c)
type(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
real(default), intent(in) :: sqme_born
real(default), dimension(:,:), intent(inout) :: sqme_charge_c
integer :: n_legs_born, i, j
real(default), dimension(:), allocatable :: sigma
real(default), dimension(:), allocatable :: Q
n_legs_born = pcm%region_data%n_legs_born
associate (flv_born => pcm%region_data%flv_born(i_flv))
allocate (sigma (n_legs_born), Q (size (flv_born%charge)))
Q = flv_born%charge
sigma(1:flv_born%n_in) = -one
sigma(flv_born%n_in + 1: ) = one
end associate
do i = 1, n_legs_born
do j = 1, n_legs_born
sqme_charge_c(i, j) = sigma(i) * sigma(j) * Q(i) * Q(j) * (-one)
end do
end do
sqme_charge_c = sqme_charge_c * sqme_born
end subroutine transfer_me_array_to_bij
end subroutine term_instance_evaluate_charge_correlations
@ %def term_instance_evaluate_charge_correlations
@ The information about spin correlations is not stored in the
[[nlo_settings]] because it is only available after the
[[fks_regions]] have been created.
<<Instances: term instance: TBP>>=
procedure :: evaluate_spin_correlations => &
term_instance_evaluate_spin_correlations
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_spin_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
end subroutine term_instance_evaluate_spin_correlations
<<Instances: procedures>>=
module subroutine term_instance_evaluate_spin_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv, i_sub, i_emitter, emitter, i_qn
integer :: n_flv, n_sub_color, n_sub_spin, n_offset,i,j
real(default), dimension(1:3, 1:3) :: sqme_spin_c
real(default), dimension(:), allocatable :: sqme_spin_c_all
real(default), dimension(:), allocatable :: sqme_spin_c_arr
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_spin_correlations")
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
if (pcm_work%real_sub%requires_spin_correlations () &
.and. term%nlo_type == NLO_REAL) then
select type (core)
type is (prc_openloops_t)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
n_flv = term%connected%trace%get_qn_index_n_flv ()
n_sub_color = term%get_n_sub_color ()
n_sub_spin = term%get_n_sub_spin ()
n_offset = 0; if(pcm%has_pdfs) n_offset = n_beams_rescaled
allocate (sqme_spin_c_arr(6))
do i_flv = 1, n_flv
allocate (sqme_spin_c_all(n_sub_spin))
do i_sub = 1, n_sub_spin
i_qn = term%connected%trace%get_qn_index (i_flv, &
i_sub = i_sub + n_offset + n_sub_color)
if (term%passed_array(i_flv) .or. .not. term%passed) then
sqme_spin_c_all(i_sub) = &
real(term%connected%trace%get_matrix_element (i_qn), default)
else
sqme_spin_c_all(i_sub) = zero
end if
end do
do i_emitter = 1, pcm%region_data%n_emitters
emitter = pcm%region_data%emitters(i_emitter)
if (emitter > 0) then
call split_array (sqme_spin_c_all, sqme_spin_c_arr)
do j = 1, size (sqme_spin_c, dim=2)
do i = j, size (sqme_spin_c, dim=1)
!!! Restoring the symmetric matrix packed into a 1-dim array
!!! c.f. [[prc_openloops_compute_sqme_spin_c]]
sqme_spin_c(i,j) = sqme_spin_c_arr(j + i * (i - 1) / 2)
if (i /= j) sqme_spin_c(j,i) = sqme_spin_c(i,j)
end do
end do
pcm_work%real_sub%sqme_born_spin_c(:,:,emitter,i_flv) = sqme_spin_c
end if
end do
deallocate (sqme_spin_c_all)
end do
end select
class default
call msg_fatal &
("Spin correlations so far only supported by OpenLoops.")
end select
end if
end select
end subroutine term_instance_evaluate_spin_correlations
@ %def term_instance_evaluate_spin_correlations
@
<<Instances: term instance: TBP>>=
procedure :: apply_fks => term_instance_apply_fks
<<Instances: sub interfaces>>=
module subroutine term_instance_apply_fks &
(term, kin, alpha_s_sub, alpha_qed_sub)
class(term_instance_t), intent(inout) :: term
class(kinematics_t), intent(inout) :: kin
real(default), intent(in) :: alpha_s_sub, alpha_qed_sub
end subroutine term_instance_apply_fks
<<Instances: procedures>>=
module subroutine term_instance_apply_fks &
(term, kin, alpha_s_sub, alpha_qed_sub)
class(term_instance_t), intent(inout) :: term
class(kinematics_t), intent(inout) :: kin
real(default), intent(in) :: alpha_s_sub, alpha_qed_sub
real(default), dimension(:), allocatable :: sqme
integer :: i, i_phs, emitter, i_qn
logical :: is_subtraction
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (term%connected%has_matrix) then
allocate (sqme (pcm%get_n_alr ()))
else
allocate (sqme (1))
end if
sqme = zero
select type (phs => kin%phs)
type is (phs_fks_t)
if (pcm%has_pdfs .and. &
pcm%settings%use_internal_color_correlations) then
call msg_fatal ("Color correlations for proton processes " // &
"so far only supported by OpenLoops.")
end if
call pcm_work%set_real_and_isr_kinematics &
(phs%phs_identifiers, kin%phs%get_sqrts ())
if (kin%emitter < 0) then
call pcm_work%set_subtraction_event ()
do i_phs = 1, pcm%region_data%n_phs
emitter = phs%phs_identifiers(i_phs)%emitter
call pcm_work%real_sub%compute (emitter, &
i_phs, alpha_s_sub, alpha_qed_sub, term%connected%has_matrix, sqme)
end do
else
call pcm_work%set_radiation_event ()
emitter = kin%emitter; i_phs = kin%i_phs
do i = 1, term%connected%trace%get_qn_index_n_flv ()
i_qn = term%connected%trace%get_qn_index (i)
if (term%passed_array(i) .or. .not. term%passed) then
pcm_work%real_sub%sqme_real_non_sub (i, i_phs) = &
real (term%connected%trace%get_matrix_element (i_qn))
else
pcm_work%real_sub%sqme_real_non_sub (i, i_phs) = zero
end if
end do
call pcm_work%real_sub%compute (emitter, i_phs, alpha_s_sub, &
alpha_qed_sub, term%connected%has_matrix, sqme)
end if
end select
end select
end select
if (term%connected%has_trace) &
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum(sqme), 0, default))
select type (pcm => term%pcm)
type is (pcm_nlo_t)
is_subtraction = kin%emitter < 0
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme * term%weight, 0, default), &
pcm%get_qn (is_subtraction), &
pcm%region_data%get_flavor_indices (is_subtraction), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme * term%weight, 0, default), &
pcm%get_qn (is_subtraction), &
pcm%region_data%get_flavor_indices (is_subtraction), &
term%connected%flows)
end select
end subroutine term_instance_apply_fks
@ %def term_instance_apply_fks
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_virt => term_instance_evaluate_sqme_virt
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_sqme_virt &
(term, alpha_s, alpha_qed)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s, alpha_qed
end subroutine term_instance_evaluate_sqme_virt
<<Instances: procedures>>=
module subroutine term_instance_evaluate_sqme_virt (term, alpha_s, alpha_qed)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s, alpha_qed
real(default), dimension(2) :: alpha_coupling
type(vector4_t), dimension(:), allocatable :: p_born
real(default), dimension(:), allocatable :: sqme_virt
integer :: i_flv, i_qn_born, i_qn_virt
if (term%nlo_type /= NLO_VIRTUAL) call msg_fatal ("Trying to " // &
"evaluate virtual matrix element with unsuited term_instance.")
- if (debug2_active (D_VIRTUAL)) then
+ if (debug2_active (D_VIRTUAL)) then
call msg_debug2 &
(D_VIRTUAL, "Evaluating virtual-subtracted matrix elements")
print *, 'ren_scale: ', term%get_ren_scale ()
print *, 'fac_scale: ', term%get_fac_scale ()
if (allocated (term%es_scale)) then
print *, 'ES scale: ', term%es_scale
else
print *, 'ES scale: ', term%get_ren_scale ()
end if
end if
select type (pcm => term%pcm)
type is (pcm_nlo_t)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
alpha_coupling = [alpha_s, alpha_qed]
if (debug2_active (D_VIRTUAL)) then
print *, 'alpha_s: ', alpha_coupling (1)
print *, 'alpha_qed: ', alpha_coupling (2)
end if
allocate (p_born (pcm%region_data%n_legs_born))
if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
p_born = pcm_work%real_kinematics%p_born_onshell%get_momenta(1)
else
p_born = term%int_hard%get_momenta ()
end if
call pcm_work%set_momenta_and_scales_virtual &
(p_born, term%ren_scale, term%get_fac_scale (), &
term%es_scale)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
associate (virtual => pcm_work%virtual)
do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
i_qn_born = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
i_qn_virt = term%connected%trace%get_qn_index (i_flv, i_sub = 1)
if (term%passed_array(i_flv) .or. .not. term%passed) then
virtual%sqme_born(i_flv) = &
real (term%connected%trace%get_matrix_element (i_qn_born))
virtual%sqme_virt_fin(i_flv) = &
real (term%connected%trace%get_matrix_element (i_qn_virt))
else
virtual%sqme_born(i_flv) = zero
virtual%sqme_virt_fin(i_flv) = zero
end if
end do
end associate
end select
call pcm_work%compute_sqme_virt (term%pcm, term%p_hard, &
alpha_coupling, term%connected%has_matrix, sqme_virt)
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum(sqme_virt), 0, default))
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme_virt * term%weight, &
0, default), pcm%get_qn (.true.), &
remove_duplicates_from_int_array ( &
pcm%region_data%get_flavor_indices (.true.)), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme_virt * term%weight, &
0, default), pcm%get_qn (.true.), &
remove_duplicates_from_int_array ( &
pcm%region_data%get_flavor_indices (.true.)), &
term%connected%flows)
end select
end select
end subroutine term_instance_evaluate_sqme_virt
@ %def term_instance_evaluate_sqme_virt
@ Needs generalization to electroweak corrections.
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_mismatch => term_instance_evaluate_sqme_mismatch
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_sqme_mismatch (term, alpha_s)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s
end subroutine term_instance_evaluate_sqme_mismatch
<<Instances: procedures>>=
module subroutine term_instance_evaluate_sqme_mismatch (term, alpha_s)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s
real(default), dimension(:), allocatable :: sqme_mism
if (term%nlo_type /= NLO_MISMATCH) call msg_fatal &
("Trying to evaluate soft mismatch with unsuited term_instance.")
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
call pcm_work%compute_sqme_mismatch &
(term%pcm, alpha_s, term%connected%has_matrix, sqme_mism)
end select
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum (sqme_mism) * term%weight, 0, default))
if (term%connected%has_matrix) then
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme_mism * term%weight, 0, default), &
pcm%get_qn (.true.), &
remove_duplicates_from_int_array ( &
pcm%region_data%get_flavor_indices (.true.)), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme_mism * term%weight, 0, default), &
pcm%get_qn (.true.), &
remove_duplicates_from_int_array ( &
pcm%region_data%get_flavor_indices (.true.)), &
term%connected%flows)
end select
end if
end subroutine term_instance_evaluate_sqme_mismatch
@ %def term_instance_evaluate_sqme_mismatch
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_dglap => term_instance_evaluate_sqme_dglap
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_sqme_dglap &
(term, alpha_s, alpha_qed)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s, alpha_qed
end subroutine term_instance_evaluate_sqme_dglap
<<Instances: procedures>>=
module subroutine term_instance_evaluate_sqme_dglap (term, alpha_s, alpha_qed)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s, alpha_qed
real(default), dimension(2) :: alpha_coupling
real(default), dimension(:), allocatable :: sqme_dglap
integer :: i_flv
if (term%nlo_type /= NLO_DGLAP) call msg_fatal &
("Trying to evaluate DGLAP remnant with unsuited term_instance.")
if (debug_on) call msg_debug2 &
(D_PROCESS_INTEGRATION, "term_instance_evaluate_sqme_dglap")
select type (pcm => term%pcm)
type is (pcm_nlo_t)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
alpha_coupling = [alpha_s,alpha_qed]
if (debug2_active (D_PROCESS_INTEGRATION)) then
associate (n_flv => pcm_work%dglap_remnant%reg_data%n_flv_born)
print *, "size(sqme_born) = ", &
size (pcm_work%dglap_remnant%sqme_born)
call term%connected%trace%write ()
end associate
end if
call pcm_work%compute_sqme_dglap_remnant (pcm, alpha_coupling, &
term%connected%has_matrix, sqme_dglap)
end select
end select
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum (sqme_dglap) * term%weight, 0, default))
if (term%connected%has_matrix) then
select type (pcm => term%pcm)
type is (pcm_nlo_t)
call refill_evaluator (cmplx (sqme_dglap * term%weight, 0, default), &
pcm%get_qn (.true.), &
remove_duplicates_from_int_array ( &
pcm%region_data%get_flavor_indices (.true.)), &
term%connected%matrix)
if (term%connected%has_flows) then
call refill_evaluator &
(cmplx (sqme_dglap * term%weight, 0, default), &
pcm%get_qn (.true.), &
remove_duplicates_from_int_array ( &
pcm%region_data%get_flavor_indices (.true.)), &
term%connected%flows)
end if
end select
end if
end subroutine term_instance_evaluate_sqme_dglap
@ %def term_instance_evaluate_sqme_dglap
@ Reset the term instance: clear the parton-state expressions and deactivate.
<<Instances: term instance: TBP>>=
procedure :: reset => term_instance_reset
<<Instances: sub interfaces>>=
module subroutine term_instance_reset (term)
class(term_instance_t), intent(inout) :: term
end subroutine term_instance_reset
<<Instances: procedures>>=
module subroutine term_instance_reset (term)
class(term_instance_t), intent(inout) :: term
call term%connected%reset_expressions ()
if (allocated (term%alpha_qcd_forced)) deallocate (term%alpha_qcd_forced)
term%active = .false.
end subroutine term_instance_reset
@ %def term_instance_reset
@ Force an $\alpha_s$ value that should be used in the matrix-element
calculation.
<<Instances: term instance: TBP>>=
procedure :: set_alpha_qcd_forced => term_instance_set_alpha_qcd_forced
<<Instances: sub interfaces>>=
module subroutine term_instance_set_alpha_qcd_forced (term, alpha_qcd)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_qcd
end subroutine term_instance_set_alpha_qcd_forced
<<Instances: procedures>>=
module subroutine term_instance_set_alpha_qcd_forced (term, alpha_qcd)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_qcd
if (allocated (term%alpha_qcd_forced)) then
term%alpha_qcd_forced = alpha_qcd
else
allocate (term%alpha_qcd_forced, source = alpha_qcd)
end if
end subroutine term_instance_set_alpha_qcd_forced
@ %def term_instance_set_alpha_qcd_forced
@ Complete the kinematics computation for the effective parton states.
We assume that the [[compute_hard_kinematics]] method of the process
component instance has already been called, so the [[int_hard]]
contains the correct hard kinematics. The duty of this procedure is
first to compute the effective kinematics and store this in the
[[int_eff]] effective interaction inside the [[isolated]] parton
state. The effective kinematics may differ from the kinematics in the hard
interaction. It may involve parton recombination or parton splitting.
The [[rearrange_partons]] method is responsible for this part.
We may also call a method to compute the effective structure-function
chain at this point. This is not implemented yet.
In the simple case that no rearrangement is necessary, as indicated by
the [[rearrange]] flag, the effective interaction is a pointer to the
hard interaction, and we can skip the rearrangement method. Similarly
for the effective structure-function chain.
The final step of kinematics setup is to transfer the effective
kinematics to the evaluators and to the [[subevt]].
<<Instances: term instance: TBP>>=
procedure :: compute_eff_kinematics => &
term_instance_compute_eff_kinematics
<<Instances: sub interfaces>>=
module subroutine term_instance_compute_eff_kinematics (term)
class(term_instance_t), intent(inout) :: term
end subroutine term_instance_compute_eff_kinematics
<<Instances: procedures>>=
module subroutine term_instance_compute_eff_kinematics (term)
class(term_instance_t), intent(inout) :: term
term%checked = .false.
term%passed = .false.
call term%isolated%receive_kinematics ()
call term%connected%receive_kinematics ()
end subroutine term_instance_compute_eff_kinematics
@ %def term_instance_compute_eff_kinematics
@ Inverse. Reconstruct the connected state from the momenta in the
trace evaluator (which we assume to be set), then reconstruct the
isolated state as far as possible. The second part finalizes the
momentum configuration, using the incoming seed momenta
<<Instances: term instance: TBP>>=
procedure :: recover_hard_kinematics => &
term_instance_recover_hard_kinematics
<<Instances: sub interfaces>>=
module subroutine term_instance_recover_hard_kinematics (term)
class(term_instance_t), intent(inout) :: term
end subroutine term_instance_recover_hard_kinematics
<<Instances: procedures>>=
module subroutine term_instance_recover_hard_kinematics (term)
class(term_instance_t), intent(inout) :: term
term%checked = .false.
term%passed = .false.
call term%connected%send_kinematics ()
call term%isolated%send_kinematics ()
end subroutine term_instance_recover_hard_kinematics
@ %def term_instance_recover_hard_kinematics
@ Check the term whether it passes cuts and, if successful, evaluate
scales and weights. The factorization scale is also given to the term
kinematics, enabling structure-function evaluation.
<<Instances: term instance: TBP>>=
procedure :: evaluate_expressions => &
term_instance_evaluate_expressions
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_expressions &
(term, config, scale_forced)
class(term_instance_t), intent(inout) :: term
type(process_beam_config_t), intent(in) :: config
real(default), intent(in), allocatable, optional :: scale_forced
end subroutine term_instance_evaluate_expressions
<<Instances: procedures>>=
module subroutine term_instance_evaluate_expressions &
(term, config, scale_forced)
class(term_instance_t), intent(inout) :: term
type(process_beam_config_t), intent(in) :: config
real(default), intent(in), allocatable, optional :: scale_forced
real(default) :: scale = 0
real(default) :: weight = 1
real(default), allocatable :: fac_scale, ren_scale
type(interaction_t), pointer :: src_int
type(state_matrix_t), pointer :: state_matrix
type(flavor_t), dimension(:), allocatable :: flv_int, flv_src, f_in, f_out
logical :: passed
integer :: n_in, n_vir, n_out, n_tot, n_flv
integer :: i, j, k
n_flv = term%connected%trace%get_qn_index_n_flv ()
if (.not. allocated (term%passed_array)) allocate (term%passed_array(n_flv))
if (term%flv_dep_cut_eval) then
do k = 1, n_flv
if (k == term%i_flv_to_i_flv_rep(k)) then
n_in = term%int_hard%get_n_in ()
associate (int_eff => term%isolated%int_eff)
state_matrix => int_eff%get_state_matrix_ptr ()
n_tot = int_eff%get_n_tot ()
flv_int = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (k))
allocate (f_in (n_in))
f_in = flv_int(1:n_in)
deallocate (flv_int)
end associate
n_in = term%connected%trace%get_n_in ()
n_vir = term%connected%trace%get_n_vir ()
n_out = term%connected%trace%get_n_out ()
allocate (f_out (n_out))
do j = 1, n_out
call term%connected%trace%find_source &
(n_in + n_vir + j, src_int, i)
if (associated (src_int)) then
state_matrix => src_int%get_state_matrix_ptr ()
flv_src = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (k))
f_out(j) = flv_src(i)
deallocate (flv_src)
end if
end do
call term%connected%renew_flv_content_subevt &
(term%isolated%sf_chain_eff, &
config%data%flv, f_in, f_out)
call term%connected%evaluate_expressions (passed, &
scale, fac_scale, ren_scale, weight, &
scale_forced, force_evaluation = .true.)
if (k == 1) then
term%scale = scale
if (allocated (fac_scale)) then
if (.not. allocated (term%fac_scale)) then
allocate (term%fac_scale, source = fac_scale)
else
term%fac_scale = fac_scale
end if
end if
if (allocated (ren_scale)) then
if (.not. allocated (term%ren_scale)) then
allocate (term%ren_scale, source = ren_scale)
else
term%ren_scale = ren_scale
end if
end if
term%weight = weight
end if
term%passed_array(k) = passed
deallocate (f_in)
deallocate (f_out)
else
term%passed_array(k) = term%passed_array(term%i_flv_to_i_flv_rep(k))
end if
end do
term%passed = any (term%passed_array)
else
call term%connected%evaluate_expressions (term%passed, &
term%scale, term%fac_scale, term%ren_scale, term%weight, &
scale_forced, force_evaluation = .true.)
term%passed_array = term%passed
end if
term%checked = .true.
end subroutine term_instance_evaluate_expressions
@ %def term_instance_evaluate_expressions
@ Evaluate the trace: first evaluate the hard interaction, then the trace
evaluator. We use the [[evaluate_interaction]] method of the process
component which generated this term. The [[subevt]] and cut expressions are
not yet filled.
The [[component]] argument is intent(inout) because the [[compute_amplitude]]
method may modify the [[core_state]] workspace object.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction => term_instance_evaluate_interaction
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_interaction (term, core, kin)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in), pointer :: core
type(kinematics_t), intent(inout) :: kin
end subroutine term_instance_evaluate_interaction
<<Instances: procedures>>=
module subroutine term_instance_evaluate_interaction (term, core, kin)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in), pointer :: core
type(kinematics_t), intent(inout) :: kin
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction")
if (kin%only_cm_frame .and. (.not. kin%lab_is_cm())) then
term%p_hard = kin%get_boost_to_cms () * term%int_hard%get_momenta ()
else
term%p_hard = term%int_hard%get_momenta ()
end if
select type (core)
class is (prc_external_t)
call term%evaluate_interaction_external (core, kin)
class default
call term%evaluate_interaction_default (core)
end select
call term%int_hard%set_matrix_element (term%amp)
end subroutine term_instance_evaluate_interaction
@ %def term_instance_evaluate_interaction
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_default &
=> term_instance_evaluate_interaction_default
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_interaction_default (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
end subroutine term_instance_evaluate_interaction_default
<<Instances: procedures>>=
module subroutine term_instance_evaluate_interaction_default (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
real(default) :: fac_scale, ren_scale
integer :: i
if (allocated (term%fac_scale)) then
fac_scale = term%fac_scale
else
fac_scale = term%scale
end if
if (allocated (term%ren_scale)) then
ren_scale = term%ren_scale
else
ren_scale = term%scale
end if
do i = 1, term%config%n_allowed
term%amp(i) = core%compute_amplitude (term%config%i_term, term%p_hard, &
term%config%flv(i), term%config%hel(i), term%config%col(i), &
fac_scale, ren_scale, term%alpha_qcd_forced, &
term%core_state)
end do
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
call pcm_work%set_fac_scale (fac_scale)
end select
end subroutine term_instance_evaluate_interaction_default
@ %def term_instance_evaluate_interaction_default
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_external &
=> term_instance_evaluate_interaction_external
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_interaction_external &
(term, core, kin)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
type(kinematics_t), intent(inout) :: kin
end subroutine term_instance_evaluate_interaction_external
<<Instances: procedures>>=
module subroutine term_instance_evaluate_interaction_external &
(term, core, kin)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
type(kinematics_t), intent(inout) :: kin
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_external")
select type (core_state => term%core_state)
type is (openloops_state_t)
select type (core)
type is (prc_openloops_t)
call core%compute_alpha_s (core_state, term%get_ren_scale ())
if (allocated (core_state%threshold_data)) &
call evaluate_threshold_parameters (core_state, core, kin%phs%get_sqrts ())
end select
class is (prc_external_state_t)
select type (core)
class is (prc_external_t)
call core%compute_alpha_s (core_state, term%get_ren_scale ())
end select
end select
call evaluate_threshold_interaction ()
if (term%nlo_type == NLO_VIRTUAL) then
call term%evaluate_interaction_external_loop (core)
else
call term%evaluate_interaction_external_tree (core)
end if
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
call pcm_work%set_fac_scale (term%get_fac_scale ())
end select
contains
subroutine evaluate_threshold_parameters (core_state, core, sqrts)
type(openloops_state_t), intent(inout) :: core_state
type(prc_openloops_t), intent(inout) :: core
real(default), intent(in) :: sqrts
real(default) :: mtop, wtop
mtop = m1s_to_mpole (sqrts)
wtop = core_state%threshold_data%compute_top_width &
(mtop, core_state%alpha_qcd)
call core%set_mass_and_width (6, mtop, wtop)
end subroutine
subroutine evaluate_threshold_interaction ()
integer :: leg
select type (core)
type is (prc_threshold_t)
if (term%nlo_type > BORN) then
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
if (kin%emitter >= 0) then
call core%set_offshell_momenta &
(pcm_work%real_kinematics%p_real_cms%get_momenta(term%config%i_term))
leg = thr_leg (kin%emitter)
call core%set_leg (leg)
call core%set_onshell_momenta &
(pcm_work%real_kinematics%p_real_onshell(leg)%get_momenta(term%config%i_term))
else
call core%set_leg (0)
call core%set_offshell_momenta &
(pcm_work%real_kinematics%p_born_cms%get_momenta(1))
end if
end select
else
call core%set_leg (-1)
call core%set_offshell_momenta (term%p_hard)
end if
end select
end subroutine evaluate_threshold_interaction
end subroutine term_instance_evaluate_interaction_external
@ %def term_instance_evaluate_interaction_external
@ Retrieve the matrix elements from a matrix element provider and place them
into [[term%amp]].
For the handling of NLO calculations, FKS applies a book keeping handling
flavor and/or particle type (e.g. for QCD: quark/gluon and quark flavor) in
order to calculate the subtraction terms. Therefore, we have to insert the
calculated matrix elements correctly into the state matrix where each entry
corresponds to a set of quantum numbers. We apply a mapping
[[hard_qn_ind]] from a list of quantum numbers provided by FKS to the
hard process [[int_hard]].
The calculated matrix elements are insert into [[term%amp]] in the following
way. The first [[n_born]] particles are the matrix element of the hard process.
In non-trivial beams, we store another [[n_beams_rescaled]] copies of these
matrix elements as the first [[n_beams_rescaled]] subtractions. This
is a remnant from times before the method
[[term_instance_set_sf_factors]] and these entries are not used
anymore. However, eliminating these entries involves deeper changes in
how the connection tables for the evaluator product are set up and
should therefore be part of a larger refactoring of the interactions
\& state matrices. The next $n_{\text{born}}\times n_{sub_color}$ are
color-correlated Born matrix elements, with then again the next
$n_{\text{born}}\times n_{emitters}\times n_{sub_spin}$ being
spin-correlated Born matrix elements.
If two or more flavor structures would produce the same amplitude we
only compute one and use the [[eqv_index]] determined by the
[[prc_core]] and just copy the result to improve performance.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_external_tree &
=> term_instance_evaluate_interaction_external_tree
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_interaction_external_tree &
(term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
end subroutine term_instance_evaluate_interaction_external_tree
<<Instances: procedures>>=
module subroutine term_instance_evaluate_interaction_external_tree &
(term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
real(default) :: sqme
real(default), dimension(:), allocatable :: sqme_color_c
real(default), dimension(:), allocatable :: sqme_spin_c
real(default), dimension(6) :: sqme_spin_c_tmp
integer :: n_flv, n_hel, n_sub_color, n_sub_spin, n_pdf_off
integer :: i_flv, i_hel, i_sub, i_color_c, i_color_c_eqv, &
i_spin_c, i_spin_c_eqv
integer :: i_flv_eqv, i_hel_eqv
integer :: emitter, i_emitter
logical :: bad_point, bp
logical, dimension(:,:), allocatable :: eqv_me_evaluated
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_external_tree")
allocate (sqme_color_c (blha_result_array_size &
(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
n_flv = term%int_hard%get_qn_index_n_flv ()
n_hel = term%int_hard%get_qn_index_n_hel ()
n_sub_color = term%get_n_sub_color ()
n_sub_spin = term%get_n_sub_spin ()
allocate (eqv_me_evaluated(n_flv,n_hel))
eqv_me_evaluated = .false.
do i_flv = 1, n_flv
if (.not. term%passed_array(i_flv) .and. term%passed) cycle
do i_hel = 1, n_hel
i_flv_eqv = core%data%eqv_flv_index(i_flv)
i_hel_eqv = core%data%eqv_hel_index(i_hel)
if (.not. eqv_me_evaluated(i_flv_eqv, i_hel_eqv)) then
select type (core)
class is (prc_external_t)
call core%update_alpha_s (term%core_state, term%get_ren_scale ())
call core%compute_sqme (i_flv, i_hel, term%p_hard, &
term%get_ren_scale (), sqme, bad_point)
call term%pcm_work%set_bad_point (bad_point)
associate (i_int => term%int_hard%get_qn_index &
(i_flv = i_flv, i_hel = i_hel, i_sub = 0))
term%amp(i_int) = cmplx (sqme, 0, default)
end associate
end select
n_pdf_off = 0
if (term%pcm%has_pdfs .and. &
(term%is_subtraction () .or. term%nlo_type == NLO_DGLAP)) then
n_pdf_off = n_pdf_off + n_beams_rescaled
do i_sub = 1, n_pdf_off
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub)) = &
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub = 0))
end do
end if
if (term%pcm%has_pdfs .and. term%nlo_type == NLO_DGLAP) then
sqme_color_c = zero
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (pcm%settings%nlo_correction_type == "EW" .and. &
pcm%region_data%alphas_power > 0) then
select type (core)
class is (prc_blha_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%get_ren_scale (), sqme_color_c, &
bad_point)
call term%pcm_work%set_bad_point (bad_point)
class is (prc_recola_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%get_ren_scale (), sqme_color_c, &
bad_point)
call term%pcm_work%set_bad_point (bad_point)
end select
end if
end select
do i_sub = 1, n_sub_color
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel, i_sub + n_pdf_off)
term%amp(i_color_c) = cmplx (sqme_color_c(i_sub), 0, default)
end do
end if
if ((term%nlo_type == NLO_REAL .and. term%is_subtraction ()) .or. &
term%nlo_type == NLO_MISMATCH) then
sqme_color_c = zero
select type (core)
class is (prc_blha_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%get_ren_scale (), sqme_color_c, bad_point)
call term%pcm_work%set_bad_point (bad_point)
class is (prc_recola_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%get_ren_scale (), sqme_color_c, bad_point)
call term%pcm_work%set_bad_point (bad_point)
end select
do i_sub = 1, n_sub_color
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel, i_sub + n_pdf_off)
term%amp(i_color_c) = cmplx (sqme_color_c(i_sub), 0, default)
end do
if (n_sub_spin > 0) then
bad_point = .false.
allocate (sqme_spin_c(0))
select type (core)
type is (prc_openloops_t)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
do i_emitter = 1, pcm%region_data%n_emitters
emitter = pcm%region_data%emitters(i_emitter)
if (emitter > 0) then
call core%compute_sqme_spin_c &
(i_flv, &
i_hel, &
emitter, &
term%p_hard, &
term%get_ren_scale (), &
sqme_spin_c_tmp, &
bp)
sqme_spin_c = [sqme_spin_c, sqme_spin_c_tmp]
bad_point = bad_point .or. bp
end if
end do
end select
do i_sub = 1, n_sub_spin
i_spin_c = term%int_hard%get_qn_index (i_flv, i_hel, &
i_sub + n_pdf_off + n_sub_color)
term%amp(i_spin_c) = cmplx &
(sqme_spin_c(i_sub), 0, default)
end do
end select
deallocate (sqme_spin_c)
end if
end if
eqv_me_evaluated(i_flv_eqv, i_hel_eqv) = .true.
else
associate (i_int => term%int_hard%get_qn_index &
(i_flv = i_flv, i_hel = i_hel, i_sub = 0), &
i_int_eqv => term%int_hard%get_qn_index &
(i_flv = i_flv_eqv, i_hel = i_hel_eqv, i_sub = 0))
term%amp(i_int) = term%amp(i_int_eqv)
end associate
n_pdf_off = 0
if (term%pcm%has_pdfs .and. &
(term%is_subtraction () .or. term%nlo_type == NLO_DGLAP)) then
n_pdf_off = n_pdf_off + n_beams_rescaled
do i_sub = 1, n_pdf_off
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub)) = &
term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub = 0))
end do
end if
if (term%pcm%has_pdfs .and. term%nlo_type == NLO_DGLAP) then
do i_sub = 1, n_sub_color
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel, i_sub + n_pdf_off)
i_color_c_eqv = term%int_hard%get_qn_index &
(i_flv_eqv, i_hel_eqv, i_sub + n_pdf_off)
term%amp(i_color_c) = term%amp(i_color_c_eqv)
end do
end if
if ((term%nlo_type == NLO_REAL .and. term%is_subtraction ()) .or. &
term%nlo_type == NLO_MISMATCH) then
do i_sub = 1, n_sub_color
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel, i_sub + n_pdf_off)
i_color_c_eqv = term%int_hard%get_qn_index &
(i_flv_eqv, i_hel_eqv, i_sub + n_pdf_off)
term%amp(i_color_c) = term%amp(i_color_c_eqv)
end do
do i_sub = 1, n_sub_spin
i_spin_c = term%int_hard%get_qn_index (i_flv, i_hel, &
i_sub + n_pdf_off + n_sub_color)
i_spin_c_eqv = term%int_hard%get_qn_index (i_flv_eqv, i_hel_eqv, &
i_sub + n_pdf_off + n_sub_color)
term%amp(i_spin_c) = term%amp(i_spin_c_eqv)
end do
end if
end if
end do
end do
end subroutine term_instance_evaluate_interaction_external_tree
@ %def term_instance_evaluate_interaction_external_tree
@ Same as for [[term_instance_evaluate_interaction_external_tree]], but
for the integrated-subtraction and finite one-loop terms. We only need
color-correlated Born matrix elements, but an additional entry per
flavor structure for the finite one-loop contribution. We thus have
$2+n_{sub_color}$ entries in the [[term%amp]] for each [[i_flv]] and
[[i_hel]] combination.
If two or more flavor structures would produce the same amplitude we
only compute one and use the [[eqv_index]] determined by the
[[prc_core]] and just copy the result to improve performance.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_external_loop &
=> term_instance_evaluate_interaction_external_loop
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_interaction_external_loop &
(term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
end subroutine term_instance_evaluate_interaction_external_loop
<<Instances: procedures>>=
module subroutine term_instance_evaluate_interaction_external_loop &
(term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: n_hel, n_sub, n_flv
integer :: i, i_flv, i_hel, i_sub, i_virt, i_color_c, i_color_c_eqv
integer :: i_flv_eqv, i_hel_eqv
real(default), dimension(4) :: sqme_virt
real(default), dimension(:), allocatable :: sqme_color_c
real(default) :: es_scale
logical :: bad_point
logical, dimension(:,:), allocatable :: eqv_me_evaluated
if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_external_loop")
allocate (sqme_color_c (blha_result_array_size &
(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
n_flv = term%int_hard%get_qn_index_n_flv ()
n_hel = term%int_hard%get_qn_index_n_hel ()
n_sub = term%int_hard%get_qn_index_n_sub ()
allocate (eqv_me_evaluated(n_flv,n_hel))
eqv_me_evaluated = .false.
i_virt = 1
do i_flv = 1, n_flv
if (.not. term%passed_array(i_flv) .and. term%passed) cycle
do i_hel = 1, n_hel
i_flv_eqv = core%data%eqv_flv_index(i_flv)
i_hel_eqv = core%data%eqv_hel_index(i_hel)
if (.not. eqv_me_evaluated(i_flv_eqv, i_hel_eqv)) then
select type (core)
class is (prc_external_t)
if (allocated (term%es_scale)) then
es_scale = term%es_scale
else
es_scale = term%get_ren_scale ()
end if
call core%compute_sqme_virt (i_flv, i_hel, term%p_hard, &
term%get_ren_scale (), es_scale, &
term%pcm%blha_defaults%loop_method, &
sqme_virt, bad_point)
call term%pcm_work%set_bad_point (bad_point)
end select
associate (i_born => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = 0), &
i_loop => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = i_virt))
term%amp(i_loop) = cmplx (sqme_virt(3), 0, default)
term%amp(i_born) = cmplx (sqme_virt(4), 0, default)
end associate
select type (pcm => term%pcm)
type is (pcm_nlo_t)
select type (core)
class is (prc_blha_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%get_ren_scale (), &
sqme_color_c, bad_point)
call term%pcm_work%set_bad_point (bad_point)
do i_sub = 1 + i_virt, n_sub
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel = i_hel, i_sub = i_sub)
! Index shift: i_sub - i_virt
term%amp(i_color_c) = &
cmplx (sqme_color_c(i_sub - i_virt), 0, default)
end do
type is (prc_recola_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, &
term%p_hard, term%get_ren_scale (), sqme_color_c, bad_point)
call term%pcm_work%set_bad_point (bad_point)
do i_sub = 1 + i_virt, n_sub
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel = i_hel, i_sub = i_sub)
! Index shift: i_sub - i_virt
term%amp(i_color_c) = &
cmplx (sqme_color_c(i_sub - i_virt), 0, default)
end do
end select
end select
eqv_me_evaluated(i_flv_eqv, i_hel_eqv) = .true.
else
associate (i_born => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = 0), &
i_loop => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = i_virt), &
i_born_eqv => term%int_hard%get_qn_index &
(i_flv_eqv, i_hel = i_hel_eqv, i_sub = 0), &
i_loop_eqv => term%int_hard%get_qn_index &
(i_flv_eqv, i_hel = i_hel_eqv, i_sub = 1))
term%amp(i_loop) = term%amp(i_loop_eqv)
term%amp(i_born) = term%amp(i_born_eqv)
end associate
do i_sub = 1 + i_virt, n_sub
i_color_c = term%int_hard%get_qn_index &
(i_flv, i_hel = i_hel, i_sub = i_sub)
i_color_c_eqv = term%int_hard%get_qn_index &
(i_flv_eqv, i_hel = i_hel_eqv, i_sub = i_sub)
! Index shift: i_sub - i_virt
term%amp(i_color_c) = term%amp(i_color_c_eqv)
end do
end if
end do
end do
end subroutine term_instance_evaluate_interaction_external_loop
@ %def term_instance_evaluate_interaction_external_loop
@ Evaluate the trace. First evaluate the
structure-function chain (i.e., the density matrix of the incoming
partons). Do this twice, in case the sf-chain instances within
[[kin]] and [[isolated]] differ. Next, evaluate the hard
interaction, then compute the convolution with the initial state.
<<Instances: term instance: TBP>>=
procedure :: evaluate_trace => term_instance_evaluate_trace
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_trace (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
end subroutine term_instance_evaluate_trace
<<Instances: procedures>>=
module subroutine term_instance_evaluate_trace (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
real(default) :: fac_scale
if (allocated (term%fac_scale)) then
fac_scale = term%fac_scale
else
fac_scale = term%scale
end if
call kin%evaluate_sf_chain (fac_scale, term%negative_sf)
call term%evaluate_scaled_sf_chains (kin)
call term%isolated%evaluate_sf_chain (fac_scale)
call term%isolated%evaluate_trace ()
call term%connected%evaluate_trace ()
end subroutine term_instance_evaluate_trace
@ %def term_instance_evaluate_trace
@ Include rescaled structure functions due to NLO calculation. We
rescale the structure function for the real subtraction
[[sf_rescale_collinear]], the collinear counter terms
[[sf_rescale_dglap_t]] and for the case, in which we have an emitter
in the initial state, we rescale the kinematics for it using
[[sf_rescale_real_t]]. The references are arXiv:0709.2092,
Eqs.~(2.35)-(2.42).
Obviously, it is completely irrelevant, which beam is treated.
It becomes problematic when handling $ep$ collisions.
Gfortran 7/8/9 bug, has to remain in the main module:
<<Instances: term instance: TBP>>=
procedure :: evaluate_scaled_sf_chains => &
term_instance_evaluate_scaled_sf_chains
<<Instances: main procedures>>=
subroutine term_instance_evaluate_scaled_sf_chains (term, kin)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
class(sf_rescale_t), allocatable :: sf_rescale
if (.not. term%pcm%has_pdfs) return
if (term%nlo_type == NLO_REAL) then
if (term%is_subtraction ()) then
allocate (sf_rescale_collinear_t :: sf_rescale)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
select type (sf_rescale)
type is (sf_rescale_collinear_t)
call sf_rescale%set (pcm_work%real_kinematics%xi_tilde)
end select
end select
call kin%sf_chain%evaluate (term%get_fac_scale (), &
term%negative_sf, sf_rescale)
deallocate (sf_rescale)
else if (kin%emitter >= 0 .and. kin%emitter <= kin%n_in) then
allocate (sf_rescale_real_t :: sf_rescale)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
select type (sf_rescale)
type is (sf_rescale_real_t)
call sf_rescale%set (pcm_work%real_kinematics%xi_tilde * &
pcm_work%real_kinematics%xi_max (kin%i_phs), &
pcm_work%real_kinematics%y (kin%i_phs))
end select
end select
call kin%sf_chain%evaluate (term%get_fac_scale (), &
term%negative_sf, sf_rescale)
deallocate (sf_rescale)
else
call kin%sf_chain%evaluate (term%get_fac_scale (), term%negative_sf)
end if
else if (term%nlo_type == NLO_DGLAP) then
allocate (sf_rescale_dglap_t :: sf_rescale)
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
select type (sf_rescale)
type is (sf_rescale_dglap_t)
call sf_rescale%set (pcm_work%isr_kinematics%z)
end select
end select
call kin%sf_chain%evaluate (term%get_fac_scale (), &
term%negative_sf, sf_rescale)
deallocate (sf_rescale)
end if
end subroutine term_instance_evaluate_scaled_sf_chains
@ %def term_instance_evaluate_scaled_sf_chains
@ Evaluate the extra data that we need for processing the object as a
physical event.
<<Instances: term instance: TBP>>=
procedure :: evaluate_event_data => term_instance_evaluate_event_data
<<Instances: sub interfaces>>=
module subroutine term_instance_evaluate_event_data (term)
class(term_instance_t), intent(inout) :: term
end subroutine term_instance_evaluate_event_data
<<Instances: procedures>>=
module subroutine term_instance_evaluate_event_data (term)
class(term_instance_t), intent(inout) :: term
logical :: only_momenta
only_momenta = term%nlo_type > BORN
call term%isolated%evaluate_event_data (only_momenta)
call term%connected%evaluate_event_data (only_momenta)
end subroutine term_instance_evaluate_event_data
@ %def term_instance_evaluate_event_data
@
<<Instances: term instance: TBP>>=
procedure :: set_fac_scale => term_instance_set_fac_scale
<<Instances: sub interfaces>>=
module subroutine term_instance_set_fac_scale (term, fac_scale)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: fac_scale
end subroutine term_instance_set_fac_scale
<<Instances: procedures>>=
module subroutine term_instance_set_fac_scale (term, fac_scale)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: fac_scale
term%fac_scale = fac_scale
end subroutine term_instance_set_fac_scale
@ %def term_instance_set_fac_scale
@ Return data that might be useful for external processing. The
factorization scale and renormalization scale are identical to the
general scale if not explicitly set:
<<Instances: term instance: TBP>>=
procedure :: get_fac_scale => term_instance_get_fac_scale
procedure :: get_ren_scale => term_instance_get_ren_scale
<<Instances: sub interfaces>>=
module function term_instance_get_fac_scale (term) result (fac_scale)
class(term_instance_t), intent(in) :: term
real(default) :: fac_scale
end function term_instance_get_fac_scale
module function term_instance_get_ren_scale (term) result (ren_scale)
class(term_instance_t), intent(in) :: term
real(default) :: ren_scale
end function term_instance_get_ren_scale
<<Instances: procedures>>=
module function term_instance_get_fac_scale (term) result (fac_scale)
class(term_instance_t), intent(in) :: term
real(default) :: fac_scale
if (allocated (term%fac_scale)) then
fac_scale = term%fac_scale
else
fac_scale = term%scale
end if
end function term_instance_get_fac_scale
module function term_instance_get_ren_scale (term) result (ren_scale)
class(term_instance_t), intent(in) :: term
real(default) :: ren_scale
if (allocated (term%ren_scale)) then
ren_scale = term%ren_scale
else
ren_scale = term%scale
end if
end function term_instance_get_ren_scale
@ %def term_instance_get_fac_scale term_instance_get_ren_scale
@ We take the strong coupling from the process core. The value is calculated
when a new event is requested, so we should call it only after the event has
been evaluated. If it is not available there (a negative number is returned),
we take the value stored in the term configuration, which should be determined
by the model. If the model does not provide a value, the result is zero.
<<Instances: term instance: TBP>>=
procedure :: get_alpha_s => term_instance_get_alpha_s
<<Instances: sub interfaces>>=
module function term_instance_get_alpha_s (term, core) result (alpha_s)
class(term_instance_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
real(default) :: alpha_s
end function term_instance_get_alpha_s
<<Instances: procedures>>=
module function term_instance_get_alpha_s (term, core) result (alpha_s)
class(term_instance_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
real(default) :: alpha_s
alpha_s = core%get_alpha_s (term%core_state)
if (alpha_s < zero) alpha_s = term%config%alpha_s
end function term_instance_get_alpha_s
@ %def term_instance_get_alpha_s
@ The second helicity for [[helicities]] comes with a minus sign
because OpenLoops inverts the helicity index of antiparticles.
<<Instances: term instance: TBP>>=
procedure :: get_helicities_for_openloops => &
term_instance_get_helicities_for_openloops
<<Instances: sub interfaces>>=
module subroutine term_instance_get_helicities_for_openloops &
(term, helicities)
class(term_instance_t), intent(in) :: term
integer, dimension(:,:), allocatable, intent(out) :: helicities
end subroutine term_instance_get_helicities_for_openloops
<<Instances: procedures>>=
module subroutine term_instance_get_helicities_for_openloops &
(term, helicities)
class(term_instance_t), intent(in) :: term
integer, dimension(:,:), allocatable, intent(out) :: helicities
type(helicity_t), dimension(:), allocatable :: hel
type(quantum_numbers_t), dimension(:,:), allocatable :: qn
type(quantum_numbers_mask_t) :: qn_mask
integer :: h, i, j, n_in
call qn_mask%set_sub (1)
call term%isolated%trace%get_quantum_numbers_mask (qn_mask, qn)
n_in = term%int_hard%get_n_in ()
allocate (helicities (size (qn, dim=1), n_in))
allocate (hel (n_in))
do i = 1, size (qn, dim=1)
do j = 1, n_in
hel(j) = qn(i, j)%get_helicity ()
call hel(j)%diagonalize ()
call hel(j)%get_indices (h, h)
helicities (i, j) = h
end do
end do
end subroutine term_instance_get_helicities_for_openloops
@ %def term_instance_get_helicities_for_openloops
@
<<Instances: term instance: TBP>>=
procedure :: get_i_term_global => term_instance_get_i_term_global
<<Instances: sub interfaces>>=
elemental module function term_instance_get_i_term_global &
(term) result (i_term)
integer :: i_term
class(term_instance_t), intent(in) :: term
end function term_instance_get_i_term_global
<<Instances: procedures>>=
elemental module function term_instance_get_i_term_global &
(term) result (i_term)
integer :: i_term
class(term_instance_t), intent(in) :: term
i_term = term%config%i_term_global
end function term_instance_get_i_term_global
@ %def term_instance_get_i_term_global
@
<<Instances: term instance: TBP>>=
procedure :: is_subtraction => term_instance_is_subtraction
<<Instances: sub interfaces>>=
elemental module function term_instance_is_subtraction (term) result (sub)
logical :: sub
class(term_instance_t), intent(in) :: term
end function term_instance_is_subtraction
<<Instances: procedures>>=
elemental module function term_instance_is_subtraction (term) result (sub)
logical :: sub
class(term_instance_t), intent(in) :: term
sub = term%config%i_term_global == term%config%i_sub
end function term_instance_is_subtraction
@ %def term_instance_is_subtraction
@ Retrieve [[n_sub]] which was calculated in [[process_term_setup_interaction]].
<<Instances: term instance: TBP>>=
procedure :: get_n_sub => term_instance_get_n_sub
procedure :: get_n_sub_color => term_instance_get_n_sub_color
procedure :: get_n_sub_spin => term_instance_get_n_sub_spin
<<Instances: sub interfaces>>=
module function term_instance_get_n_sub (term) result (n_sub)
integer :: n_sub
class(term_instance_t), intent(in) :: term
end function term_instance_get_n_sub
module function term_instance_get_n_sub_color (term) result (n_sub_color)
integer :: n_sub_color
class(term_instance_t), intent(in) :: term
end function term_instance_get_n_sub_color
module function term_instance_get_n_sub_spin (term) result (n_sub_spin)
integer :: n_sub_spin
class(term_instance_t), intent(in) :: term
end function term_instance_get_n_sub_spin
<<Instances: procedures>>=
module function term_instance_get_n_sub (term) result (n_sub)
integer :: n_sub
class(term_instance_t), intent(in) :: term
n_sub = term%config%n_sub
end function term_instance_get_n_sub
module function term_instance_get_n_sub_color (term) result (n_sub_color)
integer :: n_sub_color
class(term_instance_t), intent(in) :: term
n_sub_color = term%config%n_sub_color
end function term_instance_get_n_sub_color
module function term_instance_get_n_sub_spin (term) result (n_sub_spin)
integer :: n_sub_spin
class(term_instance_t), intent(in) :: term
n_sub_spin = term%config%n_sub_spin
end function term_instance_get_n_sub_spin
@ %def term_instance_get_n_sub
@ %def term_instance_get_n_sub_color
@ %def term_instance_get_n_sub_spin
@
\subsection{The process instance}
NOTE: The description below represents the intended structure after
refactoring and disentangling the FKS-NLO vs. LO algorithm dependencies.
A process instance contains all process data that depend on the
sampling point and thus change often. In essence, it is an event
record at the elementary (parton) level. We do not call it such, to
avoid confusion with the actual event records. If decays are
involved, the latter are compositions of several elementary processes
(i.e., their instances).
We implement the process instance as an extension of the
[[mci_sampler_t]] that we need for computing integrals and generate
events.
The base type contains: the [[integrand]], the [[selected_channel]],
the two-dimensional array [[x]] of parameters, and the one-dimensional
array [[f]] of Jacobians. These subobjects are public and used for
communicating with the multi-channel integrator.
The [[process]] pointer accesses the process of which this record is
an instance. It is required whenever the calculation needs invariant
configuration data, therefore the process should stay in memory for
the whole lifetime of its instances.
The [[pcm]] pointer is a shortcut to the [[pcm]] (process-component
manager) component of the associated process, which we need wherever
the calculation depends on the overall algorithm.
The [[pcm_work]] component is the workspace for the [[pcm]] object
referenced above.
The [[evaluation_status]] code is used to check the current status.
In particular, failure at various stages is recorded there.
The [[count]] object records process evaluations, broken down
according to status.
The [[sqme]] value is the single real number that results from
evaluating and tracing the kinematics and matrix elements. This
is the number that is handed over to an integration routine.
The [[weight]] value is the event weight. It is defined when an event
has been generated from the process instance, either weighted or
unweighted. The value is the [[sqme]] value times Jacobian weights
from the integration, or unity, respectively.
The [[i_mci]] index chooses a subset of components that are associated with
a common parameter set and integrator, i.e., that are added coherently.
The [[sf_chain]] subobject is a realization of the beam and
structure-function configuration in the [[process]] object. It is not
used for calculation directly but serves as the template for the
sf-chain instances that are contained in the [[component]] objects.
The [[kinematics]] array contains the set of phase-space points that
are associated with the current calculation. The entries may correspond
to different process components and terms. (TODO wk 19-02-22: Not implemented yet.)
TODO wk 19-02-22: May include extra arrays for storing (squared) amplitude
data. The [[term]] data set may be reduced to just results, or
be removed altogether.
The [[term]] subobjects are workspace for evaluating kinematics,
matrix elements, cuts etc. The array entries correspond to the [[term]]
configuration entries in the associated process object.
The [[mci_work]] subobject contains the array of real input parameters (random
numbers) that generates the kinematical point. It also contains the workspace
for the MC integrators. The active entry of the [[mci_work]] array is
selected by the [[i_mci]] index above.
The [[hook]] pointer accesses a list of after evaluate objects which are
evalutated after the matrix element.
<<Instances: public>>=
public :: process_instance_t
<<Instances: types>>=
type, extends (mci_sampler_t) :: process_instance_t
type(process_t), pointer :: process => null ()
class(pcm_t), pointer :: pcm => null ()
class(pcm_workspace_t), allocatable :: pcm_work
integer :: evaluation_status = STAT_UNDEFINED
real(default) :: sqme = 0
real(default) :: weight = 0
real(default) :: excess = 0
integer :: n_dropped = 0
integer :: i_mci = 0
integer :: selected_channel = 0
type(sf_chain_t) :: sf_chain
type(kinematics_t), dimension(:), allocatable :: kin
type(term_instance_t), dimension(:), allocatable :: term
type(mci_work_t), dimension(:), allocatable :: mci_work
class(process_instance_hook_t), pointer :: hook => null ()
contains
<<Instances: process instance: TBP>>
end type process_instance_t
@ %def process_instance
@
Wrapper type for storing pointers to process instance objects in arrays.
<<Instances: public>>=
public :: process_instance_ptr_t
<<Instances: types>>=
type :: process_instance_ptr_t
type(process_instance_t), pointer :: p => null ()
end type process_instance_ptr_t
@ %def process_instance_ptr_t
@ The process hooks are first-in-last-out list of objects which are evaluated
after the phase space and matrixelement are evaluated. It is possible to
retrieve the sampler object and read the sampler information.
The hook object are part of the [[process_instance]] and therefore, share a
common lifetime. A data transfer, after the usual lifetime of the
[[process_instance]], is not provided, as such the finalisation procedure has to take care
of this! E.g. write the object to file from which later the collected
information can then be retrieved.
<<Instances: public>>=
public :: process_instance_hook_t
<<Instances: types>>=
type, abstract :: process_instance_hook_t
class(process_instance_hook_t), pointer :: next => null ()
contains
procedure(process_instance_hook_init), deferred :: init
procedure(process_instance_hook_final), deferred :: final
procedure(process_instance_hook_evaluate), deferred :: evaluate
end type process_instance_hook_t
@ %def process_instance_hook_t
@ We have to provide an [[init]], a [[final]] procedure and, for after evaluation, the
[[evaluate]] procedure.
The [[init]] procedures accesses [[var_list]] and current [[instance]] object.
<<Instances: public>>=
public :: process_instance_hook_final, process_instance_hook_evaluate
<<Instances: interfaces>>=
abstract interface
subroutine process_instance_hook_init (hook, var_list, instance, pdf_data)
import :: process_instance_hook_t, var_list_t, process_instance_t, pdf_data_t
class(process_instance_hook_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
type(pdf_data_t), intent(in), optional :: pdf_data
end subroutine process_instance_hook_init
subroutine process_instance_hook_final (hook)
import :: process_instance_hook_t
class(process_instance_hook_t), intent(inout) :: hook
end subroutine process_instance_hook_final
subroutine process_instance_hook_evaluate (hook, instance)
import :: process_instance_hook_t, process_instance_t
class(process_instance_hook_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
end subroutine process_instance_hook_evaluate
end interface
@ %def process_instance_hook_final, process_instance_hook_evaluate
@ The output routine contains a header with the most relevant
information about the process, copied from
[[process_metadata_write]]. We mark the active components by an asterisk.
The next section is the MC parameter input. The following sections
are written only if the evaluation status is beyond setting the
parameters, or if the [[verbose]] option is set.
<<Instances: process instance: TBP>>=
procedure :: write_header => process_instance_write_header
procedure :: write => process_instance_write
<<Instances: sub interfaces>>=
module subroutine process_instance_write_header (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine process_instance_write_header
module subroutine process_instance_write (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine process_instance_write
<<Instances: procedures>>=
module subroutine process_instance_write_header (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
if (associated (object%process)) then
call object%process%write_meta (u, testflag)
else
write (u, "(1x,A)") "Process instance [undefined process]"
return
end if
write (u, "(3x,A)", advance = "no") "status = "
select case (object%evaluation_status)
case (STAT_INITIAL); write (u, "(A)") "initialized"
case (STAT_ACTIVATED); write (u, "(A)") "activated"
case (STAT_BEAM_MOMENTA); write (u, "(A)") "beam momenta set"
case (STAT_FAILED_KINEMATICS); write (u, "(A)") "failed kinematics"
case (STAT_SEED_KINEMATICS); write (u, "(A)") "seed kinematics"
case (STAT_HARD_KINEMATICS); write (u, "(A)") "hard kinematics"
case (STAT_EFF_KINEMATICS); write (u, "(A)") "effective kinematics"
case (STAT_FAILED_CUTS); write (u, "(A)") "failed cuts"
case (STAT_PASSED_CUTS); write (u, "(A)") "passed cuts"
case (STAT_EVALUATED_TRACE); write (u, "(A)") "evaluated trace"
call write_separator (u)
write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
case (STAT_EVENT_COMPLETE); write (u, "(A)") "event complete"
call write_separator (u)
write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
write (u, "(3x,A,ES19.12)") "weight = ", object%weight
if (.not. vanishes (object%excess)) &
write (u, "(3x,A,ES19.12)") "excess = ", object%excess
case default; write (u, "(A)") "undefined"
end select
if (object%i_mci /= 0) then
call write_separator (u)
call object%mci_work(object%i_mci)%write (u, testflag)
end if
call write_separator (u, 2)
end subroutine process_instance_write_header
module subroutine process_instance_write (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
call object%write_header (u)
if (object%evaluation_status >= STAT_BEAM_MOMENTA) then
call object%sf_chain%write (u)
call write_separator (u, 2)
if (object%evaluation_status >= STAT_SEED_KINEMATICS) then
if (object%evaluation_status >= STAT_HARD_KINEMATICS) then
call write_separator (u, 2)
write (u, "(1x,A)") "Active terms:"
if (any (object%term%active)) then
do i = 1, size (object%term)
if (object%term(i)%active) then
call write_separator (u)
call object%term(i)%write (u, &
kin = object%kin(i), &
show_eff_state = &
object%evaluation_status >= STAT_EFF_KINEMATICS, &
testflag = testflag)
end if
end do
end if
end if
call write_separator (u, 2)
end if
end if
end subroutine process_instance_write
@ %def process_instance_write_header
@ %def process_instance_write
@ Initialization connects the instance with a process. All initial
information is transferred from the process object. The process
object contains templates for the interaction subobjects (beam and
term), but no evaluators. The initialization routine
creates evaluators for the matrix element trace, other evaluators
are left untouched.
Before we start generating, we double-check if the process library
has been updated after the process was initializated
([[check_library_sanity]]). This may happen if between integration
and event generation the library has been recompiled, so all links
become broken.
The [[instance]] object must have the [[target]] attribute (also in
any caller) since the initialization routine assigns various pointers
to subobject of [[instance]].
<<Instances: process instance: TBP>>=
procedure :: init => process_instance_init
<<Instances: sub interfaces>>=
module subroutine process_instance_init (instance, process)
class(process_instance_t), intent(out), target :: instance
type(process_t), intent(inout), target :: process
end subroutine process_instance_init
<<Instances: procedures>>=
module subroutine process_instance_init (instance, process)
class(process_instance_t), intent(out), target :: instance
type(process_t), intent(inout), target :: process
integer :: i
class(pcm_t), pointer :: pcm
type(process_term_t), pointer :: term
type(var_list_t), pointer :: var_list
integer :: i_born, i_real, i_real_fin, i_component
if (debug_on) call msg_debug &
(D_PROCESS_INTEGRATION, "process_instance_init")
instance%process => process
instance%pcm => process%get_pcm_ptr ()
call instance%process%check_library_sanity ()
call instance%setup_sf_chain (process%get_beam_config_ptr ())
allocate (instance%mci_work (process%get_n_mci ()))
do i = 1, size (instance%mci_work)
call instance%process%init_mci_work (instance%mci_work(i), i)
end do
call instance%process%reset_selected_cores ()
pcm => instance%process%get_pcm_ptr ()
call pcm%allocate_workspace (instance%pcm_work)
select type (pcm)
type is (pcm_nlo_t)
!!! The process is kept when the integration is finalized, but not the
!!! process_instance. Thus, we check whether pcm has been initialized
!!! but set up the pcm_work each time.
i_real_fin = process%get_associated_real_fin (1)
if (.not. pcm%initialized) then
i_born = pcm%get_i_core (pcm%i_born)
i_real = pcm%get_i_core (pcm%i_real)
call pcm%init_qn (process%get_model_ptr ())
if (i_real_fin > 0) call pcm%allocate_ps_matching ()
var_list => process%get_var_list_ptr ()
if (var_list%get_sval (var_str ("$dalitz_plot")) /= var_str ('')) &
call pcm%activate_dalitz_plot (var_list%get_sval (var_str ("$dalitz_plot")))
end if
pcm%initialized = .true.
select type (pcm_work => instance%pcm_work)
type is (pcm_nlo_workspace_t)
call pcm_work%init_config (pcm, &
process%component_can_be_integrated (), &
process%get_nlo_type_component (), process%get_energy (), &
i_real_fin, process%get_model_ptr ())
end select
end select
! TODO wk-03-01 n_terms will eventually acquire a different meaning
allocate (instance%kin (process%get_n_terms ()))
do i = 1, process%get_n_terms ()
term => process%get_term_ptr (i)
i_component = term%i_component
call instance%kin(i)%configure (pcm, instance%pcm_work, &
instance%sf_chain, &
process%get_beam_config_ptr (), &
process%get_phs_config (i_component), &
process%get_nlo_type_component (i_component), &
term%i_sub == i)
end do
! TODO wk-03-01 n_terms will eventually acquire a different meaning
allocate (instance%term (process%get_n_terms ()))
do i = 1, process%get_n_terms ()
call instance%term(i)%configure (process, i, instance%pcm_work, &
instance%sf_chain, instance%kin(i))
end do
call instance%set_i_mci_to_real_component ()
call instance%find_same_kinematics ()
instance%evaluation_status = STAT_INITIAL
end subroutine process_instance_init
@ %def process_instance_init
@
@ Finalize all subobjects that may contain allocated pointers.
<<Instances: process instance: TBP>>=
procedure :: final => process_instance_final
<<Instances: sub interfaces>>=
module subroutine process_instance_final (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_final
<<Instances: procedures>>=
module subroutine process_instance_final (instance)
class(process_instance_t), intent(inout) :: instance
class(process_instance_hook_t), pointer :: current
integer :: i
instance%process => null ()
if (allocated (instance%mci_work)) then
do i = 1, size (instance%mci_work)
call instance%mci_work(i)%final ()
end do
deallocate (instance%mci_work)
end if
call instance%sf_chain%final ()
if (allocated (instance%kin)) then
do i = 1, size (instance%kin)
call instance%kin(i)%final ()
end do
deallocate (instance%kin)
end if
if (allocated (instance%term)) then
do i = 1, size (instance%term)
call instance%term(i)%final ()
end do
deallocate (instance%term)
end if
call instance%pcm_work%final ()
instance%evaluation_status = STAT_UNDEFINED
do while (associated (instance%hook))
current => instance%hook
call current%final ()
instance%hook => current%next
deallocate (current)
end do
instance%hook => null ()
end subroutine process_instance_final
@ %def process_instance_final
@ Revert the process instance to initial state. We do not deallocate
anything, just reset the state index and deactivate all components and
terms.
We do not reset the choice of the MCI set [[i_mci]] unless this is
required explicitly.
<<Instances: process instance: TBP>>=
procedure :: reset => process_instance_reset
<<Instances: sub interfaces>>=
module subroutine process_instance_reset (instance, reset_mci)
class(process_instance_t), intent(inout), target :: instance
logical, intent(in), optional :: reset_mci
end subroutine process_instance_reset
<<Instances: procedures>>=
module subroutine process_instance_reset (instance, reset_mci)
class(process_instance_t), intent(inout), target :: instance
logical, intent(in), optional :: reset_mci
integer :: i
call instance%process%reset_selected_cores ()
do i = 1, size (instance%term)
call instance%term(i)%reset ()
end do
instance%term%checked = .false.
instance%term%passed = .false.
instance%kin%new_seed = .true.
if (present (reset_mci)) then
if (reset_mci) instance%i_mci = 0
end if
instance%selected_channel = 0
instance%evaluation_status = STAT_INITIAL
end subroutine process_instance_reset
@ %def process_instance_reset
@
\subsubsection{Integration and event generation}
The sampler test should just evaluate the squared matrix element [[n_calls]]
times, discarding the results, and return. This can be done before
integration, e.g., for timing estimates.
<<Instances: process instance: TBP>>=
procedure :: sampler_test => process_instance_sampler_test
<<Instances: sub interfaces>>=
module subroutine process_instance_sampler_test (instance, i_mci, n_calls)
class(process_instance_t), intent(inout), target :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_calls
end subroutine process_instance_sampler_test
<<Instances: procedures>>=
module subroutine process_instance_sampler_test (instance, i_mci, n_calls)
class(process_instance_t), intent(inout), target :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_calls
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
call instance%reset_counter ()
call instance%process%sampler_test (instance, n_calls, i_mci_work)
call instance%process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
end subroutine process_instance_sampler_test
@ %def process_instance_sampler_test
@ Generate a weighted event. We select one of the available MCI
integrators by its index [[i_mci]] and thus generate an event for the
associated (group of) process component(s). The arguments exactly
correspond to the initializer and finalizer above.
The resulting event is stored in the [[process_instance]] object,
which also holds the workspace of the integrator.
Note: The [[process]] object contains the random-number state, which
changes for each event.
Otherwise, all volatile data are inside the [[instance]] object.
<<Instances: process instance: TBP>>=
procedure :: generate_weighted_event => &
process_instance_generate_weighted_event
<<Instances: sub interfaces>>=
module subroutine process_instance_generate_weighted_event (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
end subroutine process_instance_generate_weighted_event
<<Instances: procedures>>=
module subroutine process_instance_generate_weighted_event (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
associate (mci_work => instance%mci_work(i_mci_work))
call instance%process%generate_weighted_event &
(i_mci_work, mci_work, instance, &
instance%keep_failed_events ())
end associate
end subroutine process_instance_generate_weighted_event
@ %def process_instance_generate_weighted_event
@
<<Instances: process instance: TBP>>=
procedure :: generate_unweighted_event => &
process_instance_generate_unweighted_event
<<Instances: sub interfaces>>=
module subroutine process_instance_generate_unweighted_event &
(instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
end subroutine process_instance_generate_unweighted_event
<<Instances: procedures>>=
module subroutine process_instance_generate_unweighted_event (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
associate (mci_work => instance%mci_work(i_mci_work))
call instance%process%generate_unweighted_event &
(i_mci_work, mci_work, instance)
end associate
end subroutine process_instance_generate_unweighted_event
@ %def process_instance_generate_unweighted_event
@
This replaces the event generation methods for the situation that the
process instance object has been filled by other means (i.e., reading
and/or recalculating its contents). We just have to fill in missing
MCI data, especially the event weight.
<<Instances: process instance: TBP>>=
procedure :: recover_event => process_instance_recover_event
<<Instances: sub interfaces>>=
module subroutine process_instance_recover_event (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_recover_event
<<Instances: procedures>>=
module subroutine process_instance_recover_event (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_mci
i_mci = instance%i_mci
call instance%process%set_i_mci_work (i_mci)
associate (mci_instance => instance%mci_work(i_mci)%mci)
call mci_instance%fetch (instance, instance%selected_channel)
end associate
end subroutine process_instance_recover_event
@ %def process_instance_recover_event
@
@ Activate the components and terms that correspond to a currently
selected MCI parameter set.
<<Instances: process instance: TBP>>=
procedure :: activate => process_instance_activate
<<Instances: sub interfaces>>=
module subroutine process_instance_activate (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_activate
<<Instances: procedures>>=
module subroutine process_instance_activate (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i, j
integer, dimension(:), allocatable :: i_term
associate (mci_work => instance%mci_work(instance%i_mci))
call instance%process%select_components &
(mci_work%get_active_components ())
end associate
associate (process => instance%process)
do i = 1, instance%process%get_n_components ()
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (process%get_component_i_terms (i))))
i_term = process%get_component_i_terms (i)
do j = 1, size (i_term)
instance%term(i_term(j))%active = .true.
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
end associate
instance%evaluation_status = STAT_ACTIVATED
end subroutine process_instance_activate
@ %def process_instance_activate
@
<<Instances: process instance: TBP>>=
procedure :: find_same_kinematics => process_instance_find_same_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_find_same_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_find_same_kinematics
<<Instances: procedures>>=
module subroutine process_instance_find_same_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_term1, i_term2, k, n_same
do i_term1 = 1, size (instance%term)
if (.not. allocated (instance%term(i_term1)%same_kinematics)) then
n_same = 1 !!! Index group includes the index of its term_instance
do i_term2 = 1, size (instance%term)
if (i_term1 == i_term2) cycle
if (compare_md5s (i_term1, i_term2)) n_same = n_same + 1
end do
allocate (instance%term(i_term1)%same_kinematics (n_same))
associate (same_kinematics1 => instance%term(i_term1)%same_kinematics)
same_kinematics1 = 0
k = 1
do i_term2 = 1, size (instance%term)
if (compare_md5s (i_term1, i_term2)) then
same_kinematics1(k) = i_term2
k = k + 1
end if
end do
do k = 1, size (same_kinematics1)
if (same_kinematics1(k) == i_term1) cycle
i_term2 = same_kinematics1(k)
allocate (instance%term(i_term2)%same_kinematics (n_same))
instance%term(i_term2)%same_kinematics = same_kinematics1
end do
end associate
end if
end do
contains
function compare_md5s (i, j) result (same)
logical :: same
integer, intent(in) :: i, j
character(32) :: md5sum_1, md5sum_2
integer :: mode_1, mode_2
mode_1 = 0; mode_2 = 0
select type (phs => instance%kin(i)%phs%config)
type is (phs_fks_config_t)
md5sum_1 = phs%md5sum_born_config
mode_1 = phs%mode
class default
md5sum_1 = phs%md5sum_phs_config
end select
select type (phs => instance%kin(j)%phs%config)
type is (phs_fks_config_t)
md5sum_2 = phs%md5sum_born_config
mode_2 = phs%mode
class default
md5sum_2 = phs%md5sum_phs_config
end select
same = (md5sum_1 == md5sum_2) .and. (mode_1 == mode_2)
end function compare_md5s
end subroutine process_instance_find_same_kinematics
@ %def process_instance_find_same_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: transfer_same_kinematics => &
process_instance_transfer_same_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_transfer_same_kinematics &
(instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
end subroutine process_instance_transfer_same_kinematics
<<Instances: procedures>>=
module subroutine process_instance_transfer_same_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: i, i_term_same
associate (same_kinematics => instance%term(i_term)%same_kinematics)
do i = 1, size (same_kinematics)
i_term_same = same_kinematics(i)
instance%term(i_term_same)%p_seed = instance%term(i_term)%p_seed
associate (phs => instance%kin(i_term_same)%phs)
call phs%set_lorentz_transformation &
(instance%kin(i_term)%phs%get_lorentz_transformation ())
select type (phs)
type is (phs_fks_t)
call phs%set_momenta (instance%term(i_term_same)%p_seed)
if (i_term_same /= i_term) then
call phs%set_reference_frames (.false.)
end if
end select
end associate
instance%kin(i_term_same)%new_seed = .false.
end do
end associate
end subroutine process_instance_transfer_same_kinematics
@ %def process_instance_transfer_same_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: redo_sf_chains => process_instance_redo_sf_chains
<<Instances: sub interfaces>>=
module subroutine process_instance_redo_sf_chains &
(instance, i_term, phs_channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), dimension(:) :: i_term
integer, intent(in) :: phs_channel
end subroutine process_instance_redo_sf_chains
<<Instances: procedures>>=
module subroutine process_instance_redo_sf_chains &
(instance, i_term, phs_channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), dimension(:) :: i_term
integer, intent(in) :: phs_channel
integer :: i
do i = 1, size (i_term)
call instance%kin(i_term(i))%redo_sf_chain &
(instance%mci_work(instance%i_mci), phs_channel)
end do
end subroutine process_instance_redo_sf_chains
@ %def process_instance_redo_sf_chains
@ Integrate the process, using a previously initialized process
instance. We select one of the available MCI integrators by its index
[[i_mci]] and thus integrate over (structure functions and) phase
space for the associated (group of) process component(s).
<<Instances: process instance: TBP>>=
procedure :: integrate => process_instance_integrate
<<Instances: sub interfaces>>=
module subroutine process_instance_integrate (instance, i_mci, &
n_it, n_calls, adapt_grids, adapt_weights, final, pacify)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
end subroutine process_instance_integrate
<<Instances: procedures>>=
module subroutine process_instance_integrate (instance, i_mci, &
n_it, n_calls, adapt_grids, adapt_weights, final, pacify)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
integer :: nlo_type, i_mci_work
nlo_type = instance%process%get_component_nlo_type (i_mci)
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
call instance%reset_counter ()
associate (mci_work => instance%mci_work(i_mci_work), &
process => instance%process)
call process%integrate (i_mci_work, mci_work, &
instance, n_it, n_calls, adapt_grids, adapt_weights, &
final, pacify, nlo_type = nlo_type)
call process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
end associate
end subroutine process_instance_integrate
@ %def process_instance_integrate
@ Subroutine of the initialization above: initialize the beam and
structure-function chain template. We establish pointers to the
configuration data, so [[beam_config]] must have a [[target]]
attribute.
The resulting chain is not used directly for calculation. It will
acquire instances which are stored in the process-component instance
objects.
<<Instances: process instance: TBP>>=
procedure :: setup_sf_chain => process_instance_setup_sf_chain
<<Instances: sub interfaces>>=
module subroutine process_instance_setup_sf_chain (instance, config)
class(process_instance_t), intent(inout) :: instance
type(process_beam_config_t), intent(in), target :: config
end subroutine process_instance_setup_sf_chain
<<Instances: procedures>>=
module subroutine process_instance_setup_sf_chain (instance, config)
class(process_instance_t), intent(inout) :: instance
type(process_beam_config_t), intent(in), target :: config
integer :: n_strfun
n_strfun = config%n_strfun
if (n_strfun /= 0) then
call instance%sf_chain%init (config%data, config%sf)
else
call instance%sf_chain%init (config%data)
end if
if (config%sf_trace) then
call instance%sf_chain%setup_tracing (config%sf_trace_file)
end if
end subroutine process_instance_setup_sf_chain
@ %def process_instance_setup_sf_chain
@ This initialization routine should be called only for process
instances which we intend as a source for physical events. It
initializes the evaluators in the parton states of the terms. They
describe the (semi-)exclusive transition matrix and the distribution
of color flow for the partonic process, convoluted with the beam and
structure-function chain.
If the model is not provided explicitly, we may use the model instance that
belongs to the process. However, an explicit model allows us to override
particle settings.
<<Instances: process instance: TBP>>=
procedure :: setup_event_data => process_instance_setup_event_data
<<Instances: sub interfaces>>=
module subroutine process_instance_setup_event_data &
(instance, model, i_core)
class(process_instance_t), intent(inout), target :: instance
class(model_data_t), intent(in), optional, target :: model
integer, intent(in), optional :: i_core
end subroutine process_instance_setup_event_data
<<Instances: procedures>>=
module subroutine process_instance_setup_event_data (instance, model, i_core)
class(process_instance_t), intent(inout), target :: instance
class(model_data_t), intent(in), optional, target :: model
integer, intent(in), optional :: i_core
class(model_data_t), pointer :: current_model
integer :: i
class(prc_core_t), pointer :: core => null ()
if (present (model)) then
current_model => model
else
current_model => instance%process%get_model_ptr ()
end if
do i = 1, size (instance%term)
associate (term => instance%term(i), kin => instance%kin(i))
if (associated (term%config)) then
core => instance%process%get_core_term (i)
call term%setup_event_data (kin, core, current_model)
end if
end associate
end do
core => null ()
end subroutine process_instance_setup_event_data
@ %def process_instance_setup_event_data
@ Choose a MC parameter set and the corresponding integrator.
The choice persists beyond calls of the [[reset]] method above. This method
is automatically called here.
<<Instances: process instance: TBP>>=
procedure :: choose_mci => process_instance_choose_mci
<<Instances: sub interfaces>>=
module subroutine process_instance_choose_mci (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
end subroutine process_instance_choose_mci
<<Instances: procedures>>=
module subroutine process_instance_choose_mci (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
instance%i_mci = i_mci
call instance%reset ()
end subroutine process_instance_choose_mci
@ %def process_instance_choose_mci
@ Explicitly set a MC parameter set. Works only if we are in initial
state. We assume that the length of the parameter set is correct.
After setting the parameters, activate the components and terms that
correspond to the chosen MC parameter set.
The [[warmup_flag]] is used when a dummy phase-space point is computed
for the warmup of e.g. OpenLoops helicities. The setting of the
the [[evaluation_status]] has to be avoided then.
<<Instances: process instance: TBP>>=
procedure :: set_mcpar => process_instance_set_mcpar
<<Instances: sub interfaces>>=
module subroutine process_instance_set_mcpar (instance, x, warmup_flag)
class(process_instance_t), intent(inout) :: instance
real(default), dimension(:), intent(in) :: x
logical, intent(in), optional :: warmup_flag
end subroutine process_instance_set_mcpar
<<Instances: procedures>>=
module subroutine process_instance_set_mcpar (instance, x, warmup_flag)
class(process_instance_t), intent(inout) :: instance
real(default), dimension(:), intent(in) :: x
logical, intent(in), optional :: warmup_flag
logical :: activate
activate = .true.; if (present (warmup_flag)) activate = .not. warmup_flag
if (instance%evaluation_status == STAT_INITIAL) then
associate (mci_work => instance%mci_work(instance%i_mci))
call mci_work%set (x)
end associate
if (activate) call instance%activate ()
end if
end subroutine process_instance_set_mcpar
@ %def process_instance_set_mcpar
@ Receive the beam momentum/momenta from a source interaction. This
applies to a cascade decay process instance, where the `beam' momentum
varies event by event.
The master beam momentum array is contained in the main structure
function chain subobject [[sf_chain]]. The sf-chain instance that
reside in the components will take their beam momenta from there.
The procedure transforms the instance status into
[[STAT_BEAM_MOMENTA]]. For process instance with fixed beam, this
intermediate status is skipped.
<<Instances: process instance: TBP>>=
procedure :: receive_beam_momenta => process_instance_receive_beam_momenta
<<Instances: sub interfaces>>=
module subroutine process_instance_receive_beam_momenta (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_receive_beam_momenta
<<Instances: procedures>>=
module subroutine process_instance_receive_beam_momenta (instance)
class(process_instance_t), intent(inout) :: instance
if (instance%evaluation_status >= STAT_INITIAL) then
call instance%sf_chain%receive_beam_momenta ()
instance%evaluation_status = STAT_BEAM_MOMENTA
end if
end subroutine process_instance_receive_beam_momenta
@ %def process_instance_receive_beam_momenta
@ Set the beam momentum/momenta explicitly. Otherwise, analogous to
the previous procedure.
<<Instances: process instance: TBP>>=
procedure :: set_beam_momenta => process_instance_set_beam_momenta
<<Instances: sub interfaces>>=
module subroutine process_instance_set_beam_momenta (instance, p)
class(process_instance_t), intent(inout) :: instance
type(vector4_t), dimension(:), intent(in) :: p
end subroutine process_instance_set_beam_momenta
<<Instances: procedures>>=
module subroutine process_instance_set_beam_momenta (instance, p)
class(process_instance_t), intent(inout) :: instance
type(vector4_t), dimension(:), intent(in) :: p
if (instance%evaluation_status >= STAT_INITIAL) then
call instance%sf_chain%set_beam_momenta (p)
instance%evaluation_status = STAT_BEAM_MOMENTA
end if
end subroutine process_instance_set_beam_momenta
@ %def process_instance_set_beam_momenta
@ Recover the initial beam momenta (those in the [[sf_chain]]
component), given a valid (recovered) [[sf_chain_instance]] in one of
the active components. We need to do this only if the lab frame is
not the c.m.\ frame, otherwise those beams would be fixed anyway.
<<Instances: process instance: TBP>>=
procedure :: recover_beam_momenta => process_instance_recover_beam_momenta
<<Instances: sub interfaces>>=
module subroutine process_instance_recover_beam_momenta (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
end subroutine process_instance_recover_beam_momenta
<<Instances: procedures>>=
module subroutine process_instance_recover_beam_momenta (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
if (.not. instance%process%lab_is_cm ()) then
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
call instance%kin(i_term)%return_beam_momenta ()
end if
end if
end subroutine process_instance_recover_beam_momenta
@ %def process_instance_recover_beam_momenta
@ Explicitly choose MC integration channel. We assume here that the channel
count is identical for all active components.
<<Instances: process instance: TBP>>=
procedure :: select_channel => process_instance_select_channel
<<Instances: sub interfaces>>=
module subroutine process_instance_select_channel (instance, channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
end subroutine process_instance_select_channel
<<Instances: procedures>>=
module subroutine process_instance_select_channel (instance, channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
instance%selected_channel = channel
end subroutine process_instance_select_channel
@ %def process_instance_select_channel
@ First step of process evaluation: set up seed kinematics. That is, for each
active process component, compute a momentum array from the MC input
parameters.
If [[skip_term]] is set, we skip the component that accesses this
term. We can assume that the associated data have already been
recovered, and we are just computing the rest.
<<Instances: process instance: TBP>>=
procedure :: compute_seed_kinematics => &
process_instance_compute_seed_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_compute_seed_kinematics &
(instance, recover, skip_term)
class(process_instance_t), intent(inout) :: instance
logical, intent(in), optional :: recover
integer, intent(in), optional :: skip_term
end subroutine process_instance_compute_seed_kinematics
<<Instances: procedures>>=
module subroutine process_instance_compute_seed_kinematics &
(instance, recover, skip_term)
class(process_instance_t), intent(inout) :: instance
logical, intent(in), optional :: recover
integer, intent(in), optional :: skip_term
integer :: channel, skip_component, i, j
logical :: success
integer, dimension(:), allocatable :: i_term
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Compute seed kinematics: undefined integration channel")
end if
if (present (skip_term)) then
skip_component = instance%term(skip_term)%config%i_component
else
skip_component = 0
end if
if (present (recover)) then
if (recover) return
end if
if (instance%evaluation_status >= STAT_ACTIVATED) then
success = .true.
do i = 1, instance%process%get_n_components ()
if (i == skip_component) cycle
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (instance%process%get_component_i_terms (i))))
i_term = instance%process%get_component_i_terms (i)
do j = 1, size (i_term)
associate (term => instance%term(i_term(j)), kin => instance%kin(i_term(j)))
if (kin%new_seed) then
call term%compute_seed_kinematics (kin, &
instance%mci_work(instance%i_mci), channel, success)
call instance%transfer_same_kinematics (i_term(j))
end if
if (.not. success) exit
select type (pcm => instance%pcm)
class is (pcm_nlo_t)
call term%evaluate_projections (kin)
call kin%evaluate_radiation_kinematics &
(instance%mci_work(instance%i_mci)%get_x_process ())
call kin%generate_fsr_in ()
call kin%compute_xi_ref_momenta (pcm%region_data, term%nlo_type)
end select
end associate
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
if (success) then
instance%evaluation_status = STAT_SEED_KINEMATICS
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
end if
associate (mci_work => instance%mci_work(instance%i_mci))
select type (pcm_work => instance%pcm_work)
class is (pcm_nlo_workspace_t)
call pcm_work%set_x_rad (mci_work%get_x_process ())
end select
end associate
end subroutine process_instance_compute_seed_kinematics
@ %def process_instance_compute_seed_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: get_x_process => process_instance_get_x_process
<<Instances: sub interfaces>>=
pure module function process_instance_get_x_process (instance) result (x)
real(default), dimension(:), allocatable :: x
class(process_instance_t), intent(in) :: instance
end function process_instance_get_x_process
<<Instances: procedures>>=
pure module function process_instance_get_x_process (instance) result (x)
real(default), dimension(:), allocatable :: x
class(process_instance_t), intent(in) :: instance
allocate (x(size (instance%mci_work(instance%i_mci)%get_x_process ())))
x = instance%mci_work(instance%i_mci)%get_x_process ()
end function process_instance_get_x_process
@ %def process_instance_get_x_process
@
<<Instances: process instance: TBP>>=
procedure :: get_active_component_type => &
process_instance_get_active_component_type
<<Instances: sub interfaces>>=
pure module function process_instance_get_active_component_type &
(instance) result (nlo_type)
integer :: nlo_type
class(process_instance_t), intent(in) :: instance
end function process_instance_get_active_component_type
<<Instances: procedures>>=
pure module function process_instance_get_active_component_type &
(instance) result (nlo_type)
integer :: nlo_type
class(process_instance_t), intent(in) :: instance
nlo_type = instance%process%get_component_nlo_type (instance%i_mci)
end function process_instance_get_active_component_type
@ %def process_instance_get_active_component_type
@ Inverse: recover missing parts of the kinematics from the momentum
configuration, which we know for a single term and component. Given
a channel, reconstruct the MC parameter set.
<<Instances: process instance: TBP>>=
procedure :: recover_mcpar => process_instance_recover_mcpar
<<Instances: sub interfaces>>=
module subroutine process_instance_recover_mcpar (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
end subroutine process_instance_recover_mcpar
<<Instances: procedures>>=
module subroutine process_instance_recover_mcpar (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: channel, i
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Recover MC parameters: undefined integration channel")
end if
call instance%kin(i_term)%recover_mcpar &
(instance%mci_work(instance%i_mci), channel, instance%term(i_term)%p_seed)
if (instance%term(i_term)%nlo_type == NLO_REAL) then
do i = 1, size (instance%term)
if (i /= i_term .and. instance%term(i)%nlo_type == NLO_REAL) then
if (instance%term(i)%active) then
call instance%kin(i)%recover_mcpar &
(instance%mci_work(instance%i_mci), channel, &
instance%term(i)%p_seed)
end if
end if
end do
end if
end if
end subroutine process_instance_recover_mcpar
@ %def process_instance_recover_mcpar
@ This is part of [[recover_mcpar]], extracted for the case when there is
no phase space and parameters to recover, but we still need the structure
function kinematics for evaluation.
<<Instances: process instance: TBP>>=
procedure :: recover_sfchain => process_instance_recover_sfchain
<<Instances: sub interfaces>>=
module subroutine process_instance_recover_sfchain (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
end subroutine process_instance_recover_sfchain
<<Instances: procedures>>=
module subroutine process_instance_recover_sfchain (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: channel
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Recover sfchain: undefined integration channel")
end if
call instance%kin(i_term)%recover_sfchain &
(channel, instance%term(i_term)%p_seed)
end if
end subroutine process_instance_recover_sfchain
@ %def process_instance_recover_sfchain
@ Second step of process evaluation: compute all momenta, for all active
components, from the seed kinematics.
<<Instances: process instance: TBP>>=
procedure :: compute_hard_kinematics => &
process_instance_compute_hard_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_compute_hard_kinematics &
(instance, recover, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
logical, intent(in), optional :: recover
end subroutine process_instance_compute_hard_kinematics
<<Instances: procedures>>=
module subroutine process_instance_compute_hard_kinematics &
(instance, recover, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
logical, intent(in), optional :: recover
integer :: i
logical :: success
success = .true.
if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
do i = 1, size (instance%term)
associate (term => instance%term(i), kin => instance%kin(i))
if (term%active) then
call term%compute_hard_kinematics &
(kin, recover, skip_term, success)
if (.not. success) exit
!!! Ren scale is zero when this is commented out! Understand!
if (term%nlo_type == NLO_REAL) &
call kin%redo_sf_chain (instance%mci_work(instance%i_mci), &
instance%selected_channel)
end if
end associate
end do
if (success) then
instance%evaluation_status = STAT_HARD_KINEMATICS
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
end if
end subroutine process_instance_compute_hard_kinematics
@ %def process_instance_setup_compute_hard_kinematics
@ Inverse: recover seed kinematics. We know the beam momentum
configuration and the outgoing momenta of the effective interaction,
for one specific term.
<<Instances: process instance: TBP>>=
procedure :: recover_seed_kinematics => &
process_instance_recover_seed_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_recover_seed_kinematics &
(instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
end subroutine process_instance_recover_seed_kinematics
<<Instances: procedures>>=
module subroutine process_instance_recover_seed_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
type(vector4_t), dimension(:), allocatable :: p_seed_ref
integer :: i
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
call instance%term(i_term)%recover_seed_kinematics (instance%kin(i_term))
if (instance%term(i_term)%nlo_type == NLO_REAL) then
allocate (p_seed_ref &
(instance%term(i_term)%isolated%int_eff%get_n_out ()))
p_seed_ref = instance%term(i_term)%isolated%int_eff%get_momenta &
(outgoing = .true.)
do i = 1, size (instance%term)
if (i /= i_term .and. instance%term(i)%nlo_type == NLO_REAL) then
if (instance%term(i)%active) then
call instance%term(i)%recover_seed_kinematics &
(instance%kin(i), p_seed_ref)
end if
end if
end do
end if
end if
end subroutine process_instance_recover_seed_kinematics
@ %def process_instance_recover_seed_kinematics
@ Third step of process evaluation: compute the effective momentum
configurations, for all active terms, from the hard kinematics.
<<Instances: process instance: TBP>>=
procedure :: compute_eff_kinematics => &
process_instance_compute_eff_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_compute_eff_kinematics &
(instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
end subroutine process_instance_compute_eff_kinematics
<<Instances: procedures>>=
module subroutine process_instance_compute_eff_kinematics &
(instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: i
if (instance%evaluation_status >= STAT_HARD_KINEMATICS) then
do i = 1, size (instance%term)
if (present (skip_term)) then
if (i == skip_term) cycle
end if
if (instance%term(i)%active) then
call instance%term(i)%compute_eff_kinematics ()
end if
end do
instance%evaluation_status = STAT_EFF_KINEMATICS
end if
end subroutine process_instance_compute_eff_kinematics
@ %def process_instance_setup_compute_eff_kinematics
@ Inverse: recover the hard kinematics from effective kinematics for
one term, then compute effective kinematics for the other terms.
<<Instances: process instance: TBP>>=
procedure :: recover_hard_kinematics => &
process_instance_recover_hard_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_recover_hard_kinematics &
(instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
end subroutine process_instance_recover_hard_kinematics
<<Instances: procedures>>=
module subroutine process_instance_recover_hard_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: i
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
call instance%term(i_term)%recover_hard_kinematics ()
do i = 1, size (instance%term)
if (i /= i_term) then
if (instance%term(i)%active) then
call instance%term(i)%compute_eff_kinematics ()
end if
end if
end do
instance%evaluation_status = STAT_EFF_KINEMATICS
end if
end subroutine process_instance_recover_hard_kinematics
@ %def recover_hard_kinematics
@ Fourth step of process evaluation: check cuts for all terms. Where
successful, compute any scales and weights. Otherwise, deactive the term.
If any of the terms has passed, set the state to [[STAT_PASSED_CUTS]].
The argument [[scale_forced]], if present, will override the scale calculation
in the term expressions.
<<Instances: process instance: TBP>>=
procedure :: evaluate_expressions => &
process_instance_evaluate_expressions
<<Instances: sub interfaces>>=
module subroutine process_instance_evaluate_expressions &
(instance, scale_forced)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), allocatable, optional :: scale_forced
end subroutine process_instance_evaluate_expressions
<<Instances: procedures>>=
module subroutine process_instance_evaluate_expressions &
(instance, scale_forced)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), allocatable, optional :: scale_forced
integer :: i
logical :: passed_real
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%term(i)%evaluate_expressions &
(instance%process%get_beam_config (), scale_forced)
end if
end do
call evaluate_real_scales_and_cuts ()
call set_ellis_sexton_scale ()
if (.not. passed_real) then
instance%evaluation_status = STAT_FAILED_CUTS
else
if (any (instance%term%passed)) then
instance%evaluation_status = STAT_PASSED_CUTS
else
instance%evaluation_status = STAT_FAILED_CUTS
end if
end if
end if
contains
subroutine evaluate_real_scales_and_cuts ()
integer :: i
passed_real = .true.
select type (pcm => instance%pcm)
type is (pcm_nlo_t)
do i = 1, size (instance%term)
if (instance%term(i)%active .and. instance%term(i)%nlo_type == NLO_REAL) then
if (pcm%settings%cut_all_real_sqmes) &
passed_real = passed_real .and. instance%term(i)%passed
if (pcm%settings%use_born_scale) &
call replace_scales (instance%term(i))
end if
end do
end select
end subroutine evaluate_real_scales_and_cuts
subroutine replace_scales (this_term)
type(term_instance_t), intent(inout) :: this_term
integer :: i_sub
i_sub = this_term%config%i_sub
if (this_term%config%i_term_global /= i_sub .and. i_sub > 0) then
this_term%ren_scale = instance%term(i_sub)%ren_scale
this_term%fac_scale = instance%term(i_sub)%fac_scale
end if
end subroutine replace_scales
subroutine set_ellis_sexton_scale ()
real(default) :: es_scale
type(var_list_t), pointer :: var_list
integer :: i
var_list => instance%process%get_var_list_ptr ()
es_scale = var_list%get_rval (var_str ("ellis_sexton_scale"))
do i = 1, size (instance%term)
if (instance%term(i)%active .and. instance%term(i)%nlo_type == NLO_VIRTUAL) then
if (es_scale > zero) then
if (allocated (instance%term(i)%es_scale)) then
instance%term(i)%es_scale = es_scale
else
allocate (instance%term(i)%es_scale, source=es_scale)
end if
end if
end if
end do
end subroutine set_ellis_sexton_scale
end subroutine process_instance_evaluate_expressions
@ %def process_instance_evaluate_expressions
@ Fifth step of process evaluation: fill the parameters for the non-selected
channels, that have not been used for seeding. We should do this after
evaluating cuts, since we may save some expensive calculations if the phase
space point fails the cuts.
If [[skip_term]] is set, we skip the component that accesses this
term. We can assume that the associated data have already been
recovered, and we are just computing the rest.
<<Instances: process instance: TBP>>=
procedure :: compute_other_channels => &
process_instance_compute_other_channels
<<Instances: sub interfaces>>=
module subroutine process_instance_compute_other_channels &
(instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
end subroutine process_instance_compute_other_channels
<<Instances: procedures>>=
module subroutine process_instance_compute_other_channels &
(instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: channel, skip_component, i, j
integer, dimension(:), allocatable :: i_term
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Compute other channels: undefined integration channel")
end if
if (present (skip_term)) then
skip_component = instance%term(skip_term)%config%i_component
else
skip_component = 0
end if
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, instance%process%get_n_components ()
if (i == skip_component) cycle
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (instance%process%get_component_i_terms (i))))
i_term = instance%process%get_component_i_terms (i)
do j = 1, size (i_term)
call instance%kin(i_term(j))%compute_other_channels &
(instance%mci_work(instance%i_mci), channel)
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
end if
end subroutine process_instance_compute_other_channels
@ %def process_instance_compute_other_channels
@ If not done otherwise, we flag the kinematics as new for the core state,
such that the routine below will actually compute the matrix element and not
just look it up.
<<Instances: process instance: TBP>>=
procedure :: reset_core_kinematics => process_instance_reset_core_kinematics
<<Instances: sub interfaces>>=
module subroutine process_instance_reset_core_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_reset_core_kinematics
<<Instances: procedures>>=
module subroutine process_instance_reset_core_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active .and. term%passed) then
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
end if
end associate
end do
end if
end subroutine process_instance_reset_core_kinematics
@ %def process_instance_reset_core_kinematics
@ Sixth step of process evaluation: evaluate the matrix elements, and compute
the trace (summed over quantum numbers) for all terms. Finally, sum up the
terms, iterating over all active process components.
<<Instances: process instance: TBP>>=
procedure :: evaluate_trace => process_instance_evaluate_trace
<<Instances: sub interfaces>>=
module subroutine process_instance_evaluate_trace (instance, recover)
class(process_instance_t), intent(inout) :: instance
logical, intent(in), optional :: recover
end subroutine process_instance_evaluate_trace
<<Instances: procedures>>=
module subroutine process_instance_evaluate_trace (instance, recover)
class(process_instance_t), intent(inout) :: instance
logical, intent(in), optional :: recover
class(prc_core_t), pointer :: core => null ()
integer :: i, i_real_fin, i_core, i_qn, i_flv
real(default) :: alpha_s, alpha_qed
class(prc_core_t), pointer :: core_sub => null ()
class(model_data_t), pointer :: model => null ()
logical :: has_pdfs
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_evaluate_trace")
has_pdfs = instance%process%pcm_contains_pdfs ()
instance%sqme = zero
call instance%reset_matrix_elements ()
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, size (instance%term)
associate (term => instance%term(i), kin => instance%kin(i))
if (term%active .and. term%passed) then
core => instance%process%get_core_term (i)
select type (pcm => instance%process%get_pcm_ptr ())
class is (pcm_nlo_t)
i_core = pcm%get_i_core (pcm%i_sub)
core_sub => instance%process%get_core_ptr (i_core)
end select
call term%evaluate_interaction (core, kin)
call term%evaluate_trace (kin)
i_real_fin = instance%process%get_associated_real_fin (1)
if (instance%process%uses_real_partition ()) &
call term%apply_real_partition (kin)
if (term%config%i_component /= i_real_fin) then
if (term%nlo_type == BORN) then
do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
i_qn = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
if (.not. term%passed_array(i_flv)) then
call term%connected%trace%set_matrix_element &
(i_qn, cmplx (zero, zero, default))
end if
end do
end if
if ((term%nlo_type == NLO_REAL .and. kin%emitter < 0) &
.or. term%nlo_type == NLO_MISMATCH &
.or. term%nlo_type == NLO_DGLAP) &
call term%set_born_sqmes (core)
if (term%is_subtraction () .or. &
term%nlo_type == NLO_DGLAP) &
call term%set_sf_factors (kin, has_pdfs)
if (term%nlo_type > BORN) then
if (.not. (term%nlo_type == NLO_REAL .and. &
kin%emitter >= 0)) then
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (char (pcm%settings%nlo_correction_type) == "QCD" .or. &
char (pcm%settings%nlo_correction_type) == "Full") &
call term%evaluate_color_correlations (core_sub)
if (char (pcm%settings%nlo_correction_type) == "EW" .or. &
char (pcm%settings%nlo_correction_type) == "Full") then
call term%evaluate_charge_correlations (core_sub)
select type (pcm => term%pcm)
type is (pcm_nlo_t)
associate (reg_data => pcm%region_data)
if (reg_data%alphas_power > 0) &
call term%evaluate_color_correlations (core_sub)
end associate
end select
end if
end select
end if
if (term%is_subtraction ()) then
call term%evaluate_spin_correlations (core_sub)
end if
end if
alpha_s = core%get_alpha_s (term%core_state)
alpha_qed = core%get_alpha_qed (term%core_state)
if (term%nlo_type > BORN) then
select type (pcm => term%pcm)
type is (pcm_nlo_t)
if (alpha_qed == -1 .and. (&
char (pcm%settings%nlo_correction_type) == "EW" .or. &
char (pcm%settings%nlo_correction_type) == "Full")) then
call msg_bug("Attempting to compute EW corrections with alpha_qed = -1")
end if
end select
end if
if (present (recover)) then
if (recover) return
end if
select case (term%nlo_type)
case (NLO_REAL)
call term%apply_fks (kin, alpha_s, alpha_qed)
case (NLO_VIRTUAL)
call term%evaluate_sqme_virt (alpha_s, alpha_qed)
case (NLO_MISMATCH)
call term%evaluate_sqme_mismatch (alpha_s)
case (NLO_DGLAP)
call term%evaluate_sqme_dglap (alpha_s, alpha_qed)
end select
end if
end if
core_sub => null ()
instance%sqme = instance%sqme + real (sum (&
term%connected%trace%get_matrix_element () * &
term%weight))
end associate
end do
core => null ()
if (instance%pcm_work%is_valid ()) then
instance%evaluation_status = STAT_EVALUATED_TRACE
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
else
!!! Failed kinematics or failed cuts: set sqme to zero
instance%sqme = zero
end if
end subroutine process_instance_evaluate_trace
@ %def process_instance_evaluate_trace
<<Instances: term instance: TBP>>=
procedure :: set_born_sqmes => term_instance_set_born_sqmes
<<Instances: sub interfaces>>=
module subroutine term_instance_set_born_sqmes (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
end subroutine term_instance_set_born_sqmes
<<Instances: procedures>>=
module subroutine term_instance_set_born_sqmes (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: i_flv, ii_flv
real(default) :: sqme
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
ii_flv = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
if (term%passed_array (i_flv) .or. .not. term%passed) then
sqme = real (term%connected%trace%get_matrix_element (ii_flv))
else
sqme = zero
end if
select case (term%nlo_type)
case (NLO_REAL)
pcm_work%real_sub%sqme_born(i_flv) = sqme
case (NLO_MISMATCH)
pcm_work%soft_mismatch%sqme_born(i_flv) = sqme
case (NLO_DGLAP)
pcm_work%dglap_remnant%sqme_born(i_flv) = sqme
end select
end do
end select
end subroutine term_instance_set_born_sqmes
@ %def term_instance_set_born_sqmes
@ Calculates and then saves the ratio of the value of the (rescaled) real
structure function chain of each ISR alpha region over the value of the
corresponding underlying born flavor structure. In the case of emitter
0 we also need the rescaled ratio for emitter 1 and 2 in that region
for the (soft-)collinear limits. If the emitter is 1 or 2 in some
cases, e. g. for EW corrections where a photon in the proton is
required, there can be the possibility of soft radiation off the
initial state. For that purpose the unrescaled ratio is needed and as
a default we always save these numbers in [[sf_factors(:,0)]]. Although
this procedure is implying functionality for general structure functions,
it should be reviewed for anything else besides PDFs, as there might
be complications in the details. The general idea of getting the ratio
in this way should hold up in these cases as well, however.
<<Instances: term instance: TBP>>=
procedure :: set_sf_factors => term_instance_set_sf_factors
<<Instances: sub interfaces>>=
module subroutine term_instance_set_sf_factors (term, kin, has_pdfs)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
logical, intent(in) :: has_pdfs
end subroutine term_instance_set_sf_factors
<<Instances: procedures>>=
module subroutine term_instance_set_sf_factors (term, kin, has_pdfs)
class(term_instance_t), intent(inout) :: term
type(kinematics_t), intent(inout) :: kin
logical, intent(in) :: has_pdfs
type(interaction_t), pointer :: sf_chain_int
real(default) :: factor_born, factor_real
integer :: n_in, alr, em
integer :: i_born, i_real
select type (pcm_work => term%pcm_work)
type is (pcm_nlo_workspace_t)
if (.not. has_pdfs) then
pcm_work%real_sub%sf_factors = one
return
end if
select type (pcm => term%pcm)
type is (pcm_nlo_t)
sf_chain_int => kin%sf_chain%get_out_int_ptr ()
associate (reg_data => pcm%region_data)
n_in = reg_data%get_n_in ()
do alr = 1, reg_data%n_regions
em = reg_data%regions(alr)%emitter
if (em <= n_in) then
i_born = reg_data%regions(alr)%uborn_index
i_real = reg_data%regions(alr)%real_index
factor_born = sf_chain_int%get_matrix_element &
(sf_chain_int%get_sf_qn_index_born (i_born, i_sub = 0))
factor_real = sf_chain_int%get_matrix_element &
(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = em))
call set_factor (pcm_work, alr, em, factor_born, factor_real)
if (em == 0) then
do em = 1, 2
factor_real = sf_chain_int%get_matrix_element &
(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = em))
call set_factor (pcm_work, alr, em, factor_born, factor_real)
end do
else
factor_real = sf_chain_int%get_matrix_element &
(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = 0))
call set_factor (pcm_work, alr, 0, factor_born, factor_real)
end if
end if
end do
end associate
end select
end select
contains
subroutine set_factor (pcm_work, alr, em, factor_born, factor_real)
type(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
integer, intent(in) :: alr, em
real(default), intent(in) :: factor_born, factor_real
real(default) :: factor
if (any (vanishes ([factor_real, factor_born], tiny(1._default), tiny(1._default)))) then
factor = zero
else
factor = factor_real / factor_born
end if
select case (term%nlo_type)
case (NLO_REAL)
pcm_work%real_sub%sf_factors(alr, em) = factor
case (NLO_DGLAP)
pcm_work%dglap_remnant%sf_factors(alr, em) = factor
end select
end subroutine
end subroutine term_instance_set_sf_factors
@ %def term_instance_set_sf_factors
@
<<Instances: process instance: TBP>>=
procedure :: apply_real_partition => process_instance_apply_real_partition
<<Instances: sub interfaces>>=
module subroutine process_instance_apply_real_partition (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_apply_real_partition
<<Instances: procedures>>=
module subroutine process_instance_apply_real_partition (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_component, i_term
integer, dimension(:), allocatable :: i_terms
associate (process => instance%process)
i_component = process%get_first_real_component ()
if (process%component_is_selected (i_component) .and. &
process%get_component_nlo_type (i_component) == NLO_REAL) then
allocate (i_terms &
(size (process%get_component_i_terms (i_component))))
i_terms = process%get_component_i_terms (i_component)
do i_term = 1, size (i_terms)
call instance%term(i_terms(i_term))%apply_real_partition ( &
instance%kin(i_terms(i_term)))
end do
end if
if (allocated (i_terms)) deallocate (i_terms)
end associate
end subroutine process_instance_apply_real_partition
@ %def process_instance_apply_real_partition
@
<<Instances: process instance: TBP>>=
procedure :: set_i_mci_to_real_component => &
process_instance_set_i_mci_to_real_component
<<Instances: sub interfaces>>=
module subroutine process_instance_set_i_mci_to_real_component (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_set_i_mci_to_real_component
<<Instances: procedures>>=
module subroutine process_instance_set_i_mci_to_real_component (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_mci, i_component
type(process_component_t), pointer :: component => null ()
select type (pcm_work => instance%pcm_work)
type is (pcm_nlo_workspace_t)
if (allocated (pcm_work%i_mci_to_real_component)) then
call msg_warning &
("i_mci_to_real_component already allocated - replace it")
deallocate (pcm_work%i_mci_to_real_component)
end if
allocate (pcm_work%i_mci_to_real_component (size (instance%mci_work)))
do i_mci = 1, size (instance%mci_work)
do i_component = 1, instance%process%get_n_components ()
component => instance%process%get_component_ptr (i_component)
if (component%i_mci /= i_mci) cycle
select case (component%component_type)
case (COMP_MASTER, COMP_REAL)
pcm_work%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real ()
case (COMP_REAL_FIN)
pcm_work%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real_fin ()
case (COMP_REAL_SING)
pcm_work%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real_sing ()
end select
end do
end do
component => null ()
end select
end subroutine process_instance_set_i_mci_to_real_component
@ %def process_instance_set_i_mci_to_real_component
@ Final step of process evaluation: evaluate the matrix elements, and compute
the trace (summed over quantum numbers) for all terms. Finally, sum up the
terms, iterating over all active process components.
If [[weight]] is provided, we already know the kinematical event
weight (the MCI weight which depends on the kinematics sampling
algorithm, but not on the matrix element), so we do not need to take
it from the MCI record.
<<Instances: process instance: TBP>>=
procedure :: evaluate_event_data => process_instance_evaluate_event_data
<<Instances: sub interfaces>>=
module subroutine process_instance_evaluate_event_data (instance, weight)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: weight
end subroutine process_instance_evaluate_event_data
<<Instances: procedures>>=
module subroutine process_instance_evaluate_event_data (instance, weight)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: weight
integer :: i
if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active) then
call term%evaluate_event_data ()
end if
end associate
end do
if (present (weight)) then
instance%weight = weight
else
instance%weight = &
instance%mci_work(instance%i_mci)%mci%get_event_weight ()
instance%excess = &
instance%mci_work(instance%i_mci)%mci%get_event_excess ()
end if
instance%n_dropped = &
instance%mci_work(instance%i_mci)%mci%get_n_event_dropped ()
instance%evaluation_status = STAT_EVENT_COMPLETE
else
!!! failed kinematics etc.: set weight to zero
instance%weight = zero
!!! Maybe we want to process and keep the event nevertheless
if (instance%keep_failed_events ()) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active) then
call term%evaluate_event_data ()
end if
end associate
end do
! do i = 1, size (instance%term)
! instance%term(i)%fac_scale = zero
! end do
instance%evaluation_status = STAT_EVENT_COMPLETE
end if
end if
end subroutine process_instance_evaluate_event_data
@ %def process_instance_evaluate_event_data
@ Computes the real-emission matrix element for externally supplied momenta
for the term instance with index [[i_term]] and a phase space point set with
index [[i_phs]]. In addition, for the real emission, each term instance
corresponds to one emitter. There is the possibility to supply an external
$\alpha_s$ as well as an external scale to override the scale set in the
Sindarin, e.g. for POWHEG.
<<Instances: process instance: TBP>>=
procedure :: compute_sqme_rad => process_instance_compute_sqme_rad
<<Instances: sub interfaces>>=
module subroutine process_instance_compute_sqme_rad (instance, &
i_term, i_phs, is_subtraction, alpha_s_external, scale_forced)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term, i_phs
logical, intent(in) :: is_subtraction
real(default), intent(in), optional :: alpha_s_external
real(default), intent(in), allocatable, optional :: scale_forced
end subroutine process_instance_compute_sqme_rad
<<Instances: procedures>>=
module subroutine process_instance_compute_sqme_rad (instance, &
i_term, i_phs, is_subtraction, alpha_s_external, scale_forced)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term, i_phs
logical, intent(in) :: is_subtraction
real(default), intent(in), optional :: alpha_s_external
real(default), intent(in), allocatable, optional :: scale_forced
class(prc_core_t), pointer :: core
integer :: i_real_fin
logical :: has_pdfs
has_pdfs = instance%process%pcm_contains_pdfs ()
if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_compute_sqme_rad")
select type (pcm_work => instance%pcm_work)
type is (pcm_nlo_workspace_t)
associate (term => instance%term(i_term), kin => instance%kin(i_term))
core => instance%process%get_core_term (i_term)
if (is_subtraction) then
call pcm_work%set_subtraction_event ()
else
call pcm_work%set_radiation_event ()
end if
call term%int_hard%set_momenta (pcm_work%get_momenta &
(term%pcm, i_phs = i_phs, born_phsp = is_subtraction))
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
if (present (alpha_s_external)) then
call term%set_alpha_qcd_forced (alpha_s_external)
end if
call term%compute_eff_kinematics ()
call term%evaluate_expressions &
(instance%process%get_beam_config (), scale_forced)
call term%evaluate_interaction (core, kin)
call term%evaluate_trace (kin)
if (term%is_subtraction ()) then
call term%set_sf_factors (kin, has_pdfs)
select type (pcm => instance%pcm)
type is (pcm_nlo_t)
if (char (pcm%settings%nlo_correction_type) == "QCD" .or. &
char (pcm%settings%nlo_correction_type) == "Full") &
call term%evaluate_color_correlations (core)
if (char (pcm%settings%nlo_correction_type) == "EW" .or. &
char (pcm%settings%nlo_correction_type) == "Full") &
call term%evaluate_charge_correlations (core)
end select
call term%evaluate_spin_correlations (core)
end if
i_real_fin = instance%process%get_associated_real_fin (1)
if (term%config%i_component /= i_real_fin) &
call term%apply_fks (kin, core%get_alpha_s (term%core_state), &
core%get_alpha_qed (term%core_state))
if (instance%process%uses_real_partition ()) &
call instance%apply_real_partition ()
end associate
end select
core => null ()
end subroutine process_instance_compute_sqme_rad
@ %def process_instance_compute_sqme_rad
@ For unweighted event generation, we should reset the reported event
weight to unity (signed) or zero. The latter case is appropriate for
an event which failed for whatever reason.
<<Instances: process instance: TBP>>=
procedure :: normalize_weight => process_instance_normalize_weight
<<Instances: sub interfaces>>=
module subroutine process_instance_normalize_weight (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_normalize_weight
<<Instances: procedures>>=
module subroutine process_instance_normalize_weight (instance)
class(process_instance_t), intent(inout) :: instance
if (.not. vanishes (instance%weight)) then
instance%weight = sign (1._default, instance%weight)
end if
end subroutine process_instance_normalize_weight
@ %def process_instance_normalize_weight
@ This is a convenience routine that performs the computations of the
steps 1 to 5 in a single step. The arguments are the input for
[[set_mcpar]]. After this, the evaluation status should be either
[[STAT_FAILED_KINEMATICS]], [[STAT_FAILED_CUTS]] or [[STAT_EVALUATED_TRACE]].
Before calling this, we should call [[choose_mci]].
<<Instances: process instance: TBP>>=
procedure :: evaluate_sqme => process_instance_evaluate_sqme
<<Instances: sub interfaces>>=
module subroutine process_instance_evaluate_sqme (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(in) :: x
end subroutine process_instance_evaluate_sqme
<<Instances: procedures>>=
module subroutine process_instance_evaluate_sqme (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(in) :: x
call instance%reset ()
call instance%set_mcpar (x)
call instance%select_channel (channel)
call instance%compute_seed_kinematics ()
call instance%compute_hard_kinematics ()
call instance%compute_eff_kinematics ()
call instance%evaluate_expressions ()
call instance%compute_other_channels ()
call instance%evaluate_trace ()
end subroutine process_instance_evaluate_sqme
@ %def process_instance_evaluate_sqme
@ This is the inverse. Assuming that the final trace evaluator
contains a valid momentum configuration, recover kinematics
and recalculate the matrix elements and their trace.
To be precise, we first recover kinematics for the given term and
associated component, then recalculate from that all other terms and
active components. The [[channel]] is not really required to obtain
the matrix element, but it allows us to reconstruct the exact MC
parameter set that corresponds to the given phase space point.
Before calling this, we should call [[choose_mci]].
<<Instances: process instance: TBP>>=
procedure :: recover => process_instance_recover
<<Instances: sub interfaces>>=
module subroutine process_instance_recover &
(instance, channel, i_term, update_sqme, recover_phs, scale_forced)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
integer, intent(in) :: i_term
logical, intent(in) :: update_sqme
logical, intent(in) :: recover_phs
real(default), intent(in), allocatable, optional :: scale_forced
end subroutine process_instance_recover
<<Instances: procedures>>=
module subroutine process_instance_recover &
(instance, channel, i_term, update_sqme, recover_phs, scale_forced)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
integer, intent(in) :: i_term
logical, intent(in) :: update_sqme
logical, intent(in) :: recover_phs
real(default), intent(in), allocatable, optional :: scale_forced
logical :: skip_phs, recover
call instance%activate ()
instance%evaluation_status = STAT_EFF_KINEMATICS
call instance%recover_hard_kinematics (i_term)
call instance%recover_seed_kinematics (i_term)
call instance%select_channel (channel)
recover = instance%pcm_work%is_nlo ()
if (recover_phs) then
call instance%recover_mcpar (i_term)
call instance%recover_beam_momenta (i_term)
call instance%compute_seed_kinematics &
(recover = recover, skip_term = i_term)
call instance%compute_hard_kinematics &
(recover = recover, skip_term = i_term)
call instance%compute_eff_kinematics (i_term)
call instance%compute_other_channels (i_term)
else
call instance%recover_sfchain (i_term)
end if
call instance%evaluate_expressions (scale_forced)
if (update_sqme) then
call instance%reset_core_kinematics ()
call instance%evaluate_trace (recover)
end if
end subroutine process_instance_recover
@ %def process_instance_recover
@ The [[evaluate]] method is required by the [[sampler_t]] base type of which
the process instance is an extension.
The requirement is that after the process instance is evaluated, the
integrand, the selected channel, the $x$ array, and the $f$ Jacobian array are
exposed by the [[sampler_t]] object.
We allow for the additional [[hook]] to be called, if associated, for outlying
object to access information from the current state of the [[sampler]].
<<Instances: process instance: TBP>>=
procedure :: evaluate => process_instance_evaluate
<<Instances: sub interfaces>>=
module subroutine process_instance_evaluate (sampler, c, x_in, val, x, f)
class(process_instance_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
end subroutine process_instance_evaluate
<<Instances: procedures>>=
module subroutine process_instance_evaluate (sampler, c, x_in, val, x, f)
class(process_instance_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%evaluate_sqme (c, x_in)
if (sampler%is_valid ()) then
call sampler%fetch (val, x, f)
end if
call sampler%record_call ()
call sampler%evaluate_after_hook ()
end subroutine process_instance_evaluate
@ %def process_instance_evaluate
@ The phase-space point is valid if the event has valid kinematics and
has passed the cuts.
<<Instances: process instance: TBP>>=
procedure :: is_valid => process_instance_is_valid
<<Instances: sub interfaces>>=
module function process_instance_is_valid (sampler) result (valid)
class(process_instance_t), intent(in) :: sampler
logical :: valid
end function process_instance_is_valid
<<Instances: procedures>>=
module function process_instance_is_valid (sampler) result (valid)
class(process_instance_t), intent(in) :: sampler
logical :: valid
valid = sampler%evaluation_status >= STAT_PASSED_CUTS
end function process_instance_is_valid
@ %def process_instance_is_valid
@ Add a [[process_instance_hook]] object..
<<Instances: process instance: TBP>>=
procedure :: append_after_hook => process_instance_append_after_hook
<<Instances: sub interfaces>>=
module subroutine process_instance_append_after_hook (sampler, new_hook)
class(process_instance_t), intent(inout), target :: sampler
class(process_instance_hook_t), intent(inout), target :: new_hook
end subroutine process_instance_append_after_hook
<<Instances: procedures>>=
module subroutine process_instance_append_after_hook (sampler, new_hook)
class(process_instance_t), intent(inout), target :: sampler
class(process_instance_hook_t), intent(inout), target :: new_hook
class(process_instance_hook_t), pointer :: last
if (associated (new_hook%next)) then
call msg_bug ("process_instance_append_after_hook: " // &
"reuse of SAME hook object is forbidden.")
end if
if (associated (sampler%hook)) then
last => sampler%hook
do while (associated (last%next))
last => last%next
end do
last%next => new_hook
else
sampler%hook => new_hook
end if
end subroutine process_instance_append_after_hook
@ %def process_instance_append_after_evaluate_hook
@ Evaluate the after hook as first in, last out.
<<Instances: process instance: TBP>>=
procedure :: evaluate_after_hook => process_instance_evaluate_after_hook
<<Instances: sub interfaces>>=
module subroutine process_instance_evaluate_after_hook (sampler)
class(process_instance_t), intent(in) :: sampler
end subroutine process_instance_evaluate_after_hook
<<Instances: procedures>>=
module subroutine process_instance_evaluate_after_hook (sampler)
class(process_instance_t), intent(in) :: sampler
class(process_instance_hook_t), pointer :: current
current => sampler%hook
do while (associated(current))
call current%evaluate (sampler)
current => current%next
end do
end subroutine process_instance_evaluate_after_hook
@ %def process_instance_evaluate_after_hook
@ The [[rebuild]] method should rebuild the kinematics section out of
the [[x_in]] parameter set. The integrand value [[val]] should not be
computed, but is provided as input.
<<Instances: process instance: TBP>>=
procedure :: rebuild => process_instance_rebuild
<<Instances: sub interfaces>>=
module subroutine process_instance_rebuild (sampler, c, x_in, val, x, f)
class(process_instance_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
end subroutine process_instance_rebuild
<<Instances: procedures>>=
module subroutine process_instance_rebuild (sampler, c, x_in, val, x, f)
class(process_instance_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call msg_bug ("process_instance_rebuild not implemented yet")
x = 0
f = 0
end subroutine process_instance_rebuild
@ %def process_instance_rebuild
@ This is another method required by the [[sampler_t]] base type:
fetch the data that are relevant for the MCI record.
<<Instances: process instance: TBP>>=
procedure :: fetch => process_instance_fetch
<<Instances: sub interfaces>>=
module subroutine process_instance_fetch (sampler, val, x, f)
class(process_instance_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
end subroutine process_instance_fetch
<<Instances: procedures>>=
module subroutine process_instance_fetch (sampler, val, x, f)
class(process_instance_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
integer, dimension(:), allocatable :: i_terms
integer :: i, i_term_base, cc
integer :: n_channel
val = 0
associate (process => sampler%process)
FIND_COMPONENT: do i = 1, process%get_n_components ()
if (sampler%process%component_is_selected (i)) then
allocate (i_terms (size (process%get_component_i_terms (i))))
i_terms = process%get_component_i_terms (i)
i_term_base = i_terms(1)
associate (k => sampler%kin(i_term_base))
n_channel = k%n_channel
do cc = 1, n_channel
call k%get_mcpar (cc, x(:,cc))
end do
f = k%f
val = sampler%sqme * k%phs_factor
end associate
if (allocated (i_terms)) deallocate (i_terms)
exit FIND_COMPONENT
end if
end do FIND_COMPONENT
end associate
end subroutine process_instance_fetch
@ %def process_instance_fetch
@ Initialize and finalize event generation for the specified MCI
entry.
<<Instances: process instance: TBP>>=
procedure :: init_simulation => process_instance_init_simulation
procedure :: final_simulation => process_instance_final_simulation
<<Instances: sub interfaces>>=
module subroutine process_instance_init_simulation (instance, i_mci, &
safety_factor, keep_failed_events)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
end subroutine process_instance_init_simulation
module subroutine process_instance_final_simulation (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
end subroutine process_instance_final_simulation
<<Instances: procedures>>=
module subroutine process_instance_init_simulation (instance, i_mci, &
safety_factor, keep_failed_events)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
call instance%mci_work(i_mci)%init_simulation &
(safety_factor, keep_failed_events)
end subroutine process_instance_init_simulation
module subroutine process_instance_final_simulation (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
call instance%mci_work(i_mci)%final_simulation ()
end subroutine process_instance_final_simulation
@ %def process_instance_init_simulation
@ %def process_instance_final_simulation
@
\subsubsection{Accessing the process instance}
Once the seed kinematics is complete, we can retrieve the MC input parameters
for all channels, not just the seed channel.
Note: We choose the first active component. This makes sense only if the seed
kinematics is identical for all active components.
<<Instances: process instance: TBP>>=
procedure :: get_mcpar => process_instance_get_mcpar
<<Instances: sub interfaces>>=
module subroutine process_instance_get_mcpar (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(out) :: x
end subroutine process_instance_get_mcpar
<<Instances: procedures>>=
module subroutine process_instance_get_mcpar (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(out) :: x
integer :: i
if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%kin(i)%get_mcpar (channel, x)
return
end if
end do
call msg_bug ("Process instance: get_mcpar: no active channels")
else
call msg_bug ("Process instance: get_mcpar: no seed kinematics")
end if
end subroutine process_instance_get_mcpar
@ %def process_instance_get_mcpar
@ Return true if the [[sqme]] value is known. This also implies that the
event is kinematically valid and has passed all cuts.
<<Instances: process instance: TBP>>=
procedure :: has_evaluated_trace => process_instance_has_evaluated_trace
<<Instances: sub interfaces>>=
module function process_instance_has_evaluated_trace &
(instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
end function process_instance_has_evaluated_trace
<<Instances: procedures>>=
module function process_instance_has_evaluated_trace (instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
flag = instance%evaluation_status >= STAT_EVALUATED_TRACE
end function process_instance_has_evaluated_trace
@ %def process_instance_has_evaluated_trace
@ Return true if the event is complete. In particular, the event must
be kinematically valid, passed all cuts, and the event data have been
computed.
<<Instances: process instance: TBP>>=
procedure :: is_complete_event => process_instance_is_complete_event
<<Instances: sub interfaces>>=
module function process_instance_is_complete_event (instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
end function process_instance_is_complete_event
<<Instances: procedures>>=
module function process_instance_is_complete_event (instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
flag = instance%evaluation_status >= STAT_EVENT_COMPLETE
end function process_instance_is_complete_event
@ %def process_instance_is_complete_event
@ Select the term for the process instance that will provide the basic
event record (used in [[evt_trivial_make_particle_set]]). It might be
necessary to write out additional events corresponding to other terms
(done in [[evt_nlo]]).
<<Instances: process instance: TBP>>=
procedure :: select_i_term => process_instance_select_i_term
<<Instances: sub interfaces>>=
module function process_instance_select_i_term (instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
end function process_instance_select_i_term
<<Instances: procedures>>=
module function process_instance_select_i_term (instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
integer :: i_mci
i_mci = instance%i_mci
i_term = instance%process%select_i_term (i_mci)
end function process_instance_select_i_term
@ %def process_instance_select_i_term
@ Return pointer to the master beam interaction.
<<Instances: process instance: TBP>>=
procedure :: get_beam_int_ptr => process_instance_get_beam_int_ptr
<<Instances: sub interfaces>>=
module function process_instance_get_beam_int_ptr (instance) result (ptr)
class(process_instance_t), intent(in), target :: instance
type(interaction_t), pointer :: ptr
end function process_instance_get_beam_int_ptr
<<Instances: procedures>>=
module function process_instance_get_beam_int_ptr (instance) result (ptr)
class(process_instance_t), intent(in), target :: instance
type(interaction_t), pointer :: ptr
ptr => instance%sf_chain%get_beam_int_ptr ()
end function process_instance_get_beam_int_ptr
@ %def process_instance_get_beam_int_ptr
@ Return pointers to the matrix and flows interactions, given a term index.
<<Instances: process instance: TBP>>=
procedure :: get_trace_int_ptr => process_instance_get_trace_int_ptr
procedure :: get_matrix_int_ptr => process_instance_get_matrix_int_ptr
procedure :: get_flows_int_ptr => process_instance_get_flows_int_ptr
<<Instances: sub interfaces>>=
module function process_instance_get_trace_int_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
end function process_instance_get_trace_int_ptr
module function process_instance_get_matrix_int_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
end function process_instance_get_matrix_int_ptr
module function process_instance_get_flows_int_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
end function process_instance_get_flows_int_ptr
<<Instances: procedures>>=
module function process_instance_get_trace_int_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_trace_int_ptr ()
end function process_instance_get_trace_int_ptr
module function process_instance_get_matrix_int_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_matrix_int_ptr ()
end function process_instance_get_matrix_int_ptr
module function process_instance_get_flows_int_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_flows_int_ptr ()
end function process_instance_get_flows_int_ptr
@ %def process_instance_get_trace_int_ptr
@ %def process_instance_get_matrix_int_ptr
@ %def process_instance_get_flows_int_ptr
@ Return the complete account of flavor combinations in the underlying
interaction object, including beams, radiation, and hard interaction.
<<Instances: process instance: TBP>>=
procedure :: get_state_flv => process_instance_get_state_flv
<<Instances: sub interfaces>>=
module function process_instance_get_state_flv &
(instance, i_term) result (state_flv)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
type(state_flv_content_t) :: state_flv
end function process_instance_get_state_flv
<<Instances: procedures>>=
module function process_instance_get_state_flv &
(instance, i_term) result (state_flv)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
type(state_flv_content_t) :: state_flv
state_flv = instance%term(i_term)%connected%get_state_flv ()
end function process_instance_get_state_flv
@ %def process_instance_get_state_flv
@ Return pointers to the parton states of a selected term.
<<Instances: process instance: TBP>>=
procedure :: get_isolated_state_ptr => &
process_instance_get_isolated_state_ptr
procedure :: get_connected_state_ptr => &
process_instance_get_connected_state_ptr
<<Instances: sub interfaces>>=
module function process_instance_get_isolated_state_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(isolated_state_t), pointer :: ptr
end function process_instance_get_isolated_state_ptr
module function process_instance_get_connected_state_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(connected_state_t), pointer :: ptr
end function process_instance_get_connected_state_ptr
<<Instances: procedures>>=
module function process_instance_get_isolated_state_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(isolated_state_t), pointer :: ptr
ptr => instance%term(i_term)%isolated
end function process_instance_get_isolated_state_ptr
module function process_instance_get_connected_state_ptr &
(instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(connected_state_t), pointer :: ptr
ptr => instance%term(i_term)%connected
end function process_instance_get_connected_state_ptr
@ %def process_instance_get_isolated_state_ptr
@ %def process_instance_get_connected_state_ptr
@ Return the indices of the beam particles and incoming partons within the
currently active state matrix, respectively.
<<Instances: process instance: TBP>>=
procedure :: get_beam_index => process_instance_get_beam_index
procedure :: get_in_index => process_instance_get_in_index
<<Instances: sub interfaces>>=
module subroutine process_instance_get_beam_index (instance, i_term, i_beam)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_beam
end subroutine process_instance_get_beam_index
module subroutine process_instance_get_in_index (instance, i_term, i_in)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_in
end subroutine process_instance_get_in_index
<<Instances: procedures>>=
module subroutine process_instance_get_beam_index (instance, i_term, i_beam)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_beam
call instance%term(i_term)%connected%get_beam_index (i_beam)
end subroutine process_instance_get_beam_index
module subroutine process_instance_get_in_index (instance, i_term, i_in)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_in
call instance%term(i_term)%connected%get_in_index (i_in)
end subroutine process_instance_get_in_index
@ %def process_instance_get_beam_index
@ %def process_instance_get_in_index
@ Return squared matrix element and event weight, and event weight
excess where applicable. [[n_dropped]] is a number that can be
nonzero when a weighted event has been generated, dropping events with
zero weight (failed cuts) on the fly.
If [[i_term]] is provided for [[get_sqme]], we take the first matrix
element as we also set the first matrix element with [[set_only_matrix_element]]
when computing the real, the dglap or the virtual contribution.
<<Instances: process instance: TBP>>=
procedure :: get_sqme => process_instance_get_sqme
procedure :: get_weight => process_instance_get_weight
procedure :: get_excess => process_instance_get_excess
procedure :: get_n_dropped => process_instance_get_n_dropped
<<Instances: sub interfaces>>=
module function process_instance_get_sqme (instance, i_term) result (sqme)
real(default) :: sqme
class(process_instance_t), intent(in) :: instance
integer, intent(in), optional :: i_term
end function process_instance_get_sqme
module function process_instance_get_weight (instance) result (weight)
real(default) :: weight
class(process_instance_t), intent(in) :: instance
end function process_instance_get_weight
module function process_instance_get_excess (instance) result (excess)
real(default) :: excess
class(process_instance_t), intent(in) :: instance
end function process_instance_get_excess
module function process_instance_get_n_dropped (instance) result (n_dropped)
integer :: n_dropped
class(process_instance_t), intent(in) :: instance
end function process_instance_get_n_dropped
<<Instances: procedures>>=
module function process_instance_get_sqme (instance, i_term) result (sqme)
real(default) :: sqme
class(process_instance_t), intent(in) :: instance
integer, intent(in), optional :: i_term
if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
if (present (i_term)) then
sqme = instance%term(i_term)%connected%trace%get_matrix_element (1)
else
sqme = instance%sqme
end if
else
sqme = 0
end if
end function process_instance_get_sqme
module function process_instance_get_weight (instance) result (weight)
real(default) :: weight
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
weight = instance%weight
else
weight = 0
end if
end function process_instance_get_weight
module function process_instance_get_excess (instance) result (excess)
real(default) :: excess
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
excess = instance%excess
else
excess = 0
end if
end function process_instance_get_excess
module function process_instance_get_n_dropped (instance) result (n_dropped)
integer :: n_dropped
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
n_dropped = instance%n_dropped
else
n_dropped = 0
end if
end function process_instance_get_n_dropped
@ %def process_instance_get_sqme
@ %def process_instance_get_weight
@ %def process_instance_get_excess
@ %def process_instance_get_n_dropped
@ Return the currently selected MCI channel.
<<Instances: process instance: TBP>>=
procedure :: get_channel => process_instance_get_channel
<<Instances: sub interfaces>>=
module function process_instance_get_channel (instance) result (channel)
integer :: channel
class(process_instance_t), intent(in) :: instance
end function process_instance_get_channel
<<Instances: procedures>>=
module function process_instance_get_channel (instance) result (channel)
integer :: channel
class(process_instance_t), intent(in) :: instance
channel = instance%selected_channel
end function process_instance_get_channel
@ %def process_instance_get_channel
@
<<Instances: process instance: TBP>>=
procedure :: set_fac_scale => process_instance_set_fac_scale
<<Instances: sub interfaces>>=
module subroutine process_instance_set_fac_scale (instance, fac_scale)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in) :: fac_scale
end subroutine process_instance_set_fac_scale
<<Instances: procedures>>=
module subroutine process_instance_set_fac_scale (instance, fac_scale)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in) :: fac_scale
integer :: i_term
i_term = 1
call instance%term(i_term)%set_fac_scale (fac_scale)
end subroutine process_instance_set_fac_scale
@ %def process_instance_set_fac_scale
@ Return factorization scale and strong coupling. We have to select a
term instance.
<<Instances: process instance: TBP>>=
procedure :: get_fac_scale => process_instance_get_fac_scale
procedure :: get_alpha_s => process_instance_get_alpha_s
<<Instances: sub interfaces>>=
module function process_instance_get_fac_scale &
(instance, i_term) result (fac_scale)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
real(default) :: fac_scale
end function process_instance_get_fac_scale
module function process_instance_get_alpha_s &
(instance, i_term) result (alpha_s)
real(default) :: alpha_s
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
end function process_instance_get_alpha_s
<<Instances: procedures>>=
module function process_instance_get_fac_scale &
(instance, i_term) result (fac_scale)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
real(default) :: fac_scale
fac_scale = instance%term(i_term)%get_fac_scale ()
end function process_instance_get_fac_scale
module function process_instance_get_alpha_s &
(instance, i_term) result (alpha_s)
real(default) :: alpha_s
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
class(prc_core_t), pointer :: core => null ()
core => instance%process%get_core_term (i_term)
alpha_s = instance%term(i_term)%get_alpha_s (core)
core => null ()
end function process_instance_get_alpha_s
@ %def process_instance_get_fac_scale
@ %def process_instance_get_alpha_s
@
<<Instances: process instance: TBP>>=
procedure :: get_qcd => process_instance_get_qcd
<<Instances: sub interfaces>>=
module function process_instance_get_qcd (process_instance) result (qcd)
type(qcd_t) :: qcd
class(process_instance_t), intent(in) :: process_instance
end function process_instance_get_qcd
<<Instances: procedures>>=
module function process_instance_get_qcd (process_instance) result (qcd)
type(qcd_t) :: qcd
class(process_instance_t), intent(in) :: process_instance
qcd = process_instance%process%get_qcd ()
end function process_instance_get_qcd
@ %def process_instance_get_qcd
@ Counter.
<<Instances: process instance: TBP>>=
procedure :: reset_counter => process_instance_reset_counter
procedure :: record_call => process_instance_record_call
procedure :: get_counter => process_instance_get_counter
<<Instances: sub interfaces>>=
module subroutine process_instance_reset_counter (process_instance)
class(process_instance_t), intent(inout) :: process_instance
end subroutine process_instance_reset_counter
module subroutine process_instance_record_call (process_instance)
class(process_instance_t), intent(inout) :: process_instance
end subroutine process_instance_record_call
pure module function process_instance_get_counter &
(process_instance) result (counter)
class(process_instance_t), intent(in) :: process_instance
type(process_counter_t) :: counter
end function process_instance_get_counter
<<Instances: procedures>>=
module subroutine process_instance_reset_counter (process_instance)
class(process_instance_t), intent(inout) :: process_instance
call process_instance%mci_work(process_instance%i_mci)%reset_counter ()
end subroutine process_instance_reset_counter
module subroutine process_instance_record_call (process_instance)
class(process_instance_t), intent(inout) :: process_instance
call process_instance%mci_work(process_instance%i_mci)%record_call &
(process_instance%evaluation_status)
end subroutine process_instance_record_call
pure module function process_instance_get_counter &
(process_instance) result (counter)
class(process_instance_t), intent(in) :: process_instance
type(process_counter_t) :: counter
counter = process_instance%mci_work(process_instance%i_mci)%get_counter ()
end function process_instance_get_counter
@ %def process_instance_reset_counter
@ %def process_instance_record_call
@ %def process_instance_get_counter
@ Sum up the total number of calls for all MCI records.
<<Instances: process instance: TBP>>=
procedure :: get_actual_calls_total => process_instance_get_actual_calls_total
<<Instances: sub interfaces>>=
pure module function process_instance_get_actual_calls_total &
(process_instance) result (n)
class(process_instance_t), intent(in) :: process_instance
integer :: n
end function process_instance_get_actual_calls_total
<<Instances: procedures>>=
pure module function process_instance_get_actual_calls_total &
(process_instance) result (n)
class(process_instance_t), intent(in) :: process_instance
integer :: n
integer :: i
type(process_counter_t) :: counter
n = 0
do i = 1, size (process_instance%mci_work)
counter = process_instance%mci_work(i)%get_counter ()
n = n + counter%total
end do
end function process_instance_get_actual_calls_total
@ %def process_instance_get_actual_calls_total
@
<<Instances: process instance: TBP>>=
procedure :: reset_matrix_elements => process_instance_reset_matrix_elements
<<Instances: sub interfaces>>=
module subroutine process_instance_reset_matrix_elements (instance)
class(process_instance_t), intent(inout) :: instance
end subroutine process_instance_reset_matrix_elements
<<Instances: procedures>>=
module subroutine process_instance_reset_matrix_elements (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_term
do i_term = 1, size (instance%term)
call instance%term(i_term)%connected%trace%set_matrix_element &
(cmplx (0, 0, default))
call instance%term(i_term)%connected%matrix%set_matrix_element &
(cmplx (0, 0, default))
end do
end subroutine process_instance_reset_matrix_elements
@ %def process_instance_reset_matrix_elements
@
<<Instances: process instance: TBP>>=
procedure :: get_test_phase_space_point &
=> process_instance_get_test_phase_space_point
<<Instances: sub interfaces>>=
module subroutine process_instance_get_test_phase_space_point (instance, &
i_component, i_core, p)
type(vector4_t), dimension(:), allocatable, intent(out) :: p
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_component, i_core
end subroutine process_instance_get_test_phase_space_point
<<Instances: procedures>>=
module subroutine process_instance_get_test_phase_space_point (instance, &
i_component, i_core, p)
type(vector4_t), dimension(:), allocatable, intent(out) :: p
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_component, i_core
real(default), dimension(:), allocatable :: x
logical :: success
integer :: i_term
instance%i_mci = i_component
i_term = instance%process%get_i_term (i_core)
associate (term => instance%term(i_term), kin => instance%kin(i_term))
allocate (x (instance%mci_work(i_component)%config%n_par))
x = 0.5_default
call instance%set_mcpar (x, .true.)
call instance%select_channel (1)
call term%compute_seed_kinematics &
(kin, instance%mci_work(i_component), 1, success)
call kin%evaluate_radiation_kinematics &
(instance%mci_work(instance%i_mci)%get_x_process ())
call term%compute_hard_kinematics (kin, success = success)
allocate (p (size (term%p_hard)))
p = term%int_hard%get_momenta ()
end associate
end subroutine process_instance_get_test_phase_space_point
@ %def process_instance_get_test_phase_space_point
@
<<Instances: process instance: TBP>>=
procedure :: get_p_hard => process_instance_get_p_hard
<<Instances: sub interfaces>>=
pure module function process_instance_get_p_hard &
(process_instance, i_term) result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(process_instance_t), intent(in) :: process_instance
integer, intent(in) :: i_term
end function process_instance_get_p_hard
<<Instances: procedures>>=
pure module function process_instance_get_p_hard &
(process_instance, i_term) result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(process_instance_t), intent(in) :: process_instance
integer, intent(in) :: i_term
allocate (p_hard (size (process_instance%term(i_term)%get_p_hard ())))
p_hard = process_instance%term(i_term)%get_p_hard ()
end function process_instance_get_p_hard
@ %def process_instance_get_p_hard
@
<<Instances: process instance: TBP>>=
procedure :: get_first_active_i_term => &
process_instance_get_first_active_i_term
<<Instances: sub interfaces>>=
module function process_instance_get_first_active_i_term &
(instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
end function process_instance_get_first_active_i_term
<<Instances: procedures>>=
module function process_instance_get_first_active_i_term &
(instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
integer :: i
i_term = 0
do i = 1, size (instance%term)
if (instance%term(i)%active) then
i_term = i
exit
end if
end do
end function process_instance_get_first_active_i_term
@ %def process_instance_get_first_active_i_term
@
<<Instances: process instance: TBP>>=
procedure :: get_real_of_mci => process_instance_get_real_of_mci
<<Instances: sub interfaces>>=
module function process_instance_get_real_of_mci (instance) result (i_real)
integer :: i_real
class(process_instance_t), intent(in) :: instance
end function process_instance_get_real_of_mci
<<Instances: procedures>>=
module function process_instance_get_real_of_mci (instance) result (i_real)
integer :: i_real
class(process_instance_t), intent(in) :: instance
select type (pcm_work => instance%pcm_work)
type is (pcm_nlo_workspace_t)
i_real = pcm_work%i_mci_to_real_component (instance%i_mci)
end select
end function process_instance_get_real_of_mci
@ %def process_instance_get_real_of_mci
@
<<Instances: process instance: TBP>>=
procedure :: get_connected_states => process_instance_get_connected_states
<<Instances: sub interfaces>>=
module function process_instance_get_connected_states &
(instance, i_component) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_component
end function process_instance_get_connected_states
<<Instances: procedures>>=
module function process_instance_get_connected_states &
(instance, i_component) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_component
connected = instance%process%get_connected_states (i_component, &
instance%term(:)%connected)
end function process_instance_get_connected_states
@ %def process_instance_get_connected_states
@ Get the hadronic center-of-mass energy
<<Instances: process instance: TBP>>=
procedure :: get_sqrts => process_instance_get_sqrts
<<Instances: sub interfaces>>=
module function process_instance_get_sqrts (instance) result (sqrts)
class(process_instance_t), intent(in) :: instance
real(default) :: sqrts
end function process_instance_get_sqrts
<<Instances: procedures>>=
module function process_instance_get_sqrts (instance) result (sqrts)
class(process_instance_t), intent(in) :: instance
real(default) :: sqrts
sqrts = instance%process%get_sqrts ()
end function process_instance_get_sqrts
@ %def process_instance_get_sqrts
@ Get the polarizations
<<Instances: process instance: TBP>>=
procedure :: get_polarization => process_instance_get_polarization
<<Instances: sub interfaces>>=
module function process_instance_get_polarization (instance) result (pol)
class(process_instance_t), intent(in) :: instance
real(default), dimension(:), allocatable :: pol
end function process_instance_get_polarization
<<Instances: procedures>>=
module function process_instance_get_polarization (instance) result (pol)
class(process_instance_t), intent(in) :: instance
real(default), dimension(:), allocatable :: pol
pol = instance%process%get_polarization ()
end function process_instance_get_polarization
@ %def process_instance_get_polarization
@ Get the beam spectrum
<<Instances: process instance: TBP>>=
procedure :: get_beam_file => process_instance_get_beam_file
<<Instances: sub interfaces>>=
module function process_instance_get_beam_file (instance) result (file)
class(process_instance_t), intent(in) :: instance
type(string_t) :: file
end function process_instance_get_beam_file
<<Instances: procedures>>=
module function process_instance_get_beam_file (instance) result (file)
class(process_instance_t), intent(in) :: instance
type(string_t) :: file
file = instance%process%get_beam_file ()
end function process_instance_get_beam_file
@ %def process_instance_get_beam_file
@ Get the process name
<<Instances: process instance: TBP>>=
procedure :: get_process_name => process_instance_get_process_name
<<Instances: sub interfaces>>=
module function process_instance_get_process_name (instance) result (name)
class(process_instance_t), intent(in) :: instance
type(string_t) :: name
end function process_instance_get_process_name
<<Instances: procedures>>=
module function process_instance_get_process_name (instance) result (name)
class(process_instance_t), intent(in) :: instance
type(string_t) :: name
name = instance%process%get_id ()
end function process_instance_get_process_name
@ %def process_instance_get_process_name
@
\subsubsection{Particle sets}
Here we provide two procedures that convert the process instance
from/to a particle set. The conversion applies to the trace evaluator
which has no quantum-number information, thus it involves only the
momenta and the parent-child relations. We keep virtual particles.
If [[n_incoming]] is provided, the status code of the first
[[n_incoming]] particles will be reset to incoming. Otherwise, they
would be classified as virtual.
Nevertheless, it is possible to reconstruct the complete structure
from a particle set. The reconstruction implies a re-evaluation of
the structure function and matrix-element codes.
The [[i_term]] index is needed for both input and output, to select
among different active trace evaluators.
In both cases, the [[instance]] object must be properly initialized.
NB: The [[recover_beams]] option should be used only when the particle
set originates from an external event file, and the user has asked for
it. It should be switched off when reading from raw event file.
<<Instances: process instance: TBP>>=
procedure :: get_trace => process_instance_get_trace
procedure :: set_trace => process_instance_set_trace
<<Instances: sub interfaces>>=
module subroutine process_instance_get_trace &
(instance, pset, i_term, n_incoming)
class(process_instance_t), intent(in), target :: instance
type(particle_set_t), intent(out) :: pset
integer, intent(in) :: i_term
integer, intent(in), optional :: n_incoming
end subroutine process_instance_get_trace
module subroutine process_instance_set_trace &
(instance, pset, i_term, recover_beams, check_match, success)
class(process_instance_t), intent(inout), target :: instance
type(particle_set_t), intent(in) :: pset
integer, intent(in) :: i_term
logical, intent(in), optional :: recover_beams, check_match
logical, intent(out), optional :: success
end subroutine process_instance_set_trace
<<Instances: procedures>>=
module subroutine process_instance_get_trace &
(instance, pset, i_term, n_incoming)
class(process_instance_t), intent(in), target :: instance
type(particle_set_t), intent(out) :: pset
integer, intent(in) :: i_term
integer, intent(in), optional :: n_incoming
type(interaction_t), pointer :: int
logical :: ok
int => instance%get_trace_int_ptr (i_term)
call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
[0._default, 0._default], .false., .true., n_incoming)
end subroutine process_instance_get_trace
module subroutine process_instance_set_trace &
(instance, pset, i_term, recover_beams, check_match, success)
class(process_instance_t), intent(inout), target :: instance
type(particle_set_t), intent(in) :: pset
integer, intent(in) :: i_term
logical, intent(in), optional :: recover_beams, check_match
logical, intent(out), optional :: success
type(interaction_t), pointer :: int
integer :: n_in
int => instance%get_trace_int_ptr (i_term)
n_in = instance%process%get_n_in ()
call pset%fill_interaction (int, n_in, &
recover_beams = recover_beams, &
check_match = check_match, &
state_flv = instance%get_state_flv (i_term), &
success = success)
end subroutine process_instance_set_trace
@ %def process_instance_get_trace
@ %def process_instance_set_trace
@ This procedure allows us to override any QCD setting of the WHIZARD process
and directly set the coupling value that comes together with a particle set.
<<Instances: process instance: TBP>>=
procedure :: set_alpha_qcd_forced => process_instance_set_alpha_qcd_forced
<<Instances: sub interfaces>>=
module subroutine process_instance_set_alpha_qcd_forced &
(instance, i_term, alpha_qcd)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
real(default), intent(in) :: alpha_qcd
end subroutine process_instance_set_alpha_qcd_forced
<<Instances: procedures>>=
module subroutine process_instance_set_alpha_qcd_forced &
(instance, i_term, alpha_qcd)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
real(default), intent(in) :: alpha_qcd
call instance%term(i_term)%set_alpha_qcd_forced (alpha_qcd)
end subroutine process_instance_set_alpha_qcd_forced
@ %def process_instance_set_alpha_qcd_forced
@
<<Instances: process instance: TBP>>=
procedure :: has_nlo_component => process_instance_has_nlo_component
<<Instances: sub interfaces>>=
module function process_instance_has_nlo_component (instance) result (nlo)
class(process_instance_t), intent(in) :: instance
logical :: nlo
end function process_instance_has_nlo_component
<<Instances: procedures>>=
module function process_instance_has_nlo_component (instance) result (nlo)
class(process_instance_t), intent(in) :: instance
logical :: nlo
nlo = instance%process%is_nlo_calculation ()
end function process_instance_has_nlo_component
@ %def process_instance_has_nlo_component
@
<<Instances: process instance: TBP>>=
procedure :: keep_failed_events => process_instance_keep_failed_events
<<Instances: sub interfaces>>=
module function process_instance_keep_failed_events (instance) result (keep)
logical :: keep
class(process_instance_t), intent(in) :: instance
end function process_instance_keep_failed_events
<<Instances: procedures>>=
module function process_instance_keep_failed_events (instance) result (keep)
logical :: keep
class(process_instance_t), intent(in) :: instance
keep = instance%mci_work(instance%i_mci)%keep_failed_events
end function process_instance_keep_failed_events
@ %def process_instance_keep_failed_events
@
<<Instances: process instance: TBP>>=
procedure :: get_term_indices => process_instance_get_term_indices
<<Instances: sub interfaces>>=
module function process_instance_get_term_indices &
(instance, nlo_type) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_instance_t), intent(in) :: instance
integer :: nlo_type
end function process_instance_get_term_indices
<<Instances: procedures>>=
module function process_instance_get_term_indices &
(instance, nlo_type) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_instance_t), intent(in) :: instance
integer :: nlo_type
allocate (i_term (count (instance%term%nlo_type == nlo_type)))
i_term = pack (instance%term%get_i_term_global (), &
instance%term%nlo_type == nlo_type)
end function process_instance_get_term_indices
@ %def process_instance_get_term_indices
@
<<Instances: process instance: TBP>>=
procedure :: get_boost_to_lab => process_instance_get_boost_to_lab
<<Instances: sub interfaces>>=
module function process_instance_get_boost_to_lab &
(instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
end function process_instance_get_boost_to_lab
<<Instances: procedures>>=
module function process_instance_get_boost_to_lab &
(instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lt = instance%kin(i_term)%get_boost_to_lab ()
end function process_instance_get_boost_to_lab
@ %def process_instance_get_boost_to_lab
@
<<Instances: process instance: TBP>>=
procedure :: get_boost_to_cms => process_instance_get_boost_to_cms
<<Instances: sub interfaces>>=
module function process_instance_get_boost_to_cms &
(instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
end function process_instance_get_boost_to_cms
<<Instances: procedures>>=
module function process_instance_get_boost_to_cms &
(instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lt = instance%kin(i_term)%get_boost_to_cms ()
end function process_instance_get_boost_to_cms
@ %def process_instance_get_boost_to_cms
@
<<Instances: process instance: TBP>>=
procedure :: lab_is_cm => process_instance_lab_is_cm
<<Instances: sub interfaces>>=
module function process_instance_lab_is_cm &
(instance, i_term) result (lab_is_cm)
logical :: lab_is_cm
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
end function process_instance_lab_is_cm
<<Instances: procedures>>=
module function process_instance_lab_is_cm &
(instance, i_term) result (lab_is_cm)
logical :: lab_is_cm
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lab_is_cm = instance%kin(i_term)%phs%lab_is_cm ()
end function process_instance_lab_is_cm
@ %def process_instance_lab_is_cm
@
The [[pacify]] subroutine has the purpose of setting numbers to zero
which are (by comparing with a [[tolerance]] parameter) considered
equivalent with zero. We do this in some unit tests. Here, we a
apply this to the phase space subobject of the process instance.
<<Instances: public>>=
public :: pacify
<<Instances: interfaces>>=
interface pacify
module procedure pacify_process_instance
end interface pacify
<<Instances: sub interfaces>>=
module subroutine pacify_process_instance (instance)
type(process_instance_t), intent(inout) :: instance
end subroutine pacify_process_instance
<<Instances: procedures>>=
module subroutine pacify_process_instance (instance)
type(process_instance_t), intent(inout) :: instance
integer :: i
do i = 1, size (instance%kin)
call pacify (instance%kin(i)%phs)
end do
end subroutine pacify_process_instance
@ %def pacify
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[processes_ut.f90]]>>=
<<File header>>
module processes_ut
use unit_tests
use processes_uti
<<Standard module head>>
<<Processes: public test>>
<<Processes: public test auxiliary>>
contains
<<Processes: test driver>>
end module processes_ut
@ %def processes_ut
@
<<[[processes_uti.f90]]>>=
<<File header>>
module processes_uti
<<Use kinds>>
<<Use strings>>
use format_utils, only: write_separator
use constants, only: TWOPI4
use physics_defs, only: CONV
use os_interface
use sm_qcd
use lorentz
use pdg_arrays
use model_data
use models
use var_base, only: vars_t
use variables, only: var_list_t
use model_testbed, only: prepare_model
use particle_specifiers, only: new_prt_spec
use flavors
use interactions, only: reset_interaction_counter
use particles
use rng_base
use mci_base
use mci_none, only: mci_none_t
use mci_midpoint
use sf_mappings
use sf_base
use phs_base
use phs_single
use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
use phs_wood, only: phs_wood_config_t
use resonances, only: resonance_history_set_t
use process_constants
use prc_core_def, only: prc_core_def_t
use prc_core
use prc_test, only: prc_test_create_library
use prc_template_me, only: template_me_def_t
use process_libraries
use prc_test_core
use pdf, only: pdf_data_t
use process_counter
use process_config, only: process_term_t
use process, only: process_t
use instances, only: process_instance_t, process_instance_hook_t
use rng_base_ut, only: rng_test_factory_t
use sf_base_ut, only: sf_test_data_t
use mci_base_ut, only: mci_test_t
use phs_base_ut, only: phs_test_config_t
<<Standard module head>>
<<Processes: public test auxiliary>>
<<Processes: test declarations>>
<<Processes: test types>>
contains
<<Processes: tests>>
<<Processes: test auxiliary>>
end module processes_uti
@ %def processes_uti
@ API: driver for the unit tests below.
<<Processes: public test>>=
public :: processes_test
<<Processes: test driver>>=
subroutine processes_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Processes: execute tests>>
end subroutine processes_test
@ %def processes_test
\subsubsection{Write an empty process object}
The most trivial test is to write an uninitialized process object.
<<Processes: execute tests>>=
call test (processes_1, "processes_1", &
"write an empty process object", &
u, results)
<<Processes: test declarations>>=
public :: processes_1
<<Processes: tests>>=
subroutine processes_1 (u)
integer, intent(in) :: u
type(process_t) :: process
write (u, "(A)") "* Test output: processes_1"
write (u, "(A)") "* Purpose: display an empty process object"
write (u, "(A)")
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_1"
end subroutine processes_1
@ %def processes_1
@
\subsubsection{Initialize a process object}
Initialize a process and display it.
<<Processes: execute tests>>=
call test (processes_2, "processes_2", &
"initialize a simple process object", &
u, results)
<<Processes: test declarations>>=
public :: processes_2
<<Processes: tests>>=
subroutine processes_2 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable :: process
class(mci_t), allocatable :: mci_template
class(phs_config_t), allocatable :: phs_config_template
write (u, "(A)") "* Test output: processes_2"
write (u, "(A)") "* Purpose: initialize a simple process object"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes2"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%set_run_id (var_str ("run_2"))
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
call process%setup_mci (dispatch_mci_empty)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_2"
end subroutine processes_2
@ %def processes_2
@ Trivial for testing: do not allocate the MCI record.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_empty (mci, var_list, process_id, is_nlo)
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
end subroutine dispatch_mci_empty
@ %def dispatch_mci_empty
@
\subsubsection{Compute a trivial matrix element}
Initialize a process, retrieve some information and compute a matrix
element.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Processes: execute tests>>=
call test (processes_3, "processes_3", &
"retrieve a trivial matrix element", &
u, results)
<<Processes: test declarations>>=
public :: processes_3
<<Processes: tests>>=
subroutine processes_3 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_constants_t) :: data
type(vector4_t), dimension(:), allocatable :: p
write (u, "(A)") "* Test output: processes_3"
write (u, "(A)") "* Purpose: create a process &
&and compute a matrix element"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes3"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
call process%setup_mci (dispatch_mci_test3)
write (u, "(A)") "* Return the number of process components"
write (u, "(A)")
write (u, "(A,I0)") "n_components = ", process%get_n_components ()
write (u, "(A)")
write (u, "(A)") "* Return the number of flavor states"
write (u, "(A)")
data = process%get_constants (1)
write (u, "(A,I0)") "n_flv(1) = ", data%n_flv
write (u, "(A)")
write (u, "(A)") "* Return the first flavor state"
write (u, "(A)")
write (u, "(A,4(1x,I0))") "flv_state(1) =", data%flv_state (:,1)
write (u, "(A)")
write (u, "(A)") "* Set up kinematics &
&[arbitrary, the matrix element is constant]"
allocate (p (4))
write (u, "(A)")
write (u, "(A)") "* Retrieve the matrix element"
write (u, "(A)")
write (u, "(A,F5.3,' + ',F5.3,' I')") "me (1, p, 1, 1, 1) = ", &
process%compute_amplitude (1, 1, 1, p, 1, 1, 1)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_3"
end subroutine processes_3
@ %def processes_3
@ MCI record with some contents.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_test3 (mci, var_list, process_id, is_nlo)
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
allocate (mci_test_t :: mci)
select type (mci)
type is (mci_test_t)
call mci%set_dimensions (2, 2)
call mci%set_divisions (100)
end select
end subroutine dispatch_mci_test3
@ %def dispatch_mci_test3
@
\subsubsection{Generate a process instance}
Initialize a process and process instance, choose a sampling point and
fill the process instance.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Processes: execute tests>>=
call test (processes_4, "processes_4", &
"create and fill a process instance (partonic event)", &
u, results)
<<Processes: test declarations>>=
public :: processes_4
<<Processes: tests>>=
subroutine processes_4 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_4"
write (u, "(A)") "* Purpose: create a process &
&and fill a process instance"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a test process"
write (u, "(A)")
libname = "processes4"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_empty)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Inject a set of random numbers"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%set_mcpar ([0._default, 0._default])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set up hard kinematics"
write (u, "(A)")
call process_instance%select_channel (1)
call process_instance%compute_seed_kinematics ()
call process_instance%compute_hard_kinematics ()
call process_instance%compute_eff_kinematics ()
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels ()
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%evaluate_trace ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%activate ()
process_instance%evaluation_status = STAT_EFF_KINEMATICS
call process_instance%recover_hard_kinematics (i_term = 1)
call process_instance%recover_seed_kinematics (i_term = 1)
call process_instance%select_channel (1)
call process_instance%recover_mcpar (i_term = 1)
call process_instance%compute_seed_kinematics (skip_term = 1)
call process_instance%compute_hard_kinematics (skip_term = 1)
call process_instance%compute_eff_kinematics (skip_term = 1)
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels (skip_term = 1)
call process_instance%evaluate_trace ()
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_4"
end subroutine processes_4
@ %def processes_4
@
\subsubsection{Structure function configuration}
Configure structure functions (multi-channel) in a process object.
<<Processes: execute tests>>=
call test (processes_7, "processes_7", &
"process configuration with structure functions", &
u, results)
<<Processes: test declarations>>=
public :: processes_7
<<Processes: tests>>=
subroutine processes_7 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t), dimension(2) :: sf_channel
write (u, "(A)") "* Test output: processes_7"
write (u, "(A)") "* Purpose: initialize a process with &
&structure functions"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes7"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call process%test_allocate_sf_channels (3)
call sf_channel(1)%init (2)
call sf_channel(1)%activate_mapping ([1,2])
call process%set_sf_channel (2, sf_channel(1))
call sf_channel(2)%init (2)
call sf_channel(2)%set_s_mapping ([1,2])
call process%set_sf_channel (3, sf_channel(2))
call process%setup_mci (dispatch_mci_empty)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_7"
end subroutine processes_7
@ %def processes_7
@
\subsubsection{Evaluating a process with structure function}
Configure structure functions (single-channel) in a process object,
create an instance, compute kinematics and evaluate.
Note the order of operations when setting up structure functions and
phase space. The beams are first, they determine the [[sqrts]] value.
We can also set up the chain of structure functions. We then
configure the phase space. From this, we can obtain information about
special configurations (resonances, etc.), which we need for
allocating the possible structure-function channels (parameterizations
and mappings). Finally, we match phase-space channels onto
structure-function channels.
In the current example, this matching is trivial; we only have one
structure-function channel.
<<Processes: execute tests>>=
call test (processes_8, "processes_8", &
"process evaluation with structure functions", &
u, results)
<<Processes: test declarations>>=
public :: processes_8
<<Processes: tests>>=
subroutine processes_8 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t) :: sf_channel
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_8"
write (u, "(A)") "* Purpose: evaluate a process with &
&structure functions"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes8"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call process%configure_phs ()
call process%test_allocate_sf_channels (1)
call sf_channel%init (2)
call sf_channel%activate_mapping ([1,2])
call process%set_sf_channel (1, sf_channel)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_mci (dispatch_mci_empty)
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Set up kinematics and evaluate"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%evaluate_sqme (1, &
[0.8_default, 0.8_default, 0.1_default, 0.2_default])
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
call reset_interaction_counter (2)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover &
(channel = 1, i_term = 1, update_sqme = .true., recover_phs = .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_8"
end subroutine processes_8
@ %def processes_8
@
\subsubsection{Multi-channel phase space and structure function}
This is an extension of the previous example. This time, we have two
distinct structure-function channels which are matched to the two
distinct phase-space channels.
<<Processes: execute tests>>=
call test (processes_9, "processes_9", &
"multichannel kinematics and structure functions", &
u, results)
<<Processes: test declarations>>=
public :: processes_9
<<Processes: tests>>=
subroutine processes_9 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t) :: sf_channel
real(default), dimension(4) :: x_saved
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_9"
write (u, "(A)") "* Purpose: evaluate a process with &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes9"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call process%configure_phs ()
call process%test_allocate_sf_channels (2)
call sf_channel%init (2)
call process%set_sf_channel (1, sf_channel)
call sf_channel%init (2)
call sf_channel%activate_mapping ([1,2])
call process%set_sf_channel (2, sf_channel)
call process%test_set_component_sf_channel ([1, 2])
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_mci (dispatch_mci_empty)
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Set up kinematics in channel 1 and evaluate"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%evaluate_sqme (1, &
[0.8_default, 0.8_default, 0.1_default, 0.2_default])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract MC input parameters"
write (u, "(A)")
write (u, "(A)") "Channel 1:"
call process_instance%get_mcpar (1, x_saved)
write (u, "(2x,9(1x,F7.5))") x_saved
write (u, "(A)") "Channel 2:"
call process_instance%get_mcpar (2, x_saved)
write (u, "(2x,9(1x,F7.5))") x_saved
write (u, "(A)")
write (u, "(A)") "* Set up kinematics in channel 2 and evaluate"
write (u, "(A)")
call process_instance%evaluate_sqme (2, x_saved)
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Recover process instance for channel 2"
write (u, "(A)")
call reset_interaction_counter (2)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover &
(channel = 2, i_term = 1, update_sqme = .true., recover_phs = .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_9"
end subroutine processes_9
@ %def processes_9
@
\subsubsection{Event generation}
Activate the MC integrator for the process object and use it to
generate a single event. Note that the test integrator does not
require integration in preparation for generating events.
<<Processes: execute tests>>=
call test (processes_10, "processes_10", &
"event generation", &
u, results)
<<Processes: test declarations>>=
public :: processes_10
<<Processes: tests>>=
subroutine processes_10 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(mci_t), pointer :: mci
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
write (u, "(A)") "* Test output: processes_10"
write (u, "(A)") "* Purpose: generate events for a process without &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes10"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test10)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Generate weighted event"
write (u, "(A)")
call process%test_get_mci_ptr (mci)
select type (mci)
type is (mci_test_t)
! This ensures that the next 'random' numbers are 0.3, 0.5, 0.7
call mci%rng%init (3)
! Include the constant PHS factor in the stored maximum of the integrand
call mci%set_max_factor (conv * twopi4 &
/ (2 * sqrt (lambda (sqrts **2, 125._default**2, 125._default**2))))
end select
call process_instance%generate_weighted_event (1)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate unweighted event"
write (u, "(A)")
call process_instance%generate_unweighted_event (1)
call process%test_get_mci_ptr (mci)
select type (mci)
type is (mci_test_t)
write (u, "(A,I0)") " Success in try ", mci%tries
write (u, "(A)")
end select
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_10"
end subroutine processes_10
@ %def processes_10
@ MCI record with some contents.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_test10 (mci, var_list, process_id, is_nlo)
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
allocate (mci_test_t :: mci)
select type (mci)
type is (mci_test_t); call mci%set_divisions (100)
end select
end subroutine dispatch_mci_test10
@ %def dispatch_mci_test10
@
\subsubsection{Integration}
Activate the MC integrator for the process object and use it to
integrate over phase space.
<<Processes: execute tests>>=
call test (processes_11, "processes_11", &
"integration", &
u, results)
<<Processes: test declarations>>=
public :: processes_11
<<Processes: tests>>=
subroutine processes_11 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(mci_t), allocatable :: mci_template
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t), allocatable, target :: process_instance
write (u, "(A)") "* Test output: processes_11"
write (u, "(A)") "* Purpose: integrate a process without &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes11"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test10)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Integrate with default test parameters"
write (u, "(A)")
call process_instance%integrate (1, n_it=1, n_calls=10000)
call process%final_integration (1)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
process%get_integral (1) &
/ process_instance%kin(1)%phs_factor
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_11"
end subroutine processes_11
@ %def processes_11
@
\subsubsection{Complete events}
For the purpose of simplifying further tests, we implement a
convenience routine that initializes a process and prepares a single
event. This is a wrapup of the test [[processes_10]].
The procedure is re-exported by the [[processes_ut]] module.
<<Processes: public test auxiliary>>=
public :: prepare_test_process
<<Processes: test auxiliary>>=
subroutine prepare_test_process &
(process, process_instance, model, var_list, run_id)
type(process_t), intent(out), target :: process
type(process_instance_t), intent(out), target :: process_instance
class(model_data_t), intent(in), target :: model
type(var_list_t), intent(inout), optional :: var_list
type(string_t), intent(in), optional :: run_id
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), allocatable, target :: process_model
class(mci_t), pointer :: mci
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
libname = "processes_test"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
allocate (process_model)
call process_model%init (model%get_name (), &
model%get_n_real (), &
model%get_n_complex (), &
model%get_n_field (), &
model%get_n_vtx ())
call process_model%copy_from (model)
call process%init (procname, lib, os_data, process_model, var_list)
if (present (run_id)) call process%set_run_id (run_id)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test10)
call process%setup_terms ()
call process_instance%init (process)
call process%test_get_mci_ptr (mci)
select type (mci)
type is (mci_test_t)
! This ensures that the next 'random' numbers are 0.3, 0.5, 0.7
call mci%rng%init (3)
! Include the constant PHS factor in the stored maximum of the integrand
call mci%set_max_factor (conv * twopi4 &
/ (2 * sqrt (lambda (sqrts **2, 125._default**2, 125._default**2))))
end select
call process%reset_library_ptr () ! avoid dangling pointer
call process_model%final ()
end subroutine prepare_test_process
@ %def prepare_test_process
@ Here we do the cleanup of the process and process instance emitted
by the previous routine.
<<Processes: public test auxiliary>>=
public :: cleanup_test_process
<<Processes: test auxiliary>>=
subroutine cleanup_test_process (process, process_instance)
type(process_t), intent(inout) :: process
type(process_instance_t), intent(inout) :: process_instance
call process_instance%final ()
call process%final ()
end subroutine cleanup_test_process
@ %def cleanup_test_process
@
This is the actual test. Prepare the test process and event, fill
all evaluators, and display the results. Use a particle set as
temporary storage, read kinematics and recalculate the event.
<<Processes: execute tests>>=
call test (processes_12, "processes_12", &
"event post-processing", &
u, results)
<<Processes: test declarations>>=
public :: processes_12
<<Processes: tests>>=
subroutine processes_12 (u)
integer, intent(in) :: u
type(process_t), allocatable, target :: process
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
type(model_data_t), target :: model
write (u, "(A)") "* Test output: processes_12"
write (u, "(A)") "* Purpose: generate a complete partonic event"
write (u, "(A)")
call model%init_test ()
write (u, "(A)") "* Build and initialize process and process instance &
&and generate event"
write (u, "(A)")
allocate (process)
allocate (process_instance)
call prepare_test_process (process, process_instance, model, &
run_id = var_str ("run_12"))
call process_instance%setup_event_data (i_core = 1)
call process%prepare_simulation (1)
call process_instance%init_simulation (1)
call process_instance%generate_weighted_event (1)
call process_instance%evaluate_event_data ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final_simulation (1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Recover kinematics and recalculate"
write (u, "(A)")
call reset_interaction_counter (2)
allocate (process_instance)
call process_instance%init (process)
call process_instance%setup_event_data ()
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover &
(channel = 1, i_term = 1, update_sqme = .true., recover_phs = .true.)
call process_instance%recover_event ()
call process_instance%evaluate_event_data ()
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call cleanup_test_process (process, process_instance)
deallocate (process_instance)
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_12"
end subroutine processes_12
@ %def processes_12
@
\subsubsection{Colored interaction}
This test specifically checks the transformation of process data
(flavor, helicity, and color) into an interaction in a process term.
We use the [[test_t]] process core (which has no nontrivial
particles), but call only the [[is_allowed]] method, which always
returns true.
<<Processes: execute tests>>=
call test (processes_13, "processes_13", &
"colored interaction", &
u, results)
<<Processes: test declarations>>=
public :: processes_13
<<Processes: tests>>=
subroutine processes_13 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(process_term_t) :: term
class(prc_core_t), allocatable :: core
write (u, "(A)") "* Test output: processes_13"
write (u, "(A)") "* Purpose: initialized a colored interaction"
write (u, "(A)")
write (u, "(A)") "* Set up a process constants block"
write (u, "(A)")
call os_data%init ()
call model%init_sm_test ()
allocate (test_t :: core)
associate (data => term%data)
data%n_in = 2
data%n_out = 3
data%n_flv = 2
data%n_hel = 2
data%n_col = 2
data%n_cin = 2
allocate (data%flv_state (5, 2))
data%flv_state (:,1) = [ 1, 21, 1, 21, 21]
data%flv_state (:,2) = [ 2, 21, 2, 21, 21]
allocate (data%hel_state (5, 2))
data%hel_state (:,1) = [1, 1, 1, 1, 0]
data%hel_state (:,2) = [1,-1, 1,-1, 0]
allocate (data%col_state (2, 5, 2))
data%col_state (:,:,1) = &
reshape ([[1, 0], [2,-1], [3, 0], [2,-3], [0,0]], [2,5])
data%col_state (:,:,2) = &
reshape ([[1, 0], [2,-3], [3, 0], [2,-1], [0,0]], [2,5])
allocate (data%ghost_flag (5, 2))
data%ghost_flag(1:4,:) = .false.
data%ghost_flag(5,:) = .true.
end associate
write (u, "(A)") "* Set up the interaction"
write (u, "(A)")
call reset_interaction_counter ()
call term%setup_interaction (core, model)
call term%int%basic_write (u)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_13"
end subroutine processes_13
@ %def processes_13
@
\subsubsection{MD5 sums}
Configure a process with structure functions (multi-channel) and
compute MD5 sums
<<Processes: execute tests>>=
call test (processes_14, "processes_14", &
"process configuration and MD5 sum", &
u, results)
<<Processes: test declarations>>=
public :: processes_14
<<Processes: tests>>=
subroutine processes_14 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_channel_t), dimension(3) :: sf_channel
write (u, "(A)") "* Test output: processes_14"
write (u, "(A)") "* Purpose: initialize a process with &
&structure functions"
write (u, "(A)") "* and compute MD5 sum"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes7"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call lib%compute_md5sum ()
call model%init_test ()
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Set beam, structure functions, and mappings"
write (u, "(A)")
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (process%get_model_ptr (), pdg_in)
end select
call process%test_allocate_sf_channels (3)
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call process%init_sf_chain (sf_config)
deallocate (sf_config)
call sf_channel(1)%init (2)
call process%set_sf_channel (1, sf_channel(1))
call sf_channel(2)%init (2)
call sf_channel(2)%activate_mapping ([1,2])
call process%set_sf_channel (2, sf_channel(2))
call sf_channel(3)%init (2)
call sf_channel(3)%set_s_mapping ([1,2])
call process%set_sf_channel (3, sf_channel(3))
call process%setup_mci (dispatch_mci_empty)
call process%compute_md5sum ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_14"
end subroutine processes_14
@ %def processes_14
@
\subsubsection{Decay Process Evaluation}
Initialize an evaluate a decay process.
<<Processes: execute tests>>=
call test (processes_15, "processes_15", &
"decay process", &
u, results)
<<Processes: test declarations>>=
public :: processes_15
<<Processes: tests>>=
subroutine processes_15 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_15"
write (u, "(A)") "* Purpose: initialize a decay process object"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes15"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
call process%setup_beams_decay (i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_empty)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Inject a set of random numbers"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%set_mcpar ([0._default, 0._default])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set up hard kinematics"
write (u, "(A)")
call process_instance%select_channel (1)
call process_instance%compute_seed_kinematics ()
call process_instance%compute_hard_kinematics ()
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%compute_eff_kinematics ()
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels ()
call process_instance%evaluate_trace ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover (1, 1, .true., .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_15"
end subroutine processes_15
@ %def processes_15
@
\subsubsection{Integration: decay}
Activate the MC integrator for the decay object and use it to
integrate over phase space.
<<Processes: execute tests>>=
call test (processes_16, "processes_16", &
"decay integration", &
u, results)
<<Processes: test declarations>>=
public :: processes_16
<<Processes: tests>>=
subroutine processes_16 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_instance_t), allocatable, target :: process_instance
write (u, "(A)") "* Test output: processes_16"
write (u, "(A)") "* Purpose: integrate a process without &
&structure functions"
write (u, "(A)") "* in a multi-channel configuration"
write (u, "(A)")
write (u, "(A)") "* Build and initialize a process object"
write (u, "(A)")
libname = "processes16"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
call reset_interaction_counter ()
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
call process%setup_beams_decay (i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_test_midpoint)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Integrate with default test parameters"
write (u, "(A)")
call process_instance%integrate (1, n_it=1, n_calls=10000)
call process%final_integration (1)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
process%get_integral (1) &
/ process_instance%kin(1)%phs_factor
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_16"
end subroutine processes_16
@ %def processes_16
@ MCI record prepared for midpoint integrator.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
allocate (mci_midpoint_t :: mci)
end subroutine dispatch_mci_test_midpoint
@ %def dispatch_mci_test_midpoint
@
\subsubsection{Decay Process Evaluation}
Initialize an evaluate a decay process for a moving particle.
<<Processes: execute tests>>=
call test (processes_17, "processes_17", &
"decay of moving particle", &
u, results)
<<Processes: test declarations>>=
public :: processes_17
<<Processes: tests>>=
subroutine processes_17 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
type(process_instance_t), allocatable, target :: process_instance
type(particle_set_t) :: pset
type(flavor_t) :: flv_beam
real(default) :: m, p, E
write (u, "(A)") "* Test output: processes_17"
write (u, "(A)") "* Purpose: initialize a decay process object"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes17"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
call model%init_test ()
call model%set_par (var_str ("ff"), 0.4_default)
call model%set_par (var_str ("mf"), &
model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
allocate (process)
call process%init (procname, lib, os_data, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_components (phs_config_template)
write (u, "(A)") "* Prepare a trivial beam setup"
write (u, "(A)")
call process%setup_beams_decay (rest_frame = .false., i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_empty)
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set parent momentum and random numbers"
write (u, "(A)")
call process_instance%choose_mci (1)
call process_instance%set_mcpar ([0._default, 0._default])
call flv_beam%init (25, process%get_model_ptr ())
m = flv_beam%get_mass ()
p = 3 * m / 4
E = sqrt (m**2 + p**2)
call process_instance%set_beam_momenta ([vector4_moving (E, p, 3)])
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Set up hard kinematics"
write (u, "(A)")
call process_instance%select_channel (1)
call process_instance%compute_seed_kinematics ()
call process_instance%compute_hard_kinematics ()
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%compute_eff_kinematics ()
call process_instance%evaluate_expressions ()
call process_instance%compute_other_channels ()
call process_instance%evaluate_trace ()
call process_instance%write (u)
call process_instance%get_trace (pset, 1)
call process_instance%final ()
deallocate (process_instance)
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover process instance"
write (u, "(A)")
call reset_interaction_counter (3)
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1, check_match = .false.)
call process_instance%recover (1, 1, .true., .true.)
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call pset%final ()
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_17"
end subroutine processes_17
@ %def processes_17
@
\subsubsection{Resonances in Phase Space}
This test demonstrates the extraction of the resonance-history set from the
generated phase space. We need a nontrivial process, but no matrix element.
This is provided by the [[prc_template]] method, using the [[SM]] model. We
also need the [[phs_wood]] method, otherwise we would not have resonances in
the phase space configuration.
<<Processes: execute tests>>=
call test (processes_18, "processes_18", &
"extract resonance history set", &
u, results)
<<Processes: test declarations>>=
public :: processes_18
<<Processes: tests>>=
subroutine processes_18 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: model_name
type(os_data_t) :: os_data
class(model_data_t), pointer :: model
class(vars_t), pointer :: vars
type(process_t), pointer :: process
type(resonance_history_set_t) :: res_set
integer :: i
write (u, "(A)") "* Test output: processes_18"
write (u, "(A)") "* Purpose: extra resonance histories"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
libname = "processes_18_lib"
procname = "processes_18_p"
call os_data%init ()
call syntax_phs_forest_init ()
model_name = "SM"
model => null ()
call prepare_model (model, model_name, vars)
write (u, "(A)") "* Initialize a process library with one process"
write (u, "(A)")
select type (model)
class is (model_t)
call prepare_resonance_test_library (lib, libname, procname, model, os_data, u)
end select
write (u, "(A)")
write (u, "(A)") "* Initialize a process object with phase space"
allocate (process)
select type (model)
class is (model_t)
call prepare_resonance_test_process (process, lib, procname, model, os_data)
end select
write (u, "(A)")
write (u, "(A)") "* Extract resonance history set"
write (u, "(A)")
call process%extract_resonance_history_set (res_set)
call res_set%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
call model%final ()
deallocate (model)
call syntax_phs_forest_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_18"
end subroutine processes_18
@ %def processes_18
@ Auxiliary subroutine that constructs the process library for the above test.
<<Processes: test auxiliary>>=
subroutine prepare_resonance_test_library &
(lib, libname, procname, model, os_data, u)
type(process_library_t), target, intent(out) :: lib
type(string_t), intent(in) :: libname
type(string_t), intent(in) :: procname
type(model_t), intent(in), target :: model
type(os_data_t), intent(in) :: os_data
integer, intent(in) :: u
type(string_t), dimension(:), allocatable :: prt_in, prt_out
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
call lib%init (libname)
allocate (prt_in (2), prt_out (3))
prt_in = [var_str ("e+"), var_str ("e-")]
prt_out = [var_str ("d"), var_str ("ubar"), var_str ("W+")]
allocate (template_me_def_t :: def)
select type (def)
type is (template_me_def_t)
call def%init (model, prt_in, prt_out, unity = .false.)
end select
allocate (entry)
call entry%init (procname, &
model_name = model%get_name (), &
n_in = 2, n_components = 1)
call entry%import_component (1, n_out = size (prt_out), &
prt_in = new_prt_spec (prt_in), &
prt_out = new_prt_spec (prt_out), &
method = var_str ("template"), &
variant = def)
call entry%write (u)
call lib%append (entry)
call lib%configure (os_data)
call lib%write_makefile (os_data, force = .true., verbose = .false.)
call lib%clean (os_data, distclean = .false.)
call lib%write_driver (force = .true.)
call lib%load (os_data)
end subroutine prepare_resonance_test_library
@ %def prepare_resonance_test_library
@ We want a test process which has been initialized up to the point where we
can evaluate the matrix element. This is in fact rather complicated. We copy
the steps from [[integration_setup_process]] in the [[integrate]] module,
which is not available at this point.
<<Processes: test auxiliary>>=
subroutine prepare_resonance_test_process &
(process, lib, procname, model, os_data)
class(process_t), intent(out), target :: process
type(process_library_t), intent(in), target :: lib
type(string_t), intent(in) :: procname
type(model_t), intent(in), target :: model
type(os_data_t), intent(in) :: os_data
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
call process%init (procname, lib, os_data, model)
allocate (phs_wood_config_t :: phs_config_template)
call process%init_components (phs_config_template)
call process%setup_test_cores (type_string = var_str ("template"))
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci (dispatch_mci_none)
call process%setup_terms ()
end subroutine prepare_resonance_test_process
@ %def prepare_resonance_test_process
@ MCI record prepared for the none (dummy) integrator.
<<Processes: test auxiliary>>=
subroutine dispatch_mci_none (mci, var_list, process_id, is_nlo)
class(mci_t), allocatable, intent(out) :: mci
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
logical, intent(in), optional :: is_nlo
allocate (mci_none_t :: mci)
end subroutine dispatch_mci_none
@ %def dispatch_mci_none
@
\subsubsection{Add after evaluate hook(s)}
Initialize a process and process instance, add a trivial process hook,
choose a sampling point and fill the process instance.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Processes: test types>>=
type, extends(process_instance_hook_t) :: process_instance_hook_test_t
integer :: unit
character(len=15) :: name
contains
procedure :: init => process_instance_hook_test_init
procedure :: final => process_instance_hook_test_final
procedure :: evaluate => process_instance_hook_test_evaluate
end type process_instance_hook_test_t
@
<<Processes: test auxiliary>>=
subroutine process_instance_hook_test_init (hook, var_list, instance, pdf_data)
class(process_instance_hook_test_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
type(pdf_data_t), intent(in), optional :: pdf_data
end subroutine process_instance_hook_test_init
subroutine process_instance_hook_test_final (hook)
class(process_instance_hook_test_t), intent(inout) :: hook
end subroutine process_instance_hook_test_final
subroutine process_instance_hook_test_evaluate (hook, instance)
class(process_instance_hook_test_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
write (hook%unit, "(A)") "Execute hook:"
write (hook%unit, "(2X,A,1X,A,I0,A)") hook%name, "(", len (trim (hook%name)), ")"
end subroutine process_instance_hook_test_evaluate
@
<<Processes: execute tests>>=
call test (processes_19, "processes_19", &
"add trivial hooks to a process instance ", &
u, results)
<<Processes: test declarations>>=
public :: processes_19
<<Processes: tests>>=
subroutine processes_19 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
class(model_data_t), pointer :: model
type(process_t), allocatable, target :: process
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
type(process_instance_t) :: process_instance
class(process_instance_hook_t), allocatable, target :: process_instance_hook, process_instance_hook2
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_19"
write (u, "(A)") "* Purpose: allocate process instance &
&and add an after evaluate hook"
write (u, "(A)")
write (u, "(A)")
write (u, "(A)") "* Allocate a process instance"
write (u, "(A)")
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Allocate hook and add to process instance"
write (u, "(A)")
allocate (process_instance_hook_test_t :: process_instance_hook)
call process_instance%append_after_hook (process_instance_hook)
allocate (process_instance_hook_test_t :: process_instance_hook2)
call process_instance%append_after_hook (process_instance_hook2)
select type (process_instance_hook)
type is (process_instance_hook_test_t)
process_instance_hook%unit = u
process_instance_hook%name = "Hook 1"
end select
select type (process_instance_hook2)
type is (process_instance_hook_test_t)
process_instance_hook2%unit = u
process_instance_hook2%name = "Hook 2"
end select
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%evaluate_after_hook ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance_hook%final ()
deallocate (process_instance_hook)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_19"
end subroutine processes_19
@ %def processes_19
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process Stacks}
For storing and handling multiple processes, we define process stacks.
These are ordinary stacks where new process entries are pushed onto
the top. We allow for multiple entries with identical process ID, but
distinct run ID.
The implementation is essentially identical to the [[prclib_stacks]] module
above. Unfortunately, Fortran supports no generic programming, so we do not
make use of this fact.
When searching for a specific process ID, we will get (a pointer to)
the topmost process entry with that ID on the stack, which was entered
last. Usually, this is the best version of the process (in terms of
integral, etc.) Thus the stack terminology makes sense.
<<[[process_stacks.f90]]>>=
<<File header>>
module process_stacks
<<Use kinds>>
<<Use strings>>
use variables
use process
<<Standard module head>>
<<Process stacks: public>>
<<Process stacks: types>>
interface
<<Process stacks: sub interfaces>>
end interface
end module process_stacks
@ %def process_stacks
@
<<[[process_stacks_sub.f90]]>>=
<<File header>>
submodule (process_stacks) process_stacks_s
use io_units
use format_utils, only: write_separator
use diagnostics
use observables
implicit none
contains
<<Process stacks: procedures>>
end submodule process_stacks_s
@ %def process_stacks_s
@
\subsection{The process entry type}
A process entry is a process object, augmented by a pointer to the
next entry. We do not need specific methods, all relevant methods are
inherited.
On higher level, processes should be prepared as process entry objects.
<<Process stacks: public>>=
public :: process_entry_t
<<Process stacks: types>>=
type, extends (process_t) :: process_entry_t
type(process_entry_t), pointer :: next => null ()
end type process_entry_t
@ %def process_entry_t
@
\subsection{The process stack type}
For easy conversion and lookup it is useful to store the filling
number in the object. The content is stored as a linked list.
The [[var_list]] component stores process-specific results, so they
can be retrieved as (pseudo) variables.
The process stack can be linked to another one. This allows us to
work with stacks of local scope.
<<Process stacks: public>>=
public :: process_stack_t
<<Process stacks: types>>=
type :: process_stack_t
integer :: n = 0
type(process_entry_t), pointer :: first => null ()
type(var_list_t), pointer :: var_list => null ()
type(process_stack_t), pointer :: next => null ()
contains
<<Process stacks: process stack: TBP>>
end type process_stack_t
@ %def process_stack_t
@ Finalize partly: deallocate the process stack and variable list
entries, but keep the variable list as an empty object. This way, the
variable list links are kept.
<<Process stacks: process stack: TBP>>=
procedure :: clear => process_stack_clear
<<Process stacks: sub interfaces>>=
module subroutine process_stack_clear (stack)
class(process_stack_t), intent(inout) :: stack
end subroutine process_stack_clear
<<Process stacks: procedures>>=
module subroutine process_stack_clear (stack)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), pointer :: process
if (associated (stack%var_list)) then
call stack%var_list%final ()
end if
do while (associated (stack%first))
process => stack%first
stack%first => process%next
call process%final ()
deallocate (process)
end do
stack%n = 0
end subroutine process_stack_clear
@ %def process_stack_clear
@ Finalizer. Clear and deallocate the variable list.
<<Process stacks: process stack: TBP>>=
procedure :: final => process_stack_final
<<Process stacks: sub interfaces>>=
module subroutine process_stack_final (object)
class(process_stack_t), intent(inout) :: object
end subroutine process_stack_final
<<Process stacks: procedures>>=
module subroutine process_stack_final (object)
class(process_stack_t), intent(inout) :: object
call object%clear ()
if (associated (object%var_list)) then
deallocate (object%var_list)
end if
end subroutine process_stack_final
@ %def process_stack_final
@ Output. The processes on the stack will be ordered LIFO, i.e.,
backwards.
<<Process stacks: process stack: TBP>>=
procedure :: write => process_stack_write
<<Process stacks: sub interfaces>>=
recursive module subroutine process_stack_write (object, unit, pacify)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
end subroutine process_stack_write
<<Process stacks: procedures>>=
recursive module subroutine process_stack_write (object, unit, pacify)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
type(process_entry_t), pointer :: process
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
select case (object%n)
case (0)
write (u, "(1x,A)") "Process stack: [empty]"
call write_separator (u, 2)
case default
write (u, "(1x,A)") "Process stack:"
process => object%first
do while (associated (process))
call process%write (.false., u, pacify = pacify)
process => process%next
end do
end select
if (associated (object%next)) then
write (u, "(1x,A)") "[Processes from context environment:]"
call object%next%write (u, pacify)
end if
end subroutine process_stack_write
@ %def process_stack_write
@ The variable list is printed by a separate routine, since
it should be linked to the global variable list, anyway.
<<Process stacks: process stack: TBP>>=
procedure :: write_var_list => process_stack_write_var_list
<<Process stacks: sub interfaces>>=
module subroutine process_stack_write_var_list (object, unit)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine process_stack_write_var_list
<<Process stacks: procedures>>=
module subroutine process_stack_write_var_list (object, unit)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
if (associated (object%var_list)) then
call object%var_list%write (unit)
end if
end subroutine process_stack_write_var_list
@ %def process_stack_write_var_list
@ Short output.
Since this is a stack, the default output ordering for each stack will be
last-in, first-out. To enable first-in, first-out, which is more likely to be
requested, there is an optional [[fifo]] argument.
<<Process stacks: process stack: TBP>>=
procedure :: show => process_stack_show
<<Process stacks: sub interfaces>>=
recursive module subroutine process_stack_show (object, unit, fifo)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: fifo
end subroutine process_stack_show
<<Process stacks: procedures>>=
recursive module subroutine process_stack_show (object, unit, fifo)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: fifo
type(process_entry_t), pointer :: process
logical :: reverse
integer :: u, i, j
u = given_output_unit (unit)
reverse = .false.; if (present (fifo)) reverse = fifo
select case (object%n)
case (0)
case default
if (.not. reverse) then
process => object%first
do while (associated (process))
call process%show (u, verbose=.false.)
process => process%next
end do
else
do i = 1, object%n
process => object%first
do j = 1, object%n - i
process => process%next
end do
call process%show (u, verbose=.false.)
end do
end if
end select
if (associated (object%next)) call object%next%show ()
end subroutine process_stack_show
@ %def process_stack_show
@
\subsection{Link}
Link the current process stack to a global one.
<<Process stacks: process stack: TBP>>=
procedure :: link => process_stack_link
<<Process stacks: sub interfaces>>=
module subroutine process_stack_link (local_stack, global_stack)
class(process_stack_t), intent(inout) :: local_stack
type(process_stack_t), intent(in), target :: global_stack
end subroutine process_stack_link
<<Process stacks: procedures>>=
module subroutine process_stack_link (local_stack, global_stack)
class(process_stack_t), intent(inout) :: local_stack
type(process_stack_t), intent(in), target :: global_stack
local_stack%next => global_stack
end subroutine process_stack_link
@ %def process_stack_link
@ Initialize the process variable list and link the main variable list
to it.
<<Process stacks: process stack: TBP>>=
procedure :: init_var_list => process_stack_init_var_list
<<Process stacks: sub interfaces>>=
module subroutine process_stack_init_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(inout), optional :: var_list
end subroutine process_stack_init_var_list
<<Process stacks: procedures>>=
module subroutine process_stack_init_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(inout), optional :: var_list
allocate (stack%var_list)
if (present (var_list)) call var_list%link (stack%var_list)
end subroutine process_stack_init_var_list
@ %def process_stack_init_var_list
@ Link the process variable list to a global
variable list.
<<Process stacks: process stack: TBP>>=
procedure :: link_var_list => process_stack_link_var_list
<<Process stacks: sub interfaces>>=
module subroutine process_stack_link_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(in), target :: var_list
end subroutine process_stack_link_var_list
<<Process stacks: procedures>>=
module subroutine process_stack_link_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(in), target :: var_list
call stack%var_list%link (var_list)
end subroutine process_stack_link_var_list
@ %def process_stack_link_var_list
@
\subsection{Push}
We take a process pointer and push it onto the stack. The previous
pointer is nullified. Subsequently, the process is `owned' by the
stack and will be finalized when the stack is deleted.
<<Process stacks: process stack: TBP>>=
procedure :: push => process_stack_push
<<Process stacks: sub interfaces>>=
module subroutine process_stack_push (stack, process)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), intent(inout), pointer :: process
end subroutine process_stack_push
<<Process stacks: procedures>>=
module subroutine process_stack_push (stack, process)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), intent(inout), pointer :: process
process%next => stack%first
stack%first => process
process => null ()
stack%n = stack%n + 1
end subroutine process_stack_push
@ %def process_stack_push
@ Inverse: Remove the last process pointer in the list and return it.
<<Process stacks: process stack: TBP>>=
procedure :: pop_last => process_stack_pop_last
<<Process stacks: sub interfaces>>=
module subroutine process_stack_pop_last (stack, process)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), intent(inout), pointer :: process
end subroutine process_stack_pop_last
<<Process stacks: procedures>>=
module subroutine process_stack_pop_last (stack, process)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), intent(inout), pointer :: process
type(process_entry_t), pointer :: previous
integer :: i
select case (stack%n)
case (:0)
process => null ()
case (1)
process => stack%first
stack%first => null ()
stack%n = 0
case (2:)
process => stack%first
do i = 2, stack%n
previous => process
process => process%next
end do
previous%next => null ()
stack%n = stack%n - 1
end select
end subroutine process_stack_pop_last
@ %def process_stack_pop_last
@ Initialize process variables for a given process ID, without setting
values.
<<Process stacks: process stack: TBP>>=
procedure :: init_result_vars => process_stack_init_result_vars
<<Process stacks: sub interfaces>>=
module subroutine process_stack_init_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
end subroutine process_stack_init_result_vars
<<Process stacks: procedures>>=
module subroutine process_stack_init_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
call var_list_init_num_id (stack%var_list, id)
call var_list_init_process_results (stack%var_list, id)
end subroutine process_stack_init_result_vars
@ %def process_stack_init_result_vars
@ Fill process variables with values. This is executed after the
integration pass.
Note: We set only integral and error. With multiple MCI records
possible, the results for [[n_calls]], [[chi2]] etc. are not
necessarily unique. (We might set the efficiency, though.)
<<Process stacks: process stack: TBP>>=
procedure :: fill_result_vars => process_stack_fill_result_vars
<<Process stacks: sub interfaces>>=
module subroutine process_stack_fill_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
end subroutine process_stack_fill_result_vars
<<Process stacks: procedures>>=
module subroutine process_stack_fill_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
type(process_t), pointer :: process
process => stack%get_process_ptr (id)
if (associated (process)) then
call var_list_init_num_id (stack%var_list, id, process%get_num_id ())
if (process%has_integral ()) then
call var_list_init_process_results (stack%var_list, id, &
integral = process%get_integral (), &
error = process%get_error ())
end if
else
call msg_bug ("process_stack_fill_result_vars: unknown process ID")
end if
end subroutine process_stack_fill_result_vars
@ %def process_stack_fill_result_vars
@ If one of the result variables has a local image in [[var_list_local]],
update the value there as well.
<<Process stacks: process stack: TBP>>=
procedure :: update_result_vars => process_stack_update_result_vars
<<Process stacks: sub interfaces>>=
module subroutine process_stack_update_result_vars &
(stack, id, var_list_local)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
type(var_list_t), intent(inout) :: var_list_local
end subroutine process_stack_update_result_vars
<<Process stacks: procedures>>=
module subroutine process_stack_update_result_vars (stack, id, var_list_local)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
type(var_list_t), intent(inout) :: var_list_local
call update ("integral(" // id // ")")
call update ("error(" // id // ")")
contains
subroutine update (var_name)
type(string_t), intent(in) :: var_name
real(default) :: value
if (var_list_local%contains (var_name, follow_link = .false.)) then
value = stack%var_list%get_rval (var_name)
call var_list_local%set_real (var_name, value, is_known = .true.)
end if
end subroutine update
end subroutine process_stack_update_result_vars
@ %def process_stack_update_result_vars
@
\subsection{Data Access}
Tell if a process exists.
<<Process stacks: process stack: TBP>>=
procedure :: exists => process_stack_exists
<<Process stacks: sub interfaces>>=
module function process_stack_exists (stack, id) result (flag)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
logical :: flag
end function process_stack_exists
<<Process stacks: procedures>>=
module function process_stack_exists (stack, id) result (flag)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
logical :: flag
type(process_t), pointer :: process
process => stack%get_process_ptr (id)
flag = associated (process)
end function process_stack_exists
@ %def process_stack_exists
@ Return a pointer to a process with specific ID. Look also at a
linked stack, if necessary.
<<Process stacks: process stack: TBP>>=
procedure :: get_process_ptr => process_stack_get_process_ptr
<<Process stacks: sub interfaces>>=
recursive module function process_stack_get_process_ptr &
(stack, id) result (ptr)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
type(process_t), pointer :: ptr
end function process_stack_get_process_ptr
<<Process stacks: procedures>>=
recursive module function process_stack_get_process_ptr &
(stack, id) result (ptr)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
type(process_t), pointer :: ptr
type(process_entry_t), pointer :: entry
ptr => null ()
entry => stack%first
do while (associated (entry))
if (entry%get_id () == id) then
ptr => entry%process_t
return
end if
entry => entry%next
end do
if (associated (stack%next)) ptr => stack%next%get_process_ptr (id)
end function process_stack_get_process_ptr
@ %def process_stack_get_process_ptr
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[process_stacks_ut.f90]]>>=
<<File header>>
module process_stacks_ut
use unit_tests
use process_stacks_uti
<<Standard module head>>
<<Process stacks: public test>>
contains
<<Process stacks: test driver>>
end module process_stacks_ut
@ %def process_stacks_ut
@
<<[[process_stacks_uti.f90]]>>=
<<File header>>
module process_stacks_uti
<<Use strings>>
use os_interface
use sm_qcd
use models
use model_data
use variables, only: var_list_t
use process_libraries
use rng_base
use prc_test, only: prc_test_create_library
use process, only: process_t
use instances, only: process_instance_t
use processes_ut, only: prepare_test_process
use process_stacks
use rng_base_ut, only: rng_test_factory_t
<<Standard module head>>
<<Process stacks: test declarations>>
contains
<<Process stacks: tests>>
end module process_stacks_uti
@ %def process_stacks_uti
@ API: driver for the unit tests below.
<<Process stacks: public test>>=
public :: process_stacks_test
<<Process stacks: test driver>>=
subroutine process_stacks_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Process stacks: execute tests>>
end subroutine process_stacks_test
@ %def process_stacks_test
@
\subsubsection{Write an empty process stack}
The most trivial test is to write an uninitialized process stack.
<<Process stacks: execute tests>>=
call test (process_stacks_1, "process_stacks_1", &
"write an empty process stack", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_1
<<Process stacks: tests>>=
subroutine process_stacks_1 (u)
integer, intent(in) :: u
type(process_stack_t) :: stack
write (u, "(A)") "* Test output: process_stacks_1"
write (u, "(A)") "* Purpose: display an empty process stack"
write (u, "(A)")
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_1"
end subroutine process_stacks_1
@ %def process_stacks_1
@
\subsubsection{Fill a process stack}
Fill a process stack with two (identical) processes.
<<Process stacks: execute tests>>=
call test (process_stacks_2, "process_stacks_2", &
"fill a process stack", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_2
<<Process stacks: tests>>=
subroutine process_stacks_2 (u)
integer, intent(in) :: u
type(process_stack_t) :: stack
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(os_data_t) :: os_data
type(model_t), target :: model
type(var_list_t) :: var_list
type(process_entry_t), pointer :: process => null ()
write (u, "(A)") "* Test output: process_stacks_2"
write (u, "(A)") "* Purpose: fill a process stack"
write (u, "(A)")
write (u, "(A)") "* Build, initialize and store two test processes"
write (u, "(A)")
libname = "process_stacks2"
procname = libname
call os_data%init ()
call prc_test_create_library (libname, lib)
call model%init_test ()
call var_list%append_string (var_str ("$run_id"))
call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
call var_list%append_int (var_str ("seed"), 0)
allocate (process)
call var_list%set_string &
(var_str ("$run_id"), var_str ("run1"), is_known=.true.)
call process%init (procname, lib, os_data, model, var_list)
call stack%push (process)
allocate (process)
call var_list%set_string &
(var_str ("$run_id"), var_str ("run2"), is_known=.true.)
call process%init (procname, lib, os_data, model, var_list)
call stack%push (process)
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_2"
end subroutine process_stacks_2
@ %def process_stacks_2
@
\subsubsection{Fill a process stack}
Fill a process stack with two (identical) processes.
<<Process stacks: execute tests>>=
call test (process_stacks_3, "process_stacks_3", &
"process variables", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_3
<<Process stacks: tests>>=
subroutine process_stacks_3 (u)
integer, intent(in) :: u
type(process_stack_t) :: stack
type(model_t), target :: model
type(string_t) :: procname
type(process_entry_t), pointer :: process => null ()
type(process_instance_t), target :: process_instance
write (u, "(A)") "* Test output: process_stacks_3"
write (u, "(A)") "* Purpose: setup process variables"
write (u, "(A)")
write (u, "(A)") "* Initialize process variables"
write (u, "(A)")
procname = "processes_test"
call model%init_test ()
write (u, "(A)") "* Initialize process variables"
write (u, "(A)")
call stack%init_var_list ()
call stack%init_result_vars (procname)
call stack%write_var_list (u)
write (u, "(A)")
write (u, "(A)") "* Build and integrate a test process"
write (u, "(A)")
allocate (process)
call prepare_test_process (process%process_t, process_instance, model)
call process_instance%integrate (1, 1, 1000)
call process_instance%final ()
call process%final_integration (1)
call stack%push (process)
write (u, "(A)") "* Fill process variables"
write (u, "(A)")
call stack%fill_result_vars (procname)
call stack%write_var_list (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_3"
end subroutine process_stacks_3
@ %def process_stacks_3
@
\subsubsection{Linked a process stack}
Fill two process stack, linked to each other.
<<Process stacks: execute tests>>=
call test (process_stacks_4, "process_stacks_4", &
"linked stacks", &
u, results)
<<Process stacks: test declarations>>=
public :: process_stacks_4
<<Process stacks: tests>>=
subroutine process_stacks_4 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(process_stack_t), target :: stack1, stack2
type(model_t), target :: model
type(string_t) :: libname
type(string_t) :: procname1, procname2
type(os_data_t) :: os_data
type(process_entry_t), pointer :: process => null ()
write (u, "(A)") "* Test output: process_stacks_4"
write (u, "(A)") "* Purpose: link process stacks"
write (u, "(A)")
write (u, "(A)") "* Initialize process variables"
write (u, "(A)")
libname = "process_stacks_4_lib"
procname1 = "process_stacks_4a"
procname2 = "process_stacks_4b"
call os_data%init ()
write (u, "(A)") "* Initialize first process"
write (u, "(A)")
call prc_test_create_library (procname1, lib)
call model%init_test ()
allocate (process)
call process%init (procname1, lib, os_data, model)
call stack1%push (process)
write (u, "(A)") "* Initialize second process"
write (u, "(A)")
call stack2%link (stack1)
call prc_test_create_library (procname2, lib)
allocate (process)
call process%init (procname2, lib, os_data, model)
call stack2%push (process)
write (u, "(A)") "* Show linked stacks"
write (u, "(A)")
call stack2%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack2%final ()
call stack1%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_4"
end subroutine process_stacks_4
@ %def process_stacks_4
@
Index: trunk/src/fks/fks.nw
===================================================================
--- trunk/src/fks/fks.nw (revision 8819)
+++ trunk/src/fks/fks.nw (revision 8820)
@@ -1,12036 +1,12020 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: matrix elements and process libraries
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{FKS Subtraction Scheme}
\includemodulegraph{fks}
The code in this chapter implements the FKS subtraction scheme for use
with \whizard.
These are the modules:
\begin{description}
\item[fks\_regions]
Given a process definition, identify singular regions in the
associated phase space.
\item[virtual]
Handle the virtual correction matrix element.
\item[real\_subtraction]
Handle the real-subtraction matrix element.
\item[nlo\_data]
Manage the subtraction objects.
\item[dglap\_remnant]
Handle the DGLAP Remnant matrix element.
\end{description}
This chapter deals with next-to-leading order contributions to cross sections.
Basically, there are three major issues to be adressed: The creation
of the $N+1$-particle flavor structure, the construction of the
$N+1$-particle phase space and the actual calculation of the real- and
virtual-subtracted matrix elements. The first is dealt with using the
[[auto_components]] class, and it will be shown that the second
and third issue are connected in FKS subtraction.
\section{Brief outline of FKS subtraction}
{\em In the current state, this discussion is only concerned with
lepton collisions. For hadron collisions, renormalization of parton
distributions has to be taken into account. Further, for QCD
corrections, initial-state radiation is necessarily
present.}
The aim is to calculate the next-to-leading order cross section
according to
\begin{equation*}
d\sigma_{\rm{NLO}} = \mathcal{B} + \mathcal{V} +
\mathcal{R}d\Phi_{\rm{rad}}.
\end{equation*}
Analytically, the divergences, in terms of poles in the complex
quantity $\varepsilon = 2-d/2$, cancel. However, this is in general
only valid in an arbitrary, complex number of dimensions. This is,
roughly, the content of the KLN-theorem. \whizard, as any
other numerical program, is confined to four dimensions. We will
assume that the KLN-theorem is valid and that there exist subtraction
terms $\mathcal{C}$ such that
\begin{equation*}
d\sigma_{\rm{NLO}} = \mathcal{B} + \underbrace{\mathcal{V} +
\mathcal{C}}_{\text{finite}} + \underbrace{\mathcal{R} -
\mathcal{C}}_{\text{finite}},
\end{equation*}
i.e. the subtraction terms correspond to the divergent limits of the
real and virtual matrix element.
Because $\mathcal{C}$ subtracts the divergences of $\mathcal{R}$ as
well as those of $\mathcal{V}$, it suffices to consider one of them,
so we focus on $\mathcal{R}$. For this purpose, $\mathcal{R}$ is
rewritten as
\begin{equation*}
\mathcal{R} = \frac{1}{\xi^2}\frac{1}{1-y} \left(\xi^2
(1-y)\mathcal{R}\right) =
\frac{1}{\xi^2}\frac{1}{1-y}\tilde{\mathcal{R}},
\end{equation*}
with $\xi = \left(2k_{\rm{rad}}^0\right)/\sqrt{s}$ and $y =
\cos\theta$, where $k_{\rm{rad}}^0$ denotes the energy of the radiated
parton and $\theta$ is the angle between emitter and radiated
parton. $\tilde{\mathcal{R}}$ is finite, therefore the whole
singularity structure is contained in the prefactor
$\xi^{-2}(1-y)^{-1}$. Combined with the $d$-dimensional phase space
element,
\begin{equation*}
\frac{d^{d-1}k}{2k^0(2\pi)^{d-1}} =
\frac{s^{1-\varepsilon}}{(4\pi)^{d-1}}\xi^{1-2\varepsilon}\left(1-y^2\right)^{-\varepsilon}
d\xi dy d\Omega^{d-2},
\end{equation*}
this yields
\begin{equation*}
d\Phi_{\rm{rad}} \mathcal{R} = dy (1-y)^{-1-\varepsilon} d\xi
\xi^{-1-2\varepsilon} \tilde{R}.
\end{equation*}
This can further be rewritten in terms of plus-distributions,
\begin{align*}
\xi^{-1-2\varepsilon} &= -\frac{1}{2\varepsilon}\delta(\xi) +
\left(\frac{1}{\xi}\right)_+ -
2\varepsilon\left(\frac{\log\xi}{\xi}\right)_+ +
\mathcal{O}(\varepsilon^2),\\
(1-y)^{-1-\varepsilon} &= -\frac{2^{-\varepsilon}}{\varepsilon}
\delta(1-y) + \left(\frac{1}{1-y}\right)_+ - \varepsilon
\left(\frac{1}{1-y}\right)_+\log(1-y) + \mathcal{O}(\varepsilon^2),
\end{align*}
(imagine that all this is written inside of integrals, which are
spared for ease of notation) such that
\begin{align*}
d\Phi_{\rm{rad}} \mathcal{R} &= -\frac{1}{2\varepsilon} dy
(1-y)^{-1-\varepsilon}\tilde{R} (0,y) -
d\xi\left[\frac{2^{-\varepsilon}}{\varepsilon}\left(\frac{1}{\xi}\right)_+
- 2\left(\frac{\log\xi}{\xi}\right)_+\right] \tilde{R}(\xi,1) \\
&+ dy d\xi \left(\frac{1}{\xi}\right)_+
\left(\frac{1}{1-y}\right)_+
\tilde{R}(\xi, y) +
\mathcal{O}(\varepsilon).\\
\end{align*}
The summand in the second line is of order $\mathcal{O}(1)$ and is the
only one to reproduce $\mathcal{R}(\xi,y)$. It thus constitutes the
sum of the real matrix element and the corresponding counterterms.
The first summand consequently consists of the subtraction terms to
the virtual matrix elements. Above formula thus allows to calculate
all quantities to render the matrix elements finite.
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Identifying singular regions}
In the FKS subtraction scheme, the phase space is decomposed into
disjoint singular regions, such that
\begin{equation}
\label{eq:S_complete}
\sum_i \mathcal{S}_i + \sum_{ij}\mathcal{S}_{ij} = 1.
\end{equation}
The quantities $\mathcal{S}_i$ and $\mathcal{S}_{ij}$ are functions of
phase space corresponding to a pair of particles indices which can
make up a divergent phase space region. We call such an index pair a
fundamental tuple. For example, the process $e^+ \, e^- \rightarrow u
\, \bar{u} \, g$ has two singular regions, $(3,5)$ and $(4,5)$,
indicating that the gluon can be soft or collinear with respect to
either the quark or the anti-quark. Therefore, the functions $S_{ij}$
have to be chosen in such a way that their contribution makes up most
of \eqref{eq:S_complete} in phase-space configurations where
(final-state) particle $j$ is collinear to particle $i$ or/and
particle $j$ is soft. The functions $S_i$ is the corresponding
quantity for initial-state divergences.
As a singular region we understand the collection of real flavor
structures associated with an emitter and a list of all possible
fundamental tuples. As an example, consider the process $e^+ \, e^-
\rightarrow u \, \bar{u} \, g$. At next-to-leading order, processes
with an additionally radiated particle have to be considered. In this
case, these are $e^+ \, e^- \rightarrow u \, \bar{u}, \, g \, g$,
and $e^+ \, e^- \rightarrow u \, \bar{u} \, u \, \bar{u}$ (or the same
process with any other quark). Table \ref{table:singular regions} sums
up all possible singular regions for this problem.
\begin{table}
\begin{tabular}{|c|c|c|c|}
\hline
\texttt{alr} & \texttt{flst\_alr} & \texttt{emitter} &
\texttt{ftuple\_list}\\ \hline
1 & [-11,11,2,-2,21,21] & 3 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline
2 & [-11,11,2,-2,21,21] & 4 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline
3 & [-11,11,2,-2,21,21] & 5 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline
4 & [-11,11,2,-2,2,-2] & 5 & {(3,4), (3,6), (4,5), (5,6)} \\
\hline
\end{tabular}
\caption{List of singular regions. The particles are represented by
their PDG codes. The third column contains the emitter for the
specific singular region. For the process involving an additional
gluon, the gluon can either be emitted from one of the quarks or
from the first gluon. Each emitter yields the same list of
fundamental tuples, five in total. The last singular region
corresponds to the process where the gluon splits up into two
quarks. As the matrix element for this process has no information
on which quarks originate from a gluon splitting, there are ftuples
for all the quark pairs and not just those involving the emitter.}
\label{table:singular regions}
\end{table}
\\
\begin{table}
\begin{tabular}{|c|c|c|c|}
\hline
\texttt{alr} & \texttt{ftuple} & \texttt{emitter} &
\texttt{flst\_alr} \\ \hline
1 & $(3,5)$ & 5 & [-11,11,-2,21,2,21] \\ \hline
2 & $(4,5)$ & 5 & [-11,11,2,21,-2,21] \\ \hline
3 & $(3,6)$ & 5 & [-11,11,-2,21,2,21] \\ \hline
4 & $(4,6)$ & 5 & [-11,11,2,21,-2,21] \\ \hline
5 & $(5,6)$ & 5 & [-11,11,2,-2,21,21] \\ \hline
6 & $(5,6)$ & 5 & [-11,11,2,-2,2,-2] \\ \hline
\end{tabular}
\caption{Initial list of singular regions}
\label{table:ftuples and flavors}
\end{table}
Thus, during the preparation of a NLO-calculation, the possible
singular regions have to be identified. [[fks_regions.f90]] deals
with this issue.
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{FKS Regions}
<<[[fks_regions.f90]]>>=
<<File header>>
module fks_regions
<<Use kinds>>
<<Use strings>>
use diagnostics
use os_interface
use constants
use process_constants
use lorentz
use models
use resonances, only: resonance_contributors_t, resonance_history_t
use phs_fks, only: phs_identifier_t, check_for_phs_identifier
use nlo_data
<<Standard module head>>
<<FKS regions: public>>
<<FKS regions: parameters>>
<<FKS regions: types>>
<<FKS regions: interfaces>>
interface
<<FKS regions: sub interfaces>>
end interface
contains
<<FKS regions: main procedures>>
end module fks_regions
@ %def fks_regions
@
<<[[fks_regions_sub.f90]]>>=
<<File header>>
submodule (fks_regions) fks_regions_s
<<Use debug>>
use format_utils, only: write_separator
use numeric_utils
use string_utils, only: str
use io_units
use permutations
use physics_defs
use flavors
use pdg_arrays
implicit none
contains
<<FKS regions: procedures>>
end submodule fks_regions_s
@ %def fks_regions_s
@ There are three fundamental splitting types: $q \rightarrow qg$, $g
\rightarrow gg$ and $g \rightarrow qq$ for FSR and additionally $q
\rightarrow gq$ for ISR which is different from $q \rightarrow qg$ by
which particle enters the hard process.
<<FKS regions: parameters>>=
integer, parameter :: UNDEFINED_SPLITTING = 0
integer, parameter :: F_TO_FV = 1
integer, parameter :: V_TO_VV = 2
integer, parameter :: V_TO_FF = 3
integer, parameter :: F_TO_VF = 4
@
@ We group the indices of the emitting and the radiated particle in
the [[ftuple]]-object.
<<FKS regions: public>>=
public :: ftuple_t
<<FKS regions: types>>=
type :: ftuple_t
integer, dimension(2) :: ireg = [-1,-1]
integer :: i_res = 0
integer :: splitting_type
logical :: pseudo_isr = .false.
logical :: qcd_split = .false.
contains
<<FKS regions: ftuple: TBP>>
end type ftuple_t
@ %def ftuple_t
@
<<FKS regions: interfaces>>=
interface assignment(=)
module procedure ftuple_assign
end interface
interface operator(==)
module procedure ftuple_equal
end interface
interface operator(>)
module procedure ftuple_greater
end interface
interface operator(<)
module procedure ftuple_less
end interface
<<FKS regions: sub interfaces>>=
pure module subroutine ftuple_assign (ftuple_out, ftuple_in)
type(ftuple_t), intent(out) :: ftuple_out
type(ftuple_t), intent(in) :: ftuple_in
end subroutine ftuple_assign
<<FKS regions: procedures>>=
pure module subroutine ftuple_assign (ftuple_out, ftuple_in)
type(ftuple_t), intent(out) :: ftuple_out
type(ftuple_t), intent(in) :: ftuple_in
ftuple_out%ireg = ftuple_in%ireg
ftuple_out%i_res = ftuple_in%i_res
ftuple_out%splitting_type = ftuple_in%splitting_type
ftuple_out%pseudo_isr = ftuple_in%pseudo_isr
ftuple_out%qcd_split = ftuple_in%qcd_split
end subroutine ftuple_assign
@ %def ftuple_assign
@
<<FKS regions: sub interfaces>>=
elemental module function ftuple_equal (f1, f2) result (value)
logical :: value
type(ftuple_t), intent(in) :: f1, f2
end function ftuple_equal
<<FKS regions: procedures>>=
elemental module function ftuple_equal (f1, f2) result (value)
logical :: value
type(ftuple_t), intent(in) :: f1, f2
value = all (f1%ireg == f2%ireg) .and. f1%i_res == f2%i_res &
.and. f1%splitting_type == f2%splitting_type &
.and. (f1%pseudo_isr .eqv. f2%pseudo_isr) &
.and. (f1%qcd_split .eqv. f2%qcd_split)
end function ftuple_equal
@ %def ftuple_equal
@
<<FKS regions: procedures>>=
elemental function ftuple_equal_ireg (f1, f2) result (value)
logical :: value
type(ftuple_t), intent(in) :: f1, f2
value = all (f1%ireg == f2%ireg)
end function ftuple_equal_ireg
@ %def ftuple_equal_ireg
@
<<FKS regions: sub interfaces>>=
elemental module function ftuple_greater (f1, f2) result (greater)
logical :: greater
type(ftuple_t), intent(in) :: f1, f2
end function ftuple_greater
<<FKS regions: procedures>>=
elemental module function ftuple_greater (f1, f2) result (greater)
logical :: greater
type(ftuple_t), intent(in) :: f1, f2
if (f1%ireg(1) == f2%ireg(1)) then
greater = f1%ireg(2) > f2%ireg(2)
else
greater = f1%ireg(1) > f2%ireg(1)
end if
end function ftuple_greater
@ %def ftuple_greater
@
<<FKS regions: sub interfaces>>=
elemental module function ftuple_less (f1, f2) result (less)
logical :: less
type(ftuple_t), intent(in) :: f1, f2
end function ftuple_less
<<FKS regions: procedures>>=
elemental module function ftuple_less (f1, f2) result (less)
logical :: less
type(ftuple_t), intent(in) :: f1, f2
if (f1%ireg(1) == f2%ireg(1)) then
less = f1%ireg(2) < f2%ireg(2)
else
less = f1%ireg(1) < f2%ireg(1)
end if
end function ftuple_less
@ %def ftuple_less
<<FKS regions: procedures>>=
subroutine ftuple_sort_array (ftuple_array, equivalences)
type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuple_array
logical, intent(inout), dimension(:,:), allocatable :: equivalences
type(ftuple_t) :: ftuple_tmp
logical, dimension(:), allocatable :: eq_tmp
integer :: i1, i2, n
n = size (ftuple_array)
allocate (eq_tmp (n))
do i1 = 2, n
i2 = i1
do while (ftuple_array(i2 - 1) > ftuple_array(i2))
ftuple_tmp = ftuple_array(i2 - 1)
eq_tmp = equivalences(i2, :)
ftuple_array(i2 - 1) = ftuple_array(i2)
ftuple_array(i2) = ftuple_tmp
equivalences(i2 - 1, :) = equivalences(i2, :)
equivalences(i2, :) = eq_tmp
i2 = i2 - 1
if (i2 == 1) exit
end do
end do
end subroutine ftuple_sort_array
@ %def ftuple_sort_array
@
<<FKS regions: ftuple: TBP>>=
procedure :: write => ftuple_write
<<FKS regions: sub interfaces>>=
module subroutine ftuple_write (ftuple, unit, newline)
class(ftuple_t), intent(in) :: ftuple
integer, intent(in), optional :: unit
logical, intent(in), optional :: newline
end subroutine ftuple_write
<<FKS regions: procedures>>=
module subroutine ftuple_write (ftuple, unit, newline)
class(ftuple_t), intent(in) :: ftuple
integer, intent(in), optional :: unit
logical, intent(in), optional :: newline
integer :: u
logical :: nl
u = given_output_unit (unit); if (u < 0) return
nl = .true.; if (present(newline)) nl = newline
if (all (ftuple%ireg > -1)) then
if (ftuple%i_res > 0) then
if (nl) then
write (u, "(A1,I1,A1,I1,A1,I1,A1)") &
'(', ftuple%ireg(1), ',', ftuple%ireg(2), ';', ftuple%i_res, ')'
else
write (u, "(A1,I1,A1,I1,A1,I1,A1)", advance = "no") &
'(', ftuple%ireg(1), ',', ftuple%ireg(2), ';', ftuple%i_res, ')'
end if
else
if (nl) then
write (u, "(A1,I1,A1,I1,A1)") &
'(', ftuple%ireg(1), ',', ftuple%ireg(2), ')'
else
write (u, "(A1,I1,A1,I1,A1)", advance = "no") &
'(', ftuple%ireg(1), ',', ftuple%ireg(2), ')'
end if
end if
else
write (u, "(A)") "(Empty)"
end if
end subroutine ftuple_write
@ %def ftuple_write
@
<<FKS regions: procedures>>=
function ftuple_string (ftuples, latex)
type(string_t) :: ftuple_string
type(ftuple_t), intent(in), dimension(:) :: ftuples
logical, intent(in) :: latex
integer :: i, nreg
if (latex) then
ftuple_string = var_str ("$\left\{")
else
ftuple_string = var_str ("{")
end if
nreg = size(ftuples)
do i = 1, nreg
if (ftuples(i)%i_res == 0) then
ftuple_string = ftuple_string // var_str ("(") // &
str (ftuples(i)%ireg(1)) // var_str (",") // &
str (ftuples(i)%ireg(2)) // var_str (")")
else
ftuple_string = ftuple_string // var_str ("(") // &
str (ftuples(i)%ireg(1)) // var_str (",") // &
str (ftuples(i)%ireg(2)) // var_str (";") // &
str (ftuples(i)%i_res) // var_str (")")
end if
if (ftuples(i)%pseudo_isr) ftuple_string = ftuple_string // var_str ("*")
if (i < nreg) ftuple_string = ftuple_string // var_str (",")
end do
if (latex) then
ftuple_string = ftuple_string // var_str ("\right\}$")
else
ftuple_string = ftuple_string // var_str ("}")
end if
end function ftuple_string
@ %def ftuple_string
@
<<FKS regions: ftuple: TBP>>=
procedure :: get => ftuple_get
<<FKS regions: sub interfaces>>=
module subroutine ftuple_get (ftuple, pos1, pos2)
class(ftuple_t), intent(in) :: ftuple
integer, intent(out) :: pos1, pos2
end subroutine ftuple_get
<<FKS regions: procedures>>=
module subroutine ftuple_get (ftuple, pos1, pos2)
class(ftuple_t), intent(in) :: ftuple
integer, intent(out) :: pos1, pos2
pos1 = ftuple%ireg(1)
pos2 = ftuple%ireg(2)
end subroutine ftuple_get
@ %def ftuple_get
@
<<FKS regions: ftuple: TBP>>=
procedure :: set => ftuple_set
<<FKS regions: sub interfaces>>=
module subroutine ftuple_set (ftuple, pos1, pos2)
class(ftuple_t), intent(inout) :: ftuple
integer, intent(in) :: pos1, pos2
end subroutine ftuple_set
<<FKS regions: procedures>>=
module subroutine ftuple_set (ftuple, pos1, pos2)
class(ftuple_t), intent(inout) :: ftuple
integer, intent(in) :: pos1, pos2
ftuple%ireg(1) = pos1
ftuple%ireg(2) = pos2
end subroutine ftuple_set
@ %def ftuple_set
@ Determines the splitting type for FSR. There are three different
types of splittings relevant here: $g \to gg$ tagged [[V_TO_VV]], $g
\to qq$ tagged [[V_TO_FF]] and $q \to qg$ tagged [[F_TO_FV]]. For FSR,
there is no need to differentiate between $q \to qg$ and $q \to gq$
splittings.
<<FKS regions: ftuple: TBP>>=
procedure :: determine_splitting_type_fsr => &
ftuple_determine_splitting_type_fsr
<<FKS regions: sub interfaces>>=
module subroutine ftuple_determine_splitting_type_fsr (ftuple, flv, i, j)
class(ftuple_t), intent(inout) :: ftuple
type(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i, j
end subroutine ftuple_determine_splitting_type_fsr
<<FKS regions: procedures>>=
module subroutine ftuple_determine_splitting_type_fsr (ftuple, flv, i, j)
class(ftuple_t), intent(inout) :: ftuple
type(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i, j
associate (flst => flv%flst)
if (is_vector (flst(i)) .and. is_vector (flst(j))) then
ftuple%splitting_type = V_TO_VV
else if (flst(i)+flst(j) == 0 &
.and. is_fermion (flst(i))) then
ftuple%splitting_type = V_TO_FF
else if (is_fermion(flst(i)) .and. is_massless_vector (flst(j)) &
.or. is_fermion(flst(j)) .and. is_massless_vector (flst(i))) then
ftuple%splitting_type = F_TO_FV
else
ftuple%splitting_type = UNDEFINED_SPLITTING
end if
end associate
end subroutine ftuple_determine_splitting_type_fsr
@ %def ftuple_determine_splitting_type_fsr
@ Determines the splitting type for ISR. There are four different
types of splittings relevant here: $g \to gg$ tagged [[V_TO_VV]], $g
\to qq$ tagged [[V_TO_FF]], $q \to qg$ tagged [[F_TO_FV]] and $q \to
gq$ tagged [[F_TO_VF]]. The latter two need to be considered
separately for ISR as they differ with respect to which particle
enters the hard process. A splitting [[F_TO_FV]] may lead to soft
divergences while [[F_TO_VF]] does not.
We also want to emphasize that the splitting type naming convention
for ISR names the splittings considering backwards evolution. So in
the splitting [[V_TO_FF]], it is the \textit{gluon} that enteres the
hard process.
Special treatment here is required if emitter $0$ is assigned. This is
the case only when a gluon was radiated from any of the IS
particles. In this case, both splittings are soft divergent so we can
equivalently choose $1$ or $2$ as the emitter here even if both have
different flavors.
<<FKS regions: ftuple: TBP>>=
procedure :: determine_splitting_type_isr => &
ftuple_determine_splitting_type_isr
<<FKS regions: sub interfaces>>=
module subroutine ftuple_determine_splitting_type_isr (ftuple, flv, i, j)
class(ftuple_t), intent(inout) :: ftuple
type(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i, j
end subroutine ftuple_determine_splitting_type_isr
<<FKS regions: procedures>>=
module subroutine ftuple_determine_splitting_type_isr (ftuple, flv, i, j)
class(ftuple_t), intent(inout) :: ftuple
type(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i, j
integer :: em
em = i; if (i == 0) em = 1
associate (flst => flv%flst)
if (is_vector (flst(em)) .and. is_vector (flst(j))) then
ftuple%splitting_type = V_TO_VV
else if (is_massless_vector(flst(em)) .and. is_fermion(flst(j))) then
ftuple%splitting_type = F_TO_VF
else if (is_fermion(flst(em)) .and. is_massless_vector(flst(j))) then
ftuple%splitting_type = F_TO_FV
else if (is_fermion(flst(em)) .and. is_fermion(flst(j))) then
ftuple%splitting_type = V_TO_FF
else
ftuple%splitting_type = UNDEFINED_SPLITTING
end if
end associate
end subroutine ftuple_determine_splitting_type_isr
@ %def ftuple_determine_splitting_type_isr
<<FKS regions: ftuple: TBP>>=
procedure :: determine_sub_correction_type => &
ftuple_determine_sub_correction_type
<<FKS regions: sub interfaces>>=
module subroutine ftuple_determine_sub_correction_type &
(ftuple, flv_born, flv_real, i, j)
class(ftuple_t), intent(inout) :: ftuple
type(flv_structure_t), intent(in) :: flv_born, flv_real
integer, intent(in) :: i, j
end subroutine ftuple_determine_sub_correction_type
<<FKS regions: procedures>>=
module subroutine ftuple_determine_sub_correction_type &
(ftuple, flv_born, flv_real, i, j)
class(ftuple_t), intent(inout) :: ftuple
type(flv_structure_t), intent(in) :: flv_born, flv_real
integer, intent(in) :: i, j
type(flv_structure_t) :: flv_test_qcd
integer :: em
em = i; if (i == 0) em = 1
select case (ftuple%splitting_type)
case (V_TO_VV)
ftuple%qcd_split = is_gluon (flv_real%flst(em)) .and. is_gluon (flv_real%flst(j))
case (F_TO_VF)
ftuple%qcd_split = is_gluon (flv_real%flst(em))
case (F_TO_FV)
if (i == 0) then
ftuple%qcd_split = is_gluon (flv_real%flst(j))
else
ftuple%qcd_split = is_gluon (flv_real%flst(i)) .or. is_gluon (flv_real%flst(j))
end if
case (V_TO_FF)
if (any ([i, j] <= flv_real%n_in)) then
flv_test_qcd = flv_real%insert_particle_isr (i, j, GLUON)
else
flv_test_qcd = flv_real%insert_particle_fsr (i, j, GLUON)
end if
ftuple%qcd_split = flv_test_qcd .equiv. flv_born
case (UNDEFINED_SPLITTING)
ftuple%qcd_split = .false.
end select
end subroutine ftuple_determine_sub_correction_type
@ %def ftuple_determine_sub_correction_type
@ Two debug functions to check the consistency of [[ftuples]]
<<FKS regions: ftuple: TBP>>=
procedure :: has_negative_elements => ftuple_has_negative_elements
procedure :: has_identical_elements => ftuple_has_identical_elements
<<FKS regions: sub interfaces>>=
elemental module function ftuple_has_negative_elements &
(ftuple) result (value)
logical :: value
class(ftuple_t), intent(in) :: ftuple
end function ftuple_has_negative_elements
elemental module function ftuple_has_identical_elements &
(ftuple) result (value)
logical :: value
class(ftuple_t), intent(in) :: ftuple
end function ftuple_has_identical_elements
<<FKS regions: procedures>>=
elemental module function ftuple_has_negative_elements &
(ftuple) result (value)
logical :: value
class(ftuple_t), intent(in) :: ftuple
value = any (ftuple%ireg < 0)
end function ftuple_has_negative_elements
elemental module function ftuple_has_identical_elements &
(ftuple) result (value)
logical :: value
class(ftuple_t), intent(in) :: ftuple
value = ftuple%ireg(1) == ftuple%ireg(2)
end function ftuple_has_identical_elements
@ %def ftuple_has_negative_elements, ftuple_has_identical_elements
@ Each singular region can have a different number of
emitter-radiation pairs. This is coped with using the linked list
[[ftuple_list]].
<<FKS regions: types>>=
type :: ftuple_list_t
integer :: index = 0
type(ftuple_t) :: ftuple
type(ftuple_list_t), pointer :: next => null ()
type(ftuple_list_t), pointer :: prev => null ()
type(ftuple_list_t), pointer :: equiv => null ()
contains
<<FKS regions: ftuple list: TBP>>
end type ftuple_list_t
@ %def ftuple_list_t
@
<<FKS regions: ftuple list: TBP>>=
procedure :: write => ftuple_list_write
<<FKS regions: sub interfaces>>=
module subroutine ftuple_list_write (list, unit, verbose)
class(ftuple_list_t), intent(in), target :: list
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine ftuple_list_write
<<FKS regions: procedures>>=
module subroutine ftuple_list_write (list, unit, verbose)
class(ftuple_list_t), intent(in), target :: list
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
type(ftuple_list_t), pointer :: current
logical :: verb
integer :: u
u = given_output_unit (unit); if (u < 0) return
verb = .false.; if (present (verbose)) verb = verbose
select type (list)
type is (ftuple_list_t)
current => list
do
call current%ftuple%write (unit = u, newline = .false.)
if (verb .and. associated (current%equiv)) &
write (u, '(A)', advance = "no") "'"
if (associated (current%next)) then
current => current%next
else
exit
end if
end do
write (u, *) ""
end select
end subroutine ftuple_list_write
@ %def ftuple_list_write
@
<<FKS regions: ftuple list: TBP>>=
procedure :: append => ftuple_list_append
<<FKS regions: sub interfaces>>=
module subroutine ftuple_list_append (list, ftuple)
class(ftuple_list_t), intent(inout), target :: list
type(ftuple_t), intent(in) :: ftuple
end subroutine ftuple_list_append
<<FKS regions: procedures>>=
module subroutine ftuple_list_append (list, ftuple)
class(ftuple_list_t), intent(inout), target :: list
type(ftuple_t), intent(in) :: ftuple
type(ftuple_list_t), pointer :: current
select type (list)
type is (ftuple_list_t)
if (list%index == 0) then
nullify (list%next)
list%index = 1
list%ftuple = ftuple
else
current => list
do
if (associated (current%next)) then
current => current%next
else
allocate (current%next)
nullify (current%next%next)
nullify (current%next%equiv)
current%next%prev => current
current%next%index = current%index + 1
current%next%ftuple = ftuple
exit
end if
end do
end if
end select
end subroutine ftuple_list_append
@ %def ftuple_list_append
@
<<FKS regions: ftuple list: TBP>>=
procedure :: get_n_tuples => ftuple_list_get_n_tuples
<<FKS regions: sub interfaces>>=
impure elemental module function ftuple_list_get_n_tuples &
(list) result(n_tuples)
integer :: n_tuples
class(ftuple_list_t), intent(in), target :: list
end function ftuple_list_get_n_tuples
<<FKS regions: procedures>>=
impure elemental module function ftuple_list_get_n_tuples &
(list) result(n_tuples)
integer :: n_tuples
class(ftuple_list_t), intent(in), target :: list
type(ftuple_list_t), pointer :: current
n_tuples = 0
select type (list)
type is (ftuple_list_t)
current => list
if (current%index > 0) then
n_tuples = 1
do
if (associated (current%next)) then
current => current%next
n_tuples = n_tuples + 1
else
exit
end if
end do
end if
end select
end function ftuple_list_get_n_tuples
@ %def ftuple_list_get_n_tuples
@
<<FKS regions: ftuple list: TBP>>=
procedure :: get_entry => ftuple_list_get_entry
<<FKS regions: sub interfaces>>=
module function ftuple_list_get_entry (list, index) result (entry)
type(ftuple_list_t), pointer :: entry
class(ftuple_list_t), intent(in), target :: list
integer, intent(in) :: index
end function ftuple_list_get_entry
<<FKS regions: procedures>>=
module function ftuple_list_get_entry (list, index) result (entry)
type(ftuple_list_t), pointer :: entry
class(ftuple_list_t), intent(in), target :: list
integer, intent(in) :: index
type(ftuple_list_t), pointer :: current
integer :: i
entry => null()
select type (list)
type is (ftuple_list_t)
current => list
if (index == 1) then
entry => current
else
do i = 1, index - 1
current => current%next
end do
entry => current
end if
end select
end function ftuple_list_get_entry
@ %def ftuple_list_get_entry
@
<<FKS regions: ftuple list: TBP>>=
procedure :: get_ftuple => ftuple_list_get_ftuple
<<FKS regions: sub interfaces>>=
module function ftuple_list_get_ftuple (list, index) result (ftuple)
type(ftuple_t) :: ftuple
class(ftuple_list_t), intent(in), target :: list
integer, intent(in) :: index
end function ftuple_list_get_ftuple
<<FKS regions: procedures>>=
module function ftuple_list_get_ftuple (list, index) result (ftuple)
type(ftuple_t) :: ftuple
class(ftuple_list_t), intent(in), target :: list
integer, intent(in) :: index
type(ftuple_list_t), pointer :: entry
entry => list%get_entry (index)
ftuple = entry%ftuple
end function ftuple_list_get_ftuple
@ %def ftuple_list_get_ftuple
@
<<FKS regions: ftuple list: TBP>>=
procedure :: set_equiv => ftuple_list_set_equiv
<<FKS regions: sub interfaces>>=
module subroutine ftuple_list_set_equiv (list, i1, i2)
class(ftuple_list_t), intent(in) :: list
integer, intent(in) :: i1, i2
end subroutine ftuple_list_set_equiv
<<FKS regions: procedures>>=
module subroutine ftuple_list_set_equiv (list, i1, i2)
class(ftuple_list_t), intent(in) :: list
integer, intent(in) :: i1, i2
type(ftuple_list_t), pointer :: list1, list2 => null ()
select type (list)
type is (ftuple_list_t)
if (list%get_ftuple (i1) > list%get_ftuple (i2)) then
list1 => list%get_entry (i2)
list2 => list%get_entry (i1)
else
list1 => list%get_entry (i1)
list2 => list%get_entry (i2)
end if
do
if (associated (list1%equiv)) then
list1 => list1%equiv
else
exit
end if
end do
list1%equiv => list2
end select
end subroutine ftuple_list_set_equiv
@ %def ftuple_list_set_equiv
@
<<FKS regions: ftuple list: TBP>>=
procedure :: check_equiv => ftuple_list_check_equiv
<<FKS regions: sub interfaces>>=
module function ftuple_list_check_equiv(list, i1, i2) result (eq)
class(ftuple_list_t), intent(in) :: list
integer, intent(in) :: i1, i2
logical :: eq
end function ftuple_list_check_equiv
<<FKS regions: procedures>>=
module function ftuple_list_check_equiv(list, i1, i2) result (eq)
class(ftuple_list_t), intent(in) :: list
integer, intent(in) :: i1, i2
logical :: eq
type(ftuple_list_t), pointer :: current
eq = .false.
select type (list)
type is (ftuple_list_t)
current => list%get_entry (i1)
do
if (associated (current%equiv)) then
current => current%equiv
if (current%index == i2) then
eq = .true.
exit
end if
else
exit
end if
end do
end select
end function ftuple_list_check_equiv
@ %def ftuple_list_sort
@
<<FKS regions: ftuple list: TBP>>=
procedure :: to_array => ftuple_list_to_array
<<FKS regions: sub interfaces>>=
module subroutine ftuple_list_to_array &
(ftuple_list, ftuple_array, equivalences, ordered)
class(ftuple_list_t), intent(in), target :: ftuple_list
type(ftuple_t), intent(out), dimension(:), allocatable :: ftuple_array
logical, intent(out), dimension(:,:), allocatable :: equivalences
logical, intent(in) :: ordered
end subroutine ftuple_list_to_array
<<FKS regions: procedures>>=
module subroutine ftuple_list_to_array &
(ftuple_list, ftuple_array, equivalences, ordered)
class(ftuple_list_t), intent(in), target :: ftuple_list
type(ftuple_t), intent(out), dimension(:), allocatable :: ftuple_array
logical, intent(out), dimension(:,:), allocatable :: equivalences
logical, intent(in) :: ordered
integer :: i_tuple, n
type(ftuple_list_t), pointer :: current => null ()
integer :: i1, i2
type(ftuple_t) :: ftuple_tmp
logical, dimension(:), allocatable :: eq_tmp
n = ftuple_list%get_n_tuples ()
allocate (ftuple_array (n), equivalences (n, n))
equivalences = .false.
select type (ftuple_list)
type is (ftuple_list_t)
current => ftuple_list
i_tuple = 1
do
ftuple_array(i_tuple) = current%ftuple
if (associated (current%equiv)) then
i1 = current%index
i2 = current%equiv%index
equivalences (i1, i2) = .true.
end if
if (associated (current%next)) then
current => current%next
i_tuple = i_tuple + 1
else
exit
end if
end do
end select
if (ordered) call ftuple_sort_array (ftuple_array, equivalences)
end subroutine ftuple_list_to_array
@ %def ftuple_list_to_array
@
<<FKS regions: procedures>>=
subroutine print_equivalence_matrix (ftuple_array, equivalences)
type(ftuple_t), intent(in), dimension(:) :: ftuple_array
logical, intent(in), dimension(:,:) :: equivalences
integer :: i, i1, i2
print *, 'Equivalence matrix: '
do i = 1, size (ftuple_array)
call ftuple_array(i)%get(i1,i2)
print *, 'i: ', i, '(', i1, i2, '): ', equivalences(i,:)
end do
end subroutine print_equivalence_matrix
@ %def print_equivalence_matrix
@ Class for working with the flavor specification arrays.
<<FKS regions: public>>=
public :: flv_structure_t
<<FKS regions: types>>=
type :: flv_structure_t
integer, dimension(:), allocatable :: flst
integer, dimension(:), allocatable :: tag
integer :: nlegs = 0
integer :: n_in = 0
logical, dimension(:), allocatable :: massive
logical, dimension(:), allocatable :: colored
real(default), dimension(:), allocatable :: charge
real(default) :: prt_symm_fs = 1._default
integer :: eqv_index = 0
contains
<<FKS regions: flv structure: TBP>>
end type flv_structure_t
@ %def flv_structure_t
@
Returns \texttt{true} if the two particles at position \texttt{i}
and \texttt{j} in the flavor array can originate from the same
splitting. For this purpose, the function first checks whether the splitting is
allowed at all. If this is the case, the emitter is removed from the
flavor array. If the resulting array is equivalent to the Born flavor
structure \texttt{flv\_born}, the pair is accepted as a valid
splitting.
We first check whether the splitting is possible. The array
[[flv_orig]] contains all particles which share a vertex with the
particles at position [[i]] and [[j]]. If any of these particles belongs
to the initial state, a PDG-ID flip is necessary to correctly recognize
the vertex. If its size is equal to zero, no splitting is possible and
the subroutine is exited. Otherwise, we loop over all possible underlying
Born flavor structures and check if any of them equals the actual underlying
Born flavor structure. For a quark emitting a gluon, [[flv_orig]] contains
the PDG code of the anti-quark. To be on the safe side, a second array is created,
which contains both the positively and negatively signed PDG
codes. Then, the origial tuple $(i,j)$ is removed from the real flavor
structure and the particles in [[flv_orig2]] are inserted.
If the resulting Born configuration is equal to the underlying Born
configuration, up to a permutation of final-state particles, the tuple
$(i,j)$ is accepted as valid.
<<FKS regions: flv structure: TBP>>=
procedure :: valid_pair => flv_structure_valid_pair
<<FKS regions: sub interfaces>>=
module function flv_structure_valid_pair &
(flv, i, j, flv_ref, model) result (valid)
logical :: valid
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i,j
type(flv_structure_t), intent(in) :: flv_ref
type(model_t), intent(in) :: model
end function flv_structure_valid_pair
<<FKS regions: procedures>>=
module function flv_structure_valid_pair &
(flv, i, j, flv_ref, model) result (valid)
logical :: valid
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i,j
type(flv_structure_t), intent(in) :: flv_ref
type(model_t), intent(in) :: model
integer :: k, n_orig
type(flv_structure_t) :: flv_test
integer, dimension(:), allocatable :: flv_orig
valid = .false.
if (all ([i, j] <= flv%n_in)) return
if (i <= flv%n_in .and. is_fermion(flv%flst(i))) then
call model%match_vertex (-flv%flst(i), flv%flst(j), flv_orig)
else if (j <= flv%n_in .and. is_fermion(flv%flst(j))) then
call model%match_vertex (flv%flst(i), -flv%flst(j), flv_orig)
else
call model%match_vertex (flv%flst(i), flv%flst(j), flv_orig)
end if
n_orig = size (flv_orig)
if (n_orig == 0) then
return
else
do k = 1, n_orig
if (any ([i, j] <= flv%n_in)) then
flv_test = flv%insert_particle_isr (i, j, flv_orig(k))
else
flv_test = flv%insert_particle_fsr (i, j, flv_orig(k))
end if
valid = flv_ref .equiv. flv_test
call flv_test%final ()
if (valid) return
end do
end if
deallocate (flv_orig)
end function flv_structure_valid_pair
@ %def flv_structure_valid_pair
@ This function checks whether two flavor arrays are the same up to a
permutation of the final-state particles
<<FKS regions: procedures>>=
function flv_structure_equivalent (flv1, flv2, with_tag) result (equiv)
logical :: equiv
type(flv_structure_t), intent(in) :: flv1, flv2
logical, intent(in) :: with_tag
type(flv_perm_t) :: perm
integer :: n
n = size (flv1%flst)
equiv = .true.
if (n /= size (flv2%flst)) then
call msg_fatal &
('flv_structure_equivalent: flavor arrays do not have equal lengths')
else if (flv1%n_in /= flv2%n_in) then
call msg_fatal &
('flv_structure_equivalent: flavor arrays do not have equal n_in')
else
call perm%init (flv1, flv2, flv1%n_in, flv1%nlegs, with_tag)
equiv = perm%eqv (flv2, flv1, with_tag)
call perm%final ()
end if
end function flv_structure_equivalent
@ %def flv_structure_equivalent
@
<<FKS regions: sub interfaces>>=
module function flv_structure_equivalent_no_tag (flv1, flv2) result(equiv)
logical :: equiv
type(flv_structure_t), intent(in) :: flv1, flv2
end function flv_structure_equivalent_no_tag
module function flv_structure_equivalent_with_tag (flv1, flv2) result(equiv)
logical :: equiv
type(flv_structure_t), intent(in) :: flv1, flv2
endfunction flv_structure_equivalent_with_tag
<<FKS regions: procedures>>=
module function flv_structure_equivalent_no_tag (flv1, flv2) result(equiv)
logical :: equiv
type(flv_structure_t), intent(in) :: flv1, flv2
equiv = flv_structure_equivalent (flv1, flv2, .false.)
end function flv_structure_equivalent_no_tag
module function flv_structure_equivalent_with_tag (flv1, flv2) result(equiv)
logical :: equiv
type(flv_structure_t), intent(in) :: flv1, flv2
equiv = flv_structure_equivalent (flv1, flv2, .true.)
end function flv_structure_equivalent_with_tag
@ %def flv_structure_equivalent_no_tag, flv_structure_equivalent_with_tag
@
<<FKS regions: sub interfaces>>=
pure module subroutine flv_structure_assign_flv (flv_out, flv_in)
type(flv_structure_t), intent(out) :: flv_out
type(flv_structure_t), intent(in) :: flv_in
end subroutine flv_structure_assign_flv
<<FKS regions: procedures>>=
pure module subroutine flv_structure_assign_flv (flv_out, flv_in)
type(flv_structure_t), intent(out) :: flv_out
type(flv_structure_t), intent(in) :: flv_in
flv_out%nlegs = flv_in%nlegs
flv_out%n_in = flv_in%n_in
flv_out%prt_symm_fs = flv_in%prt_symm_fs
if (allocated (flv_in%flst)) then
allocate (flv_out%flst (size (flv_in%flst)))
flv_out%flst = flv_in%flst
end if
if (allocated (flv_in%tag)) then
allocate (flv_out%tag (size (flv_in%tag)))
flv_out%tag = flv_in%tag
end if
if (allocated (flv_in%massive)) then
allocate (flv_out%massive (size (flv_in%massive)))
flv_out%massive = flv_in%massive
end if
if (allocated (flv_in%colored)) then
allocate (flv_out%colored (size (flv_in%colored)))
flv_out%colored = flv_in%colored
end if
end subroutine flv_structure_assign_flv
@ %def flv_structure_assign_flv
@
<<FKS regions: sub interfaces>>=
pure module subroutine flv_structure_assign_integer (flv_out, iarray)
type(flv_structure_t), intent(out) :: flv_out
integer, intent(in), dimension(:) :: iarray
end subroutine flv_structure_assign_integer
<<FKS regions: procedures>>=
pure module subroutine flv_structure_assign_integer (flv_out, iarray)
type(flv_structure_t), intent(out) :: flv_out
integer, intent(in), dimension(:) :: iarray
integer :: i
flv_out%nlegs = size (iarray)
allocate (flv_out%flst (flv_out%nlegs))
allocate (flv_out%tag (flv_out%nlegs))
flv_out%flst = iarray
flv_out%tag = [(i, i = 1, flv_out%nlegs)]
end subroutine flv_structure_assign_integer
@ %def flv_structure_assign_integer
@ Returs a new flavor array with the particle at position
\texttt{index} removed.
<<FKS regions: flv structure: TBP>>=
procedure :: remove_particle => flv_structure_remove_particle
<<FKS regions: sub interfaces>>=
module function flv_structure_remove_particle (flv, index) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: index
end function flv_structure_remove_particle
<<FKS regions: procedures>>=
module function flv_structure_remove_particle (flv, index) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: index
integer :: n1, n2
integer :: i, removed_tag
n1 = size (flv%flst); n2 = n1 - 1
allocate (flv_new%flst (n2), flv_new%tag (n2))
flv_new%nlegs = n2
flv_new%n_in = flv%n_in
removed_tag = flv%tag(index)
if (index == 1) then
flv_new%flst(1 : n2) = flv%flst(2 : n1)
flv_new%tag(1 : n2) = flv%tag(2 : n1)
else if (index == n1) then
flv_new%flst(1 : n2) = flv%flst(1 : n2)
flv_new%tag(1 : n2) = flv%tag(1 : n2)
else
flv_new%flst(1 : index - 1) = flv%flst(1 : index - 1)
flv_new%flst(index : n2) = flv%flst(index + 1 : n1)
flv_new%tag(1 : index - 1) = flv%tag(1 : index - 1)
flv_new%tag(index : n2) = flv%tag(index + 1 : n1)
end if
do i = 1, n2
if (flv_new%tag(i) > removed_tag) &
flv_new%tag(i) = flv_new%tag(i) - 1
end do
call flv_new%compute_prt_symm_fs (flv_new%n_in)
end function flv_structure_remove_particle
@ %def flv_structure_remove_particle
@ Removes the particles at position i1 and i2 and inserts a new
particle of matching flavor at position i1.
<<FKS regions: flv structure: TBP>>=
procedure :: insert_particle_fsr => flv_structure_insert_particle_fsr
<<FKS regions: sub interfaces>>=
module function flv_structure_insert_particle_fsr &
(flv, i1, i2, flv_add) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i1, i2, flv_add
end function flv_structure_insert_particle_fsr
<<FKS regions: procedures>>=
module function flv_structure_insert_particle_fsr &
(flv, i1, i2, flv_add) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i1, i2, flv_add
if (flv%flst(i1) + flv_add == 0 .or. flv%flst(i2) + flv_add == 0) then
flv_new = flv%insert_particle (i1, i2, -flv_add)
else
flv_new = flv%insert_particle (i1, i2, flv_add)
end if
end function flv_structure_insert_particle_fsr
@ %def flv_structure_insert_particle_fsr
@ Same as [[insert_particle_fsr]] but for ISR, the two particles are
not exchangeable.
<<FKS regions: flv structure: TBP>>=
procedure :: insert_particle_isr => flv_structure_insert_particle_isr
<<FKS regions: sub interfaces>>=
module function flv_structure_insert_particle_isr &
(flv, i_in, i_out, flv_add) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i_in, i_out, flv_add
end function flv_structure_insert_particle_isr
<<FKS regions: procedures>>=
module function flv_structure_insert_particle_isr &
(flv, i_in, i_out, flv_add) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i_in, i_out, flv_add
if (flv%flst(i_in) + flv_add == 0) then
flv_new = flv%insert_particle (i_in, i_out, -flv_add)
else
flv_new = flv%insert_particle (i_in, i_out, flv_add)
end if
end function flv_structure_insert_particle_isr
@ %def flv_structure_insert_particle_isr
@ Removes the particles at position i1 and i2 and inserts a new
particle at position i1.
<<FKS regions: flv structure: TBP>>=
procedure :: insert_particle => flv_structure_insert_particle
<<FKS regions: sub interfaces>>=
module function flv_structure_insert_particle &
(flv, i1, i2, particle) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i1, i2, particle
end function flv_structure_insert_particle
<<FKS regions: procedures>>=
module function flv_structure_insert_particle &
(flv, i1, i2, particle) result (flv_new)
type(flv_structure_t) :: flv_new
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: i1, i2, particle
type(flv_structure_t) :: flv_tmp
integer :: n1, n2
integer :: new_tag
n1 = size (flv%flst); n2 = n1 - 1
allocate (flv_new%flst (n2), flv_new%tag (n2))
flv_new%nlegs = n2
flv_new%n_in = flv%n_in
new_tag = maxval(flv%tag) + 1
if (i1 < i2) then
flv_tmp = flv%remove_particle (i1)
flv_tmp = flv_tmp%remove_particle (i2 - 1)
else if(i2 < i1) then
flv_tmp = flv%remove_particle(i2)
flv_tmp = flv_tmp%remove_particle(i1 - 1)
else
call msg_fatal ("flv_structure_insert_particle: Indices are identical!")
end if
if (i1 == 1) then
flv_new%flst(1) = particle
flv_new%flst(2 : n2) = flv_tmp%flst(1 : n2 - 1)
flv_new%tag(1) = new_tag
flv_new%tag(2 : n2) = flv_tmp%tag(1 : n2 - 1)
else if (i1 == n1 .or. i1 == n2) then
flv_new%flst(1 : n2 - 1) = flv_tmp%flst(1 : n2 - 1)
flv_new%flst(n2) = particle
flv_new%tag(1 : n2 - 1) = flv_tmp%tag(1 : n2 - 1)
flv_new%tag(n2) = new_tag
else
flv_new%flst(1 : i1 - 1) = flv_tmp%flst(1 : i1 - 1)
flv_new%flst(i1) = particle
flv_new%flst(i1 + 1 : n2) = flv_tmp%flst(i1 : n2 - 1)
flv_new%tag(1 : i1 - 1) = flv_tmp%tag(1 : i1 - 1)
flv_new%tag(i1) = new_tag
flv_new%tag(i1 + 1 : n2) = flv_tmp%tag(i1 : n2 - 1)
end if
call flv_new%compute_prt_symm_fs (flv_new%n_in)
end function flv_structure_insert_particle
@ %def flv_structure_insert_particle
@ Counts the number of occurances of a particle in a
flavor array
<<FKS regions: flv structure: TBP>>=
procedure :: count_particle => flv_structure_count_particle
<<FKS regions: sub interfaces>>=
module function flv_structure_count_particle (flv, part) result (n)
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: part
integer :: n
end function flv_structure_count_particle
<<FKS regions: procedures>>=
module function flv_structure_count_particle (flv, part) result (n)
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: part
integer :: n
n = count (flv%flst == part)
end function flv_structure_count_particle
@ %def flv_structure_count_particle
@ Initializer for flavor structures
<<FKS regions: flv structure: TBP>>=
procedure :: init => flv_structure_init
<<FKS regions: sub interfaces>>=
module subroutine flv_structure_init (flv, aval, n_in, tags)
class(flv_structure_t), intent(inout) :: flv
integer, intent(in), dimension(:) :: aval
integer, intent(in) :: n_in
integer, intent(in), dimension(:), optional :: tags
end subroutine flv_structure_init
<<FKS regions: procedures>>=
module subroutine flv_structure_init (flv, aval, n_in, tags)
class(flv_structure_t), intent(inout) :: flv
integer, intent(in), dimension(:) :: aval
integer, intent(in) :: n_in
integer, intent(in), dimension(:), optional :: tags
integer :: i, n
integer, dimension(:), allocatable :: aval_unique
integer, dimension(:), allocatable :: mult
n = size (aval)
allocate (flv%flst (n), flv%tag (n))
flv%flst = aval
if (present (tags)) then
flv%tag = tags
else
do i = 1, n
flv%tag(i) = i
end do
end if
flv%nlegs = n
flv%n_in = n_in
call flv%compute_prt_symm_fs (flv%n_in)
end subroutine flv_structure_init
@ %def flv_structure_init
@
<<FKS regions: flv structure: TBP>>=
procedure :: compute_prt_symm_fs => flv_structure_compute_prt_symm_fs
<<FKS regions: sub interfaces>>=
module subroutine flv_structure_compute_prt_symm_fs (flv, n_in)
class(flv_structure_t), intent(inout) :: flv
integer, intent(in) :: n_in
end subroutine flv_structure_compute_prt_symm_fs
<<FKS regions: procedures>>=
module subroutine flv_structure_compute_prt_symm_fs (flv, n_in)
class(flv_structure_t), intent(inout) :: flv
integer, intent(in) :: n_in
integer, dimension(:), allocatable :: flst_unique
integer, dimension(:), allocatable :: mult
integer :: i
flst_unique = remove_duplicates_from_int_array (flv%flst(n_in + 1 :))
allocate (mult(size (flst_unique)))
do i = 1, size (flst_unique)
mult(i) = count (flv%flst(n_in + 1 :) == flst_unique(i))
end do
flv%prt_symm_fs = one / product (gamma (real (mult + 1, default)))
end subroutine flv_structure_compute_prt_symm_fs
@ %def flv_structure_compute_prt_symm_fs
@
<<FKS regions: flv structure: TBP>>=
procedure :: write => flv_structure_write
<<FKS regions: sub interfaces>>=
module subroutine flv_structure_write (flv, unit)
class(flv_structure_t), intent(in) :: flv
integer, intent(in), optional :: unit
end subroutine flv_structure_write
<<FKS regions: procedures>>=
module subroutine flv_structure_write (flv, unit)
class(flv_structure_t), intent(in) :: flv
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, '(A)') char (flv%to_string ())
end subroutine flv_structure_write
@ %def flv_structure_write
@
<<FKS regions: flv structure: TBP>>=
procedure :: to_string => flv_structure_to_string
<<FKS regions: sub interfaces>>=
module function flv_structure_to_string (flv) result (flv_string)
type(string_t) :: flv_string
class(flv_structure_t), intent(in) :: flv
end function flv_structure_to_string
<<FKS regions: procedures>>=
module function flv_structure_to_string (flv) result (flv_string)
type(string_t) :: flv_string
class(flv_structure_t), intent(in) :: flv
integer :: i, n
if (allocated (flv%flst)) then
flv_string = var_str ("[")
n = size (flv%flst)
do i = 1, n - 1
flv_string = flv_string // str (flv%flst(i)) // var_str(",")
end do
flv_string = flv_string // str (flv%flst(n)) // var_str("]")
else
flv_string = var_str ("[not allocated]")
end if
end function flv_structure_to_string
@ %def flv_structure_to_string
@ Creates the underlying Born flavor structure for a given real flavor
structure if the particle at position \texttt{emitter} is removed
<<FKS regions: flv structure: TBP>>=
procedure :: create_uborn => flv_structure_create_uborn
<<FKS regions: sub interfaces>>=
module function flv_structure_create_uborn &
(flv, emitter, nlo_correction_type) result(flv_uborn)
type(flv_structure_t) :: flv_uborn
class(flv_structure_t), intent(in) :: flv
type(string_t), intent(in) :: nlo_correction_type
integer, intent(in) :: emitter
end function flv_structure_create_uborn
<<FKS regions: procedures>>=
module function flv_structure_create_uborn &
(flv, emitter, nlo_correction_type) result(flv_uborn)
type(flv_structure_t) :: flv_uborn
class(flv_structure_t), intent(in) :: flv
type(string_t), intent(in) :: nlo_correction_type
integer, intent(in) :: emitter
integer n_legs
integer :: f1, f2
integer :: gauge_boson
n_legs = size(flv%flst)
allocate (flv_uborn%flst (n_legs - 1), flv_uborn%tag (n_legs - 1))
gauge_boson = determine_gauge_boson_to_be_inserted ()
if (emitter > flv%n_in) then
f1 = flv%flst(n_legs); f2 = flv%flst(n_legs - 1)
if (is_massless_vector (f1)) then
!!! Emitted particle is a gluon or photon => just remove it
flv_uborn = flv%remove_particle(n_legs)
else if (is_fermion (f1) .and. is_fermion (f2) .and. f1 + f2 == 0) then
!!! Emission type is a gauge boson splitting into two fermions
flv_uborn = flv%insert_particle(n_legs - 1, n_legs, gauge_boson)
else
call msg_error ("Create underlying Born: Unsupported splitting type.")
call msg_error (char (str (flv%flst)))
call msg_fatal ("FKS - FAIL")
end if
else if (emitter > 0) then
f1 = flv%flst(n_legs); f2 = flv%flst(emitter)
if (is_massless_vector (f1)) then
flv_uborn = flv%remove_particle(n_legs)
else if (is_fermion (f1) .and. is_massless_vector (f2)) then
flv_uborn = flv%insert_particle (emitter, n_legs, -f1)
else if (is_fermion (f1) .and. is_fermion (f2) .and. f1 == f2) then
flv_uborn = flv%insert_particle(emitter, n_legs, gauge_boson)
end if
else
flv_uborn = flv%remove_particle (n_legs)
end if
contains
integer function determine_gauge_boson_to_be_inserted ()
select case (char (nlo_correction_type))
case ("QCD")
determine_gauge_boson_to_be_inserted = GLUON
case ("EW")
determine_gauge_boson_to_be_inserted = PHOTON
case ("Full")
call msg_fatal ("NLO correction type 'Full' not yet implemented!")
case default
call msg_fatal ("Invalid NLO correction type! Valid inputs " // &
"are: QCD, EW and Full (default: QCD)")
end select
end function determine_gauge_boson_to_be_inserted
end function flv_structure_create_uborn
@ %def flv_structure_create_uborn
@
<<FKS regions: flv structure: TBP>>=
procedure :: init_mass_color_and_charge => &
flv_structure_init_mass_color_and_charge
<<FKS regions: sub interfaces>>=
module subroutine flv_structure_init_mass_color_and_charge (flv, model)
class(flv_structure_t), intent(inout) :: flv
type(model_t), intent(in) :: model
end subroutine flv_structure_init_mass_color_and_charge
<<FKS regions: procedures>>=
module subroutine flv_structure_init_mass_color_and_charge (flv, model)
class(flv_structure_t), intent(inout) :: flv
type(model_t), intent(in) :: model
integer :: i
type(flavor_t) :: flavor
allocate (flv%massive (flv%nlegs), flv%colored(flv%nlegs), &
flv%charge(flv%nlegs))
do i = 1, flv%nlegs
call flavor%init (flv%flst(i), model)
flv%massive(i) = flavor%get_mass () > 0
flv%colored(i) = &
is_quark (flv%flst(i)) .or. is_gluon (flv%flst(i))
flv%charge(i) = flavor%get_charge ()
end do
end subroutine flv_structure_init_mass_color_and_charge
@ %def flv_structure_init_mass_color_and_charge
@
<<FKS regions: flv structure: TBP>>=
procedure :: get_last_two => flv_structure_get_last_two
<<FKS regions: sub interfaces>>=
module function flv_structure_get_last_two (flv, n) result (flst_last)
integer, dimension(2) :: flst_last
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: n
end function flv_structure_get_last_two
<<FKS regions: procedures>>=
module function flv_structure_get_last_two (flv, n) result (flst_last)
integer, dimension(2) :: flst_last
class(flv_structure_t), intent(in) :: flv
integer, intent(in) :: n
flst_last = [flv%flst(n - 1), flv%flst(n)]
end function flv_structure_get_last_two
@ %def flv_structure_get_last_two
@
<<FKS regions: flv structure: TBP>>=
procedure :: final => flv_structure_final
<<FKS regions: sub interfaces>>=
module subroutine flv_structure_final (flv)
class(flv_structure_t), intent(inout) :: flv
end subroutine flv_structure_final
<<FKS regions: procedures>>=
module subroutine flv_structure_final (flv)
class(flv_structure_t), intent(inout) :: flv
if (allocated (flv%flst)) deallocate (flv%flst)
if (allocated (flv%tag)) deallocate (flv%tag)
if (allocated (flv%massive)) deallocate (flv%massive)
if (allocated (flv%colored)) deallocate (flv%colored)
if (allocated (flv%charge)) deallocate (flv%charge)
end subroutine flv_structure_final
@ %def flv_structure_final
@
<<FKS regions: types>>=
type :: flv_perm_t
integer, dimension(:,:), allocatable :: perms
contains
<<FKS regions: flavor permutation: TBP>>
end type flv_perm_t
@ %def flv_perm_t
@
<<FKS regions: flavor permutation: TBP>>=
procedure :: init => flv_perm_init
<<FKS regions: sub interfaces>>=
module subroutine flv_perm_init &
(perm, flv_in, flv_ref, n_first, n_last, with_tag)
class(flv_perm_t), intent(out) :: perm
type(flv_structure_t), intent(in) :: flv_in, flv_ref
integer, intent(in) :: n_first, n_last
logical, intent(in) :: with_tag
end subroutine flv_perm_init
<<FKS regions: procedures>>=
module subroutine flv_perm_init &
(perm, flv_in, flv_ref, n_first, n_last, with_tag)
class(flv_perm_t), intent(out) :: perm
type(flv_structure_t), intent(in) :: flv_in, flv_ref
integer, intent(in) :: n_first, n_last
logical, intent(in) :: with_tag
integer :: flv1, flv2, tmp
integer :: tag1, tag2
integer :: i, j, j_min, i_perm
integer, dimension(:,:), allocatable :: perm_list_tmp
type(flv_structure_t) :: flv_copy
logical :: condition
logical, dimension(:), allocatable :: already_correct
flv_copy = flv_in
allocate (perm_list_tmp (factorial (n_last - n_first - 1), 2))
allocate (already_correct (flv_in%nlegs))
already_correct = flv_in%flst == flv_ref%flst
if (with_tag) &
already_correct = already_correct .and. (flv_in%tag == flv_ref%tag)
j_min = n_first + 1
i_perm = 0
do i = n_first + 1, n_last
flv1 = flv_ref%flst(i)
tag1 = flv_ref%tag(i)
do j = j_min, n_last
if (already_correct(i) .or. already_correct(j)) cycle
flv2 = flv_copy%flst(j)
tag2 = flv_copy%tag(j)
condition = (flv1 == flv2) .and. i /= j
if (with_tag) condition = condition .and. (tag1 == tag2)
if (condition) then
i_perm = i_perm + 1
tmp = flv_copy%flst(i)
flv_copy%flst(i) = flv2
flv_copy%flst(j) = tmp
tmp = flv_copy%tag(i)
flv_copy%tag(i) = tag2
flv_copy%tag(j) = tmp
perm_list_tmp (i_perm, 1) = i
perm_list_tmp (i_perm, 2) = j
exit
end if
end do
j_min = j_min + 1
end do
allocate (perm%perms (i_perm, 2))
perm%perms = perm_list_tmp (1 : i_perm, :)
deallocate (perm_list_tmp)
call flv_copy%final ()
end subroutine flv_perm_init
@ %def flv_perm_init
@
<<FKS regions: flavor permutation: TBP>>=
procedure :: write => flv_perm_write
<<FKS regions: sub interfaces>>=
module subroutine flv_perm_write (perm, unit)
class(flv_perm_t), intent(in) :: perm
integer, intent(in), optional :: unit
end subroutine flv_perm_write
<<FKS regions: procedures>>=
module subroutine flv_perm_write (perm, unit)
class(flv_perm_t), intent(in) :: perm
integer, intent(in), optional :: unit
integer :: i, n, u
u = given_output_unit (unit); if (u < 0) return
write (u, "(A)") "Flavor permutation list: "
n = size (perm%perms, dim = 1)
if (n > 0) then
do i = 1, n
write (u, "(A1,I1,1X,I1,A1)", advance = "no") "[", &
perm%perms(i,1), perm%perms(i,2), "]"
if (i < n) write (u, "(A4)", advance = "no") " // "
end do
write (u, "(A)") ""
else
write (u, "(A)") "[Empty]"
end if
end subroutine flv_perm_write
@ %def flv_perm_write
@
<<FKS regions: flavor permutation: TBP>>=
procedure :: reset => flv_perm_final
procedure :: final => flv_perm_final
<<FKS regions: sub interfaces>>=
module subroutine flv_perm_final (perm)
class(flv_perm_t), intent(inout) :: perm
end subroutine flv_perm_final
<<FKS regions: procedures>>=
module subroutine flv_perm_final (perm)
class(flv_perm_t), intent(inout) :: perm
if (allocated (perm%perms)) deallocate (perm%perms)
end subroutine flv_perm_final
@ %def flv_perm_final
@
<<FKS regions: flavor permutation: TBP>>=
generic :: apply => &
apply_flv_structure, apply_index, apply_ftuple
procedure :: apply_flv_structure => flv_perm_apply_flv_structure
procedure :: apply_index => flv_perm_apply_index
procedure :: apply_ftuple => flv_perm_apply_ftuple
<<FKS regions: sub interfaces>>=
elemental module function flv_perm_apply_flv_structure &
(perm, flv_in, invert) result (flv_out)
type(flv_structure_t) :: flv_out
class(flv_perm_t), intent(in) :: perm
type(flv_structure_t), intent(in) :: flv_in
logical, intent(in), optional :: invert
end function flv_perm_apply_flv_structure
<<FKS regions: procedures>>=
elemental module function flv_perm_apply_flv_structure &
(perm, flv_in, invert) result (flv_out)
type(flv_structure_t) :: flv_out
class(flv_perm_t), intent(in) :: perm
type(flv_structure_t), intent(in) :: flv_in
logical, intent(in), optional :: invert
integer :: i, i1, i2
integer :: p1, p2, incr
integer :: flv_tmp, tag_tmp
logical :: inv
inv = .false.; if (present(invert)) inv = invert
flv_out = flv_in
if (inv) then
p1 = 1
p2 = size (perm%perms, dim = 1)
incr = 1
else
p1 = size (perm%perms, dim = 1)
p2 = 1
incr = -1
end if
do i = p1, p2, incr
i1 = perm%perms(i,1)
i2 = perm%perms(i,2)
flv_tmp = flv_out%flst(i1)
tag_tmp = flv_out%tag(i1)
flv_out%flst(i1) = flv_out%flst(i2)
flv_out%flst(i2) = flv_tmp
flv_out%tag(i1) = flv_out%tag(i2)
flv_out%tag(i2) = tag_tmp
end do
end function flv_perm_apply_flv_structure
@ %def flv_perm_apply_flv_structure
@
<<FKS regions: sub interfaces>>=
elemental module function flv_perm_apply_index &
(perm, i_in) result (i_out)
integer :: i_out
class(flv_perm_t), intent(in) :: perm
integer, intent(in) :: i_in
end function flv_perm_apply_index
<<FKS regions: procedures>>=
elemental module function flv_perm_apply_index &
(perm, i_in) result (i_out)
integer :: i_out
class(flv_perm_t), intent(in) :: perm
integer, intent(in) :: i_in
integer :: i, i1, i2
i_out = i_in
do i = size (perm%perms(:,1)), 1, -1
i1 = perm%perms(i,1)
i2 = perm%perms(i,2)
if (i_out == i1) then
i_out = i2
else if (i_out == i2) then
i_out = i1
end if
end do
end function flv_perm_apply_index
@ %def flv_perm_apply_index
@
<<FKS regions: sub interfaces>>=
elemental module function flv_perm_apply_ftuple &
(perm, f_in) result (f_out)
type(ftuple_t) :: f_out
class(flv_perm_t), intent(in) :: perm
type(ftuple_t), intent(in) :: f_in
end function flv_perm_apply_ftuple
<<FKS regions: procedures>>=
elemental module function flv_perm_apply_ftuple &
(perm, f_in) result (f_out)
type(ftuple_t) :: f_out
class(flv_perm_t), intent(in) :: perm
type(ftuple_t), intent(in) :: f_in
integer :: i, i1, i2
f_out = f_in
do i = size (perm%perms, dim = 1), 1, -1
i1 = perm%perms(i,1)
i2 = perm%perms(i,2)
if (f_out%ireg(1) == i1) then
f_out%ireg(1) = i2
else if (f_out%ireg(1) == i2) then
f_out%ireg(1) = i1
end if
if (f_out%ireg(2) == i1) then
f_out%ireg(2) = i2
else if (f_out%ireg(2) == i2) then
f_out%ireg(2) = i1
end if
end do
if (f_out%ireg(1) > f_out%ireg(2)) f_out%ireg = f_out%ireg([2,1])
end function flv_perm_apply_ftuple
@ %def flv_perm_apply_ftuple
@
<<FKS regions: flavor permutation: TBP>>=
procedure :: eqv => flv_perm_eqv
<<FKS regions: sub interfaces>>=
module function flv_perm_eqv &
(perm, flv1, flv2, with_tag) result (valid)
logical :: valid
class(flv_perm_t), intent(in) :: perm
type(flv_structure_t), intent(in) :: flv1, flv2
logical, intent(in) :: with_tag
end function flv_perm_eqv
<<FKS regions: procedures>>=
module function flv_perm_eqv &
(perm, flv1, flv2, with_tag) result (valid)
logical :: valid
class(flv_perm_t), intent(in) :: perm
type(flv_structure_t), intent(in) :: flv1, flv2
logical, intent(in) :: with_tag
type(flv_structure_t) :: flv_tmp
flv_tmp = perm%apply (flv2, invert = .true.)
valid = all (flv_tmp%flst == flv1%flst)
if (with_tag) valid = valid .and. all (flv_tmp%tag == flv1%tag)
call flv_tmp%final ()
end function flv_perm_eqv
@ %def flv_perm_eqv
@ A singular region is a partition of phase space which is associated with
an individual emitter and, if relevant, resonance. It is associated with
an $\alpha_r$- and resonance-index, with a real flavor structure and
its underlying Born flavor structure. To compute the FKS weights, it is
relevant to know all the other particle indices which can result in a
divergenent phase space configuration, which are collected in the
[[ftuples]]-array.
Some singular regions might behave physically identical. E.g. a real
flavor structure associated with three-jet production is $[11,-11,2,-2,21,21]$.
Here, there are two possible [[ftuples]] which contribute to the same
$u \rightarrow u g$ splitting, namely $(3,5)$ and $(3,6)$. The resulting
singular regions will be identical. To avoid this, one singular region
is associated with the multiplicity factor [[mult]]. When computing the
subtraction terms for each singular region, the result is then simply
multiplied by this factor.\\
The [[double_fsr]]-flag indicates whether the singular region should
also be supplied by a symmetry factor, explained below.
<<FKS regions: public>>=
public :: singular_region_t
<<FKS regions: types>>=
type :: singular_region_t
integer :: alr
integer :: i_res
type(flv_structure_t) :: flst_real
type(flv_structure_t) :: flst_uborn
integer :: mult
integer :: emitter
integer :: nregions
integer :: real_index
type(ftuple_t), dimension(:), allocatable :: ftuples
integer :: uborn_index
logical :: double_fsr = .false.
logical :: soft_divergence = .false.
logical :: coll_divergence = .false.
type(string_t) :: nlo_correction_type
integer, dimension(:), allocatable :: i_reg_to_i_con
logical :: pseudo_isr = .false.
logical :: sc_required = .false.
integer :: eqv_index = 0
contains
<<FKS regions: singular region: TBP>>
end type singular_region_t
@ %def singular_region_t
@
<<FKS regions: singular region: TBP>>=
procedure :: init => singular_region_init
<<FKS regions: sub interfaces>>=
module subroutine singular_region_init (sregion, alr, mult, i_res, &
flst_real, flst_uborn, flv_born, emitter, ftuples, equivalences, &
nlo_correction_type)
class(singular_region_t), intent(out) :: sregion
integer, intent(in) :: alr, mult, i_res
type(flv_structure_t), intent(in) :: flst_real
type(flv_structure_t), intent(in) :: flst_uborn
type(flv_structure_t), dimension(:), intent(in) :: flv_born
integer, intent(in) :: emitter
type(ftuple_t), intent(inout), dimension(:) :: ftuples
logical, intent(inout), dimension(:,:) :: equivalences
type(string_t), intent(in) :: nlo_correction_type
end subroutine singular_region_init
<<FKS regions: procedures>>=
module subroutine singular_region_init (sregion, alr, mult, i_res, &
flst_real, flst_uborn, flv_born, emitter, ftuples, equivalences, &
nlo_correction_type)
class(singular_region_t), intent(out) :: sregion
integer, intent(in) :: alr, mult, i_res
type(flv_structure_t), intent(in) :: flst_real
type(flv_structure_t), intent(in) :: flst_uborn
type(flv_structure_t), dimension(:), intent(in) :: flv_born
integer, intent(in) :: emitter
type(ftuple_t), intent(inout), dimension(:) :: ftuples
logical, intent(inout), dimension(:,:) :: equivalences
type(string_t), intent(in) :: nlo_correction_type
integer :: i
call debug_input_values ()
sregion%alr = alr
sregion%mult = mult
sregion%i_res = i_res
sregion%flst_real = flst_real
sregion%flst_uborn = flst_uborn
sregion%emitter = emitter
sregion%nlo_correction_type = nlo_correction_type
sregion%nregions = size (ftuples)
allocate (sregion%ftuples (sregion%nregions))
sregion%ftuples = ftuples
do i = 1, size(flv_born)
if (flv_born (i) .equiv. sregion%flst_uborn) then
sregion%uborn_index = i
exit
end if
end do
sregion%sc_required = any (sregion%flst_uborn%flst == GLUON) .or. &
any (sregion%flst_uborn%flst == PHOTON)
contains
subroutine debug_input_values()
if (debug_on) call msg_debug2 (D_SUBTRACTION, "singular_region_init")
if (debug2_active (D_SUBTRACTION)) then
print *, 'alr = ', alr
print *, 'mult = ', mult
print *, 'i_res = ', i_res
call flst_real%write ()
call flst_uborn%write ()
print *, 'emitter = ', emitter
call print_equivalence_matrix (ftuples, equivalences)
end if
end subroutine debug_input_values
end subroutine singular_region_init
@ %def singular_region_init
<<FKS regions: singular region: TBP>>=
procedure :: write => singular_region_write
<<FKS regions: sub interfaces>>=
module subroutine singular_region_write (sregion, unit, maxnregions)
class(singular_region_t), intent(in) :: sregion
integer, intent(in), optional :: unit
integer, intent(in), optional :: maxnregions
end subroutine singular_region_write
<<FKS regions: procedures>>=
module subroutine singular_region_write (sregion, unit, maxnregions)
class(singular_region_t), intent(in) :: sregion
integer, intent(in), optional :: unit
integer, intent(in), optional :: maxnregions
character(len=7), parameter :: flst_format = "(I3,A1)"
character(len=7), parameter :: ireg_space_format = "(7X,A1)"
integer :: nreal, nborn, i, u, mr
integer :: nleft, nright, nreg, nreg_diff
u = given_output_unit (unit); if (u < 0) return
mr = sregion%nregions; if (present (maxnregions)) mr = maxnregions
nreal = size (sregion%flst_real%flst)
nborn = size (sregion%flst_uborn%flst)
call write_vline (u)
write (u, '(A1)', advance = 'no') '['
do i = 1, nreal - 1
write (u, flst_format, advance = 'no') sregion%flst_real%flst(i), ','
end do
write (u, flst_format, advance = 'no') sregion%flst_real%flst(nreal), ']'
call write_vline (u)
write (u, '(I6)', advance = 'no') sregion%real_index
call write_vline (u)
write (u, '(I3)', advance = 'no') sregion%emitter
call write_vline (u)
write (u, '(I3)', advance = 'no') sregion%mult
call write_vline (u)
write (u, '(I4)', advance = 'no') sregion%nregions
call write_vline (u)
if (sregion%i_res > 0) then
write (u, '(I3)', advance = 'no') sregion%i_res
call write_vline (u)
end if
nreg = sregion%nregions
if (nreg == mr) then
nleft = 0
nright = 0
else
nreg_diff = mr - nreg
nleft = nreg_diff / 2
if (mod(nreg_diff , 2) == 0) then
nright = nleft
else
nright = nleft + 1
end if
end if
if (nleft > 0) then
do i = 1, nleft
write(u, ireg_space_format, advance='no') ' '
end do
end if
write (u, '(A)', advance = 'no') char (ftuple_string (sregion%ftuples, .false.))
call write_vline (u)
write (u,'(A1)',advance = 'no') '['
do i = 1, nborn - 1
write(u, flst_format, advance = 'no') sregion%flst_uborn%flst(i), ','
end do
write (u, flst_format, advance = 'no') sregion%flst_uborn%flst(nborn), ']'
call write_vline (u)
write (u, '(I7)', advance = 'no') sregion%uborn_index
call write_vline (u)
if (sregion%nlo_correction_type == "EW") then
write (u, '(A3)', advance = 'no') 'ew'
else if (sregion%nlo_correction_type == "QCD") then
write (u, '(A4)', advance = 'no') 'qcd'
else
write (u, '(A5)', advance = 'no') 'none'
end if
write (u, '(A)')
end subroutine singular_region_write
@ %def singular_region_write
@
<<FKS regions: singular region: TBP>>=
procedure :: write_latex => singular_region_write_latex
<<FKS regions: sub interfaces>>=
module subroutine singular_region_write_latex (region, unit)
class(singular_region_t), intent(in) :: region
integer, intent(in), optional :: unit
end subroutine singular_region_write_latex
<<FKS regions: procedures>>=
module subroutine singular_region_write_latex (region, unit)
class(singular_region_t), intent(in) :: region
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(I2,A3,A,A3,I2,A3,I1,A3,I1,A3,A,A3,I2,A3,A,A3)") &
region%alr, " & ", char (region%flst_real%to_string ()), &
" & ", region%real_index, " & ", region%emitter, " & ", &
region%mult, " & ", char (ftuple_string (region%ftuples, .true.)), &
" & ", region%uborn_index, " & ", char (region%flst_uborn%to_string ()), &
" \\"
end subroutine singular_region_write_latex
@ %def singular_region_write_latex
@ In case of a $g \rightarrow gg$ splitting, the factor
\begin{equation*}
\frac{2E_{\rm{em}}}{E_{\rm{em}} + E_{\rm{rad}}}
\end{equation*}
is multiplied to the real matrix element. This way, the symmetry of
the splitting is used and only one singular region has to be taken
into account. However, the factor ensures that there is only a soft
singularity if the radiated parton becomes soft.
<<FKS regions: singular region: TBP>>=
procedure :: set_splitting_info => singular_region_set_splitting_info
<<FKS regions: sub interfaces>>=
module subroutine singular_region_set_splitting_info (region, n_in)
class(singular_region_t), intent(inout) :: region
integer, intent(in) :: n_in
end subroutine singular_region_set_splitting_info
<<FKS regions: procedures>>=
module subroutine singular_region_set_splitting_info (region, n_in)
class(singular_region_t), intent(inout) :: region
integer, intent(in) :: n_in
integer :: i1, i2
integer :: reg
region%double_fsr = .false.
region%soft_divergence = .false.
associate (ftuple => region%ftuples)
do reg = 1, region%nregions
call ftuple(reg)%get (i1, i2)
if (i1 /= region%emitter .or. i2 /= region%flst_real%nlegs) then
cycle
else
if (ftuple(reg)%splitting_type == V_TO_VV .or. &
ftuple(reg)%splitting_type == F_TO_FV ) then
region%soft_divergence = .true.
end if
if (i1 == 0) then
region%coll_divergence = &
.not. all (region%flst_real%massive(1:n_in))
else
region%coll_divergence = .not. region%flst_real%massive(i1)
end if
if (ftuple(reg)%splitting_type == V_TO_VV) then
if (all (ftuple(reg)%ireg > n_in)) &
region%double_fsr = &
all (is_gluon (region%flst_real%flst(ftuple(reg)%ireg)))
exit
else if (ftuple(reg)%splitting_type == UNDEFINED_SPLITTING) then
call msg_fatal ("All splittings should be defined!")
end if
end if
end do
if (.not. region%soft_divergence .and. .not. region%coll_divergence) &
call msg_fatal ("Singular region defined without divergence!")
end associate
end subroutine singular_region_set_splitting_info
@ %def singular_region_set_splitting_info
@
<<FKS regions: singular region: TBP>>=
procedure :: double_fsr_factor => singular_region_double_fsr_factor
<<FKS regions: sub interfaces>>=
module function singular_region_double_fsr_factor (region, p) result (val)
class(singular_region_t), intent(in) :: region
type(vector4_t), intent(in), dimension(:) :: p
real(default) :: val
end function singular_region_double_fsr_factor
<<FKS regions: procedures>>=
module function singular_region_double_fsr_factor (region, p) result (val)
class(singular_region_t), intent(in) :: region
type(vector4_t), intent(in), dimension(:) :: p
real(default) :: val
real(default) :: E_rad, E_em
if (region%double_fsr) then
E_em = energy (p(region%emitter))
E_rad = energy (p(region%flst_real%nlegs))
val = two * E_em / (E_em + E_rad)
else
val = one
end if
end function singular_region_double_fsr_factor
@ %def singular_region_double_fsr_factor
@
<<FKS regions: singular region: TBP>>=
procedure :: has_soft_divergence => singular_region_has_soft_divergence
<<FKS regions: sub interfaces>>=
module function singular_region_has_soft_divergence (region) result (div)
logical :: div
class(singular_region_t), intent(in) :: region
end function singular_region_has_soft_divergence
<<FKS regions: procedures>>=
module function singular_region_has_soft_divergence (region) result (div)
logical :: div
class(singular_region_t), intent(in) :: region
div = region%soft_divergence
end function singular_region_has_soft_divergence
@ %def singular_region_has_soft_divergence
@
<<FKS regions: singular region: TBP>>=
procedure :: has_collinear_divergence => &
singular_region_has_collinear_divergence
<<FKS regions: sub interfaces>>=
module function singular_region_has_collinear_divergence &
(region) result (div)
logical :: div
class(singular_region_t), intent(in) :: region
end function singular_region_has_collinear_divergence
<<FKS regions: procedures>>=
module function singular_region_has_collinear_divergence &
(region) result (div)
logical :: div
class(singular_region_t), intent(in) :: region
div = region%coll_divergence
end function singular_region_has_collinear_divergence
@ %def singular_region_has_collinear_divergence
@
<<FKS regions: singular region: TBP>>=
procedure :: has_identical_ftuples => singular_region_has_identical_ftuples
<<FKS regions: sub interfaces>>=
elemental module function singular_region_has_identical_ftuples &
(sregion) result (value)
logical :: value
class(singular_region_t), intent(in) :: sregion
end function singular_region_has_identical_ftuples
<<FKS regions: procedures>>=
elemental module function singular_region_has_identical_ftuples &
(sregion) result (value)
logical :: value
class(singular_region_t), intent(in) :: sregion
integer :: alr
value = .false.
do alr = 1, sregion%nregions
value = value .or. (count (sregion%ftuples(alr) == sregion%ftuples) > 1)
end do
end function singular_region_has_identical_ftuples
@ %def singular_region_has_identical_ftuples
@
<<FKS regions: interfaces>>=
interface assignment(=)
module procedure singular_region_assign
end interface
<<FKS regions: sub interfaces>>=
module subroutine singular_region_assign (reg_out, reg_in)
type(singular_region_t), intent(out) :: reg_out
type(singular_region_t), intent(in) :: reg_in
end subroutine singular_region_assign
<<FKS regions: procedures>>=
module subroutine singular_region_assign (reg_out, reg_in)
type(singular_region_t), intent(out) :: reg_out
type(singular_region_t), intent(in) :: reg_in
reg_out%alr = reg_in%alr
reg_out%i_res = reg_in%i_res
reg_out%flst_real = reg_in%flst_real
reg_out%flst_uborn = reg_in%flst_uborn
reg_out%mult = reg_in%mult
reg_out%emitter = reg_in%emitter
reg_out%nregions = reg_in%nregions
reg_out%real_index = reg_in%real_index
reg_out%uborn_index = reg_in%uborn_index
reg_out%double_fsr = reg_in%double_fsr
reg_out%soft_divergence = reg_in%soft_divergence
reg_out%coll_divergence = reg_in%coll_divergence
reg_out%nlo_correction_type = reg_in%nlo_correction_type
if (allocated (reg_in%ftuples)) then
allocate (reg_out%ftuples (size (reg_in%ftuples)))
reg_out%ftuples = reg_in%ftuples
else
call msg_bug ("singular_region_assign: Trying to copy a " // &
"singular region without allocated ftuples!")
end if
end subroutine singular_region_assign
@ %def singular_region_assign
@ Two singular regions match if they would produce the same amplitude.
For this we have to check that their real and underlying Born flavor
structures are equivalent, as determined by the [[prc_core]]. However,
since there are more aspects of a singular region that make it unique,
we have to check other attributes as well.
<<FKS regions: interfaces>>=
interface operator(.match.)
module procedure singular_region_match
end interface
<<FKS regions: sub interfaces>>=
module function singular_region_match (reg1, reg2) result (match)
type(singular_region_t), intent(in) :: reg1, reg2
logical :: match
end function singular_region_match
<<FKS regions: procedures>>=
module function singular_region_match (reg1, reg2) result (match)
type(singular_region_t), intent(in) :: reg1, reg2
logical :: match
match = all ([reg1%flst_real%eqv_index, reg2%flst_real%eqv_index] > 0)
match = match .and. (reg1%flst_real%eqv_index == reg2%flst_real%eqv_index)
match = match .and. (reg1%flst_uborn%eqv_index == reg2%flst_uborn%eqv_index)
match = match .and. (reg1%mult == reg2%mult)
match = match .and. (reg1%emitter == reg2%emitter)
match = match .and. (reg1%nregions == reg2%nregions)
match = match .and. (reg1%double_fsr .eqv. reg2%double_fsr)
match = match .and. (reg1%soft_divergence .eqv. reg2%soft_divergence)
match = match .and. (reg1%coll_divergence .eqv. reg2%coll_divergence)
match = match .and. (char (reg1%nlo_correction_type) == char (reg2%nlo_correction_type))
if (match) match = match .and. (all (reg1%ftuples == reg2%ftuples))
end function singular_region_match
@ %def singular_region_match
@
<<FKS regions: types>>=
type :: resonance_mapping_t
type(resonance_history_t), dimension(:), allocatable :: res_histories
integer, dimension(:), allocatable :: alr_to_i_res
integer, dimension(:,:), allocatable :: i_res_to_alr
type(vector4_t), dimension(:), allocatable :: p_res
contains
<<FKS regions: resonance mapping: TBP>>
end type resonance_mapping_t
@ %def resonance_mapping_t
@ Testing: Init resonance mapping for $\mu \mu b b$ final state.
<<FKS regions: resonance mapping: TBP>>=
procedure :: init => resonance_mapping_init
<<FKS regions: sub interfaces>>=
module subroutine resonance_mapping_init (res_map, res_hist)
class(resonance_mapping_t), intent(inout) :: res_map
type(resonance_history_t), intent(in), dimension(:) :: res_hist
end subroutine resonance_mapping_init
<<FKS regions: procedures>>=
module subroutine resonance_mapping_init (res_map, res_hist)
class(resonance_mapping_t), intent(inout) :: res_map
type(resonance_history_t), intent(in), dimension(:) :: res_hist
integer :: n_hist, i_hist1, i_hist2, n_contributors
n_contributors = 0
n_hist = size (res_hist)
allocate (res_map%res_histories (n_hist))
do i_hist1 = 1, n_hist
if (i_hist1 + 1 <= n_hist) then
do i_hist2 = i_hist1 + 1, n_hist
if (.not. (res_hist(i_hist1) .contains. res_hist(i_hist2))) &
n_contributors = n_contributors + &
res_hist(i_hist2)%n_resonances
end do
else
n_contributors = n_contributors + res_hist(i_hist1)%n_resonances
end if
end do
allocate (res_map%p_res (n_contributors))
res_map%res_histories = res_hist
res_map%p_res = vector4_null
end subroutine resonance_mapping_init
@ %def resonance_mapping_init
@
<<FKS regions: resonance mapping: TBP>>=
procedure :: set_alr_to_i_res => resonance_mapping_set_alr_to_i_res
<<FKS regions: sub interfaces>>=
module subroutine resonance_mapping_set_alr_to_i_res &
(res_map, regions, alr_new_to_old)
class(resonance_mapping_t), intent(inout) :: res_map
type(singular_region_t), intent(in), dimension(:) :: regions
integer, intent(out), dimension(:), allocatable :: alr_new_to_old
end subroutine resonance_mapping_set_alr_to_i_res
<<FKS regions: procedures>>=
module subroutine resonance_mapping_set_alr_to_i_res &
(res_map, regions, alr_new_to_old)
class(resonance_mapping_t), intent(inout) :: res_map
type(singular_region_t), intent(in), dimension(:) :: regions
integer, intent(out), dimension(:), allocatable :: alr_new_to_old
integer :: alr, i_res
integer :: alr_new, n_alr_res
integer :: k
if (debug_on) call msg_debug &
(D_SUBTRACTION, "resonance_mapping_set_alr_to_i_res")
n_alr_res = 0
do alr = 1, size (regions)
do i_res = 1, size (res_map%res_histories)
if (res_map%res_histories(i_res)%contains_leg &
(regions(alr)%emitter)) &
n_alr_res = n_alr_res + 1
end do
end do
allocate (res_map%alr_to_i_res (n_alr_res))
allocate (res_map%i_res_to_alr (size (res_map%res_histories), 10))
res_map%i_res_to_alr = 0
allocate (alr_new_to_old (n_alr_res))
alr_new = 1
do alr = 1, size (regions)
do i_res = 1, size (res_map%res_histories)
if (res_map%res_histories(i_res)%contains_leg &
(regions(alr)%emitter)) then
res_map%alr_to_i_res (alr_new) = i_res
alr_new_to_old (alr_new) = alr
alr_new = alr_new + 1
end if
end do
end do
do i_res = 1, size (res_map%res_histories)
k = 1
do alr = 1, size (regions)
if (res_map%res_histories(i_res)%contains_leg &
(regions(alr)%emitter)) then
res_map%i_res_to_alr (i_res, k) = alr
k = k + 1
end if
end do
end do
if (debug_active (D_SUBTRACTION)) then
print *, 'i_res_to_alr:'
do i_res = 1, size(res_map%i_res_to_alr, dim=1)
print *, res_map%i_res_to_alr (i_res, :)
end do
print *, 'alr_new_to_old:', alr_new_to_old
end if
end subroutine resonance_mapping_set_alr_to_i_res
@ %def resonance_mapping_set_alr_to_i_res
@
<<FKS regions: resonance mapping: TBP>>=
procedure :: get_resonance_history => resonance_mapping_get_resonance_history
<<FKS regions: sub interfaces>>=
module function resonance_mapping_get_resonance_history &
(res_map, alr) result (res_hist)
type(resonance_history_t) :: res_hist
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
end function resonance_mapping_get_resonance_history
<<FKS regions: procedures>>=
module function resonance_mapping_get_resonance_history &
(res_map, alr) result (res_hist)
type(resonance_history_t) :: res_hist
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
res_hist = res_map%res_histories(res_map%alr_to_i_res (alr))
end function resonance_mapping_get_resonance_history
@ %def resonance_mapping_get_resonance_history
@
<<FKS regions: resonance mapping: TBP>>=
procedure :: write => resonance_mapping_write
<<FKS regions: sub interfaces>>=
module subroutine resonance_mapping_write (res_map)
class(resonance_mapping_t), intent(in) :: res_map
end subroutine resonance_mapping_write
<<FKS regions: procedures>>=
module subroutine resonance_mapping_write (res_map)
class(resonance_mapping_t), intent(in) :: res_map
integer :: i_res
do i_res = 1, size (res_map%res_histories)
call res_map%res_histories(i_res)%write ()
end do
end subroutine resonance_mapping_write
@ %def resonance_mapping_write
@
<<FKS regions: resonance mapping: TBP>>=
procedure :: get_resonance_value => resonance_mapping_get_resonance_value
<<FKS regions: sub interfaces>>=
module function resonance_mapping_get_resonance_value &
(res_map, i_res, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: i_res
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
end function resonance_mapping_get_resonance_value
<<FKS regions: procedures>>=
module function resonance_mapping_get_resonance_value &
(res_map, i_res, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: i_res
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
p_map = res_map%res_histories(i_res)%mapping (p, i_gluon)
end function resonance_mapping_get_resonance_value
@ %def resonance_mapping_get_resonance_value
@
<<FKS regions: resonance mapping: TBP>>=
procedure :: get_resonance_all => resonance_mapping_get_resonance_all
<<FKS regions: sub interfaces>>=
module function resonance_mapping_get_resonance_all &
(res_map, alr, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
end function resonance_mapping_get_resonance_all
<<FKS regions: procedures>>=
module function resonance_mapping_get_resonance_all &
(res_map, alr, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
integer :: i_res
p_map = zero
do i_res = 1, size (res_map%res_histories)
associate (res => res_map%res_histories(i_res))
if (any (res_map%i_res_to_alr (i_res, :) == alr)) &
p_map = p_map + res%mapping (p, i_gluon)
end associate
end do
end function resonance_mapping_get_resonance_all
@ %def resonance_mapping_get_resonance_all
@
<<FKS regions: resonance mapping: TBP>>=
procedure :: get_weight => resonance_mapping_get_weight
<<FKS regions: sub interfaces>>=
module function resonance_mapping_get_weight (res_map, alr, p) result (pfr)
real(default) :: pfr
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
end function resonance_mapping_get_weight
<<FKS regions: procedures>>=
module function resonance_mapping_get_weight (res_map, alr, p) result (pfr)
real(default) :: pfr
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
real(default) :: sumpfr
integer :: i_res
sumpfr = zero
do i_res = 1, size (res_map%res_histories)
sumpfr = sumpfr + res_map%get_resonance_value (i_res, p)
end do
pfr = res_map%get_resonance_value (res_map%alr_to_i_res (alr), p) / sumpfr
end function resonance_mapping_get_weight
@ %def resonance_mapping_get_weight
@
<<FKS regions: resonance mapping: TBP>>=
procedure :: get_resonance_alr => resonance_mapping_get_resonance_alr
<<FKS regions: sub interfaces>>=
module function resonance_mapping_get_resonance_alr &
(res_map, alr, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
end function resonance_mapping_get_resonance_alr
<<FKS regions: procedures>>=
module function resonance_mapping_get_resonance_alr &
(res_map, alr, p, i_gluon) result (p_map)
real(default) :: p_map
class(resonance_mapping_t), intent(in) :: res_map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in), optional :: i_gluon
integer :: i_res
i_res = res_map%alr_to_i_res (alr)
p_map = res_map%res_histories(i_res)%mapping (p, i_gluon)
end function resonance_mapping_get_resonance_alr
@ %def resonance_mapping_get_resonance_alr
@
<<FKS regions: interfaces>>=
interface assignment(=)
module procedure resonance_mapping_assign
end interface
<<FKS regions: sub interfaces>>=
module subroutine resonance_mapping_assign (res_map_out, res_map_in)
type(resonance_mapping_t), intent(out) :: res_map_out
type(resonance_mapping_t), intent(in) :: res_map_in
end subroutine resonance_mapping_assign
<<FKS regions: procedures>>=
module subroutine resonance_mapping_assign (res_map_out, res_map_in)
type(resonance_mapping_t), intent(out) :: res_map_out
type(resonance_mapping_t), intent(in) :: res_map_in
if (allocated (res_map_in%res_histories)) then
allocate (res_map_out%res_histories (size (res_map_in%res_histories)))
res_map_out%res_histories = res_map_in%res_histories
end if
if (allocated (res_map_in%alr_to_i_res)) then
allocate (res_map_out%alr_to_i_res (size (res_map_in%alr_to_i_res)))
res_map_out%alr_to_i_res = res_map_in%alr_to_i_res
end if
if (allocated (res_map_in%i_res_to_alr)) then
allocate (res_map_out%i_res_to_alr (size (res_map_in%i_res_to_alr, 1), &
size (res_map_in%i_res_to_alr, 2)))
res_map_out%i_res_to_alr = res_map_in%i_res_to_alr
end if
if (allocated (res_map_in%p_res)) then
allocate (res_map_out%p_res (size (res_map_in%p_res)))
res_map_out%p_res = res_map_in%p_res
end if
end subroutine resonance_mapping_assign
@ %def resonance_mapping_assign
@ Every FKS mapping should store the $\sum_\alpha d_{ij}^{-1}$ and
$\sum_\alpha d_{ij,\rm{soft}}^{-1}$.
Also we keep the option open to use a normlization factor, which ensures
$\sum_\alpha S_\alpha = 1$.
<<FKS regions: types>>=
type, abstract :: fks_mapping_t
real(default) :: sumdij
real(default) :: sumdij_soft
logical :: pseudo_isr = .false.
real(default) :: normalization_factor = one
contains
<<FKS regions: fks mapping: TBP>>
end type fks_mapping_t
@ %def fks_mapping_t
@
<<FKS regions: public>>=
public :: fks_mapping_default_t
<<FKS regions: types>>=
type, extends (fks_mapping_t) :: fks_mapping_default_t
real(default) :: exp_1, exp_2
integer :: n_in
contains
<<FKS regions: fks mapping default: TBP>>
end type fks_mapping_default_t
@ %def fks_mapping_default_t
@
<<FKS regions: public>>=
public :: fks_mapping_resonances_t
<<FKS regions: types>>=
type, extends (fks_mapping_t) :: fks_mapping_resonances_t
real(default) :: exp_1, exp_2
type(resonance_mapping_t) :: res_map
integer :: i_con = 0
contains
<<FKS regions: fks mapping resonances: TBP>>
end type fks_mapping_resonances_t
@ %def fks_mapping_resonances_t
@
<<FKS regions: public>>=
public :: operator(.equiv.)
public :: operator(.equivtag.)
<<FKS regions: interfaces>>=
interface operator(.equiv.)
module procedure flv_structure_equivalent_no_tag
end interface
interface operator(.equivtag.)
module procedure flv_structure_equivalent_with_tag
end interface
interface assignment(=)
module procedure flv_structure_assign_flv
module procedure flv_structure_assign_integer
end interface
@ %def operator_equiv
@
<<FKS regions: public>>=
public :: region_data_t
<<FKS regions: types>>=
type :: region_data_t
type(singular_region_t), dimension(:), allocatable :: regions
type(flv_structure_t), dimension(:), allocatable :: flv_born
type(flv_structure_t), dimension(:), allocatable :: flv_real
integer, dimension(:), allocatable :: eqv_flv_index_born
integer, dimension(:), allocatable :: eqv_flv_index_real
integer, dimension(:), allocatable :: emitters
integer :: n_regions = 0
integer :: n_emitters = 0
integer :: n_flv_born = 0
integer :: n_flv_real = 0
integer :: n_in = 0
integer :: n_legs_born = 0
integer :: n_legs_real = 0
integer :: n_phs = 0
integer :: alpha_power = 0
integer :: alphas_power = 0
type(string_t) :: nlo_correction_type
class(fks_mapping_t), allocatable :: fks_mapping
integer, dimension(:), allocatable :: resonances
type(resonance_contributors_t), dimension(:), allocatable :: alr_contributors
integer, dimension(:), allocatable :: alr_to_i_contributor
integer, dimension(:), allocatable :: i_phs_to_i_con
contains
<<FKS regions: reg data: TBP>>
end type region_data_t
@ %def region_data_t
@ Gfortran 7/8/9/ bug, has to remain in the main module:
<<FKS regions: reg data: TBP>>=
procedure :: allocate_fks_mappings => region_data_allocate_fks_mappings
<<FKS regions: main procedures>>=
subroutine region_data_allocate_fks_mappings (reg_data, mapping_type)
class(region_data_t), intent(inout) :: reg_data
integer, intent(in) :: mapping_type
select case (mapping_type)
case (FKS_DEFAULT)
allocate (fks_mapping_default_t :: reg_data%fks_mapping)
case (FKS_RESONANCES)
allocate (fks_mapping_resonances_t :: reg_data%fks_mapping)
case default
call msg_fatal ("Init region_data: FKS mapping not implemented!")
end select
end subroutine region_data_allocate_fks_mappings
@ %def region_data_allocate_fks_mappings
@
<<FKS regions: reg data: TBP>>=
procedure :: init => region_data_init
<<FKS regions: sub interfaces>>=
module subroutine region_data_init (reg_data, n_in, model, flavor_born, &
flavor_real, nlo_correction_type, alpha_pow, alphas_pow)
class(region_data_t), intent(out) :: reg_data
integer, intent(in) :: n_in, alpha_pow, alphas_pow
type(model_t), intent(in) :: model
integer, intent(in), dimension(:,:) :: flavor_born, flavor_real
type(string_t), intent(in) :: nlo_correction_type
end subroutine region_data_init
<<FKS regions: procedures>>=
module subroutine region_data_init (reg_data, n_in, model, flavor_born, &
flavor_real, nlo_correction_type, alpha_pow, alphas_pow)
class(region_data_t), intent(out) :: reg_data
integer, intent(in) :: n_in, alpha_pow, alphas_pow
type(model_t), intent(in) :: model
integer, intent(in), dimension(:,:) :: flavor_born, flavor_real
type(string_t), intent(in) :: nlo_correction_type
integer, dimension(:,:), allocatable :: flv_real_tmp
type(ftuple_list_t), dimension(:), allocatable :: ftuples
integer, dimension(:), allocatable :: emitter
type(flv_structure_t), dimension(:), allocatable :: flst_alr
integer :: i, n_real
integer :: n_flv_real_before_check
reg_data%n_in = n_in
reg_data%alpha_power = alpha_pow
reg_data%alphas_power = alphas_pow
reg_data%n_flv_born = size (flavor_born, dim = 2)
reg_data%n_legs_born = size (flavor_born, dim = 1)
reg_data%n_legs_real = reg_data%n_legs_born + 1
reg_data%nlo_correction_type = nlo_correction_type
n_flv_real_before_check = size (flavor_real, dim = 2)
allocate (reg_data%flv_born (reg_data%n_flv_born))
allocate (flv_real_tmp (reg_data%n_legs_real, n_flv_real_before_check))
do i = 1, reg_data%n_flv_born
call reg_data%flv_born(i)%init (flavor_born (:, i), n_in)
end do
n_real = 0
do i = 1, n_flv_real_before_check
if (nlo_correction_type == "EW") then
if (.not. (query_coupling_powers &
(flavor_real (:, i), reg_data%alpha_power + 1, &
reg_data%alphas_power))) cycle
end if
n_real = n_real + 1
flv_real_tmp (:, n_real) = flavor_real (:, i)
end do
allocate (reg_data%flv_real (n_real))
do i = 1, n_real
call reg_data%flv_real(i)%init (flv_real_tmp (:, i), n_in)
end do
call reg_data%find_regions (model, ftuples, emitter, flst_alr)
call reg_data%init_singular_regions (ftuples, emitter, &
flst_alr, nlo_correction_type)
reg_data%n_flv_real = maxval (reg_data%regions%real_index)
call reg_data%find_emitters ()
call reg_data%set_mass_color_and_charge (model)
call reg_data%set_splitting_info ()
end subroutine region_data_init
@ %def region_data_init
@
<<FKS regions: reg data: TBP>>=
procedure :: init_resonance_information => &
region_data_init_resonance_information
<<FKS regions: sub interfaces>>=
module subroutine region_data_init_resonance_information (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_init_resonance_information
<<FKS regions: procedures>>=
module subroutine region_data_init_resonance_information (reg_data)
class(region_data_t), intent(inout) :: reg_data
call reg_data%enlarge_singular_regions_with_resonances ()
call reg_data%find_resonances ()
end subroutine region_data_init_resonance_information
@ %def region_data_init_resonance_information
@
<<FKS regions: reg data: TBP>>=
procedure :: set_resonance_mappings => region_data_set_resonance_mappings
<<FKS regions: sub interfaces>>=
module subroutine region_data_set_resonance_mappings &
(reg_data, resonance_histories)
class(region_data_t), intent(inout) :: reg_data
type(resonance_history_t), intent(in), dimension(:) :: resonance_histories
end subroutine region_data_set_resonance_mappings
<<FKS regions: procedures>>=
module subroutine region_data_set_resonance_mappings &
(reg_data, resonance_histories)
class(region_data_t), intent(inout) :: reg_data
type(resonance_history_t), intent(in), dimension(:) :: resonance_histories
select type (map => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
call map%res_map%init (resonance_histories)
end select
end subroutine region_data_set_resonance_mappings
@ %def region_data_set_resonance_mappings
@
<<FKS regions: reg data: TBP>>=
procedure :: setup_fks_mappings => region_data_setup_fks_mappings
<<FKS regions: sub interfaces>>=
module subroutine region_data_setup_fks_mappings (reg_data, template, n_in)
class(region_data_t), intent(inout) :: reg_data
type(fks_template_t), intent(in) :: template
integer, intent(in) :: n_in
end subroutine region_data_setup_fks_mappings
<<FKS regions: procedures>>=
module subroutine region_data_setup_fks_mappings (reg_data, template, n_in)
class(region_data_t), intent(inout) :: reg_data
type(fks_template_t), intent(in) :: template
integer, intent(in) :: n_in
call reg_data%allocate_fks_mappings (template%mapping_type)
select type (map => reg_data%fks_mapping)
type is (fks_mapping_default_t)
call map%set_parameter (n_in, template%fks_dij_exp1, &
template%fks_dij_exp2)
end select
end subroutine region_data_setup_fks_mappings
@ %def region_data_setup_fks_mappings
@ So far, we have only created singular regions for a non-resonant case. When
resonance mappings are required, we have more singular regions, since they
must now be identified by their emitter-resonance pair index, where the emitter
must be compatible with the resonance.
<<FKS regions: reg data: TBP>>=
procedure :: enlarge_singular_regions_with_resonances &
=> region_data_enlarge_singular_regions_with_resonances
<<FKS regions: sub interfaces>>=
module subroutine region_data_enlarge_singular_regions_with_resonances &
(reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_enlarge_singular_regions_with_resonances
<<FKS regions: procedures>>=
module subroutine region_data_enlarge_singular_regions_with_resonances &
(reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr
integer, dimension(:), allocatable :: alr_new_to_old
integer :: n_alr_new
type(singular_region_t), dimension(:), allocatable :: save_regions
if (debug_on) call msg_debug &
(D_SUBTRACTION, "region_data_enlarge_singular_regions_with_resonances")
call debug_input_values ()
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_default_t)
return
type is (fks_mapping_resonances_t)
allocate (save_regions (reg_data%n_regions))
do alr = 1, reg_data%n_regions
save_regions(alr) = reg_data%regions(alr)
end do
associate (res_map => fks_mapping%res_map)
call res_map%set_alr_to_i_res (reg_data%regions, alr_new_to_old)
deallocate (reg_data%regions)
n_alr_new = size (alr_new_to_old)
reg_data%n_regions = n_alr_new
allocate (reg_data%regions (n_alr_new))
do alr = 1, n_alr_new
reg_data%regions(alr) = save_regions(alr_new_to_old (alr))
reg_data%regions(alr)%i_res = res_map%alr_to_i_res (alr)
end do
end associate
end select
contains
subroutine debug_input_values ()
if (debug2_active (D_SUBTRACTION)) then
call reg_data%write ()
end if
end subroutine debug_input_values
end subroutine region_data_enlarge_singular_regions_with_resonances
@ %def region_data_enlarge_singular_regions_with_resonances
@
<<FKS regions: reg data: TBP>>=
procedure :: set_isr_pseudo_regions => region_data_set_isr_pseudo_regions
<<FKS regions: sub interfaces>>=
module subroutine region_data_set_isr_pseudo_regions (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_set_isr_pseudo_regions
<<FKS regions: procedures>>=
module subroutine region_data_set_isr_pseudo_regions (reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr
integer :: n_alr_new
!!! Subroutine called for threshold factorization ->
!!! Size of singular regions at this point is fixed
type(singular_region_t), dimension(2) :: save_regions
integer, dimension(4) :: alr_new_to_old
do alr = 1, reg_data%n_regions
save_regions(alr) = reg_data%regions(alr)
end do
n_alr_new = reg_data%n_regions * 2
alr_new_to_old = [1, 1, 2, 2]
deallocate (reg_data%regions)
allocate (reg_data%regions (n_alr_new))
reg_data%n_regions = n_alr_new
do alr = 1, n_alr_new
reg_data%regions(alr) = save_regions(alr_new_to_old (alr))
call add_pseudo_emitters (reg_data%regions(alr))
if (mod (alr, 2) == 0) reg_data%regions(alr)%pseudo_isr = .true.
end do
contains
subroutine add_pseudo_emitters (sregion)
type(singular_region_t), intent(inout) :: sregion
type(ftuple_t), dimension(2) :: ftuples_save
integer :: alr
do alr = 1, 2
ftuples_save(alr) = sregion%ftuples(alr)
end do
deallocate (sregion%ftuples)
sregion%nregions = sregion%nregions * 2
allocate (sregion%ftuples (sregion%nregions))
do alr = 1, sregion%nregions
sregion%ftuples(alr) = ftuples_save (alr_new_to_old(alr))
if (mod (alr, 2) == 0) sregion%ftuples(alr)%pseudo_isr = .true.
end do
end subroutine add_pseudo_emitters
end subroutine region_data_set_isr_pseudo_regions
@ %def region_data_set_isr_pseudo_regions
@ This subroutine splits up the ftuple-list of the singular regions
into interference-free lists, i.e. lists which only contain the same
emitter. This is relevant for factorized NLO calculations. In the
current implementation, it is hand-tailored for the threshold
computation, but should be generalized further in the future.
<<FKS regions: reg data: TBP>>=
procedure :: split_up_interference_regions_for_threshold => &
region_data_split_up_interference_regions_for_threshold
<<FKS regions: sub interfaces>>=
module subroutine region_data_split_up_interference_regions_for_threshold &
(reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_split_up_interference_regions_for_threshold
<<FKS regions: procedures>>=
module subroutine region_data_split_up_interference_regions_for_threshold &
(reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr, i_ftuple
integer :: current_emitter
integer :: i1, i2
integer :: n_new_reg
type(ftuple_t), dimension(2) :: ftuples
do alr = 1, reg_data%n_regions
associate (region => reg_data%regions(alr))
current_emitter = region%emitter
n_new_reg = 0
do i_ftuple = 1, region%nregions
call region%ftuples(i_ftuple)%get (i1, i2)
if (i1 == current_emitter) then
n_new_reg = n_new_reg + 1
ftuples(n_new_reg) = region%ftuples(i_ftuple)
end if
end do
deallocate (region%ftuples)
allocate (region%ftuples(n_new_reg))
region%ftuples = ftuples (1 : n_new_reg)
region%nregions = n_new_reg
end associate
end do
reg_data%fks_mapping%normalization_factor = 0.5_default
end subroutine region_data_split_up_interference_regions_for_threshold
@ %def region_data_split_up_interference_regions_for_threshold
@
<<FKS regions: reg data: TBP>>=
procedure :: set_mass_color_and_charge => &
region_data_set_mass_color_and_charge
<<FKS regions: sub interfaces>>=
module subroutine region_data_set_mass_color_and_charge (reg_data, model)
class(region_data_t), intent(inout) :: reg_data
type(model_t), intent(in) :: model
end subroutine region_data_set_mass_color_and_charge
<<FKS regions: procedures>>=
module subroutine region_data_set_mass_color_and_charge (reg_data, model)
class(region_data_t), intent(inout) :: reg_data
type(model_t), intent(in) :: model
integer :: i
do i = 1, reg_data%n_regions
associate (region => reg_data%regions(i))
call region%flst_uborn%init_mass_color_and_charge (model)
call region%flst_real%init_mass_color_and_charge (model)
end associate
end do
do i = 1, reg_data%n_flv_born
call reg_data%flv_born(i)%init_mass_color_and_charge (model)
end do
do i = 1, size (reg_data%flv_real)
call reg_data%flv_real(i)%init_mass_color_and_charge (model)
end do
end subroutine region_data_set_mass_color_and_charge
@ %def region_data_set_mass_color_and_charge
@
<<FKS regions: reg data: TBP>>=
procedure :: uses_resonances => region_data_uses_resonances
<<FKS regions: sub interfaces>>=
module function region_data_uses_resonances (reg_data) result (val)
logical :: val
class(region_data_t), intent(in) :: reg_data
end function region_data_uses_resonances
<<FKS regions: procedures>>=
module function region_data_uses_resonances (reg_data) result (val)
logical :: val
class(region_data_t), intent(in) :: reg_data
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
val = .true.
class default
val = .false.
end select
end function region_data_uses_resonances
@ %def region_data_uses_resonances
@ Creates a list containing the emitter of each singular region.
<<FKS regions: reg data: TBP>>=
procedure :: get_emitter_list => region_data_get_emitter_list
<<FKS regions: sub interfaces>>=
pure module function region_data_get_emitter_list &
(reg_data) result (emitters)
class(region_data_t), intent(in) :: reg_data
integer, dimension(:), allocatable :: emitters
end function region_data_get_emitter_list
<<FKS regions: procedures>>=
pure module function region_data_get_emitter_list (reg_data) result (emitters)
class(region_data_t), intent(in) :: reg_data
integer, dimension(:), allocatable :: emitters
integer :: i
allocate (emitters (reg_data%n_regions))
do i = 1, reg_data%n_regions
emitters(i) = reg_data%regions(i)%emitter
end do
end function region_data_get_emitter_list
@ %def region_data_get_emitter_list
@ Returns the number of emitters not equal to 0 to avoid double counting
between emitters 0, 1 and 2.
<<FKS regions: reg data: TBP>>=
procedure :: get_n_emitters_sc => region_data_get_n_emitters_sc
<<FKS regions: sub interfaces>>=
module function region_data_get_n_emitters_sc &
(reg_data) result (n_emitters_sc)
class(region_data_t), intent(in) :: reg_data
integer :: n_emitters_sc
end function region_data_get_n_emitters_sc
<<FKS regions: procedures>>=
module function region_data_get_n_emitters_sc &
(reg_data) result (n_emitters_sc)
class(region_data_t), intent(in) :: reg_data
integer :: n_emitters_sc
n_emitters_sc = count (reg_data%emitters /= 0)
end function region_data_get_n_emitters_sc
@ %def region_data_get_n_emitters_sc
@
<<FKS regions: reg data: TBP>>=
procedure :: get_associated_resonances => &
region_data_get_associated_resonances
<<FKS regions: sub interfaces>>=
module function region_data_get_associated_resonances &
(reg_data, emitter) result (res)
integer, dimension(:), allocatable :: res
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: emitter
end function region_data_get_associated_resonances
<<FKS regions: procedures>>=
module function region_data_get_associated_resonances &
(reg_data, emitter) result (res)
integer, dimension(:), allocatable :: res
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: emitter
integer :: alr, i
integer :: n_res
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
n_res = 0
do alr = 1, reg_data%n_regions
if (reg_data%regions(alr)%emitter == emitter) &
n_res = n_res + 1
end do
if (n_res > 0) then
allocate (res (n_res))
else
return
end if
i = 1
do alr = 1, reg_data%n_regions
if (reg_data%regions(alr)%emitter == emitter) then
res (i) = fks_mapping%res_map%alr_to_i_res (alr)
i = i + 1
end if
end do
end select
end function region_data_get_associated_resonances
@ %def region_data_get_associated_resonances
@
<<FKS regions: reg data: TBP>>=
procedure :: emitter_is_compatible_with_resonance => &
region_data_emitter_is_compatible_with_resonance
<<FKS regions: sub interfaces>>=
module function region_data_emitter_is_compatible_with_resonance &
(reg_data, i_res, emitter) result (compatible)
logical :: compatible
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_res, emitter
end function region_data_emitter_is_compatible_with_resonance
<<FKS regions: procedures>>=
module function region_data_emitter_is_compatible_with_resonance &
(reg_data, i_res, emitter) result (compatible)
logical :: compatible
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_res, emitter
integer :: i_res_alr, alr
compatible = .false.
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
do alr = 1, reg_data%n_regions
i_res_alr = fks_mapping%res_map%alr_to_i_res (alr)
if (i_res_alr == i_res .and. reg_data%get_emitter(alr) == emitter) then
compatible = .true.
exit
end if
end do
end select
end function region_data_emitter_is_compatible_with_resonance
@ %def region_data_emitter_is_compatible_with_resonance
@
<<FKS regions: reg data: TBP>>=
procedure :: emitter_is_in_resonance => region_data_emitter_is_in_resonance
<<FKS regions: sub interfaces>>=
module function region_data_emitter_is_in_resonance &
(reg_data, i_res, emitter) result (exist)
logical :: exist
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_res, emitter
end function region_data_emitter_is_in_resonance
<<FKS regions: procedures>>=
module function region_data_emitter_is_in_resonance &
(reg_data, i_res, emitter) result (exist)
logical :: exist
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_res, emitter
integer :: i
exist = .false.
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
associate (res_history => fks_mapping%res_map%res_histories(i_res))
do i = 1, res_history%n_resonances
exist = exist .or. &
any (res_history%resonances(i)%contributors%c == emitter)
end do
end associate
end select
end function region_data_emitter_is_in_resonance
@ %def region_data_emitter_is_in_resonance
@
<<FKS regions: reg data: TBP>>=
procedure :: get_contributors => region_data_get_contributors
<<FKS regions: sub interfaces>>=
module subroutine region_data_get_contributors &
(reg_data, i_res, emitter, c, success)
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_res, emitter
integer, intent(inout), dimension(:), allocatable :: c
logical, intent(out) :: success
end subroutine region_data_get_contributors
<<FKS regions: procedures>>=
module subroutine region_data_get_contributors &
(reg_data, i_res, emitter, c, success)
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_res, emitter
integer, intent(inout), dimension(:), allocatable :: c
logical, intent(out) :: success
integer :: i
success = .false.
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
associate (res_history => fks_mapping%res_map%res_histories (i_res))
do i = 1, res_history%n_resonances
if (any (res_history%resonances(i)%contributors%c == emitter)) then
allocate (c (size (res_history%resonances(i)%contributors%c)))
c = res_history%resonances(i)%contributors%c
success = .true.
exit
end if
end do
end associate
end select
end subroutine region_data_get_contributors
@ %def region_data_get_contributors
@
<<FKS regions: reg data: TBP>>=
procedure :: get_emitter => region_data_get_emitter
<<FKS regions: sub interfaces>>=
pure module function region_data_get_emitter &
(reg_data, alr) result (emitter)
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: alr
integer :: emitter
end function region_data_get_emitter
<<FKS regions: procedures>>=
pure module function region_data_get_emitter (reg_data, alr) result (emitter)
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: alr
integer :: emitter
emitter = reg_data%regions(alr)%emitter
end function region_data_get_emitter
@ %def region_data_get_emitter
@
<<FKS regions: reg data: TBP>>=
procedure :: map_real_to_born_index => region_data_map_real_to_born_index
<<FKS regions: sub interfaces>>=
module function region_data_map_real_to_born_index &
(reg_data, real_index) result (uborn_index)
integer :: uborn_index
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: real_index
end function region_data_map_real_to_born_index
<<FKS regions: procedures>>=
module function region_data_map_real_to_born_index &
(reg_data, real_index) result (uborn_index)
integer :: uborn_index
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: real_index
integer :: alr
uborn_index = 0
do alr = 1, size (reg_data%regions)
if (reg_data%regions(alr)%real_index == real_index) then
uborn_index = reg_data%regions(alr)%uborn_index
exit
end if
end do
end function region_data_map_real_to_born_index
@ %def region_data_map_real_to_born_index
@
<<FKS regions: reg data: TBP>>=
generic :: get_flv_states_born => get_flv_states_born_single, &
get_flv_states_born_array
procedure :: get_flv_states_born_single => &
region_data_get_flv_states_born_single
procedure :: get_flv_states_born_array => &
region_data_get_flv_states_born_array
<<FKS regions: sub interfaces>>=
module function region_data_get_flv_states_born_array &
(reg_data) result (flv_states)
integer, dimension(:,:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
end function region_data_get_flv_states_born_array
module function region_data_get_flv_states_born_single &
(reg_data, i_flv) result (flv_states)
integer, dimension(:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_flv
end function region_data_get_flv_states_born_single
<<FKS regions: procedures>>=
module function region_data_get_flv_states_born_array &
(reg_data) result (flv_states)
integer, dimension(:,:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
integer :: i_flv
allocate (flv_states (reg_data%n_legs_born, reg_data%n_flv_born))
do i_flv = 1, reg_data%n_flv_born
flv_states (:, i_flv) = reg_data%flv_born(i_flv)%flst
end do
end function region_data_get_flv_states_born_array
module function region_data_get_flv_states_born_single &
(reg_data, i_flv) result (flv_states)
integer, dimension(:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_flv
allocate (flv_states (reg_data%n_legs_born))
flv_states = reg_data%flv_born(i_flv)%flst
end function region_data_get_flv_states_born_single
@ %def region_data_get_flv_states_born
@
<<FKS regions: reg data: TBP>>=
generic :: get_flv_states_real => &
get_flv_states_real_single, get_flv_states_real_array
procedure :: get_flv_states_real_single => &
region_data_get_flv_states_real_single
procedure :: get_flv_states_real_array => &
region_data_get_flv_states_real_array
<<FKS regions: sub interfaces>>=
module function region_data_get_flv_states_real_single &
(reg_data, i_flv) result (flv_states)
integer, dimension(:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_flv
end function region_data_get_flv_states_real_single
module function region_data_get_flv_states_real_array &
(reg_data) result (flv_states)
integer, dimension(:,:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
end function region_data_get_flv_states_real_array
<<FKS regions: procedures>>=
module function region_data_get_flv_states_real_single &
(reg_data, i_flv) result (flv_states)
integer, dimension(:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_flv
integer :: i_reg
allocate (flv_states (reg_data%n_legs_real))
do i_reg = 1, reg_data%n_regions
if (i_flv == reg_data%regions(i_reg)%real_index) then
flv_states = reg_data%regions(i_reg)%flst_real%flst
exit
end if
end do
end function region_data_get_flv_states_real_single
module function region_data_get_flv_states_real_array &
(reg_data) result (flv_states)
integer, dimension(:,:), allocatable :: flv_states
class(region_data_t), intent(in) :: reg_data
integer :: i_flv
allocate (flv_states (reg_data%n_legs_real, reg_data%n_flv_real))
do i_flv = 1, reg_data%n_flv_real
flv_states (:, i_flv) = reg_data%get_flv_states_real (i_flv)
end do
end function region_data_get_flv_states_real_array
@ %def region_data_get_flv_states_real
@
<<FKS regions: reg data: TBP>>=
procedure :: get_all_flv_states => region_data_get_all_flv_states
<<FKS regions: sub interfaces>>=
module subroutine region_data_get_all_flv_states &
(reg_data, flv_born, flv_real)
class(region_data_t), intent(in) :: reg_data
integer, dimension(:,:), allocatable, intent(out) :: flv_born, flv_real
end subroutine region_data_get_all_flv_states
<<FKS regions: procedures>>=
module subroutine region_data_get_all_flv_states &
(reg_data, flv_born, flv_real)
class(region_data_t), intent(in) :: reg_data
integer, dimension(:,:), allocatable, intent(out) :: flv_born, flv_real
allocate (flv_born (reg_data%n_legs_born, reg_data%n_flv_born))
flv_born = reg_data%get_flv_states_born ()
allocate (flv_real (reg_data%n_legs_real, reg_data%n_flv_real))
flv_real = reg_data%get_flv_states_real ()
end subroutine region_data_get_all_flv_states
@ %def region_data_get_all_flv_states
@
<<FKS regions: reg data: TBP>>=
procedure :: get_n_in => region_data_get_n_in
<<FKS regions: sub interfaces>>=
module function region_data_get_n_in (reg_data) result (n_in)
integer :: n_in
class(region_data_t), intent(in) :: reg_data
end function region_data_get_n_in
<<FKS regions: procedures>>=
module function region_data_get_n_in (reg_data) result (n_in)
integer :: n_in
class(region_data_t), intent(in) :: reg_data
n_in = reg_data%n_in
end function region_data_get_n_in
@ %def region_data_get_n_in
@
<<FKS regions: reg data: TBP>>=
procedure :: get_n_legs_real => region_data_get_n_legs_real
<<FKS regions: sub interfaces>>=
module function region_data_get_n_legs_real (reg_data) result (n_legs)
integer :: n_legs
class(region_data_t), intent(in) :: reg_data
end function region_data_get_n_legs_real
<<FKS regions: procedures>>=
module function region_data_get_n_legs_real (reg_data) result (n_legs)
integer :: n_legs
class(region_data_t), intent(in) :: reg_data
n_legs = reg_data%n_legs_real
end function region_data_get_n_legs_real
@ %def region_data_get_n_legs_real
<<FKS regions: reg data: TBP>>=
procedure :: get_n_legs_born => region_data_get_n_legs_born
<<FKS regions: sub interfaces>>=
module function region_data_get_n_legs_born (reg_data) result (n_legs)
integer :: n_legs
class(region_data_t), intent(in) :: reg_data
end function region_data_get_n_legs_born
<<FKS regions: procedures>>=
module function region_data_get_n_legs_born (reg_data) result (n_legs)
integer :: n_legs
class(region_data_t), intent(in) :: reg_data
n_legs = reg_data%n_legs_born
end function region_data_get_n_legs_born
@ %def region_data_get_n_legs_born
<<FKS regions: reg data: TBP>>=
procedure :: get_n_flv_real => region_data_get_n_flv_real
<<FKS regions: sub interfaces>>=
module function region_data_get_n_flv_real (reg_data) result (n_flv)
integer :: n_flv
class(region_data_t), intent(in) :: reg_data
end function region_data_get_n_flv_real
<<FKS regions: procedures>>=
module function region_data_get_n_flv_real (reg_data) result (n_flv)
integer :: n_flv
class(region_data_t), intent(in) :: reg_data
n_flv = reg_data%n_flv_real
end function region_data_get_n_flv_real
@ %def region_data_get_n_flv_real
<<FKS regions: reg data: TBP>>=
procedure :: get_n_flv_born => region_data_get_n_flv_born
<<FKS regions: sub interfaces>>=
module function region_data_get_n_flv_born (reg_data) result (n_flv)
integer :: n_flv
class(region_data_t), intent(in) :: reg_data
end function region_data_get_n_flv_born
<<FKS regions: procedures>>=
module function region_data_get_n_flv_born (reg_data) result (n_flv)
integer :: n_flv
class(region_data_t), intent(in) :: reg_data
n_flv = reg_data%n_flv_born
end function region_data_get_n_flv_born
@ %def region_data_get_n_flv_born
@ Returns $S_i = \frac{1}{\mathcal{D}d_i}$ or $S_{ij} =
\frac{1}{\mathcal{D}d_{ij}}$ for one particular singular region. At
this point, the flavor array should be rearranged in such a way that
the emitted particle is at the last position of
the flavor structure list.
<<FKS regions: reg data: TBP>>=
generic :: get_svalue => get_svalue_last_pos, get_svalue_ij
procedure :: get_svalue_last_pos => region_data_get_svalue_last_pos
procedure :: get_svalue_ij => region_data_get_svalue_ij
<<FKS regions: sub interfaces>>=
module function region_data_get_svalue_ij &
(reg_data, p_real, alr, i, j, i_res) result (sval)
class(region_data_t), intent(inout) :: reg_data
type(vector4_t), intent(in), dimension(:) :: p_real
integer, intent(in) :: alr, i, j
integer, intent(in) :: i_res
real(default) :: sval
end function region_data_get_svalue_ij
module function region_data_get_svalue_last_pos &
(reg_data, p, alr, emitter, i_res) result (sval)
class(region_data_t), intent(inout) :: reg_data
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: alr, emitter
integer, intent(in) :: i_res
real(default) :: sval
end function region_data_get_svalue_last_pos
<<FKS regions: procedures>>=
module function region_data_get_svalue_ij &
(reg_data, p_real, alr, i, j, i_res) result (sval)
class(region_data_t), intent(inout) :: reg_data
type(vector4_t), intent(in), dimension(:) :: p_real
integer, intent(in) :: alr, i, j
integer, intent(in) :: i_res
real(default) :: sval
associate (map => reg_data%fks_mapping)
call map%compute_sumdij (reg_data%regions(alr), p_real)
select type (map)
type is (fks_mapping_resonances_t)
map%i_con = reg_data%alr_to_i_contributor (alr)
end select
map%pseudo_isr = reg_data%regions(alr)%pseudo_isr
sval = map%svalue (p_real, i, j, i_res) * map%normalization_factor
end associate
end function region_data_get_svalue_ij
module function region_data_get_svalue_last_pos &
(reg_data, p, alr, emitter, i_res) result (sval)
class(region_data_t), intent(inout) :: reg_data
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: alr, emitter
integer, intent(in) :: i_res
real(default) :: sval
sval = reg_data%get_svalue (p, alr, emitter, reg_data%n_legs_real, i_res)
end function region_data_get_svalue_last_pos
@ %def region_data_get_svalue
@ The same as above, but for the soft limit.
<<FKS regions: reg data: TBP>>=
procedure :: get_svalue_soft => region_data_get_svalue_soft
<<FKS regions: sub interfaces>>=
module function region_data_get_svalue_soft &
(reg_data, p_born, p_soft, alr, emitter, i_res) result (sval)
class(region_data_t), intent(inout) :: reg_data
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: alr, emitter, i_res
real(default) :: sval
end function region_data_get_svalue_soft
<<FKS regions: procedures>>=
module function region_data_get_svalue_soft &
(reg_data, p_born, p_soft, alr, emitter, i_res) result (sval)
class(region_data_t), intent(inout) :: reg_data
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: alr, emitter, i_res
real(default) :: sval
associate (map => reg_data%fks_mapping)
call map%compute_sumdij_soft (reg_data%regions(alr), p_born, p_soft)
select type (map)
type is (fks_mapping_resonances_t)
map%i_con = reg_data%alr_to_i_contributor (alr)
end select
map%pseudo_isr = reg_data%regions(alr)%pseudo_isr
sval = map%svalue_soft (p_born, p_soft, emitter, i_res) * &
map%normalization_factor
end associate
end function region_data_get_svalue_soft
@ %def region_data_get_svalue_soft
@ This subroutine starts with a specification of $N$- and
$N+1$-particle configurations, [[flst_born]] and [[flst_real]], saved
in [[reg_data]]. From these, it creates a list of fundamental tuples,
a list of emitters and a list containing the $N+1$-particle
configuration, rearranged in such a way that the emitter-radiation
pair is last ([[flst_alr]]). For the $e^+ \, e^- \, \rightarrow u \,
\bar{u} \, g$- example, the generated objects are shown in table
\ref{table:ftuples and flavors}. Note that at this point, [[flst_alr]]
is arranged in such a way that the emitter can only be equal to
$n_{legs}-1$ for final-state radiation or 0, 1, or 2 for initial-state
radiation. Further, it occurs that regions can be equivalent. For
example in table \ref{table:ftuples and flavors} the regions
corresponding to \texttt{alr} = 1 and \texttt{alr} = 3 as well as
\texttt{alr} = 2 and \texttt{alr} = 4 describe the same physics and
are therefore equivalent.
@
<<FKS regions: reg data: TBP>>=
procedure :: find_regions => region_data_find_regions
<<FKS regions: sub interfaces>>=
module subroutine region_data_find_regions &
(reg_data, model, ftuples, emitters, flst_alr)
class(region_data_t), intent(in) :: reg_data
type(model_t), intent(in) :: model
type(ftuple_list_t), intent(out), dimension(:), allocatable :: ftuples
integer, intent(out), dimension(:), allocatable :: emitters
type(flv_structure_t), intent(out), dimension(:), allocatable :: flst_alr
end subroutine region_data_find_regions
<<FKS regions: procedures>>=
module subroutine region_data_find_regions &
(reg_data, model, ftuples, emitters, flst_alr)
class(region_data_t), intent(in) :: reg_data
type(model_t), intent(in) :: model
type(ftuple_list_t), intent(out), dimension(:), allocatable :: ftuples
integer, intent(out), dimension(:), allocatable :: emitters
type(flv_structure_t), intent(out), dimension(:), allocatable :: flst_alr
type(ftuple_list_t), dimension(:,:), allocatable :: ftuples_tmp
integer, dimension(:,:), allocatable :: ftuple_index
integer :: n_born, n_real
integer :: n_legreal
integer :: i_born, i_real, i_ftuple
integer :: last_registered_i_born, last_registered_i_real
n_born = size (reg_data%flv_born)
n_real = size (reg_data%flv_real)
n_legreal = size (reg_data%flv_real(1)%flst)
allocate (emitters (0))
allocate (flst_alr (0))
allocate (ftuples (0))
i_ftuple = 0
last_registered_i_born = 0; last_registered_i_real = 0
do i_real = 1, n_real
do i_born = 1, n_born
call setup_flsts_emitters_and_ftuples_fsr &
(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
call setup_flsts_emitters_and_ftuples_isr &
(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
end do
end do
contains
function incr_i_ftuple_if_required (i_born, i_real, i_ftuple_in) result (i_ftuple)
integer :: i_ftuple
integer, intent(in) :: i_born, i_real, i_ftuple_in
if (last_registered_i_born /= i_born .or. last_registered_i_real /= i_real) then
last_registered_i_born = i_born
last_registered_i_real = i_real
i_ftuple = i_ftuple_in + 1
else
i_ftuple = i_ftuple_in
end if
end function incr_i_ftuple_if_required
subroutine setup_flsts_emitters_and_ftuples_fsr &
(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
integer, intent(in) :: i_real, i_born
integer, intent(inout) :: i_ftuple
type(flv_structure_t), intent(inout), dimension(:), allocatable :: flst_alr
integer, intent(inout), dimension(:), allocatable :: emitters
type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
type(ftuple_list_t) :: ftuples_tmp
type(flv_structure_t) :: flst_alr_tmp
type(ftuple_t) :: current_ftuple
integer :: leg1, leg2
logical :: valid
associate (flv_born => reg_data%flv_born(i_born), &
flv_real => reg_data%flv_real(i_real))
do leg1 = reg_data%n_in + 1, n_legreal
do leg2 = leg1 + 1, n_legreal
valid = flv_real%valid_pair(leg1, leg2, flv_born, model)
if (valid) then
if (is_vector(flv_real%flst(leg1)) .and. &
is_fermion(flv_real%flst(leg2))) then
flst_alr_tmp = create_alr (flv_real, &
reg_data%n_in, leg2, leg1)
else
flst_alr_tmp = create_alr (flv_real, &
reg_data%n_in, leg1, leg2)
end if
flst_alr = [flst_alr, flst_alr_tmp]
emitters = [emitters, n_legreal - 1]
call current_ftuple%set (leg1, leg2)
call current_ftuple%determine_splitting_type_fsr &
(flv_real, leg1, leg2)
call current_ftuple%determine_sub_correction_type &
(flv_born, flv_real, leg1, leg2)
i_ftuple = incr_i_ftuple_if_required (i_born, i_real, i_ftuple)
if (i_ftuple > size (ftuples)) then
call ftuples_tmp%append (current_ftuple)
ftuples = [ftuples, ftuples_tmp]
else
call ftuples(i_ftuple)%append (current_ftuple)
end if
end if
end do
end do
end associate
end subroutine setup_flsts_emitters_and_ftuples_fsr
subroutine setup_flsts_emitters_and_ftuples_isr &
(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
integer, intent(in) :: i_real, i_born
integer, intent(inout) :: i_ftuple
type(flv_structure_t), intent(inout), dimension(:), allocatable :: flst_alr
integer, intent(inout), dimension(:), allocatable :: emitters
type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
type(ftuple_list_t) :: ftuples_tmp
type(flv_structure_t) :: flst_alr_tmp
type(ftuple_t) :: current_ftuple
integer :: leg, emitter
logical :: valid1, valid2
associate (flv_born => reg_data%flv_born(i_born), &
flv_real => reg_data%flv_real(i_real))
do leg = reg_data%n_in + 1, n_legreal
valid1 = flv_real%valid_pair(1, leg, flv_born, model)
if (reg_data%n_in > 1) then
valid2 = flv_real%valid_pair(2, leg, flv_born, model)
else
valid2 = .false.
end if
if (valid1 .and. valid2) then
emitter = 0
else if (valid1 .and. .not. valid2) then
emitter = 1
else if (.not. valid1 .and. valid2) then
emitter = 2
else
emitter = -1
end if
if (valid1 .or. valid2) then
flst_alr_tmp = create_alr (flv_real, reg_data%n_in, emitter, leg)
flst_alr = [flst_alr, flst_alr_tmp]
emitters = [emitters, emitter]
call current_ftuple%set(emitter, leg)
call current_ftuple%determine_splitting_type_isr &
(flv_real, emitter, leg)
call current_ftuple%determine_sub_correction_type &
(flv_born, flv_real, emitter, leg)
i_ftuple = incr_i_ftuple_if_required (i_born, i_real, i_ftuple)
if (i_ftuple > size (ftuples)) then
call ftuples_tmp%append (current_ftuple)
ftuples = [ftuples, ftuples_tmp]
else
call ftuples(i_ftuple)%append (current_ftuple)
end if
end if
end do
end associate
end subroutine setup_flsts_emitters_and_ftuples_isr
end subroutine region_data_find_regions
@ %def region_data_find_regions
@ We transfer the mapping of flavor structures that lead to the same amplitude
(with structure functions already accounted for!) to the Born and real
[[flv_structure]] of each [[singular_region]].
We then use this information, besides other data of each [[singular_region]],
to determine which produce the same amplitude for the non-subtracted real
and real subtraction terms and set up the equivalence index mapping for
each region.
<<FKS regions: reg data: TBP>>=
procedure :: find_eqv_regions => region_data_find_eqv_regions
<<FKS regions: sub interfaces>>=
module subroutine region_data_find_eqv_regions (reg_data, optimize)
class(region_data_t), intent(inout) :: reg_data
logical, intent(in) :: optimize
end subroutine region_data_find_eqv_regions
<<FKS regions: procedures>>=
module subroutine region_data_find_eqv_regions (reg_data, optimize)
class(region_data_t), intent(inout) :: reg_data
logical, intent(in) :: optimize
integer :: n_reg, alr1, alr2
n_reg = reg_data%n_regions
if (optimize) then
do alr1 = 1, n_reg
reg_data%regions(alr1)%flst_uborn%eqv_index = &
reg_data%eqv_flv_index_born(reg_data%regions(alr1)%uborn_index)
reg_data%regions(alr1)%flst_real%eqv_index = &
reg_data%eqv_flv_index_real(reg_data%regions(alr1)%real_index)
end do
do alr1 = 1, n_reg
do alr2 = 1, alr1
if (reg_data%regions(alr2) .match. reg_data%regions(alr1)) then
reg_data%regions(alr1)%eqv_index = alr2
exit
end if
end do
end do
else
do alr1 = 1, n_reg
reg_data%regions(alr1)%eqv_index = alr1
end do
end if
end subroutine region_data_find_eqv_regions
@ %def region_data_find_eqv_regions
@ Creates singular regions according to table \ref{table:singular
regions}. It scans all regions in table \ref{table:ftuples and
flavors} and records the real flavor structures. If they are
equivalent, the flavor structure is not recorded, but the multiplicity
of the present one is increased.
<<FKS regions: reg data: TBP>>=
procedure :: init_singular_regions => region_data_init_singular_regions
<<FKS regions: sub interfaces>>=
module subroutine region_data_init_singular_regions &
(reg_data, ftuples, emitter, flv_alr, nlo_correction_type)
class(region_data_t), intent(inout) :: reg_data
type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
type(string_t), intent(in) :: nlo_correction_type
integer, intent(in), dimension(:) :: emitter
type(flv_structure_t), intent(in), dimension(:) :: flv_alr
end subroutine region_data_init_singular_regions
<<FKS regions: procedures>>=
module subroutine region_data_init_singular_regions &
(reg_data, ftuples, emitter, flv_alr, nlo_correction_type)
class(region_data_t), intent(inout) :: reg_data
type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
type(string_t), intent(in) :: nlo_correction_type
type(string_t), dimension(:), allocatable :: nlo_correction_type_dyn
integer, intent(in), dimension(:) :: emitter
integer :: n_independent_flv
type(flv_structure_t), intent(in), dimension(:) :: flv_alr
type(flv_structure_t), dimension(:), allocatable :: flv_uborn, &
flv_alr_registered
integer, dimension(:), allocatable :: mult
integer, dimension(:), allocatable :: flst_emitter
integer :: n_regions, maxregions
integer, dimension(:), allocatable :: index
integer :: i, i_flv, n_legs
logical :: equiv, valid_fs_splitting, pure_corr_type, &
corr_type_valid, non_singular_reg
integer :: i_first, i_reg, i_reg_prev
integer, dimension(:), allocatable :: region_to_ftuple, alr_limits
integer, dimension(:), allocatable :: equiv_index
maxregions = size (emitter)
n_legs = flv_alr(1)%nlegs
allocate (flv_uborn (maxregions))
allocate (flv_alr_registered (maxregions))
allocate (mult (maxregions))
mult = 0
allocate (flst_emitter (maxregions))
allocate (index (0))
allocate (region_to_ftuple (maxregions))
allocate (equiv_index (maxregions))
allocate (nlo_correction_type_dyn (maxregions))
call setup_region_mappings (n_independent_flv, alr_limits, region_to_ftuple)
nlo_correction_type_dyn = nlo_correction_type
i_first = 1
i_reg = 1
SCAN_FLAVORS: do i_flv = 1, n_independent_flv
SCAN_FTUPLES: do i = i_first, i_first + alr_limits (i_flv) - 1
equiv = .false.
corr_type_valid = .true.
non_singular_reg = .false.
if (i == i_first) then
flv_alr_registered(i_reg) = flv_alr(i)
if (nlo_correction_type == "EW" .and. &
reg_data%alphas_power > 0) then
nlo_correction_type_dyn (i_reg) = &
set_dynamic_correction_type (i)
end if
flv_uborn(i_reg) = flv_alr(i)%create_uborn (emitter(i), &
nlo_correction_type_dyn (i_reg))
flst_emitter(i_reg) = emitter(i)
equiv_index(i_reg) = region_to_ftuple(i)
if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
corr_type_valid = (nlo_correction_type_dyn (i_reg) == "EW" .and. &
query_coupling_powers (flv_uborn(i_reg)%flst, &
reg_data%alpha_power, reg_data%alphas_power)) &
.or. (nlo_correction_type_dyn (i_reg) == "QCD" .and. &
query_coupling_powers (flv_uborn(i_reg)%flst, &
reg_data%alpha_power + 1, reg_data%alphas_power - 1))
non_singular_reg = .not. corr_type_valid .and. &
qcd_ew_interferences (flv_alr_registered(i_reg)%flst) &
.and. query_coupling_powers (flv_alr_registered(i_reg)%flst, &
reg_data%alpha_power+2, reg_data%alphas_power-1) &
.and. .not. qcd_ew_interferences (flv_uborn(i_reg)%flst) &
.and. nlo_correction_type_dyn (i_reg) == "QCD"
if (non_singular_reg) nlo_correction_type_dyn (i_reg) = "none"
end if
if (corr_type_valid .or. non_singular_reg) then
mult(i_reg) = mult(i_reg) + 1
index = [index, region_to_real_index(ftuples, i)]
i_reg = i_reg + 1
end if
else
!!! Check for equivalent flavor structures
do i_reg_prev = 1, i_reg - 1
if (emitter(i) == flst_emitter(i_reg_prev) .and. emitter(i) > reg_data%n_in) then
valid_fs_splitting = check_fs_splitting &
(flv_alr(i)%get_last_two(n_legs), &
flv_alr_registered(i_reg_prev)%get_last_two(n_legs), &
flv_alr(i)%tag(n_legs - 1), &
flv_alr_registered(i_reg_prev)%tag(n_legs - 1))
if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
nlo_correction_type_dyn (i_reg) = set_dynamic_correction_type (i)
end if
pure_corr_type = nlo_correction_type_dyn (i_reg) &
== nlo_correction_type_dyn (i_reg_prev)
if ((flv_alr(i) .equiv. flv_alr_registered(i_reg_prev)) &
.and. valid_fs_splitting .and. pure_corr_type) then
mult(i_reg_prev) = mult(i_reg_prev) + 1
equiv = .true.
call ftuples(region_to_real_index(ftuples, i))%set_equiv &
(equiv_index(i_reg_prev), region_to_ftuple(i))
exit
end if
else if (emitter(i) == flst_emitter(i_reg_prev) .and. emitter(i) <= reg_data%n_in) then
if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
nlo_correction_type_dyn (i_reg) = set_dynamic_correction_type (i)
end if
pure_corr_type = nlo_correction_type_dyn (i_reg) &
== nlo_correction_type_dyn (i_reg_prev)
if ((flv_alr(i) .equiv. flv_alr_registered(i_reg_prev)) &
.and. pure_corr_type) then
mult(i_reg_prev) = mult(i_reg_prev) + 1
equiv = .true.
call ftuples(region_to_real_index(ftuples, i))%set_equiv &
(equiv_index(i_reg_prev), region_to_ftuple(i))
exit
end if
end if
end do
if (.not. equiv) then
flv_alr_registered(i_reg) = flv_alr(i)
if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
nlo_correction_type_dyn (i_reg) = set_dynamic_correction_type (i)
end if
flv_uborn(i_reg) = flv_alr(i)%create_uborn (emitter(i), &
nlo_correction_type_dyn (i_reg))
flst_emitter(i_reg) = emitter(i)
equiv_index (i_reg) = region_to_ftuple(i)
if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
corr_type_valid = (nlo_correction_type_dyn (i_reg) == "EW" .and. &
query_coupling_powers (flv_uborn(i_reg)%flst, &
reg_data%alpha_power, reg_data%alphas_power)) &
.or. (nlo_correction_type_dyn (i_reg) == "QCD" .and. &
query_coupling_powers (flv_uborn(i_reg)%flst, &
reg_data%alpha_power + 1, reg_data%alphas_power - 1))
non_singular_reg = .not. corr_type_valid .and. &
qcd_ew_interferences (flv_alr_registered(i_reg)%flst) &
.and. query_coupling_powers (flv_alr_registered(i_reg)%flst, &
reg_data%alpha_power+2, reg_data%alphas_power-1) &
.and. .not. qcd_ew_interferences (flv_uborn(i_reg)%flst) &
.and. nlo_correction_type_dyn (i_reg) == "QCD"
if (non_singular_reg) nlo_correction_type_dyn (i_reg) = "none"
end if
if (corr_type_valid .or. non_singular_reg) then
mult(i_reg) = mult(i_reg) + 1
index = [index, region_to_real_index(ftuples, i)]
i_reg = i_reg + 1
end if
end if
end if
end do SCAN_FTUPLES
i_first = i_first + alr_limits(i_flv)
end do SCAN_FLAVORS
n_regions = i_reg - 1
allocate (reg_data%regions (n_regions))
reg_data%n_regions = n_regions
call account_for_regions_from_other_uborns (ftuples)
call init_regions_with_permuted_flavors ()
call assign_real_indices ()
deallocate (flv_uborn)
deallocate (flv_alr_registered)
deallocate (mult)
deallocate (flst_emitter)
deallocate (index)
deallocate (region_to_ftuple)
deallocate (equiv_index)
contains
subroutine account_for_regions_from_other_uborns (ftuples)
type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
integer :: alr1, alr2, i
type(ftuple_t), dimension(:), allocatable :: ftuples_alr1, ftuples_alr2
logical, dimension(:,:), allocatable :: equivalences
do alr1 = 1, n_regions
do alr2 = 1, n_regions
if (index(alr1) == index(alr2)) cycle
if (flv_alr_registered(alr1) .equiv. flv_alr_registered(alr2)) then
call ftuples(index(alr1))%to_array (ftuples_alr1, equivalences, .false.)
call ftuples(index(alr2))%to_array (ftuples_alr2, equivalences, .false.)
do i = 1, size (ftuples_alr2)
if (.not. any (ftuple_equal_ireg (ftuples_alr1, ftuples_alr2(i)))) then
call ftuples(index(alr1))%append (ftuples_alr2(i))
end if
end do
end if
end do
end do
end subroutine account_for_regions_from_other_uborns
subroutine setup_region_mappings (n_independent_flv, &
alr_limits, region_to_ftuple)
integer, intent(inout) :: n_independent_flv
integer, intent(inout), dimension(:), allocatable :: alr_limits
integer, intent(inout), dimension(:), allocatable :: region_to_ftuple
integer :: i, j, i_flv
if (any (ftuples%get_n_tuples() == 0)) &
call msg_fatal ("Inconsistent collection of FKS pairs!")
n_independent_flv = size (ftuples)
alr_limits = ftuples%get_n_tuples()
if (.not. (sum (alr_limits) == maxregions)) &
call msg_fatal ("Too many regions!")
j = 1
do i_flv = 1, n_independent_flv
do i = 1, alr_limits(i_flv)
region_to_ftuple(j) = i
j = j + 1
end do
end do
end subroutine setup_region_mappings
subroutine check_permutation (perm, flv_perm, flv_orig, i_reg)
type(flv_perm_t), intent(in) :: perm
type(flv_structure_t), intent(in) :: flv_perm, flv_orig
integer, intent(in) :: i_reg
type(flv_structure_t) :: flv_tmp
flv_tmp = perm%apply (flv_orig, invert = .true.)
if (.not. all (flv_tmp%flst == flv_perm%flst)) then
print *, 'Fail at: ', i_reg
print *, 'Original flavor structure: ', flv_orig%flst
call perm%write ()
print *, 'Permuted flavor: ', flv_perm%flst
print *, 'Should be: ', flv_tmp%flst
call msg_fatal ("Permutation does not reproduce original flavor!")
end if
end subroutine check_permutation
subroutine init_regions_with_permuted_flavors ()
type(flv_perm_t) :: perm_list
type(ftuple_t), dimension(:), allocatable :: ftuple_array
logical, dimension(:,:), allocatable :: equivalences
integer :: i, j
do j = 1, n_regions
do i = 1, reg_data%n_flv_born
if (reg_data%flv_born (i) .equiv. flv_uborn (j)) then
call perm_list%reset ()
call perm_list%init (reg_data%flv_born(i), flv_uborn(j), &
reg_data%n_in, reg_data%n_legs_born, .true.)
flv_uborn(j) = perm_list%apply (flv_uborn(j))
flv_alr_registered(j) = perm_list%apply (flv_alr_registered(j))
flst_emitter(j) = perm_list%apply (flst_emitter(j))
end if
end do
call ftuples(index(j))%to_array (ftuple_array, equivalences, .false.)
do i = 1, size (reg_data%flv_real)
if (reg_data%flv_real(i) .equiv. flv_alr_registered(j)) then
call perm_list%reset ()
call perm_list%init (flv_alr_registered(j), reg_data%flv_real(i), &
reg_data%n_in, reg_data%n_legs_real, .false.)
if (debug_active (D_SUBTRACTION)) call check_permutation &
(perm_list, reg_data%flv_real(i), flv_alr_registered(j), j)
ftuple_array = perm_list%apply (ftuple_array)
call ftuple_sort_array (ftuple_array, equivalences)
end if
end do
call reg_data%regions(j)%init (j, mult(j), 0, flv_alr_registered(j), &
flv_uborn(j), reg_data%flv_born, flst_emitter(j), ftuple_array, &
equivalences, nlo_correction_type_dyn (j))
if (allocated (ftuple_array)) deallocate (ftuple_array)
if (allocated (equivalences)) deallocate (equivalences)
end do
end subroutine init_regions_with_permuted_flavors
subroutine assign_real_indices ()
type(flv_structure_t) :: current_flv_real
type(flv_structure_t), dimension(:), allocatable :: these_flv
integer :: i_real, current_uborn_index
integer :: i, j, this_i_real
allocate (these_flv (size (flv_alr_registered)))
i_real = 1
associate (regions => reg_data%regions)
do i = 1, reg_data%n_regions
do j = 1, size (these_flv)
if (.not. allocated (these_flv(j)%flst)) then
this_i_real = i_real
call these_flv(i_real)%init (flv_alr_registered(i)%flst, reg_data%n_in)
i_real = i_real + 1
exit
else if (all (these_flv(j)%flst == flv_alr_registered(i)%flst)) then
this_i_real = j
exit
end if
end do
regions(i)%real_index = this_i_real
end do
end associate
deallocate (these_flv)
end subroutine assign_real_indices
function check_fs_splitting (flv1, flv2, tag1, tag2) result (valid)
logical :: valid
integer, intent(in), dimension(2) :: flv1, flv2
integer, intent(in) :: tag1, tag2
if (flv1(1) + flv1(2) == 0) then
valid = abs(flv1(1)) == abs(flv2(1)) .and. abs(flv1(2)) == abs(flv2(2))
else
valid = flv1(1) == flv2(1) .and. flv1(2) == flv2(2) .and. tag1 == tag2
end if
end function check_fs_splitting
function set_dynamic_correction_type (i_flv_alr) result (nlo_corr_type_dyn)
type(string_t) :: nlo_corr_type_dyn
type(ftuple_t) :: ftuple_tmp
integer, intent(in) :: i_flv_alr
ftuple_tmp = ftuples (region_to_real_index(ftuples, i_flv_alr))%get_ftuple &
(region_to_ftuple(i_flv_alr))
if (ftuple_tmp%qcd_split) then
nlo_corr_type_dyn = var_str ("QCD")
else
nlo_corr_type_dyn = var_str ("EW")
end if
end function set_dynamic_correction_type
end subroutine region_data_init_singular_regions
@ %def region_data_init_singular_regions
@ Create an array containing all emitters and resonances of [[region_data]].
<<FKS regions: reg data: TBP>>=
procedure :: find_emitters => region_data_find_emitters
<<FKS regions: sub interfaces>>=
module subroutine region_data_find_emitters (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_find_emitters
<<FKS regions: procedures>>=
module subroutine region_data_find_emitters (reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr, j, n_em, em
integer, dimension(:), allocatable :: em_count
allocate (em_count(reg_data%n_regions))
em_count = -1
n_em = 0
!!!Count the number of different emitters
do alr = 1, reg_data%n_regions
em = reg_data%regions(alr)%emitter
if (.not. any (em_count == em)) then
n_em = n_em + 1
em_count(alr) = em
end if
end do
if (n_em < 1) call msg_fatal ("region_data_find_emitters: No emitters found!")
reg_data%n_emitters = n_em
allocate (reg_data%emitters (reg_data%n_emitters))
reg_data%emitters = -1
j = 1
do alr = 1, size (reg_data%regions)
em = reg_data%regions(alr)%emitter
if (.not. any (reg_data%emitters == em)) then
reg_data%emitters(j) = em
j = j + 1
end if
end do
end subroutine region_data_find_emitters
@ %def region_data_find_emitters
@
<<FKS regions: reg data: TBP>>=
procedure :: find_resonances => region_data_find_resonances
<<FKS regions: sub interfaces>>=
module subroutine region_data_find_resonances (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_find_resonances
<<FKS regions: procedures>>=
module subroutine region_data_find_resonances (reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr, j, k, n_res, n_contr
integer :: res
integer, dimension(10) :: res_count
type(resonance_contributors_t), dimension(10) :: contributors_count
type(resonance_contributors_t) :: contributors
integer :: i_res, emitter
logical :: share_emitter
res_count = -1
n_res = 0; n_contr = 0
!!! Count the number of different resonances
do alr = 1, reg_data%n_regions
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
res = fks_mapping%res_map%alr_to_i_res (alr)
if (.not. any (res_count == res)) then
n_res = n_res + 1
res_count(alr) = res
end if
end select
end do
if (n_res > 0) allocate (reg_data%resonances (n_res))
j = 1
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
do alr = 1, size (reg_data%regions)
res = fks_mapping%res_map%alr_to_i_res (alr)
if (.not. any (reg_data%resonances == res)) then
reg_data%resonances(j) = res
j = j + 1
end if
end do
allocate (reg_data%alr_to_i_contributor (size (reg_data%regions)))
do alr = 1, size (reg_data%regions)
i_res = fks_mapping%res_map%alr_to_i_res (alr)
emitter = reg_data%regions(alr)%emitter
call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter)
if (.not. share_emitter) cycle
if (.not. any (contributors_count == contributors)) then
n_contr = n_contr + 1
contributors_count(alr) = contributors
end if
if (allocated (contributors%c)) deallocate (contributors%c)
end do
allocate (reg_data%alr_contributors (n_contr))
j = 1
do alr = 1, size (reg_data%regions)
i_res = fks_mapping%res_map%alr_to_i_res (alr)
emitter = reg_data%regions(alr)%emitter
call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter)
if (.not. share_emitter) cycle
if (.not. any (reg_data%alr_contributors == contributors)) then
reg_data%alr_contributors(j) = contributors
reg_data%alr_to_i_contributor (alr) = j
j = j + 1
else
do k = 1, size (reg_data%alr_contributors)
if (reg_data%alr_contributors(k) == contributors) exit
end do
reg_data%alr_to_i_contributor (alr) = k
end if
if (allocated (contributors%c)) deallocate (contributors%c)
end do
end select
call reg_data%extend_ftuples (n_res)
call reg_data%set_contributors ()
end subroutine region_data_find_resonances
@ %def region_data_find_resonances
@
<<FKS regions: reg data: TBP>>=
procedure :: set_i_phs_to_i_con => region_data_set_i_phs_to_i_con
<<FKS regions: sub interfaces>>=
module subroutine region_data_set_i_phs_to_i_con (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_set_i_phs_to_i_con
<<FKS regions: procedures>>=
module subroutine region_data_set_i_phs_to_i_con (reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr
integer :: i_res, emitter, i_con, i_phs, i_em
type(phs_identifier_t), dimension(:), allocatable :: phs_id_tmp
logical :: share_emitter, phs_exist
type(resonance_contributors_t) :: contributors
allocate (phs_id_tmp (reg_data%n_phs))
if (allocated (reg_data%resonances)) then
allocate (reg_data%i_phs_to_i_con (reg_data%n_phs))
do i_em = 1, size (reg_data%emitters)
emitter = reg_data%emitters(i_em)
do i_res = 1, size (reg_data%resonances)
if (reg_data%emitter_is_compatible_with_resonance (i_res, emitter)) then
alr = find_alr (emitter, i_res)
if (alr == 0) call msg_fatal ("Could not find requested alpha region!")
i_con = reg_data%alr_to_i_contributor (alr)
call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter)
if (.not. share_emitter) cycle
call check_for_phs_identifier &
(phs_id_tmp, reg_data%n_in, emitter, contributors%c, phs_exist, i_phs)
if (phs_id_tmp(i_phs)%emitter < 0) then
phs_id_tmp(i_phs)%emitter = emitter
allocate (phs_id_tmp(i_phs)%contributors (size (contributors%c)))
phs_id_tmp(i_phs)%contributors = contributors%c
end if
reg_data%i_phs_to_i_con (i_phs) = i_con
end if
if (allocated (contributors%c)) deallocate (contributors%c)
end do
end do
end if
contains
function find_alr (emitter, i_res) result (alr)
integer :: alr
integer, intent(in) :: emitter, i_res
integer :: i
do i = 1, reg_data%n_regions
if (reg_data%regions(i)%emitter == emitter .and. &
reg_data%regions(i)%i_res == i_res) then
alr = i
return
end if
end do
alr = 0
end function find_alr
end subroutine region_data_set_i_phs_to_i_con
@ %def region_data_set_i_phs_to_i_con
@
<<FKS regions: reg data: TBP>>=
procedure :: set_alr_to_i_phs => region_data_set_alr_to_i_phs
<<FKS regions: sub interfaces>>=
module subroutine region_data_set_alr_to_i_phs &
(reg_data, phs_identifiers, alr_to_i_phs)
class(region_data_t), intent(inout) :: reg_data
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
integer, intent(out), dimension(:) :: alr_to_i_phs
end subroutine region_data_set_alr_to_i_phs
<<FKS regions: procedures>>=
module subroutine region_data_set_alr_to_i_phs &
(reg_data, phs_identifiers, alr_to_i_phs)
class(region_data_t), intent(inout) :: reg_data
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
integer, intent(out), dimension(:) :: alr_to_i_phs
integer :: alr, i_phs
integer :: emitter, i_res
type(resonance_contributors_t) :: contributors
logical :: share_emitter, phs_exist
do alr = 1, reg_data%n_regions
associate (region => reg_data%regions(alr))
emitter = region%emitter
i_res = region%i_res
if (i_res /= 0) then
call reg_data%get_contributors (i_res, emitter, &
contributors%c, share_emitter)
if (.not. share_emitter) cycle
end if
if (allocated (contributors%c)) then
call check_for_phs_identifier (phs_identifiers, reg_data%n_in, &
emitter, contributors%c, phs_exist = phs_exist, i_phs = i_phs)
else
call check_for_phs_identifier (phs_identifiers, reg_data%n_in, &
emitter, phs_exist = phs_exist, i_phs = i_phs)
end if
if (.not. phs_exist) &
call msg_fatal ("phs identifiers are not set up correctly!")
alr_to_i_phs(alr) = i_phs
end associate
if (allocated (contributors%c)) deallocate (contributors%c)
end do
end subroutine region_data_set_alr_to_i_phs
@ %def region_data_set_alr_to_i_phs
@
<<FKS regions: reg data: TBP>>=
procedure :: set_contributors => region_data_set_contributors
<<FKS regions: sub interfaces>>=
module subroutine region_data_set_contributors (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_set_contributors
<<FKS regions: procedures>>=
module subroutine region_data_set_contributors (reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr, i_res, i_reg, i_con
integer :: i1, i2, i_em
integer, dimension(:), allocatable :: contributors
logical :: share_emitter
do alr = 1, size (reg_data%regions)
associate (sregion => reg_data%regions(alr))
allocate (sregion%i_reg_to_i_con (sregion%nregions))
do i_reg = 1, sregion%nregions
call sregion%ftuples(i_reg)%get (i1, i2)
i_em = get_emitter_index (i1, i2, reg_data%n_legs_real)
i_res = sregion%ftuples(i_reg)%i_res
call reg_data%get_contributors &
(i_res, i_em, contributors, share_emitter)
!!! Lookup contributor index
do i_con = 1, size (reg_data%alr_contributors)
if (all (reg_data%alr_contributors(i_con)%c == contributors)) &
then
sregion%i_reg_to_i_con (i_reg) = i_con
exit
end if
end do
deallocate (contributors)
end do
end associate
end do
contains
function get_emitter_index (i1, i2, n) result (i_em)
integer :: i_em
integer, intent(in) :: i1, i2, n
if (i1 == n) then
i_em = i2
else
i_em = i1
end if
end function get_emitter_index
end subroutine region_data_set_contributors
@ %def region_data_set_contributors
@ This extension of the ftuples is still too naive as it assumes that the same
resonances are possible for all ftuples
<<FKS regions: reg data: TBP>>=
procedure :: extend_ftuples => region_data_extend_ftuples
<<FKS regions: sub interfaces>>=
module subroutine region_data_extend_ftuples (reg_data, n_res)
class(region_data_t), intent(inout) :: reg_data
integer, intent(in) :: n_res
end subroutine region_data_extend_ftuples
<<FKS regions: procedures>>=
module subroutine region_data_extend_ftuples (reg_data, n_res)
class(region_data_t), intent(inout) :: reg_data
integer, intent(in) :: n_res
integer :: alr, n_reg_save
integer :: i_reg, i_res, i_em, k
type(ftuple_t), dimension(:), allocatable :: ftuple_save
integer :: n_new
do alr = 1, size (reg_data%regions)
associate (sregion => reg_data%regions(alr))
n_reg_save = sregion%nregions
allocate (ftuple_save (n_reg_save))
ftuple_save = sregion%ftuples
n_new = count_n_new_ftuples (sregion, n_res)
deallocate (sregion%ftuples)
sregion%nregions = n_new
allocate (sregion%ftuples (n_new))
k = 1
do i_res = 1, n_res
do i_reg = 1, n_reg_save
associate (ftuple_new => sregion%ftuples(k))
i_em = ftuple_save(i_reg)%ireg(1)
if (reg_data%emitter_is_in_resonance (i_res, i_em)) then
call ftuple_new%set (i_em, ftuple_save(i_reg)%ireg(2))
ftuple_new%i_res = i_res
ftuple_new%splitting_type = ftuple_save(i_reg)%splitting_type
k = k + 1
end if
end associate
end do
end do
end associate
deallocate (ftuple_save)
end do
contains
function count_n_new_ftuples (sregion, n_res) result (n_new)
integer :: n_new
type(singular_region_t), intent(in) :: sregion
integer, intent(in) :: n_res
integer :: i_reg, i_res, i_em
n_new = 0
do i_reg = 1, sregion%nregions
do i_res = 1, n_res
i_em = sregion%ftuples(i_reg)%ireg(1)
if (reg_data%emitter_is_in_resonance (i_res, i_em)) &
n_new = n_new + 1
end do
end do
end function count_n_new_ftuples
end subroutine region_data_extend_ftuples
@ %def region_data_extend_ftuples
@
<<FKS regions: reg data: TBP>>=
procedure :: get_flavor_indices => region_data_get_flavor_indices
<<FKS regions: sub interfaces>>=
module function region_data_get_flavor_indices &
(reg_data, born) result (i_flv)
integer, dimension(:), allocatable :: i_flv
class(region_data_t), intent(in) :: reg_data
logical, intent(in) :: born
end function region_data_get_flavor_indices
<<FKS regions: procedures>>=
module function region_data_get_flavor_indices (reg_data, born) result (i_flv)
integer, dimension(:), allocatable :: i_flv
class(region_data_t), intent(in) :: reg_data
logical, intent(in) :: born
allocate (i_flv (reg_data%n_regions))
if (born) then
i_flv = reg_data%regions%uborn_index
else
i_flv = reg_data%regions%real_index
end if
end function region_data_get_flavor_indices
@ %def region_data_get_flavor_indices
@
<<FKS regions: reg data: TBP>>=
procedure :: get_matrix_element_index => region_data_get_matrix_element_index
<<FKS regions: sub interfaces>>=
module function region_data_get_matrix_element_index &
(reg_data, i_reg) result (i_me)
integer :: i_me
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_reg
end function region_data_get_matrix_element_index
<<FKS regions: procedures>>=
module function region_data_get_matrix_element_index &
(reg_data, i_reg) result (i_me)
integer :: i_me
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_reg
i_me = reg_data%regions(i_reg)%real_index
end function region_data_get_matrix_element_index
@ %def region_data_get_matrix_element_index
@
<<FKS regions: reg data: TBP>>=
procedure :: compute_number_of_phase_spaces &
=> region_data_compute_number_of_phase_spaces
<<FKS regions: sub interfaces>>=
module subroutine region_data_compute_number_of_phase_spaces (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_compute_number_of_phase_spaces
<<FKS regions: procedures>>=
module subroutine region_data_compute_number_of_phase_spaces (reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: i_em, i_res, i_phs
integer :: emitter
type(resonance_contributors_t) :: contributors
integer, parameter :: n_max_phs = 10
type(phs_identifier_t), dimension(n_max_phs) :: phs_id_tmp
logical :: share_emitter, phs_exist
if (allocated (reg_data%resonances)) then
reg_data%n_phs = 0
do i_em = 1, size (reg_data%emitters)
emitter = reg_data%emitters(i_em)
do i_res = 1, size (reg_data%resonances)
if (reg_data%emitter_is_compatible_with_resonance (i_res, emitter)) then
call reg_data%get_contributors &
(i_res, emitter, contributors%c, share_emitter)
if (.not. share_emitter) cycle
call check_for_phs_identifier (phs_id_tmp, reg_data%n_in, &
emitter, contributors%c, phs_exist, i_phs)
if (.not. phs_exist) then
reg_data%n_phs = reg_data%n_phs + 1
if (reg_data%n_phs > n_max_phs) call msg_fatal &
("Buffer of phase space identifieres: Too much phase spaces!")
call phs_id_tmp(i_phs)%init (emitter, contributors%c)
end if
end if
if (allocated (contributors%c)) deallocate (contributors%c)
end do
end do
else
reg_data%n_phs = size (remove_duplicates_from_int_array &
(reg_data%emitters))
end if
end subroutine region_data_compute_number_of_phase_spaces
@ %def region_data_compute_number_of_phase_spaces
@
<<FKS regions: reg data: TBP>>=
procedure :: get_n_phs => region_data_get_n_phs
<<FKS regions: sub interfaces>>=
module function region_data_get_n_phs (reg_data) result (n_phs)
integer :: n_phs
class(region_data_t), intent(in) :: reg_data
end function region_data_get_n_phs
<<FKS regions: procedures>>=
module function region_data_get_n_phs (reg_data) result (n_phs)
integer :: n_phs
class(region_data_t), intent(in) :: reg_data
n_phs = reg_data%n_phs
end function region_data_get_n_phs
@ %def region_data_get_n_phs
@
<<FKS regions: reg data: TBP>>=
procedure :: set_splitting_info => region_data_set_splitting_info
<<FKS regions: sub interfaces>>=
module subroutine region_data_set_splitting_info (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_set_splitting_info
<<FKS regions: procedures>>=
module subroutine region_data_set_splitting_info (reg_data)
class(region_data_t), intent(inout) :: reg_data
integer :: alr
do alr = 1, reg_data%n_regions
call reg_data%regions(alr)%set_splitting_info (reg_data%n_in)
end do
end subroutine region_data_set_splitting_info
@ %def region_data_set_splitting_info
@
<<FKS regions: reg data: TBP>>=
procedure :: init_phs_identifiers => region_data_init_phs_identifiers
<<FKS regions: sub interfaces>>=
module subroutine region_data_init_phs_identifiers (reg_data, phs_id)
class(region_data_t), intent(in) :: reg_data
type(phs_identifier_t), intent(out), dimension(:), allocatable :: phs_id
end subroutine region_data_init_phs_identifiers
<<FKS regions: procedures>>=
module subroutine region_data_init_phs_identifiers (reg_data, phs_id)
class(region_data_t), intent(in) :: reg_data
type(phs_identifier_t), intent(out), dimension(:), allocatable :: phs_id
integer :: i_em, i_res, i_phs
integer :: emitter
type(resonance_contributors_t) :: contributors
logical :: share_emitter, phs_exist
allocate (phs_id (reg_data%n_phs))
do i_em = 1, size (reg_data%emitters)
emitter = reg_data%emitters(i_em)
if (allocated (reg_data%resonances)) then
do i_res = 1, size (reg_data%resonances)
call reg_data%get_contributors (i_res, emitter, &
contributors%c, share_emitter)
if (.not. share_emitter) cycle
call check_for_phs_identifier &
(phs_id, reg_data%n_in, emitter, contributors%c, &
phs_exist, i_phs)
if (.not. phs_exist) &
call phs_id(i_phs)%init (emitter, contributors%c)
if (allocated (contributors%c)) deallocate (contributors%c)
end do
else
call check_for_phs_identifier (phs_id, reg_data%n_in, emitter, &
phs_exist = phs_exist, i_phs = i_phs)
if (.not. phs_exist) call phs_id(i_phs)%init (emitter)
end if
end do
end subroutine region_data_init_phs_identifiers
@ %def region_data_init_phs_identifiers
@ Gathers all ftuples from all ALRs.
There are at most $n \cdot (n-1)$ ftuples with $i$ and $j$ in the final state
and up to $3n$ ftuples with $i$ in the initial state.
<<FKS regions: reg data: TBP>>=
procedure :: get_all_ftuples => region_data_get_all_ftuples
<<FKS regions: sub interfaces>>=
module subroutine region_data_get_all_ftuples (reg_data, ftuples)
class(region_data_t), intent(in) :: reg_data
type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuples
end subroutine region_data_get_all_ftuples
<<FKS regions: procedures>>=
module subroutine region_data_get_all_ftuples (reg_data, ftuples)
class(region_data_t), intent(in) :: reg_data
type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuples
type(ftuple_t), dimension(:), allocatable :: ftuple_tmp
integer :: i, j, alr, n_fs
j = 0
n_fs = reg_data%n_legs_real - reg_data%n_in
allocate (ftuple_tmp (n_fs * (n_fs - 1) + 3 * n_fs))
do i = 1, reg_data%n_regions
associate (region => reg_data%regions(i))
do alr = 1, region%nregions
if (.not. any &
(ftuple_equal_ireg (region%ftuples(alr), ftuple_tmp))) then
j = j + 1
ftuple_tmp(j) = region%ftuples(alr)
end if
end do
end associate
end do
allocate (ftuples (j))
ftuples = ftuple_tmp(1:j)
deallocate (ftuple_tmp)
end subroutine region_data_get_all_ftuples
@ %def region_data_get_all_ftuples
@
<<FKS regions: reg data: TBP>>=
procedure :: write_to_file => region_data_write_to_file
<<FKS regions: sub interfaces>>=
module subroutine region_data_write_to_file &
(reg_data, proc_id, latex, os_data)
class(region_data_t), intent(inout) :: reg_data
type(string_t), intent(in) :: proc_id
logical, intent(in) :: latex
type(os_data_t), intent(in) :: os_data
end subroutine region_data_write_to_file
<<FKS regions: procedures>>=
module subroutine region_data_write_to_file &
(reg_data, proc_id, latex, os_data)
class(region_data_t), intent(inout) :: reg_data
type(string_t), intent(in) :: proc_id
logical, intent(in) :: latex
type(os_data_t), intent(in) :: os_data
type(string_t) :: filename
integer :: u
integer :: status
if (latex) then
filename = proc_id // "_fks_regions.tex"
else
filename = proc_id // "_fks_regions.out"
end if
u = free_unit ()
open (u, file=char(filename), action = "write", status="replace")
if (latex) then
call reg_data%write_latex (u)
close (u)
call os_data%build_latex_file &
(proc_id // "_fks_regions", stat_out = status)
if (status /= 0) &
call msg_error (char ("Failed to compile " // filename))
else
call reg_data%write (u)
close (u)
end if
end subroutine region_data_write_to_file
@ %def region_data_write_to_file
@
<<FKS regions: reg data: TBP>>=
procedure :: write_latex => region_data_write_latex
<<FKS regions: sub interfaces>>=
module subroutine region_data_write_latex (reg_data, unit)
class(region_data_t), intent(in) :: reg_data
integer, intent(in), optional :: unit
end subroutine region_data_write_latex
<<FKS regions: procedures>>=
module subroutine region_data_write_latex (reg_data, unit)
class(region_data_t), intent(in) :: reg_data
integer, intent(in), optional :: unit
integer :: i, u
u = given_output_unit (); if (present (unit)) u = unit
write (u, "(A)") "\documentclass{article}"
write (u, "(A)") "\begin{document}"
write (u, "(A)") "%FKS region data, automatically created by WHIZARD"
write (u, "(A)") "\begin{table}"
write (u, "(A)") "\begin{center}"
write (u, "(A)") "\begin{tabular} {|c|c|c|c|c|c|c|c|}"
write (u, "(A)") "\hline"
write (u, "(A)") "$\alpha_r$ & $f_r$ & $i_r$ & $\varepsilon$ & " // &
"$\varsigma$ & $\mathcal{P}_{\rm{FKS}}$ & $i_b$ & $f_b$ \\"
write (u, "(A)") "\hline"
do i = 1, reg_data%n_regions
call reg_data%regions(i)%write_latex (u)
end do
write (u, "(A)") "\hline"
write (u, "(A)") "\end{tabular}"
write (u, "(A)") "\caption{List of singular regions}"
write (u, "(A)") "\begin{description}"
write (u, "(A)") "\item[$\alpha_r$] Index of the singular region"
write (u, "(A)") "\item[$f_r$] Real flavor structure"
write (u, "(A)") "\item[$i_r$] Index of the associated real flavor structure"
write (u, "(A)") "\item[$\varepsilon$] Emitter"
write (u, "(A)") "\item[$\varsigma$] Multiplicity"
!!! The symbol used by 0908.4272 for multiplicities
write (u, "(A)") "\item[$\mathcal{P}_{\rm{FKS}}$] The set of singular FKS-pairs"
write (u, "(A)") "\item[$i_b$] Underlying Born index"
write (u, "(A)") "\item[$f_b$] Underlying Born flavor structure"
write (u, "(A)") "\end{description}"
write (u, "(A)") "\end{center}"
write (u, "(A)") "\end{table}"
write (u, "(A)") "\end{document}"
end subroutine region_data_write_latex
@ %def region_data_write_latex
@ Creates a table with information about all singular regions and
writes it to a file.
<<FKS regions: reg data: TBP>>=
procedure :: write => region_data_write
<<FKS regions: sub interfaces>>=
module subroutine region_data_write (reg_data, unit)
class(region_data_t), intent(in) :: reg_data
integer, intent(in), optional :: unit
end subroutine region_data_write
<<FKS regions: procedures>>=
module subroutine region_data_write (reg_data, unit)
class(region_data_t), intent(in) :: reg_data
integer, intent(in), optional :: unit
integer :: j
integer :: maxnregions, i_reg_max
type(string_t) :: flst_title, ftuple_title
integer :: n_res, u
u = given_output_unit (unit); if (u < 0) return
maxnregions = 1; i_reg_max = 1
do j = 1, reg_data%n_regions
if (size (reg_data%regions(j)%ftuples) > maxnregions) then
maxnregions = reg_data%regions(j)%nregions
i_reg_max = j
end if
end do
flst_title = '(A' // flst_title_format(reg_data%n_legs_real) // ')'
ftuple_title = '(A' // ftuple_title_format() // ')'
write (u,'(A,1X,I4)') 'Total number of regions: ', size(reg_data%regions)
write (u, '(A4)', advance = 'no') ' alr'
call write_vline (u)
write (u, char (flst_title), advance = 'no') 'flst_real'
call write_vline (u)
write (u, '(A6)', advance = 'no') 'i_real'
call write_vline (u)
write (u, '(A3)', advance = 'no') 'em'
call write_vline (u)
write (u, '(A3)', advance = 'no') 'mult'
call write_vline (u)
write (u, '(A4)', advance = 'no') 'nreg'
call write_vline (u)
if (allocated (reg_data%fks_mapping)) then
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
write (u, '(A3)', advance = 'no') 'res'
call write_vline (u)
end select
end if
write (u, char (ftuple_title), advance = 'no') 'ftuples'
call write_vline (u)
flst_title = '(A' // flst_title_format(reg_data%n_legs_born) // ')'
write (u, char (flst_title), advance = 'no') 'flst_born'
call write_vline (u)
write (u, '(A7)', advance = 'no') 'i_born'
call write_vline (u)
write (u, '(A4)') 'corr'
do j = 1, reg_data%n_regions
write (u, '(I4)', advance = 'no') j
call reg_data%regions(j)%write (u, maxnregions)
end do
call write_separator (u)
if (allocated (reg_data%fks_mapping)) then
select type (fks_mapping => reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
write (u, '(A)')
write (u, '(A)') &
"The FKS regions are combined with resonance information: "
n_res = size (fks_mapping%res_map%res_histories)
write (u, '(A,1X,I1)') "Number of QCD resonance histories: ", n_res
do j = 1, n_res
write (u, '(A,1X,I1)') "i_res = ", j
call fks_mapping%res_map%res_histories(j)%write (u)
call write_separator (u)
end do
end select
end if
contains
function flst_title_format (n) result (frmt)
integer, intent(in) :: n
type(string_t) :: frmt
character(len=2) :: frmt_char
write (frmt_char, '(I2)') 4 * n + 1
frmt = var_str (frmt_char)
end function flst_title_format
function ftuple_title_format () result (frmt)
type(string_t) :: frmt
integer :: n_ftuple_char
!!! An ftuple (x,x) consists of five characters. In the string, they
!!! are separated by maxregions - 1 commas. In total these are
!!! 5 * maxnregions + maxnregions - 1 = 6 * maxnregions - 1 characters.
!!! The {} brackets at add two additional characters.
n_ftuple_char = 6 * maxnregions + 1
!!! If there are resonances, each ftuple with a resonance adds a ";x"
!!! to the ftuple
n_ftuple_char = n_ftuple_char + &
2 * count (reg_data%regions(i_reg_max)%ftuples%i_res > 0)
!!! Pseudo-ISR regions are denoted with a * at the end
n_ftuple_char = n_ftuple_char + &
count (reg_data%regions(i_reg_max)%ftuples%pseudo_isr)
frmt = str (n_ftuple_char)
end function ftuple_title_format
end subroutine region_data_write
@ %def region_data_write
@
<<FKS regions: procedures>>=
subroutine write_vline (u)
integer, intent(in) :: u
character(len=10), parameter :: sep_format = "(1X,A2,1X)"
write (u, sep_format, advance = 'no') '||'
end subroutine write_vline
@ %def write_vline
@
<<FKS regions: public>>=
public :: assignment(=)
<<FKS regions: interfaces>>=
interface assignment(=)
module procedure region_data_assign
end interface
<<FKS regions: sub interfaces>>=
module subroutine region_data_assign (reg_data_out, reg_data_in)
type(region_data_t), intent(out) :: reg_data_out
type(region_data_t), intent(in) :: reg_data_in
end subroutine region_data_assign
<<FKS regions: procedures>>=
module subroutine region_data_assign (reg_data_out, reg_data_in)
type(region_data_t), intent(out) :: reg_data_out
type(region_data_t), intent(in) :: reg_data_in
integer :: i
if (allocated (reg_data_in%regions)) then
allocate (reg_data_out%regions (size (reg_data_in%regions)))
do i = 1, size (reg_data_in%regions)
reg_data_out%regions(i) = reg_data_in%regions(i)
end do
else
call msg_warning &
("Copying region data without allocated singular regions!")
end if
if (allocated (reg_data_in%flv_born)) then
allocate (reg_data_out%flv_born (size (reg_data_in%flv_born)))
do i = 1, size (reg_data_in%flv_born)
reg_data_out%flv_born(i) = reg_data_in%flv_born(i)
end do
else
call msg_warning &
("Copying region data without allocated born flavor structure!")
end if
if (allocated (reg_data_in%flv_real)) then
allocate (reg_data_out%flv_real (size (reg_data_in%flv_real)))
do i = 1, size (reg_data_in%flv_real)
reg_data_out%flv_real(i) = reg_data_in%flv_real(i)
end do
else
call msg_warning ("Copying region data without allocated real flavor structure!")
end if
if (allocated (reg_data_in%emitters)) then
allocate (reg_data_out%emitters (size (reg_data_in%emitters)))
do i = 1, size (reg_data_in%emitters)
reg_data_out%emitters(i) = reg_data_in%emitters(i)
end do
else
call msg_warning ("Copying region data without allocated emitters!")
end if
reg_data_out%n_regions = reg_data_in%n_regions
reg_data_out%n_emitters = reg_data_in%n_emitters
reg_data_out%n_flv_born = reg_data_in%n_flv_born
reg_data_out%n_flv_real = reg_data_in%n_flv_real
reg_data_out%n_in = reg_data_in%n_in
reg_data_out%n_legs_born = reg_data_in%n_legs_born
reg_data_out%n_legs_real = reg_data_in%n_legs_real
if (allocated (reg_data_in%fks_mapping)) then
select type (fks_mapping_in => reg_data_in%fks_mapping)
type is (fks_mapping_default_t)
allocate (fks_mapping_default_t :: reg_data_out%fks_mapping)
select type (fks_mapping_out => reg_data_out%fks_mapping)
type is (fks_mapping_default_t)
fks_mapping_out = fks_mapping_in
end select
type is (fks_mapping_resonances_t)
allocate (fks_mapping_resonances_t :: reg_data_out%fks_mapping)
select type (fks_mapping_out => reg_data_out%fks_mapping)
type is (fks_mapping_resonances_t)
fks_mapping_out = fks_mapping_in
end select
end select
else
call msg_warning ("Copying region data without allocated FKS regions!")
end if
if (allocated (reg_data_in%resonances)) then
allocate (reg_data_out%resonances (size (reg_data_in%resonances)))
reg_data_out%resonances = reg_data_in%resonances
end if
reg_data_out%n_phs = reg_data_in%n_phs
if (allocated (reg_data_in%alr_contributors)) then
allocate (reg_data_out%alr_contributors (size (reg_data_in%alr_contributors)))
reg_data_out%alr_contributors = reg_data_in%alr_contributors
end if
if (allocated (reg_data_in%alr_to_i_contributor)) then
allocate (reg_data_out%alr_to_i_contributor &
(size (reg_data_in%alr_to_i_contributor)))
reg_data_out%alr_to_i_contributor = reg_data_in%alr_to_i_contributor
end if
end subroutine region_data_assign
@ %def region_data_assign
@ Returns the index of the real flavor structure an ftuple belogs to.
<<FKS regions: procedures>>=
function region_to_real_index (list, i) result(index)
type(ftuple_list_t), intent(in), dimension(:), allocatable :: list
integer, intent(in) :: i
integer, dimension(:), allocatable :: nreg
integer :: index, j
allocate (nreg (0))
index = 0
do j = 1, size (list)
nreg = [nreg, sum (list(:j)%get_n_tuples ())]
if (j == 1) then
if (i <= nreg(j)) then
index = j
exit
end if
else
if (i > nreg(j - 1) .and. i <= nreg(j)) then
index = j
exit
end if
end if
end do
end function region_to_real_index
@ %def region_to_real_index
@ Final state emission: Rearrange the flavor array in such a way that
the emitted particle is last and the emitter is second last. [[i1]] is
the index of the emitter, [[i2]] is the index of the emitted particle.
Initial state emission: Just put the emitted particle to the last
position.
<<FKS regions: procedures>>=
function create_alr (flv1, n_in, i_em, i_rad) result(flv2)
type(flv_structure_t), intent(in) :: flv1
integer, intent(in) :: n_in
integer, intent(in) :: i_em, i_rad
type(flv_structure_t) :: flv2
integer :: n
n = size (flv1%flst)
allocate (flv2%flst (n), flv2%tag (n))
flv2%nlegs = n
flv2%n_in = n_in
if (i_em > n_in) then
flv2%flst(1 : n_in) = flv1%flst(1 : n_in)
flv2%flst(n - 1) = flv1%flst(i_em)
flv2%flst(n) = flv1%flst(i_rad)
flv2%tag(1 : n_in) = flv1%tag(1 : n_in)
flv2%tag(n - 1) = flv1%tag(i_em)
flv2%tag(n) = flv1%tag(i_rad)
call fill_remaining_flavors (n_in, .true.)
else
flv2%flst(1 : n_in) = flv1%flst(1 : n_in)
flv2%flst(n) = flv1%flst(i_rad)
flv2%tag(1 : n_in) = flv1%tag(1 : n_in)
flv2%tag(n) = flv1%tag(i_rad)
call fill_remaining_flavors (n_in, .false.)
end if
call flv2%compute_prt_symm_fs (flv2%n_in)
contains
@ Order remaining particles according to their original position
<<FKS regions: procedures>>=
subroutine fill_remaining_flavors (n_in, final_final)
integer, intent(in) :: n_in
logical, intent(in) :: final_final
integer :: i, j
logical :: check
j = n_in + 1
do i = n_in + 1, n
if (final_final) then
check = (i /= i_em .and. i /= i_rad)
else
check = (i /= i_rad)
end if
if (check) then
flv2%flst(j) = flv1%flst(i)
flv2%tag(j) = flv1%tag(i)
j = j + 1
end if
end do
end subroutine fill_remaining_flavors
end function create_alr
@ %def create_alr
@
<<FKS regions: reg data: TBP>>=
procedure :: has_pseudo_isr => region_data_has_pseudo_isr
<<FKS regions: sub interfaces>>=
module function region_data_has_pseudo_isr (reg_data) result (flag)
logical :: flag
class(region_data_t), intent(in) :: reg_data
end function region_data_has_pseudo_isr
<<FKS regions: procedures>>=
module function region_data_has_pseudo_isr (reg_data) result (flag)
logical :: flag
class(region_data_t), intent(in) :: reg_data
flag = any (reg_data%regions%pseudo_isr)
end function region_data_has_pseudo_isr
@ %def region_data_has_pseudo_isr
@ Performs consistency checks on [[region_data]]. Up to now only
checks that no [[ftuple]] appears more than once.
<<FKS regions: reg data: TBP>>=
procedure :: check_consistency => region_data_check_consistency
<<FKS regions: sub interfaces>>=
module subroutine region_data_check_consistency (reg_data, fail_fatal, unit)
class(region_data_t), intent(in) :: reg_data
logical, intent(in) :: fail_fatal
integer, intent(in), optional :: unit
end subroutine region_data_check_consistency
<<FKS regions: procedures>>=
module subroutine region_data_check_consistency (reg_data, fail_fatal, unit)
class(region_data_t), intent(in) :: reg_data
logical, intent(in) :: fail_fatal
integer, intent(in), optional :: unit
integer :: u
integer :: i_reg, alr
integer :: i1, f1, f2
logical :: undefined_ftuples, same_ftuple_indices, valid_splitting
logical, dimension(4) :: no_fail
u = given_output_unit(unit); if (u < 0) return
no_fail = .true.
call msg_message ("Check that no negative ftuple indices occur", unit = u)
do i_reg = 1, reg_data%n_regions
if (any (reg_data%regions(i_reg)%ftuples%has_negative_elements ())) then
!!! This error is so severe that we stop immediately
call msg_fatal ("Negative ftuple indices!")
end if
end do
call msg_message ("Success!", unit = u)
call msg_message ("Check that there is no ftuple with identical elements", unit = u)
do i_reg = 1, reg_data%n_regions
if (any (reg_data%regions(i_reg)%ftuples%has_identical_elements ())) then
!!! This error is so severe that we stop immediately
call msg_fatal ("Identical ftuple indices!")
end if
end do
call msg_message ("Success!", unit = u)
call msg_message ("Check that there are no duplicate ftuples in a region", unit = u)
do i_reg = 1, reg_data%n_regions
if (reg_data%regions(i_reg)%has_identical_ftuples ()) then
if (no_fail(1)) then
call msg_error ("FAIL: ", unit = u)
no_fail(1) = .false.
end if
write (u, '(A,1x,I3)') 'i_reg:', i_reg
end if
end do
if (no_fail(1)) call msg_message ("Success!", unit = u)
call msg_message ("Check that ftuples add up to a valid splitting", unit = u)
do i_reg = 1, reg_data%n_regions
do alr = 1, reg_data%regions(i_reg)%nregions
associate (region => reg_data%regions(i_reg))
i1 = region%ftuples(alr)%ireg(1)
if (i1 == 0) i1 = 1 !!! Gluon emission from both initial-state particles
f1 = region%flst_real%flst(i1)
f2 = region%flst_real%flst(region%ftuples(alr)%ireg(2))
! Flip PDG sign of IS fermions to allow a q -> g q splitting
! in which the ftuple has the flavors (q,q).
if (i1 <= reg_data%n_in .and. is_fermion(f1)) then
f1 = -f1
end if
valid_splitting = f1 + f2 == 0 &
.or. (is_gluon(f1) .and. is_gluon(f2)) &
.or. (is_massive_vector(f1) .and. is_photon(f2)) &
.or. is_fermion_vector_splitting (f1, f2)
if (.not. valid_splitting) then
if (no_fail(2)) then
call msg_error ("FAIL: ", unit = u)
no_fail(2) = .false.
end if
write (u, '(A,1x,I3)') 'i_reg:', i_reg
exit
end if
end associate
end do
end do
if (no_fail(2)) call msg_message ("Success!", unit = u)
call msg_message ("Check that at least one ftuple contains the emitter", unit = u)
do i_reg = 1, reg_data%n_regions
associate (region => reg_data%regions(i_reg))
if (.not. any (region%emitter == region%ftuples%ireg(1))) then
if (no_fail(3)) then
call msg_error ("FAIL: ", unit = u)
no_fail(3) = .false.
end if
write (u, '(A,1x,I3)') 'i_reg:', i_reg
end if
end associate
end do
if (no_fail(3)) call msg_message ("Success!", unit = u)
call msg_message ("Check that each region has at least one ftuple &
&with index n + 1", unit = u)
do i_reg = 1, reg_data%n_regions
if (.not. any (reg_data%regions(i_reg)%ftuples%ireg(2) == reg_data%n_legs_real)) then
if (no_fail(4)) then
call msg_error ("FAIL: ", unit = u)
no_fail(4) = .false.
end if
write (u, '(A,1x,I3)') 'i_reg:', i_reg
end if
end do
if (no_fail(4)) call msg_message ("Success!", unit = u)
if (.not. all (no_fail)) &
call abort_with_message ("Stop due to inconsistent region data!")
contains
subroutine abort_with_message (msg)
character(len=*), intent(in) :: msg
if (fail_fatal) then
call msg_fatal (msg)
else
call msg_error (msg, unit = u)
end if
end subroutine abort_with_message
function is_fermion_vector_splitting (pdg_1, pdg_2) result (value)
logical :: value
integer, intent(in) :: pdg_1, pdg_2
value = (is_fermion (pdg_1) .and. is_massless_vector (pdg_2)) .or. &
(is_fermion (pdg_2) .and. is_massless_vector (pdg_1))
end function
end subroutine region_data_check_consistency
@ %def region_data_check_consistency
@
<<FKS regions: reg data: TBP>>=
procedure :: requires_spin_correlations => &
region_data_requires_spin_correlations
<<FKS regions: sub interfaces>>=
module function region_data_requires_spin_correlations &
(reg_data) result (flag)
class(region_data_t), intent(in) :: reg_data
logical :: flag
end function region_data_requires_spin_correlations
<<FKS regions: procedures>>=
module function region_data_requires_spin_correlations &
(reg_data) result (flag)
class(region_data_t), intent(in) :: reg_data
logical :: flag
integer :: alr
flag = .false.
do alr = 1, reg_data%n_regions
flag = reg_data%regions(alr)%sc_required
if (flag) return
end do
end function region_data_requires_spin_correlations
@ %def region_data_requires_spin_correlations
@ We have to apply the symmetry factor for identical particles of the
real flavor structure to the born squared matrix element. The corresponding
factor from the born flavor structure has to be cancelled.
<<FKS regions: reg data: TBP>>=
procedure :: born_to_real_symm_factor_fs => &
region_data_born_to_real_symm_factor_fs
<<FKS regions: sub interfaces>>=
module function region_data_born_to_real_symm_factor_fs &
(reg_data, alr) result (factor)
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: alr
real(default) :: factor
end function region_data_born_to_real_symm_factor_fs
<<FKS regions: procedures>>=
module function region_data_born_to_real_symm_factor_fs &
(reg_data, alr) result (factor)
class(region_data_t), intent(in) :: reg_data
integer, intent(in) :: alr
real(default) :: factor
associate (flv_real => reg_data%regions(alr)%flst_real, &
flv_uborn => reg_data%regions(alr)%flst_uborn)
factor = flv_real%prt_symm_fs / flv_uborn%prt_symm_fs
end associate
end function region_data_born_to_real_symm_factor_fs
@ %def region_data_born_to_real_symm_factor_fs
@
<<FKS regions: reg data: TBP>>=
procedure :: final => region_data_final
<<FKS regions: sub interfaces>>=
module subroutine region_data_final (reg_data)
class(region_data_t), intent(inout) :: reg_data
end subroutine region_data_final
<<FKS regions: procedures>>=
module subroutine region_data_final (reg_data)
class(region_data_t), intent(inout) :: reg_data
if (allocated (reg_data%regions)) deallocate (reg_data%regions)
if (allocated (reg_data%flv_born)) deallocate (reg_data%flv_born)
if (allocated (reg_data%flv_real)) deallocate (reg_data%flv_real)
if (allocated (reg_data%emitters)) deallocate (reg_data%emitters)
if (allocated (reg_data%fks_mapping)) deallocate (reg_data%fks_mapping)
if (allocated (reg_data%resonances)) deallocate (reg_data%resonances)
if (allocated (reg_data%alr_contributors)) &
deallocate (reg_data%alr_contributors)
if (allocated (reg_data%alr_to_i_contributor)) &
deallocate (reg_data%alr_to_i_contributor)
end subroutine region_data_final
@ %def region_data_final
@
<<FKS regions: fks mapping: TBP>>=
procedure (fks_mapping_dij), deferred :: dij
<<FKS regions: interfaces>>=
abstract interface
function fks_mapping_dij (map, p, i, j, i_con) result (d)
import
real(default) :: d
class(fks_mapping_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_con
end function fks_mapping_dij
end interface
@ %def fks_mapping_dij
@
<<FKS regions: fks mapping: TBP>>=
procedure (fks_mapping_compute_sumdij), deferred :: compute_sumdij
<<FKS regions: interfaces>>=
abstract interface
subroutine fks_mapping_compute_sumdij (map, sregion, p_real)
import
class(fks_mapping_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_real
end subroutine fks_mapping_compute_sumdij
end interface
@ %def fks_mapping_compute_sumdij
@
<<FKS regions: fks mapping: TBP>>=
procedure (fks_mapping_svalue), deferred :: svalue
<<FKS regions: interfaces>>=
abstract interface
function fks_mapping_svalue (map, p, i, j, i_res) result (value)
import
real(default) :: value
class(fks_mapping_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_res
end function fks_mapping_svalue
end interface
@ %def fks_mapping_svalue
<<FKS regions: fks mapping: TBP>>=
procedure (fks_mapping_dij_soft), deferred :: dij_soft
<<FKS regions: interfaces>>=
abstract interface
function fks_mapping_dij_soft (map, p_born, p_soft, em, i_con) result (d)
import
real(default) :: d
class(fks_mapping_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_con
end function fks_mapping_dij_soft
end interface
@ %def fks_mapping_dij_soft
@
<<FKS regions: fks mapping: TBP>>=
procedure (fks_mapping_compute_sumdij_soft), deferred :: compute_sumdij_soft
<<FKS regions: interfaces>>=
abstract interface
subroutine fks_mapping_compute_sumdij_soft (map, sregion, p_born, p_soft)
import
class(fks_mapping_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
end subroutine fks_mapping_compute_sumdij_soft
end interface
@ %def fks_mapping_compute_sumdij_soft
@
<<FKS regions: fks mapping: TBP>>=
procedure (fks_mapping_svalue_soft), deferred :: svalue_soft
<<FKS regions: interfaces>>=
abstract interface
function fks_mapping_svalue_soft (map, p_born, p_soft, em, i_res) result (value)
import
real(default) :: value
class(fks_mapping_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_res
end function fks_mapping_svalue_soft
end interface
@ %def fks_mapping_svalue_soft
@
<<FKS regions: fks mapping default: TBP>>=
procedure :: set_parameter => fks_mapping_default_set_parameter
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_default_set_parameter &
(map, n_in, dij_exp1, dij_exp2)
class(fks_mapping_default_t), intent(inout) :: map
integer, intent(in) :: n_in
real(default), intent(in) :: dij_exp1, dij_exp2
end subroutine fks_mapping_default_set_parameter
<<FKS regions: procedures>>=
module subroutine fks_mapping_default_set_parameter &
(map, n_in, dij_exp1, dij_exp2)
class(fks_mapping_default_t), intent(inout) :: map
integer, intent(in) :: n_in
real(default), intent(in) :: dij_exp1, dij_exp2
map%n_in = n_in
map%exp_1 = dij_exp1
map%exp_2 = dij_exp2
end subroutine fks_mapping_default_set_parameter
@ %def fks_mapping_default_set_parameter
@ Computes the $d_{ij}$-quantities defined als follows:
\begin{align*}
d_{0i} &= \left[E_i^2\left(1-y_i\right)\right]^{p_2}\\,
d_{1i} &= \left[2E_i^2\left(1-y_i\right)\right]^{p_2}\\,
d_{2i} &= \left[2E_i^2\left(1+y_i\right)\right]^{p_2}\\,
\end{align*}
for initial state regions and
\begin{align*}
d_{ij} = \left[2(k_i \cdot k_j) \frac{E_i E_j}{(E_i+E_j)^2}\right]^{p_1}
\end{align*}
for final state regions, c.f. [1002.2581, Eq. 4.23f].
The exponents $p_1$ and $p_2$ can be used for
tuning the efficiency of the mapping and are set to $1$ per default.
<<FKS regions: fks mapping default: TBP>>=
procedure :: dij => fks_mapping_default_dij
<<FKS regions: sub interfaces>>=
module function fks_mapping_default_dij (map, p, i, j, i_con) result (d)
real(default) :: d
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_con
end function fks_mapping_default_dij
<<FKS regions: procedures>>=
module function fks_mapping_default_dij (map, p, i, j, i_con) result (d)
real(default) :: d
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_con
d = zero
if (map%pseudo_isr) then
d = dij_threshold_gluon_from_top (i, j, p, map%exp_1)
else if (i > map%n_in .and. j > map%n_in) then
d = dij_fsr (p(i), p(j), map%exp_1)
else
d = dij_isr (map%n_in, i, j, p, map%exp_2)
end if
contains
function dij_fsr (p1, p2, expo) result (d_ij)
real(default) :: d_ij
type(vector4_t), intent(in) :: p1, p2
real(default), intent(in) :: expo
real(default) :: E1, E2
E1 = p1%p(0); E2 = p2%p(0)
d_ij = (two * p1 * p2 * E1 * E2 / (E1 + E2)**2)**expo
end function dij_fsr
function dij_threshold_gluon_from_top (i, j, p, expo) result (d_ij)
real(default) :: d_ij
integer, intent(in) :: i, j
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: expo
type(vector4_t) :: p_top
if (i == THR_POS_B) then
p_top = p(THR_POS_WP) + p(THR_POS_B)
else
p_top = p(THR_POS_WM) + p(THR_POS_BBAR)
end if
d_ij = dij_fsr (p_top, p(j), expo)
end function dij_threshold_gluon_from_top
function dij_isr (n_in, i, j, p, expo) result (d_ij)
real(default) :: d_ij
integer, intent(in) :: n_in, i, j
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: expo
real(default) :: E, y
select case (n_in)
case (1)
call get_emitter_variables (1, i, j, p, E, y)
d_ij = (E**2 * (one - y**2))**expo
case (2)
if ((i == 0 .and. j > 2) .or. (j == 0 .and. i > 2)) then
call get_emitter_variables (0, i, j, p, E, y)
d_ij = (E**2 * (one - y**2))**expo
else if ((i == 1 .and. j > 2) .or. (j == 1 .and. i > 2)) then
call get_emitter_variables (1, i, j, p, E, y)
d_ij = (two * E**2 * (one - y))**expo
else if ((i == 2 .and. j > 2) .or. (j == 2 .and. i > 2)) then
call get_emitter_variables (2, i, j, p, E, y)
d_ij = (two * E**2 * (one + y))**expo
end if
end select
end function dij_isr
subroutine get_emitter_variables (i_check, i, j, p, E, y)
integer, intent(in) :: i_check, i, j
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(out) :: E, y
if (j == i_check) then
E = energy (p(i))
y = polar_angle_ct (p(i))
else
E = energy (p(j))
y = polar_angle_ct(p(j))
end if
end subroutine get_emitter_variables
end function fks_mapping_default_dij
@ %def fks_mapping_default_dij
@ Computes the quantity
\begin{equation*}
\mathcal{D} = \sum_k \frac{1}{d_{0k}} + \sum_{kl} \frac{1}{d_{kl}}.
\end{equation*}
where the sum goes over all ftuples of a single singular region.
<<FKS regions: fks mapping default: TBP>>=
procedure :: compute_sumdij => fks_mapping_default_compute_sumdij
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_default_compute_sumdij (map, sregion, p_real)
class(fks_mapping_default_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_real
end subroutine fks_mapping_default_compute_sumdij
<<FKS regions: procedures>>=
module subroutine fks_mapping_default_compute_sumdij (map, sregion, p_real)
class(fks_mapping_default_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_real
real(default) :: d
integer :: i_ftuple, i, j
associate (ftuples => sregion%ftuples)
d = zero
do i_ftuple = 1, sregion%nregions
call ftuples(i_ftuple)%get (i, j)
map%pseudo_isr = ftuples(i_ftuple)%pseudo_isr
d = d + one / map%dij (p_real, i, j)
end do
end associate
map%sumdij = d
end subroutine fks_mapping_default_compute_sumdij
@ %def fks_mapping_default_compute_sumdij
@ Computes
\begin{equation*}
S_i = \frac{1}{\mathcal{D} d_{0i}}
\end{equation*}
or
\begin{equation*}
S_{ij} = \frac{1}{\mathcal{D} d_{ij}},
\end{equation*}
respectively.
<<FKS regions: fks mapping default: TBP>>=
procedure :: svalue => fks_mapping_default_svalue
<<FKS regions: sub interfaces>>=
module function fks_mapping_default_svalue &
(map, p, i, j, i_res) result (value)
real(default) :: value
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_res
end function fks_mapping_default_svalue
<<FKS regions: procedures>>=
module function fks_mapping_default_svalue &
(map, p, i, j, i_res) result (value)
real(default) :: value
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_res
value = one / (map%dij (p, i, j) * map%sumdij)
end function fks_mapping_default_svalue
@ %def fks_mapping_default_svalue
@ In the soft limit, our treatment of the divergencies requires a
modification of the mapping functions. Recall that there, the ratios of
the $d$-functions must approach either $1$ or $0$. This means
\begin{equation*}
\frac{d_{lm}}{d_{0m}} = \frac{(2k_l \cdot k_m) \left[E_lE_m /(E_l +
E_m)^2\right]}{E_m^2 (1-y^2)}
\overset {k_m = E_m \hat{k}} {=} \frac{E_l E_m^2}{(E_l + E_m)^2}
\frac{2k_l \cdot \hat{k}}{E_m^2 (1-y^2)}
\overset {E_m \to 0}{=} \frac{2k_l \cdot \hat{k}}{E_l}{(1-y^2)},
\end{equation*}
where we have written the gluon momentum in terms of the soft momentum
$\hat{k}$. In the same limit
\begin{equation*}
\frac{d_{lm}}{d_{nm}} = \frac{k_l \cdot \hat{k}}{k_n \cdot \hat{k}}
\frac{E_n}{E_l}.
\end{equation*}
From these equations we can deduce the soft limit of $d$:
\begin{align*}
d_0^{\rm{soft}} &= 1 - y^2,\\
d_1^{\rm{soft}} &= 2(1-y),\\
d_2^{\rm{soft}} &= 2(1+y),\\
d_i^{\rm{soft}} &= \frac{2 k_i \cdot \hat{k}}{E_i}.
\end{align*}
<<FKS regions: fks mapping default: TBP>>=
procedure :: dij_soft => fks_mapping_default_dij_soft
<<FKS regions: sub interfaces>>=
module function fks_mapping_default_dij_soft &
(map, p_born, p_soft, em, i_con) result (d)
real(default) :: d
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_con
end function fks_mapping_default_dij_soft
<<FKS regions: procedures>>=
module function fks_mapping_default_dij_soft &
(map, p_born, p_soft, em, i_con) result (d)
real(default) :: d
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_con
if (map%pseudo_isr) then
d = dij_soft_threshold_gluon_from_top (em, p_born, p_soft, map%exp_1)
else if (em <= map%n_in) then
d = dij_soft_isr (map%n_in, p_soft, map%exp_2)
else
d = dij_soft_fsr (p_born(em), p_soft, map%exp_1)
end if
contains
function dij_soft_threshold_gluon_from_top &
(em, p_born, p_soft, expo) result (dij_soft)
real(default) :: dij_soft
integer, intent(in) :: em
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
real(default), intent(in) :: expo
type(vector4_t) :: p_top
if (em == THR_POS_B) then
p_top = p_born(THR_POS_WP) + p_born(THR_POS_B)
else
p_top = p_born(THR_POS_WM) + p_born(THR_POS_BBAR)
end if
dij_soft = dij_soft_fsr (p_top, p_soft, expo)
end function dij_soft_threshold_gluon_from_top
function dij_soft_fsr (p_em, p_soft, expo) result (dij_soft)
real(default) :: dij_soft
type(vector4_t), intent(in) :: p_em, p_soft
real(default), intent(in) :: expo
dij_soft = (two * p_em * p_soft / p_em%p(0))**expo
end function dij_soft_fsr
function dij_soft_isr (n_in, p_soft, expo) result (dij_soft)
real(default) :: dij_soft
integer, intent(in) :: n_in
type(vector4_t), intent(in) :: p_soft
real(default), intent(in) :: expo
real(default) :: y
y = polar_angle_ct (p_soft)
select case (n_in)
case (1)
dij_soft = one - y**2
case (2)
select case (em)
case (0)
dij_soft = one - y**2
case (1)
dij_soft = two * (one - y)
case (2)
dij_soft = two * (one + y)
case default
dij_soft = zero
call msg_fatal ("fks_mappings_default_dij_soft: n_in > 2")
end select
case default
dij_soft = zero
call msg_fatal ("fks_mappings_default_dij_soft: n_in > 2")
end select
dij_soft = dij_soft**expo
end function dij_soft_isr
end function fks_mapping_default_dij_soft
@ %def fks_mapping_default_dij_soft
@ Computes the sum of all soft [[dij]]s required to normalize the soft
$S$ functions [[s_alpha_soft]] similar to
[[fks_mapping_default_compute_sumdij]]. In the soft limit however, we
need to skip all ftuples $(i,j)$ in which $j$ does not correspond to
the emitted particle because those $d_{ij}$s are finite and thus their
contribution to the soft S function vanishes in the limit of soft
radiation. Technically, they would not vanish if computed here because
the fixed [[p_soft]] at this point would not fit their actual
emitter.
<<FKS regions: fks mapping default: TBP>>=
procedure :: compute_sumdij_soft => fks_mapping_default_compute_sumdij_soft
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_default_compute_sumdij_soft &
(map, sregion, p_born, p_soft)
class(fks_mapping_default_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
end subroutine fks_mapping_default_compute_sumdij_soft
<<FKS regions: procedures>>=
module subroutine fks_mapping_default_compute_sumdij_soft &
(map, sregion, p_born, p_soft)
class(fks_mapping_default_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
real(default) :: d
integer :: i_ftuple, i, j
integer :: nlegs
d = zero
nlegs = size (sregion%flst_real%flst)
associate (ftuples => sregion%ftuples)
do i_ftuple = 1, sregion%nregions
call ftuples(i_ftuple)%get (i ,j)
if (j == nlegs) then
map%pseudo_isr = ftuples(i_ftuple)%pseudo_isr
d = d + one / map%dij_soft (p_born, p_soft, i)
end if
end do
end associate
map%sumdij_soft = d
end subroutine fks_mapping_default_compute_sumdij_soft
@ %def fks_mapping_default_compute_sumdij_soft
@
<<FKS regions: fks mapping default: TBP>>=
procedure :: svalue_soft => fks_mapping_default_svalue_soft
<<FKS regions: sub interfaces>>=
module function fks_mapping_default_svalue_soft &
(map, p_born, p_soft, em, i_res) result (value)
real(default) :: value
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_res
end function fks_mapping_default_svalue_soft
<<FKS regions: procedures>>=
module function fks_mapping_default_svalue_soft &
(map, p_born, p_soft, em, i_res) result (value)
real(default) :: value
class(fks_mapping_default_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_res
value = one / (map%sumdij_soft * map%dij_soft (p_born, p_soft, em))
end function fks_mapping_default_svalue_soft
@ %def fks_mapping_default_svalue_soft
@
<<FKS regions: interfaces>>=
interface assignment(=)
module procedure fks_mapping_default_assign
end interface
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_default_assign (fks_map_out, fks_map_in)
type(fks_mapping_default_t), intent(out) :: fks_map_out
type(fks_mapping_default_t), intent(in) :: fks_map_in
end subroutine fks_mapping_default_assign
<<FKS regions: procedures>>=
module subroutine fks_mapping_default_assign (fks_map_out, fks_map_in)
type(fks_mapping_default_t), intent(out) :: fks_map_out
type(fks_mapping_default_t), intent(in) :: fks_map_in
fks_map_out%exp_1 = fks_map_in%exp_1
fks_map_out%exp_2 = fks_map_in%exp_2
fks_map_out%n_in = fks_map_in%n_in
end subroutine fks_mapping_default_assign
@ %def fks_mapping_default_assign
@ The $d_{ij,k}$-functions for the resonance mapping are basically the same
as in the default case, but the kinematical values here must be evaluated
in the resonance frame of reference. The energy of parton $i$ in a given
resonance frame with momentum $p_{res}$ is
\begin{equation*}
E_i = \frac{p_i^0 \cdot p_{res}}{m_{res}}.
\end{equation*}
However, since the expressions only depend on ratios of four-momenta, we
leave out the denominator because it will cancel out anyway.
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: dij => fks_mapping_resonances_dij
<<FKS regions: sub interfaces>>=
module function fks_mapping_resonances_dij (map, p, i, j, i_con) result (d)
real(default) :: d
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_con
end function fks_mapping_resonances_dij
<<FKS regions: procedures>>=
module function fks_mapping_resonances_dij (map, p, i, j, i_con) result (d)
real(default) :: d
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_con
real(default) :: E1, E2
integer :: ii_con
if (present (i_con)) then
ii_con = i_con
else
call msg_fatal ("Resonance mappings require resonance index as input!")
end if
d = 0
if (i /= j) then
if (i > 2 .and. j > 2) then
associate (p_res => map%res_map%p_res (ii_con))
E1 = p(i) * p_res
E2 = p(j) * p_res
d = two * p(i) * p(j) * E1 * E2 / (E1 + E2)**2
end associate
else
call msg_fatal ("Resonance mappings are not implemented for ISR")
end if
end if
end function fks_mapping_resonances_dij
@ %def fks_mapping_resonances_dij
@ Computes
\begin{equation*}
S_\alpha = \frac{P^{f_r(\alpha)}d^{-1}(\alpha)}
{\sum_{f_r' \in T(F_r(\alpha))}P^{f_r'}\sum_{\alpha' \in Sr(f_r')}d^{-1}(\alpha)}.
\end{equation*}
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: compute_sumdij => fks_mapping_resonances_compute_sumdij
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_resonances_compute_sumdij &
(map, sregion, p_real)
class(fks_mapping_resonances_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_real
end subroutine fks_mapping_resonances_compute_sumdij
<<FKS regions: procedures>>=
module subroutine fks_mapping_resonances_compute_sumdij (map, sregion, p_real)
class(fks_mapping_resonances_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_real
real(default) :: d, pfr
integer :: i_res, i_reg, i, j, i_con
integer :: nlegreal
nlegreal = size (p_real)
d = zero
do i_reg = 1, sregion%nregions
associate (ftuple => sregion%ftuples(i_reg))
call ftuple%get (i, j)
i_res = ftuple%i_res
end associate
pfr = map%res_map%get_resonance_value (i_res, p_real, nlegreal)
i_con = sregion%i_reg_to_i_con (i_reg)
d = d + pfr / map%dij (p_real, i, j, i_con)
end do
map%sumdij = d
end subroutine fks_mapping_resonances_compute_sumdij
@ %def fks_mapping_resonances_compute_sumdij
@
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: svalue => fks_mapping_resonances_svalue
<<FKS regions: sub interfaces>>=
module function fks_mapping_resonances_svalue &
(map, p, i, j, i_res) result (value)
real(default) :: value
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_res
end function fks_mapping_resonances_svalue
<<FKS regions: procedures>>=
module function fks_mapping_resonances_svalue &
(map, p, i, j, i_res) result (value)
real(default) :: value
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: i, j
integer, intent(in), optional :: i_res
real(default) :: pfr
integer :: i_gluon
i_gluon = size (p)
pfr = map%res_map%get_resonance_value (i_res, p, i_gluon)
value = pfr / (map%dij (p, i, j, map%i_con) * map%sumdij)
end function fks_mapping_resonances_svalue
@ %def fks_mapping_resonances_svalue
@
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: get_resonance_weight => &
fks_mapping_resonances_get_resonance_weight
<<FKS regions: sub interfaces>>=
module function fks_mapping_resonances_get_resonance_weight &
(map, alr, p) result (pfr)
real(default) :: pfr
class(fks_mapping_resonances_t), intent(in) :: map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
end function fks_mapping_resonances_get_resonance_weight
<<FKS regions: procedures>>=
module function fks_mapping_resonances_get_resonance_weight &
(map, alr, p) result (pfr)
real(default) :: pfr
class(fks_mapping_resonances_t), intent(in) :: map
integer, intent(in) :: alr
type(vector4_t), intent(in), dimension(:) :: p
pfr = map%res_map%get_weight (alr, p)
end function fks_mapping_resonances_get_resonance_weight
@ %def fks_mapping_resonances_get_resonance_weight
@ As above, the soft limit of $d_{ij,k}$ must be computed in the resonance frame of
reference.
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: dij_soft => fks_mapping_resonances_dij_soft
<<FKS regions: sub interfaces>>=
module function fks_mapping_resonances_dij_soft &
(map, p_born, p_soft, em, i_con) result (d)
real(default) :: d
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_con
end function fks_mapping_resonances_dij_soft
<<FKS regions: procedures>>=
module function fks_mapping_resonances_dij_soft &
(map, p_born, p_soft, em, i_con) result (d)
real(default) :: d
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_con
real(default) :: E1, E2
integer :: ii_con
type(vector4_t) :: pb
if (present (i_con)) then
ii_con = i_con
else
call msg_fatal ("fks_mapping_resonances requires resonance index")
end if
associate (p_res => map%res_map%p_res(ii_con))
pb = p_born(em)
E1 = pb * p_res
E2 = p_soft * p_res
d = two * pb * p_soft * E1 * E2 / E1**2
end associate
end function fks_mapping_resonances_dij_soft
@ %def fks_mapping_resonances_dij_soft
@
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: compute_sumdij_soft => fks_mapping_resonances_compute_sumdij_soft
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_resonances_compute_sumdij_soft &
(map, sregion, p_born, p_soft)
class(fks_mapping_resonances_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
end subroutine fks_mapping_resonances_compute_sumdij_soft
<<FKS regions: procedures>>=
module subroutine fks_mapping_resonances_compute_sumdij_soft &
(map, sregion, p_born, p_soft)
class(fks_mapping_resonances_t), intent(inout) :: map
type(singular_region_t), intent(in) :: sregion
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
real(default) :: d
real(default) :: pfr
integer :: i_res, i, j, i_reg, i_con
integer :: nlegs
d = zero
nlegs = size (sregion%flst_real%flst)
do i_reg = 1, sregion%nregions
associate (ftuple => sregion%ftuples(i_reg))
call ftuple%get(i, j)
i_res = ftuple%i_res
end associate
pfr = map%res_map%get_resonance_value (i_res, p_born)
i_con = sregion%i_reg_to_i_con (i_reg)
if (j == nlegs) d = d + pfr / map%dij_soft (p_born, p_soft, i, i_con)
end do
map%sumdij_soft = d
end subroutine fks_mapping_resonances_compute_sumdij_soft
@ %def fks_mapping_resonances_ompute_sumdij_soft
@
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: svalue_soft => fks_mapping_resonances_svalue_soft
<<FKS regions: sub interfaces>>=
module function fks_mapping_resonances_svalue_soft &
(map, p_born, p_soft, em, i_res) result (value)
real(default) :: value
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_res
end function fks_mapping_resonances_svalue_soft
<<FKS regions: procedures>>=
module function fks_mapping_resonances_svalue_soft &
(map, p_born, p_soft, em, i_res) result (value)
real(default) :: value
class(fks_mapping_resonances_t), intent(in) :: map
type(vector4_t), intent(in), dimension(:) :: p_born
type(vector4_t), intent(in) :: p_soft
integer, intent(in) :: em
integer, intent(in), optional :: i_res
real(default) :: pfr
pfr = map%res_map%get_resonance_value (i_res, p_born)
value = pfr / (map%sumdij_soft * map%dij_soft &
(p_born, p_soft, em, map%i_con))
end function fks_mapping_resonances_svalue_soft
@ %def fks_mapping_resonances_svalue_soft
@
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: set_resonance_momentum => &
fks_mapping_resonances_set_resonance_momentum
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_resonances_set_resonance_momentum (map, p)
class(fks_mapping_resonances_t), intent(inout) :: map
type(vector4_t), intent(in) :: p
end subroutine fks_mapping_resonances_set_resonance_momentum
<<FKS regions: procedures>>=
module subroutine fks_mapping_resonances_set_resonance_momentum (map, p)
class(fks_mapping_resonances_t), intent(inout) :: map
type(vector4_t), intent(in) :: p
map%res_map%p_res = p
end subroutine fks_mapping_resonances_set_resonance_momentum
@ %def fks_mapping_resonances_set_resonance_momentum
@
<<FKS regions: fks mapping resonances: TBP>>=
procedure :: set_resonance_momenta => &
fks_mapping_resonances_set_resonance_momenta
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_resonances_set_resonance_momenta (map, p)
class(fks_mapping_resonances_t), intent(inout) :: map
type(vector4_t), intent(in), dimension(:) :: p
end subroutine fks_mapping_resonances_set_resonance_momenta
<<FKS regions: procedures>>=
module subroutine fks_mapping_resonances_set_resonance_momenta (map, p)
class(fks_mapping_resonances_t), intent(inout) :: map
type(vector4_t), intent(in), dimension(:) :: p
map%res_map%p_res = p
end subroutine fks_mapping_resonances_set_resonance_momenta
@ %def fks_mapping_resonances_set_resonance_momenta
@
<<FKS regions: interfaces>>=
interface assignment(=)
module procedure fks_mapping_resonances_assign
end interface
<<FKS regions: sub interfaces>>=
module subroutine fks_mapping_resonances_assign (fks_map_out, fks_map_in)
type(fks_mapping_resonances_t), intent(out) :: fks_map_out
type(fks_mapping_resonances_t), intent(in) :: fks_map_in
end subroutine fks_mapping_resonances_assign
<<FKS regions: procedures>>=
module subroutine fks_mapping_resonances_assign (fks_map_out, fks_map_in)
type(fks_mapping_resonances_t), intent(out) :: fks_map_out
type(fks_mapping_resonances_t), intent(in) :: fks_map_in
fks_map_out%exp_1 = fks_map_in%exp_1
fks_map_out%exp_2 = fks_map_in%exp_2
fks_map_out%res_map = fks_map_in%res_map
end subroutine fks_mapping_resonances_assign
@ %def fks_mapping_resonances_assign
@
<<FKS regions: public>>=
public :: create_resonance_histories_for_threshold
<<FKS regions: sub interfaces>>=
module function create_resonance_histories_for_threshold &
() result (res_history)
type(resonance_history_t) :: res_history
end function create_resonance_histories_for_threshold
<<FKS regions: procedures>>=
module function create_resonance_histories_for_threshold &
() result (res_history)
type(resonance_history_t) :: res_history
res_history%n_resonances = 2
allocate (res_history%resonances (2))
allocate (res_history%resonances(1)%contributors%c(2))
allocate (res_history%resonances(2)%contributors%c(2))
res_history%resonances(1)%contributors%c = [THR_POS_WP, THR_POS_B]
res_history%resonances(2)%contributors%c = [THR_POS_WM, THR_POS_BBAR]
end function create_resonance_histories_for_threshold
@ %def create_resonance_histories_for_threshold
@
<<FKS regions: public>>=
public :: setup_region_data_for_test
<<FKS regions: sub interfaces>>=
module subroutine setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, &
nlo_corr_type, alpha_pow, alphas_pow)
integer, intent(in) :: n_in, alpha_pow, alphas_pow
integer, intent(in), dimension(:,:) :: flv_born, flv_real
type(string_t), intent(in) :: nlo_corr_type
type(region_data_t), intent(out) :: reg_data
end subroutine setup_region_data_for_test
<<FKS regions: procedures>>=
module subroutine setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, &
nlo_corr_type, alpha_pow, alphas_pow)
integer, intent(in) :: n_in, alpha_pow, alphas_pow
integer, intent(in), dimension(:,:) :: flv_born, flv_real
type(string_t), intent(in) :: nlo_corr_type
type(region_data_t), intent(out) :: reg_data
type(model_t), pointer :: test_model => null ()
call create_test_model (var_str ("SM"), test_model)
call test_model%set_real (var_str ("me"), 0._default)
call test_model%set_real (var_str ("mmu"), 0._default)
call test_model%set_real (var_str ("mtau"), 0._default)
call test_model%set_real (var_str ("ms"), 0._default)
call test_model%set_real (var_str ("mc"), 0._default)
call test_model%set_real (var_str ("mb"), 0._default)
call reg_data%init (n_in, test_model, flv_born, flv_real, nlo_corr_type, alpha_pow, &
alphas_pow)
end subroutine setup_region_data_for_test
@ %def setup_region_data_for_test
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Unit tests}
\clearpage
<<[[fks_regions_ut.f90]]>>=
<<File header>>
module fks_regions_ut
use unit_tests
use fks_regions_uti
<<Standard module head>>
<<FKS regions: public test>>
contains
<<FKS regions: test driver>>
end module fks_regions_ut
@ %def fks_regions_ut
@
<<[[fks_regions_uti.f90]]>>=
<<File header>>
module fks_regions_uti
<<Use strings>>
use format_utils, only: write_separator
use os_interface
use models
use fks_regions
<<Standard module head>>
<<FKS regions: test declarations>>
contains
<<FKS regions: tests>>
end module fks_regions_uti
@ %def fks_regions_uti
@
<<FKS regions: public test>>=
public :: fks_regions_test
<<FKS regions: test driver>>=
subroutine fks_regions_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
call test(fks_regions_1, "fks_regions_1", &
"Test flavor structure utilities", u, results)
call test(fks_regions_2, "fks_regions_2", &
"Test singular regions for final-state radiation for n = 2", &
u, results)
call test(fks_regions_3, "fks_regions_3", &
"Test singular regions for final-state radiation for n = 3", &
u, results)
call test(fks_regions_4, "fks_regions_4", &
"Test singular regions for final-state radiation for n = 4", &
u, results)
call test(fks_regions_5, "fks_regions_5", &
"Test singular regions for final-state radiation for n = 5", &
u, results)
call test(fks_regions_6, "fks_regions_6", &
"Test singular regions for initial-state radiation", &
u, results)
call test(fks_regions_7, "fks_regions_7", &
"Check Latex output", u, results)
call test(fks_regions_8, "fks_regions_8", &
"Test singular regions for initial-state photon contributions", &
u, results)
end subroutine fks_regions_test
@ %def fks_regions_test
@
<<FKS regions: test declarations>>=
public :: fks_regions_1
<<FKS regions: tests>>=
subroutine fks_regions_1 (u)
integer, intent(in) :: u
type(flv_structure_t) :: flv_born, flv_real
type(model_t), pointer :: test_model => null ()
write (u, "(A)") "* Test output: fks_regions_1"
write (u, "(A)") "* Purpose: Test utilities of flavor structure manipulation"
write (u, "(A)")
call create_test_model (var_str ("SM"), test_model)
flv_born = [11, -11, 2, -2]
flv_real = [11, -11, 2, -2, 21]
flv_born%n_in = 2; flv_real%n_in = 2
write (u, "(A)") "* Valid splittings of ee -> uu"
write (u, "(A)") "Born Flavors: "
call flv_born%write (u)
write (u, "(A)") "Real Flavors: "
call flv_real%write (u)
write (u, "(A,L1)") "3, 4 (2, -2) : ", flv_real%valid_pair (3, 4, flv_born, test_model)
write (u, "(A,L1)") "4, 3 (-2, 2) : ", flv_real%valid_pair (4, 3, flv_born, test_model)
write (u, "(A,L1)") "3, 5 (2, 21) : ", flv_real%valid_pair (3, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 3 (21, 2) : ", flv_real%valid_pair (5, 3, flv_born, test_model)
write (u, "(A,L1)") "4, 5 (-2, 21): ", flv_real%valid_pair (4, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 4 (21, -2): ", flv_real%valid_pair (5, 4, flv_born, test_model)
call write_separator (u)
call flv_born%final ()
call flv_real%final ()
flv_born = [2, -2, 11, -11]
flv_real = [2, -2, 11, -11, 21]
flv_born%n_in = 2; flv_real%n_in = 2
write (u, "(A)") "* Valid splittings of uu -> ee"
write (u, "(A)") "Born Flavors: "
call flv_born%write (u)
write (u, "(A)") "Real Flavors: "
call flv_real%write (u)
write (u, "(A,L1)") "1, 2 (2, -2) : " , flv_real%valid_pair (1, 2, flv_born, test_model)
write (u, "(A,L1)") "2, 1 (-2, 2) : " , flv_real%valid_pair (2, 1, flv_born, test_model)
write (u, "(A,L1)") "5, 2 (21, -2): " , flv_real%valid_pair (5, 2, flv_born, test_model)
write (u, "(A,L1)") "2, 5 (-2, 21): " , flv_real%valid_pair (2, 5, flv_born, test_model)
write (u, "(A,L1)") "1, 5 (21, 2) : " , flv_real%valid_pair (5, 1, flv_born, test_model)
write (u, "(A,L1)") "5, 1 (2, 21) : " , flv_real%valid_pair (1, 5, flv_born, test_model)
call flv_real%final ()
flv_real = [21, -2, 11, -11, -2]
flv_real%n_in = 2
write (u, "(A)") "Real Flavors: "
call flv_real%write (u)
write (u, "(A,L1)") "1, 2 (21, -2): " , flv_real%valid_pair (1, 2, flv_born, test_model)
write (u, "(A,L1)") "2, 1 (-2, 21): " , flv_real%valid_pair (2, 1, flv_born, test_model)
write (u, "(A,L1)") "5, 2 (-2, -2): " , flv_real%valid_pair (5, 2, flv_born, test_model)
write (u, "(A,L1)") "2, 5 (-2, -2): " , flv_real%valid_pair (2, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 1 (-2, 21): " , flv_real%valid_pair (5, 1, flv_born, test_model)
write (u, "(A,L1)") "1, 5 (21, -2): " , flv_real%valid_pair (1, 5, flv_born, test_model)
call flv_real%final ()
flv_real = [2, 21, 11, -11, 2]
flv_real%n_in = 2
write (u, "(A)") "Real Flavors: "
call flv_real%write (u)
write (u, "(A,L1)") "1, 2 (2, 21) : " , flv_real%valid_pair (1, 2, flv_born, test_model)
write (u, "(A,L1)") "2, 1 (21, 2) : " , flv_real%valid_pair (2, 1, flv_born, test_model)
write (u, "(A,L1)") "5, 2 (2, 21) : " , flv_real%valid_pair (5, 2, flv_born, test_model)
write (u, "(A,L1)") "2, 5 (21, 2) : " , flv_real%valid_pair (2, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 1 (2, 2) : " , flv_real%valid_pair (5, 1, flv_born, test_model)
write (u, "(A,L1)") "1, 5 (2, 2) : " , flv_real%valid_pair (1, 5, flv_born, test_model)
call write_separator (u)
call flv_born%final ()
call flv_real%final ()
flv_born = [11, -11, 2, -2, 21]
flv_real = [11, -11, 2, -2, 21, 21]
flv_born%n_in = 2; flv_real%n_in = 2
write (u, "(A)") "* Valid splittings of ee -> uug"
write (u, "(A)") "Born Flavors: "
call flv_born%write (u)
write (u, "(A)") "Real Flavors: "
call flv_real%write (u)
write (u, "(A,L1)") "3, 4 (2, -2) : " , flv_real%valid_pair (3, 4, flv_born, test_model)
write (u, "(A,L1)") "4, 3 (-2, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model)
write (u, "(A,L1)") "3, 5 (2, 21) : " , flv_real%valid_pair (3, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 3 (21, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model)
write (u, "(A,L1)") "4, 5 (-2, 21): " , flv_real%valid_pair (4, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 4 (21, -2): " , flv_real%valid_pair (5, 4, flv_born, test_model)
write (u, "(A,L1)") "3, 6 (2, 21) : " , flv_real%valid_pair (3, 6, flv_born, test_model)
write (u, "(A,L1)") "6, 3 (21, 2) : " , flv_real%valid_pair (6, 3, flv_born, test_model)
write (u, "(A,L1)") "4, 6 (-2, 21): " , flv_real%valid_pair (4, 6, flv_born, test_model)
write (u, "(A,L1)") "6, 4 (21, -2): " , flv_real%valid_pair (6, 4, flv_born, test_model)
write (u, "(A,L1)") "5, 6 (21, 21): " , flv_real%valid_pair (5, 6, flv_born, test_model)
write (u, "(A,L1)") "6, 5 (21, 21): " , flv_real%valid_pair (6, 5, flv_born, test_model)
call flv_real%final ()
flv_real = [11, -11, 2, -2, 1, -1]
flv_real%n_in = 2
write (u, "(A)") "Real Flavors (exemplary g -> dd splitting): "
call flv_real%write (u)
write (u, "(A,L1)") "3, 4 (2, -2) : " , flv_real%valid_pair (3, 4, flv_born, test_model)
write (u, "(A,L1)") "4, 3 (-2, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model)
write (u, "(A,L1)") "3, 5 (2, 1) : " , flv_real%valid_pair (3, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 3 (1, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model)
write (u, "(A,L1)") "4, 5 (-2, 1) : " , flv_real%valid_pair (4, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 4 (1, -2) : " , flv_real%valid_pair (5, 4, flv_born, test_model)
write (u, "(A,L1)") "3, 6 (2, -1) : " , flv_real%valid_pair (3, 6, flv_born, test_model)
write (u, "(A,L1)") "6, 3 (-1, 2) : " , flv_real%valid_pair (6, 3, flv_born, test_model)
write (u, "(A,L1)") "4, 6 (-2, -1): " , flv_real%valid_pair (4, 6, flv_born, test_model)
write (u, "(A,L1)") "6, 4 (-1, -2): " , flv_real%valid_pair (6, 4, flv_born, test_model)
write (u, "(A,L1)") "5, 6 (1, -1) : " , flv_real%valid_pair (5, 6, flv_born, test_model)
write (u, "(A,L1)") "6, 5 (-1, 1) : " , flv_real%valid_pair (6, 5, flv_born, test_model)
call write_separator (u)
call flv_born%final ()
call flv_real%final ()
flv_born = [6, -5, 2, -1 ]
flv_real = [6, -5, 2, -1, 21]
flv_born%n_in = 1; flv_real%n_in = 1
write (u, "(A)") "* Valid splittings of t -> b u d~"
write (u, "(A)") "Born Flavors: "
call flv_born%write (u)
write (u, "(A)") "Real Flavors: "
call flv_real%write (u)
write (u, "(A,L1)") "1, 2 (6, -5) : " , flv_real%valid_pair (1, 2, flv_born, test_model)
write (u, "(A,L1)") "1, 3 (6, 2) : " , flv_real%valid_pair (1, 3, flv_born, test_model)
write (u, "(A,L1)") "1, 4 (6, -1) : " , flv_real%valid_pair (1, 4, flv_born, test_model)
write (u, "(A,L1)") "2, 1 (-5, 6) : " , flv_real%valid_pair (2, 1, flv_born, test_model)
write (u, "(A,L1)") "3, 1 (2, 6) : " , flv_real%valid_pair (3, 1, flv_born, test_model)
write (u, "(A,L1)") "4, 1 (-1, 6) : " , flv_real%valid_pair (4, 1, flv_born, test_model)
write (u, "(A,L1)") "2, 3 (-5, 2) : " , flv_real%valid_pair (2, 3, flv_born, test_model)
write (u, "(A,L1)") "2, 4 (-5, -1): " , flv_real%valid_pair (2, 4, flv_born, test_model)
write (u, "(A,L1)") "3, 2 (2, -5) : " , flv_real%valid_pair (3, 2, flv_born, test_model)
write (u, "(A,L1)") "4, 2 (-1, -5): " , flv_real%valid_pair (4, 2, flv_born, test_model)
write (u, "(A,L1)") "3, 4 (2, -1) : " , flv_real%valid_pair (3, 4, flv_born, test_model)
write (u, "(A,L1)") "4, 3 (-1, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model)
write (u, "(A,L1)") "1, 5 (6, 21) : " , flv_real%valid_pair (1, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 1 (21, 6) : " , flv_real%valid_pair (5, 1, flv_born, test_model)
write (u, "(A,L1)") "2, 5 (-5, 21): " , flv_real%valid_pair (2, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 2 (21, 5) : " , flv_real%valid_pair (5, 2, flv_born, test_model)
write (u, "(A,L1)") "3, 5 (2, 21) : " , flv_real%valid_pair (3, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 3 (21, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model)
write (u, "(A,L1)") "4, 5 (-1, 21): " , flv_real%valid_pair (4, 5, flv_born, test_model)
write (u, "(A,L1)") "5, 4 (21, -1): " , flv_real%valid_pair (5, 4, flv_born, test_model)
call flv_born%final ()
call flv_real%final ()
end subroutine fks_regions_1
@ %def fks_regions_1
@
<<FKS regions: test declarations>>=
public :: fks_regions_2
<<FKS regions: tests>>=
subroutine fks_regions_2 (u)
integer, intent(in) :: u
integer :: n_flv_born, n_flv_real
integer :: n_legs_born, n_legs_real
integer :: n_in
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(region_data_t) :: reg_data
write (u, "(A)") "* Test output: fks_regions_2"
write (u, "(A)") "* Create singular regions for processes with up to four singular regions"
write (u, "(A)") "* ee -> qq with QCD corrections"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 1
n_legs_born = 4; n_legs_real = 5
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, 2, -2]
flv_real (:, 1) = [11, -11, 2, -2, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
call write_separator (u)
write (u, "(A)") "* ee -> qq with EW corrections"
write (u, "(A)")
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, 2, -2]
flv_real (:, 1) = [11, -11, 2, -2, 22]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 2, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
call write_separator (u)
write (u, "(A)") "* ee -> tt"
write (u, "(A)")
write (u, "(A)") "* This process has four singular regions because they are not equivalent."
n_flv_born = 1; n_flv_real = 1
n_legs_born = 6; n_legs_real = 7
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, 6, -6, 6, -6]
flv_real (:, 1) = [11, -11, 6, -6, 6, -6, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 4, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
end subroutine fks_regions_2
@ %def fks_regions_2
@
<<FKS regions: test declarations>>=
public :: fks_regions_3
<<FKS regions: tests>>=
subroutine fks_regions_3 (u)
integer, intent(in) :: u
integer :: n_flv_born, n_flv_real
integer :: n_legs_born, n_legs_real
integer :: n_in, i, j
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(region_data_t) :: reg_data
write (u, "(A)") "* Test output: fks_regions_3"
write (u, "(A)") "* Create singular regions for processes with three final-state particles"
write (u, "(A)") "* ee -> qqg"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 2
n_legs_born = 5; n_legs_real = 6
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, 2, -2, 21]
flv_real (:, 1) = [11, -11, 2, -2, 21, 21]
flv_real (:, 2) = [11, -11, 2, -2, 1, -1]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 1)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
call write_separator (u)
write (u, "(A)") "* ee -> qqA"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 2
n_legs_born = 5; n_legs_real = 6
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, 2, -2, 22]
flv_real (:, 1) = [11, -11, 2, -2, 22, 22]
flv_real (:, 2) = [11, -11, 2, -2, 11, -11]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 3, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
call write_separator (u)
write (u, "(A)") "* ee -> jet jet jet"
write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl"
write (u, "(A)")
n_flv_born = 5; n_flv_real = 22
n_legs_born = 5; n_legs_real = 6
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, -4, 4, 21]
flv_born (:, 2) = [11, -11, -2, 2, 21]
flv_born (:, 3) = [11, -11, -5, 5, 21]
flv_born (:, 4) = [11, -11, -3, 3, 21]
flv_born (:, 5) = [11, -11, -1, 1, 21]
flv_real (:, 1) = [11, -11, -4, -4, 4, 4]
flv_real (:, 2) = [11, -11, -4, -2, 2, 4]
flv_real (:, 3) = [11, -11, -4, 4, 21, 21]
flv_real (:, 4) = [11, -11, -4, -5, 4, 5]
flv_real (:, 5) = [11, -11, -4, -3, 4, 3]
flv_real (:, 6) = [11, -11, -4, -1, 2, 3]
flv_real (:, 7) = [11, -11, -4, -1, 4, 1]
flv_real (:, 8) = [11, -11, -2, -2, 2, 2]
flv_real (:, 9) = [11, -11, -2, 2, 21, 21]
flv_real (:, 10) = [11, -11, -2, -5, 2, 5]
flv_real (:, 11) = [11, -11, -2, -3, 2, 3]
flv_real (:, 12) = [11, -11, -2, -3, 4, 1]
flv_real (:, 13) = [11, -11, -2, -1, 2, 1]
flv_real (:, 14) = [11, -11, -5, -5, 5, 5]
flv_real (:, 15) = [11, -11, -5, -3, 3, 5]
flv_real (:, 16) = [11, -11, -5, -1, 1, 5]
flv_real (:, 17) = [11, -11, -5, 5, 21, 21]
flv_real (:, 18) = [11, -11, -3, -3, 3, 3]
flv_real (:, 19) = [11, -11, -3, -1, 1, 3]
flv_real (:, 20) = [11, -11, -3, 3, 21, 21]
flv_real (:, 21) = [11, -11, -1, -1, 1, 1]
flv_real (:, 22) = [11, -11, -1, 1, 21, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 1)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
call write_separator (u)
write (u, "(A)") "* ee -> L L A"
write (u, "(A)") "* with L = e2:E2:e3:E3"
write (u, "(A)")
n_flv_born = 2; n_flv_real = 6
n_legs_born = 5; n_legs_real = 6
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, -15, 15, 22]
flv_born (:, 2) = [11, -11, -13, 13, 22]
flv_real (:, 1) = [11, -11, -15, -15, 15, 15]
flv_real (:, 2) = [11, -11, -15, -13, 13, 13]
flv_real (:, 3) = [11, -11, -13, -15, 13, 15]
flv_real (:, 4) = [11, -11, -15, 15, 22, 22]
flv_real (:, 5) = [11, -11, -13, -13, 13, 13]
flv_real (:, 6) = [11, -11, -13, 13, 22, 22]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 3, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
end subroutine fks_regions_3
@ %def fks_regions_3
@
<<FKS regions: test declarations>>=
public :: fks_regions_4
<<FKS regions: tests>>=
subroutine fks_regions_4 (u)
integer, intent(in) :: u
integer :: n_flv_born, n_flv_real
integer :: n_legs_born, n_legs_real
integer :: n_in
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(region_data_t) :: reg_data
write (u, "(A)") "* Test output: fks_regions_4"
write (u, "(A)") "* Create singular regions for processes with four final-state particles"
write (u, "(A)") "* ee -> 4 jet"
write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl"
write (u, "(A)")
n_flv_born = 22; n_flv_real = 22
n_legs_born = 6; n_legs_real = 7
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, -4, -4, 4, 4]
flv_born (:, 2) = [11, -11, -4, -2, 2, 4]
flv_born (:, 3) = [11, -11, -4, 4, 21, 21]
flv_born (:, 4) = [11, -11, -4, -5, 4, 5]
flv_born (:, 5) = [11, -11, -4, -3, 4, 3]
flv_born (:, 6) = [11, -11, -4, -1, 2, 3]
flv_born (:, 7) = [11, -11, -4, -1, 4, 1]
flv_born (:, 8) = [11, -11, -2, -2, 2, 2]
flv_born (:, 9) = [11, -11, -2, 2, 21, 21]
flv_born (:, 10) = [11, -11, -2, -5, 2, 5]
flv_born (:, 11) = [11, -11, -2, -3, 2, 3]
flv_born (:, 12) = [11, -11, -2, -3, 4, 1]
flv_born (:, 13) = [11, -11, -2, -1, 2, 1]
flv_born (:, 14) = [11, -11, -5, -5, 5, 5]
flv_born (:, 15) = [11, -11, -5, -3, 3, 5]
flv_born (:, 16) = [11, -11, -5, -1, 1, 5]
flv_born (:, 17) = [11, -11, -5, 5, 21, 21]
flv_born (:, 18) = [11, -11, -3, -3, 3, 3]
flv_born (:, 19) = [11, -11, -3, -1, 1, 3]
flv_born (:, 20) = [11, -11, -3, -3, 21, 21]
flv_born (:, 21) = [11, -11, -1, -1, 1, 1]
flv_born (:, 22) = [11, -11, -1, 1, 21, 21]
flv_real (:, 1) = [11, -11, -4, -4, 4, 4, 21]
flv_real (:, 2) = [11, -11, -4, -2, 2, 4, 21]
flv_real (:, 3) = [11, -11, -4, 4, 21, 21, 21]
flv_real (:, 4) = [11, -11, -4, -5, 4, 5, 21]
flv_real (:, 5) = [11, -11, -4, -3, 4, 3, 21]
flv_real (:, 6) = [11, -11, -4, -1, 2, 3, 21]
flv_real (:, 7) = [11, -11, -4, -1, 4, 1, 21]
flv_real (:, 8) = [11, -11, -2, -2, 2, 2, 21]
flv_real (:, 9) = [11, -11, -2, 2, 21, 21, 21]
flv_real (:, 10) = [11, -11, -2, -5, 2, 5, 21]
flv_real (:, 11) = [11, -11, -2, -3, 2, 3, 21]
flv_real (:, 12) = [11, -11, -2, -3, 4, 1, 21]
flv_real (:, 13) = [11, -11, -2, -1, 2, 1, 21]
flv_real (:, 14) = [11, -11, -5, -5, 5, 5, 21]
flv_real (:, 15) = [11, -11, -5, -3, 3, 5, 21]
flv_real (:, 16) = [11, -11, -5, -1, 1, 5, 21]
flv_real (:, 17) = [11, -11, -5, 5, 21, 21, 21]
flv_real (:, 18) = [11, -11, -3, -3, 3, 3, 21]
flv_real (:, 19) = [11, -11, -3, -1, 1, 3, 21]
flv_real (:, 20) = [11, -11, -3, 3, 21, 21, 21]
flv_real (:, 21) = [11, -11, -1, -1, 1, 1, 21]
flv_real (:, 22) = [11, -11, -1, 1, 21, 21, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 2)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
call write_separator (u)
write (u, "(A)") "* ee -> bbmumu with QCD corrections"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 1
n_legs_born = 6; n_legs_real = 7
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, -5, 5, -13, 13]
flv_real (:, 1) = [11, -11, -5, 5, -13, 13, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 4, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
call write_separator (u)
write (u, "(A)") "* ee -> bbmumu with EW corrections"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 1
n_legs_born = 6; n_legs_real = 7
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, -5, 5, -13, 13]
flv_real (:, 1) = [11, -11, -5, 5, -13, 13, 22]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 4, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
end subroutine fks_regions_4
@ %def fks_regions_4
@
<<FKS regions: test declarations>>=
public :: fks_regions_5
<<FKS regions: tests>>=
subroutine fks_regions_5 (u)
integer, intent(in) :: u
integer :: n_flv_born, n_flv_real
integer :: n_legs_born, n_legs_real
integer :: n_in
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(region_data_t) :: reg_data
write (u, "(A)") "* Test output: fks_regions_5"
write (u, "(A)") "* Create singular regions for processes with five final-state particles"
write (u, "(A)") "* ee -> 5 jet"
write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl"
write (u, "(A)")
n_flv_born = 22; n_flv_real = 67
n_legs_born = 7; n_legs_real = 8
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:,1) = [11,-11,-4,-4,4,4,21]
flv_born (:,2) = [11,-11,-4,-2,2,4,21]
flv_born (:,3) = [11,-11,-4,4,21,21,21]
flv_born (:,4) = [11,-11,-4,-5,4,5,21]
flv_born (:,5) = [11,-11,-4,-3,4,3,21]
flv_born (:,6) = [11,-11,-4,-1,2,3,21]
flv_born (:,7) = [11,-11,-4,-1,4,1,21]
flv_born (:,8) = [11,-11,-2,-2,2,2,21]
flv_born (:,9) = [11,-11,-2,2,21,21,21]
flv_born (:,10) = [11,-11,-2,-5,2,5,21]
flv_born (:,11) = [11,-11,-2,-3,2,3,21]
flv_born (:,12) = [11,-11,-2,-3,4,1,21]
flv_born (:,13) = [11,-11,-2,-1,2,1,21]
flv_born (:,14) = [11,-11,-5,-5,5,5,21]
flv_born (:,15) = [11,-11,-5,-3,3,5,21]
flv_born (:,16) = [11,-11,-5,-1,1,5,21]
flv_born (:,17) = [11,-11,-5,5,21,21,21]
flv_born (:,18) = [11,-11,-3,-3,3,3,21]
flv_born (:,19) = [11,-11,-3,-1,1,3,21]
flv_born (:,20) = [11,-11,-3,3,21,21,21]
flv_born (:,21) = [11,-11,-1,-1,1,1,21]
flv_born (:,22) = [11,-11,-1,1,21,21,21]
flv_real (:,1) = [11,-11,-4,-4,-4,4,4,4]
flv_real (:,2) = [11,-11,-4,-4,-2,2,4,4]
flv_real (:,3) = [11,-11,-4,-4,4,4,21,21]
flv_real (:,4) = [11,-11,-4,-4,-5,4,4,5]
flv_real (:,5) = [11,-11,-4,-4,-3,4,4,3]
flv_real (:,6) = [11,-11,-4,-4,-1,2,4,3]
flv_real (:,7) = [11,-11,-4,-4,-1,4,4,1]
flv_real (:,8) = [11,-11,-4,-2,-2,2,2,4]
flv_real (:,9) = [11,-11,-4,-2,2,4,21,21]
flv_real (:,10) = [11,-11,-4,-2,-5,2,4,5]
flv_real (:,11) = [11,-11,-4,-2,-3,2,4,3]
flv_real (:,12) = [11,-11,-4,-2,-3,4,4,1]
flv_real (:,13) = [11,-11,-4,-2,-1,2,2,3]
flv_real (:,14) = [11,-11,-4,-2,-1,2,4,1]
flv_real (:,15) = [11,-11,-4,4,21,21,21,21]
flv_real (:,16) = [11,-11,-4,-5,4,5,21,21]
flv_real (:,17) = [11,-11,-4,-5,-5,4,5,5]
flv_real (:,18) = [11,-11,-4,-5,-3,4,3,5]
flv_real (:,19) = [11,-11,-4,-5,-1,2,3,5]
flv_real (:,20) = [11,-11,-4,-5,-1,4,1,5]
flv_real (:,21) = [11,-11,-4,-3,4,3,21,21]
flv_real (:,22) = [11,-11,-4,-3,-3,4,3,3]
flv_real (:,23) = [11,-11,-4,-3,-1,2,3,3]
flv_real (:,24) = [11,-11,-4,-3,-1,4,1,3]
flv_real (:,25) = [11,-11,-4,-1,2,3,21,21]
flv_real (:,26) = [11,-11,-4,-1,4,1,21,21]
flv_real (:,27) = [11,-11,-4,-1,-1,2,1,3]
flv_real (:,28) = [11,-11,-4,-1,-1,4,1,1]
flv_real (:,29) = [11,-11,-2,-2,-2,2,2,2]
flv_real (:,30) = [11,-11,-2,-2,2,2,21,21]
flv_real (:,31) = [11,-11,-2,-2,-5,2,2,5]
flv_real (:,32) = [11,-11,-2,-2,-3,2,2,3]
flv_real (:,33) = [11,-11,-2,-2,-3,2,4,1]
flv_real (:,34) = [11,-11,-2,-2,-1,2,2,1]
flv_real (:,35) = [11,-11,-2,2,21,21,21,21]
flv_real (:,36) = [11,-11,-2,-5,2,5,21,21]
flv_real (:,37) = [11,-11,-2,-5,-5,2,5,5]
flv_real (:,38) = [11,-11,-2,-5,-3,2,3,5]
flv_real (:,39) = [11,-11,-2,-5,-3,4,1,5]
flv_real (:,40) = [11,-11,-2,-5,-1,2,1,5]
flv_real (:,41) = [11,-11,-2,-3,2,3,21,21]
flv_real (:,42) = [11,-11,-2,-3,4,1,21,21]
flv_real (:,43) = [11,-11,-2,-3,-3,2,3,3]
flv_real (:,44) = [11,-11,-2,-3,-3,4,1,3]
flv_real (:,45) = [11,-11,-2,-3,-1,2,1,3]
flv_real (:,46) = [11,-11,-2,-3,-1,4,1,1]
flv_real (:,47) = [11,-11,-2,-1,2,1,21,21]
flv_real (:,48) = [11,-11,-2,-1,-1,2,1,1]
flv_real (:,49) = [11,-11,-5,-5,-5,5,5,5]
flv_real (:,50) = [11,-11,-5,-5,-3,3,5,5]
flv_real (:,51) = [11,-11,-5,-5,-1,1,5,5]
flv_real (:,52) = [11,-11,-5,-5,5,5,21,21]
flv_real (:,53) = [11,-11,-5,-3,-3,3,3,5]
flv_real (:,54) = [11,-11,-5,-3,-1,1,3,5]
flv_real (:,55) = [11,-11,-5,-3,3,5,21,21]
flv_real (:,56) = [11,-11,-5,-1,-1,1,1,5]
flv_real (:,57) = [11,-11,-5,-1,1,5,21,21]
flv_real (:,58) = [11,-11,-5,5,21,21,21,21]
flv_real (:,59) = [11,-11,-3,-3,-3,3,3,3]
flv_real (:,60) = [11,-11,-3,-3,-1,1,3,3]
flv_real (:,61) = [11,-11,-3,-3,3,3,21,21]
flv_real (:,62) = [11,-11,-3,-1,-1,1,1,3]
flv_real (:,63) = [11,-11,-3,-1,1,3,21,21]
flv_real (:,64) = [11,-11,-3,3,21,21,21,21]
flv_real (:,65) = [11,-11,-1,-1,-1,1,1,1]
flv_real (:,66) = [11,-11,-1,-1,1,1,21,21]
flv_real (:,67) = [11,-11,-1,1,21,21,21,21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 3)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
end subroutine fks_regions_5
@ %def fks_regions_5
@
<<FKS regions: test declarations>>=
public :: fks_regions_6
<<FKS regions: tests>>=
subroutine fks_regions_6 (u)
integer, intent(in) :: u
integer :: n_flv_born, n_flv_real
integer :: n_legs_born, n_legs_real
integer :: n_in
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(region_data_t) :: reg_data
integer :: i, j
integer, dimension(10) :: flavors
write (u, "(A)") "* Test output: fks_regions_6"
write (u, "(A)") "* Create table of singular regions for Drell Yan"
write (u, "(A)")
n_flv_born = 10; n_flv_real = 30
n_legs_born = 4; n_legs_real = 5
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flavors = [-5, -4, -3, -2, -1, 1, 2, 3, 4, 5]
do i = 1, n_flv_born
flv_born (3:4, i) = [11, -11]
end do
do j = 1, n_flv_born
flv_born (1, j) = flavors (j)
flv_born (2, j) = -flavors (j)
end do
do i = 1, n_flv_real
flv_real (3:4, i) = [11, -11]
end do
i = 1
do j = 1, n_flv_real
if (mod (j, 3) == 1) then
flv_real (1, j) = flavors (i)
flv_real (2, j) = -flavors (i)
flv_real (5, j) = 21
else if (mod (j, 3) == 2) then
flv_real (1, j) = flavors (i)
flv_real (2, j) = 21
flv_real (5, j) = flavors (i)
else
flv_real (1, j) = 21
flv_real (2, j) = -flavors (i)
flv_real (5, j) = -flavors (i)
i = i + 1
end if
end do
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
call write_separator (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
write (u, "(A)") "* Create table of singular regions for hadronic top decay"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 1
n_legs_born = 4; n_legs_real = 5
n_in = 1
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [6, -5, 2, -1]
flv_real (:, 1) = [6, -5, 2, -1, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 0, 2)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
call write_separator (u)
deallocate (flv_born, flv_real)
call reg_data%final ()
write (u, "(A)") "* Create table of singular regions for dijet s sbar -> jet jet"
write (u, "(A)") "* With jet = u:d:gl"
write (u, "(A)")
n_flv_born = 3; n_flv_real = 3
n_legs_born = 4; n_legs_real = 5
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
do i = 1, n_flv_born
flv_born (1:2, i) = [3, -3]
end do
flv_born (3, :) = [1, 2, 21]
flv_born (4, :) = [-1, -2, 21]
do i = 1, n_flv_real
flv_real (1:2, i) = [3, -3]
end do
flv_real (3, :) = [1, 2, 21]
flv_real (4, :) = [-1, -2, 21]
flv_real (5, :) = [21, 21, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 0, 2)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
call reg_data%final ()
end subroutine fks_regions_6
@ %def fks_regions_6
@
<<FKS regions: test declarations>>=
public :: fks_regions_7
<<FKS regions: tests>>=
subroutine fks_regions_7 (u)
integer, intent(in) :: u
integer :: n_flv_born, n_flv_real
integer :: n_legs_born, n_legs_real
integer :: n_in
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(region_data_t) :: reg_data
write (u, "(A)") "* Test output: fks_regions_7"
write (u, "(A)") "* Create table of singular regions for ee -> qq"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 1
n_legs_born = 4; n_legs_real = 5
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, 2, -2]
flv_real (:, 1) = [11, -11, 2, -2, 21]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 0)
call reg_data%write_latex (u)
call reg_data%final ()
end subroutine fks_regions_7
@ %def fks_regions_7
@
<<FKS regions: test declarations>>=
public :: fks_regions_8
<<FKS regions: tests>>=
subroutine fks_regions_8 (u)
integer, intent(in) :: u
integer :: n_flv_born, n_flv_real
integer :: n_legs_born, n_legs_real
integer :: n_in
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(region_data_t) :: reg_data
integer :: i, j
integer, dimension(10) :: flavors
write (u, "(A)") "* Test output: fks_regions_8"
write (u, "(A)") "* Create table of singular regions for ee -> ee"
write (u, "(A)")
n_flv_born = 1; n_flv_real = 3
n_legs_born = 4; n_legs_real = 5
n_in = 2
allocate (flv_born (n_legs_born, n_flv_born))
allocate (flv_real (n_legs_real, n_flv_real))
flv_born (:, 1) = [11, -11, -11, 11]
flv_real (:, 1) = [11, -11, -11, 11, 22]
flv_real (:, 2) = [11, 22, -11, 11, 11]
flv_real (:, 3) = [22, -11, 11, -11, -11]
call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 2, 0)
call reg_data%check_consistency (.false., u)
call reg_data%write (u)
call reg_data%final ()
end subroutine fks_regions_8
@ %def fks_regions_8
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{NLO infrastructure and data}
This module contains the settings and data infrastructure.
<<[[nlo_data.f90]]>>=
<<File header>>
module nlo_data
<<Use kinds>>
<<Use strings>>
use constants, only: zero
use lorentz
use variables, only: var_list_t
use physics_defs, only: NO_FACTORIZATION, FACTORIZATION_THRESHOLD
<<Standard module head>>
<<NLO data: public>>
<<NLO data: parameters>>
<<NLO data: types>>
interface
<<NLO data: sub interfaces>>
end interface
end module nlo_data
@ %def nlo_data
@
<<[[nlo_data_sub.f90]]>>=
<<File header>>
submodule (nlo_data) nlo_data_s
use diagnostics
use string_utils, only: split_string, read_ival, string_contains_word
use io_units
use format_defs, only: FMT_15
use physics_defs, only: THR_POS_WP, THR_POS_WM
use physics_defs, only: THR_POS_B, THR_POS_BBAR
implicit none
contains
<<NLO data: procedures>>
end submodule nlo_data_s
@ %def nlo_data_s
@
<<NLO data: parameters>>=
integer, parameter, public :: FKS_DEFAULT = 1
integer, parameter, public :: FKS_RESONANCES = 2
integer, dimension(2), parameter, public :: ASSOCIATED_LEG_PAIR = [1, 3]
@ %def parameters
@
<<NLO data: public>>=
public :: fks_template_t
<<NLO data: types>>=
type :: fks_template_t
logical :: subtraction_disabled = .false.
integer :: mapping_type = FKS_DEFAULT
logical :: count_kinematics = .false.
real(default) :: fks_dij_exp1
real(default) :: fks_dij_exp2
real(default) :: xi_min
real(default) :: y_max
real(default) :: xi_cut, delta_o, delta_i
type(string_t), dimension(:), allocatable :: excluded_resonances
integer :: n_f
contains
<<NLO data: fks template: TBP>>
end type fks_template_t
@ %def fks_template_t
@
<<NLO data: fks template: TBP>>=
procedure :: write => fks_template_write
<<NLO data: sub interfaces>>=
module subroutine fks_template_write (template, unit)
class(fks_template_t), intent(in) :: template
integer, intent(in), optional :: unit
end subroutine fks_template_write
<<NLO data: procedures>>=
module subroutine fks_template_write (template, unit)
class(fks_template_t), intent(in) :: template
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u,'(1x,A)') 'FKS Template: '
write (u,'(1x,A)', advance = 'no') 'Mapping Type: '
select case (template%mapping_type)
case (FKS_DEFAULT)
write (u,'(A)') 'Default'
case (FKS_RESONANCES)
write (u,'(A)') 'Resonances'
case default
write (u,'(A)') 'Unkown'
end select
write (u,'(1x,A,ES4.3,ES4.3)') 'd_ij exponentials: ', &
template%fks_dij_exp1, template%fks_dij_exp2
write (u, '(1x,A,ES4.3,ES4.3)') 'xi_cut: ', &
template%xi_cut
write (u, '(1x,A,ES4.3,ES4.3)') 'delta_o: ', &
template%delta_o
write (u, '(1x,A,ES4.3,ES4.3)') 'delta_i: ', &
template%delta_i
end subroutine fks_template_write
@ %def fks_template_write
@ Set FKS parameters. $\xi_{\text{cut}}, \delta_o$ and
$\delta_{\mathrm{I}}$ steer the ratio of the integrated and real
subtraction.
<<NLO data: fks template: TBP>>=
procedure :: set_parameters => fks_template_set_parameters
<<NLO data: sub interfaces>>=
module subroutine fks_template_set_parameters (template, &
exp1, exp2, xi_min, y_max, xi_cut, delta_o, delta_i)
class(fks_template_t), intent(inout) :: template
real(default), intent(in) :: exp1, exp2
real(default), intent(in) :: xi_min, y_max, &
xi_cut, delta_o, delta_i
end subroutine fks_template_set_parameters
<<NLO data: procedures>>=
module subroutine fks_template_set_parameters (template, &
exp1, exp2, xi_min, y_max, xi_cut, delta_o, delta_i)
class(fks_template_t), intent(inout) :: template
real(default), intent(in) :: exp1, exp2
real(default), intent(in) :: xi_min, y_max, &
xi_cut, delta_o, delta_i
template%fks_dij_exp1 = exp1
template%fks_dij_exp2 = exp2
template%xi_min = xi_min
template%y_max = y_max
template%xi_cut = xi_cut
template%delta_o = delta_o
template%delta_i = delta_i
end subroutine fks_template_set_parameters
@ %def fks_template_set_parameters
<<NLO data: fks template: TBP>>=
procedure :: set_mapping_type => fks_template_set_mapping_type
<<NLO data: sub interfaces>>=
module subroutine fks_template_set_mapping_type (template, val)
class(fks_template_t), intent(inout) :: template
integer, intent(in) :: val
end subroutine fks_template_set_mapping_type
<<NLO data: procedures>>=
module subroutine fks_template_set_mapping_type (template, val)
class(fks_template_t), intent(inout) :: template
integer, intent(in) :: val
template%mapping_type = val
end subroutine fks_template_set_mapping_type
@ %def fks_template_set_mapping_type
@
<<NLO data: fks template: TBP>>=
procedure :: set_counter => fks_template_set_counter
<<NLO data: sub interfaces>>=
module subroutine fks_template_set_counter (template)
class(fks_template_t), intent(inout) :: template
end subroutine fks_template_set_counter
<<NLO data: procedures>>=
module subroutine fks_template_set_counter (template)
class(fks_template_t), intent(inout) :: template
template%count_kinematics = .true.
end subroutine fks_template_set_counter
@ %def fks_template_set_counter
@
<<NLO data: public>>=
public :: get_threshold_momenta
<<NLO data: sub interfaces>>=
module function get_threshold_momenta (p) result (p_thr)
type(vector4_t), dimension(4) :: p_thr
type(vector4_t), intent(in), dimension(:) :: p
end function get_threshold_momenta
<<NLO data: procedures>>=
module function get_threshold_momenta (p) result (p_thr)
type(vector4_t), dimension(4) :: p_thr
type(vector4_t), intent(in), dimension(:) :: p
p_thr(1) = p(THR_POS_WP) + p(THR_POS_B)
p_thr(2) = p(THR_POS_B)
p_thr(3) = p(THR_POS_WM) + p(THR_POS_BBAR)
p_thr(4) = p(THR_POS_BBAR)
end function get_threshold_momenta
@ %def get_threshold_momenta
@
\subsection{NLO settings and steering}
<<NLO data: public>>=
public :: nlo_settings_t
<<NLO data: types>>=
type :: nlo_settings_t
logical :: use_internal_color_correlations = .true.
logical :: use_internal_spin_correlations = .false.
logical :: use_resonance_mappings = .false.
logical :: combined_integration = .false.
logical :: fixed_order_nlo = .false.
logical :: test_soft_limit = .false.
logical :: test_coll_limit = .false.
logical :: test_anti_coll_limit = .false.
integer, dimension(:), allocatable :: selected_alr
integer :: factorization_mode = NO_FACTORIZATION
!!! Probably not the right place for this. Revisit after refactoring
real(default) :: powheg_damping_scale = zero
type(fks_template_t) :: fks_template
type(string_t) :: virtual_selection
logical :: virtual_resonance_aware_collinear = .true.
logical :: use_born_scale = .false.
logical :: cut_all_real_sqmes = .false.
type(string_t) :: nlo_correction_type
logical :: reuse_amplitudes_fks = .false.
contains
<<NLO data: nlo settings: TBP>>
end type nlo_settings_t
@ %def nlo_settings_t
@
<<NLO data: nlo settings: TBP>>=
procedure :: init => nlo_settings_init
<<NLO data: sub interfaces>>=
module subroutine nlo_settings_init (nlo_settings, var_list, fks_template)
class(nlo_settings_t), intent(inout) :: nlo_settings
type(var_list_t), intent(in) :: var_list
type(fks_template_t), intent(in), optional :: fks_template
end subroutine nlo_settings_init
<<NLO data: procedures>>=
module subroutine nlo_settings_init (nlo_settings, var_list, fks_template)
class(nlo_settings_t), intent(inout) :: nlo_settings
type(var_list_t), intent(in) :: var_list
type(fks_template_t), intent(in), optional :: fks_template
type(string_t) :: color_method
if (present (fks_template)) nlo_settings%fks_template = fks_template
color_method = var_list%get_sval (var_str ('$correlation_me_method'))
if (color_method == "") &
color_method = var_list%get_sval (var_str ('$method'))
nlo_settings%use_internal_color_correlations = color_method == 'omega' &
.or. color_method == 'threshold'
nlo_settings%combined_integration = var_list%get_lval &
(var_str ("?combined_nlo_integration"))
nlo_settings%fixed_order_nlo = var_list%get_lval &
(var_str ("?fixed_order_nlo_events"))
nlo_settings%test_soft_limit = &
var_list%get_lval (var_str ('?test_soft_limit'))
nlo_settings%test_coll_limit = &
var_list%get_lval (var_str ('?test_coll_limit'))
nlo_settings%test_anti_coll_limit = &
var_list%get_lval (var_str ('?test_anti_coll_limit'))
call setup_alr_selection ()
nlo_settings%virtual_selection = &
var_list%get_sval (var_str ('$virtual_selection'))
nlo_settings%virtual_resonance_aware_collinear = &
var_list%get_lval (var_str ('?virtual_collinear_resonance_aware'))
nlo_settings%powheg_damping_scale = &
var_list%get_rval (var_str ('powheg_damping_scale'))
nlo_settings%use_born_scale = &
var_list%get_lval (var_str ("?nlo_use_born_scale"))
nlo_settings%cut_all_real_sqmes = &
var_list%get_lval (var_str ("?nlo_cut_all_real_sqmes"))
nlo_settings%nlo_correction_type = &
var_list%get_sval (var_str ('$nlo_correction_type'))
nlo_settings%reuse_amplitudes_fks = &
var_list%get_lval (var_str ('?nlo_reuse_amplitudes_fks'))
contains
subroutine setup_alr_selection ()
type(string_t) :: alr_selection
type(string_t), dimension(:), allocatable :: alr_split
integer :: i, i1, i2
alr_selection = var_list%get_sval (var_str ('$select_alpha_regions'))
if (string_contains_word (alr_selection, var_str (","))) then
call split_string (alr_selection, var_str (","), alr_split)
allocate (nlo_settings%selected_alr (size (alr_split)))
do i = 1, size (alr_split)
nlo_settings%selected_alr(i) = read_ival(alr_split(i))
end do
else if (string_contains_word (alr_selection, var_str (":"))) then
call split_string (alr_selection, var_str (":"), alr_split)
if (size (alr_split) == 2) then
i1 = read_ival (alr_split(1))
i2 = read_ival (alr_split(2))
allocate (nlo_settings%selected_alr (i2 - i1 + 1))
do i = 1, i2 - i1 + 1
nlo_settings%selected_alr(i) = read_ival (alr_split(i))
end do
else
call msg_fatal ("select_alpha_regions: ':' specifies a range!")
end if
else if (len(alr_selection) == 1) then
allocate (nlo_settings%selected_alr (1))
nlo_settings%selected_alr(1) = read_ival (alr_selection)
end if
if (allocated (alr_split)) deallocate (alr_split)
end subroutine setup_alr_selection
end subroutine nlo_settings_init
@ %def nlo_settings_init
@
<<NLO data: nlo settings: TBP>>=
procedure :: write => nlo_settings_write
<<NLO data: sub interfaces>>=
module subroutine nlo_settings_write (nlo_settings, unit)
class(nlo_settings_t), intent(in) :: nlo_settings
integer, intent(in), optional :: unit
end subroutine nlo_settings_write
<<NLO data: procedures>>=
module subroutine nlo_settings_write (nlo_settings, unit)
class(nlo_settings_t), intent(in) :: nlo_settings
integer, intent(in), optional :: unit
integer :: i, u
u = given_output_unit (unit); if (u < 0) return
write (u, '(A)') 'nlo_settings:'
write (u, '(3X,A,L1)') 'internal_color_correlations = ', &
nlo_settings%use_internal_color_correlations
write (u, '(3X,A,L1)') 'internal_spin_correlations = ', &
nlo_settings%use_internal_spin_correlations
write (u, '(3X,A,L1)') 'use_resonance_mappings = ', &
nlo_settings%use_resonance_mappings
write (u, '(3X,A,L1)') 'combined_integration = ', &
nlo_settings%combined_integration
write (u, '(3X,A,L1)') 'test_soft_limit = ', &
nlo_settings%test_soft_limit
write (u, '(3X,A,L1)') 'test_coll_limit = ', &
nlo_settings%test_coll_limit
write (u, '(3X,A,L1)') 'test_anti_coll_limit = ', &
nlo_settings%test_anti_coll_limit
if (allocated (nlo_settings%selected_alr)) then
write (u, '(3x,A)', advance = "no") 'selected alpha regions = ['
do i = 1, size (nlo_settings%selected_alr)
write (u, '(A,I0)', advance = "no") ",", &
nlo_settings%selected_alr(i)
end do
write (u, '(A)') "]"
end if
write (u, '(3X,A,' // FMT_15 // ')') 'powheg_damping_scale = ', &
nlo_settings%powheg_damping_scale
write (u, '(3X,A,A)') 'virtual_selection = ', &
char (nlo_settings%virtual_selection)
write (u, '(3X,A,A)') 'Real factorization mode = ', &
char (factorization_mode (nlo_settings%factorization_mode))
contains
function factorization_mode (fm)
type(string_t) :: factorization_mode
integer, intent(in) :: fm
select case (fm)
case (NO_FACTORIZATION)
factorization_mode = var_str ("None")
case (FACTORIZATION_THRESHOLD)
factorization_mode = var_str ("Threshold")
case default
factorization_mode = var_str ("Undefined!")
end select
end function factorization_mode
end subroutine nlo_settings_write
@ %def nlo_settings_write
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Virtual contribution to the cross section}
This module implements the UV-finite virtual contribution of an NLO
calculation together with the integrated (FKS) subtraction terms.
<<[[virtual.f90]]>>=
<<File header>>
module virtual
<<Use kinds>>
<<Use strings>>
use pdg_arrays
use models
use model_data, only: model_data_t, field_data_t
use lorentz
use nlo_data, only: nlo_settings_t
use fks_regions
<<Standard module head>>
<<Virtual: public>>
<<Virtual: types>>
interface
<<Virtual: sub interfaces>>
end interface
end module virtual
@ %def virtual
@
<<[[virtual_sub.f90]]>>=
<<File header>>
submodule (virtual) virtual_s
<<Use debug>>
use constants
use numeric_utils
use diagnostics
use physics_defs
use sm_physics
use flavors
use nlo_data, only: ASSOCIATED_LEG_PAIR, get_threshold_momenta
implicit none
contains
<<Virtual: procedures>>
end submodule virtual_s
@ %def virtual_s
@
<<Virtual: public>>=
public :: virtual_t
<<Virtual: types>>=
type :: virtual_t
type(nlo_settings_t) :: settings
real(default), dimension(:,:,:), allocatable :: gamma_0, gamma_p, c_flv
real(default) :: fac_scale
real(default), allocatable :: ren_scale
real(default), allocatable :: es_scale2
integer, dimension(:), allocatable :: n_is_neutrinos
integer :: n_in, n_legs, n_flv
logical :: bad_point = .false.
type(string_t) :: selection
real(default), dimension(:), allocatable :: sqme_born
real(default), dimension(:), allocatable :: sqme_virt_fin
real(default), dimension(:,:,:), allocatable :: sqme_color_c
real(default), dimension(:,:,:), allocatable :: sqme_charge_c
logical :: has_pdfs = .false.
contains
<<Virtual: virtual: TBP>>
end type virtual_t
@ %def virtual_t
@
<<Virtual: virtual: TBP>>=
procedure :: init => virtual_init
<<Virtual: sub interfaces>>=
module subroutine virtual_init &
(virt, flv_born, n_in, settings, model, has_pdfs)
class(virtual_t), intent(inout) :: virt
integer, intent(in), dimension(:,:) :: flv_born
integer, intent(in) :: n_in
type(nlo_settings_t), intent(in) :: settings
class(model_data_t), intent(in) :: model
logical, intent(in) :: has_pdfs
end subroutine virtual_init
<<Virtual: procedures>>=
module subroutine virtual_init &
(virt, flv_born, n_in, settings, model, has_pdfs)
class(virtual_t), intent(inout) :: virt
integer, intent(in), dimension(:,:) :: flv_born
integer, intent(in) :: n_in
type(nlo_settings_t), intent(in) :: settings
class(model_data_t), intent(in) :: model
logical, intent(in) :: has_pdfs
integer :: i_flv, n_corr
n_corr = 2
virt%n_legs = size (flv_born, 1); virt%n_flv = size (flv_born, 2)
virt%n_in = n_in
allocate (virt%sqme_born (virt%n_flv))
allocate (virt%sqme_virt_fin (virt%n_flv))
allocate (virt%sqme_color_c (virt%n_legs, virt%n_legs, virt%n_flv))
allocate (virt%sqme_charge_c (virt%n_legs, virt%n_legs, virt%n_flv))
allocate (virt%gamma_0 (virt%n_legs, virt%n_flv, n_corr), &
virt%gamma_p (virt%n_legs, virt%n_flv, n_corr), &
virt%c_flv (virt%n_legs, virt%n_flv, n_corr))
call virt%init_constants (flv_born, settings%fks_template%n_f, model)
allocate (virt%n_is_neutrinos (virt%n_flv))
virt%n_is_neutrinos = 0
do i_flv = 1, virt%n_flv
if (is_neutrino (flv_born(1, i_flv))) &
virt%n_is_neutrinos(i_flv) = virt%n_is_neutrinos(i_flv) + 1
if (is_neutrino (flv_born(2, i_flv))) &
virt%n_is_neutrinos(i_flv) = virt%n_is_neutrinos(i_flv) + 1
end do
select case (char (settings%virtual_selection))
case ("Full", "OLP", "Subtraction")
virt%selection = settings%virtual_selection
case default
call msg_fatal ('Virtual selection: Possible values are "Full", "OLP" or "Subtraction')
end select
virt%settings = settings
virt%has_pdfs = has_pdfs
contains
function is_neutrino (flv) result (neutrino)
integer, intent(in) :: flv
logical :: neutrino
neutrino = (abs(flv) == 12 .or. abs(flv) == 14 .or. abs(flv) == 16)
end function is_neutrino
end subroutine virtual_init
@ %def virtual_init
@ The virtual subtraction terms contain Casimir operators and derived
constants, listed below:
\begin{align}
\label{eqn:C(q)}
C(q) = C(\bar{q}) &= C_F, \\
\label{eqn:C(g)}
C(g) &= C_A,\\
\label{eqn:gamma(q)}
\gamma(q) = \gamma(\bar{q}) &= \frac{3}{2} C_F,\\
\label{eqn:gamma(g)}
\gamma(g) &= \frac{11}{6} C_A - \frac{2}{3} T_F N_f,\\
\label{eqn:gammap(q)}
\gamma'(q) = \gamma'(\bar{q}) &= \left(\frac{13}{2} -
\frac{2\pi^2}{3}\right) C_F, \\
\label{eqn:gammap(g)}
\gamma'(g) &= \left(\frac{67}{9} - \frac{2\pi^2}{3}\right) C_A -
\frac{23}{9} T_F N_f.
\end{align}
For uncolored particles, [[virtual_init_constants]] sets $C$, $\gamma$ and $\gamma'$ to zero.
<<Virtual: virtual: TBP>>=
procedure :: init_constants => virtual_init_constants
<<Virtual: sub interfaces>>=
module subroutine virtual_init_constants (virt, flv_born, nf_input, model)
class(virtual_t), intent(inout) :: virt
integer, intent(in), dimension(:,:) :: flv_born
integer, intent(in) :: nf_input
type(string_t), dimension(2) :: corr_type
class(model_data_t), intent(in) :: model
end subroutine virtual_init_constants
<<Virtual: procedures>>=
module subroutine virtual_init_constants (virt, flv_born, nf_input, model)
class(virtual_t), intent(inout) :: virt
integer, intent(in), dimension(:,:) :: flv_born
integer, intent(in) :: nf_input
type(string_t), dimension(2) :: corr_type
class(model_data_t), intent(in) :: model
type(field_data_t), pointer :: field
integer :: i_part, i_flv, pdg, i_corr
real(default) :: nf, CA_factor, TR_sum
real(default), dimension(:,:), allocatable :: CF_factor, TR_factor
type(flavor_t) :: flv
allocate (CF_factor (size (flv_born, 1), size (flv_born, 2)), &
TR_factor (size (flv_born, 1), size (flv_born, 2)))
corr_type (1) = "QCD"; corr_type (2) = "EW"
do i_corr = 1, 2
TR_sum = 0
if (i_corr == 1) then
CA_factor = CA; CF_factor = CF; TR_factor = TR
nf = real(nf_input, default)
TR_sum = nf * TR
else
CA_factor = zero
do i_flv = 1, size (flv_born, 2)
do i_part = 1, size (flv_born, 1)
call flv%init (flv_born(i_part, i_flv), model)
CF_factor(i_part, i_flv) = (flv%get_charge ())**2
TR_factor(i_part, i_flv) = (flv%get_charge ())**2
if (is_quark (flv_born (i_part, i_flv))) &
TR_factor(i_part, i_flv) = NC * TR_factor(i_part, i_flv)
end do
end do
do pdg = 1, nf_input
field => model%get_field_ptr (pdg)
TR_sum = TR_sum + NC*field%get_charge()**2
end do
do pdg = 11, 15, 2
field => model%get_field_ptr (pdg)
if (field%get_mass() > 0) exit
TR_sum = TR_sum + field%get_charge()**2
end do
end if
do i_flv = 1, size (flv_born, 2)
do i_part = 1, size (flv_born, 1)
if (is_massless_vectorboson (flv_born(i_part, i_flv), corr_type (i_corr))) then
virt%gamma_0(i_part, i_flv, i_corr) = 11._default / 6._default * CA_factor &
- two / three * TR_sum
virt%gamma_p(i_part, i_flv, i_corr) = (67._default / 9._default &
- two * pi**2 / three) * CA_factor &
- 23._default / 9._default * TR_sum
virt%c_flv(i_part, i_flv, i_corr) = CA_factor
else if (is_corresponding_fermion (flv_born(i_part, i_flv), corr_type (i_corr))) then
virt%gamma_0(i_part, i_flv, i_corr) = 1.5_default * CF_factor(i_part, i_flv)
virt%gamma_p(i_part, i_flv, i_corr) = (6.5_default - two * pi**2 / three) * CF_factor(i_part, i_flv)
virt%c_flv(i_part, i_flv, i_corr) = CF_factor(i_part, i_flv)
else if (is_massive_vectorboson (flv_born(i_part, i_flv), corr_type (i_corr))) then
virt%gamma_0(i_part, i_flv, i_corr) = zero
virt%gamma_p(i_part, i_flv, i_corr) = zero
virt%c_flv(i_part, i_flv, i_corr) = CF_factor(i_part, i_flv)
else
virt%gamma_0(i_part, i_flv, i_corr) = zero
virt%gamma_p(i_part, i_flv, i_corr) = zero
virt%c_flv(i_part, i_flv, i_corr) = zero
end if
end do
end do
end do
contains
function is_massless_vectorboson (pdg_nr, nlo_corr_type)
logical :: is_massless_vectorboson
integer, intent(in) :: pdg_nr
type(string_t), intent(in) :: nlo_corr_type
is_massless_vectorboson = .false.
if (nlo_corr_type == "QCD") then
is_massless_vectorboson = is_gluon (pdg_nr)
else if (nlo_corr_type == "EW") then
is_massless_vectorboson = is_photon (pdg_nr)
end if
end function is_massless_vectorboson
function is_corresponding_fermion (pdg_nr, nlo_corr_type)
logical :: is_corresponding_fermion
integer, intent(in) :: pdg_nr
type(string_t), intent(in) :: nlo_corr_type
is_corresponding_fermion = .false.
if (nlo_corr_type == "QCD") then
is_corresponding_fermion = is_quark (pdg_nr)
else if (nlo_corr_type == "EW") then
is_corresponding_fermion = is_fermion (pdg_nr)
end if
end function is_corresponding_fermion
function is_massive_vectorboson (pdg_nr, nlo_corr_type)
logical :: is_massive_vectorboson
integer, intent(in) :: pdg_nr
type(string_t), intent(in) :: nlo_corr_type
is_massive_vectorboson = .false.
if (nlo_corr_type == "EW") then
is_massive_vectorboson = is_massive_vector (pdg_nr)
end if
end function is_massive_vectorboson
end subroutine virtual_init_constants
@ %def virtual_init_constants
@ Set the renormalization scale. If the input is zero, use the
center-of-mass energy.
<<Virtual: virtual: TBP>>=
procedure :: set_ren_scale => virtual_set_ren_scale
<<Virtual: sub interfaces>>=
module subroutine virtual_set_ren_scale (virt, ren_scale)
class(virtual_t), intent(inout) :: virt
real(default), allocatable, intent(in) :: ren_scale
end subroutine virtual_set_ren_scale
<<Virtual: procedures>>=
module subroutine virtual_set_ren_scale (virt, ren_scale)
class(virtual_t), intent(inout) :: virt
real(default), allocatable, intent(in) :: ren_scale
if (allocated (ren_scale)) then
if (allocated (virt%ren_scale)) then
virt%ren_scale = ren_scale
else
allocate (virt%ren_scale, source=ren_scale)
end if
end if
end subroutine virtual_set_ren_scale
@ %def virtual_set_ren_scale
@
<<Virtual: virtual: TBP>>=
procedure :: set_fac_scale => virtual_set_fac_scale
<<Virtual: sub interfaces>>=
module subroutine virtual_set_fac_scale (virt, p, fac_scale)
class(virtual_t), intent(inout) :: virt
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in), optional :: fac_scale
end subroutine virtual_set_fac_scale
<<Virtual: procedures>>=
module subroutine virtual_set_fac_scale (virt, p, fac_scale)
class(virtual_t), intent(inout) :: virt
type(vector4_t), dimension(:), intent(in) :: p
real(default), intent(in), optional :: fac_scale
if (present (fac_scale)) then
virt%fac_scale = fac_scale
else
virt%fac_scale = (p(1) + p(2))**1
end if
end subroutine virtual_set_fac_scale
@ %def virtual_set_fac_scale
<<Virtual: virtual: TBP>>=
procedure :: set_ellis_sexton_scale => virtual_set_ellis_sexton_scale
<<Virtual: sub interfaces>>=
module subroutine virtual_set_ellis_sexton_scale (virt, Q)
class(virtual_t), intent(inout) :: virt
real(default), allocatable, intent(in) :: Q
end subroutine virtual_set_ellis_sexton_scale
<<Virtual: procedures>>=
module subroutine virtual_set_ellis_sexton_scale (virt, Q)
class(virtual_t), intent(inout) :: virt
real(default), allocatable, intent(in) :: Q
if (allocated (Q)) then
if (allocated (virt%es_scale2)) then
virt%es_scale2 = Q * Q
else
allocate (virt%es_scale2, source=Q*Q)
end if
end if
end subroutine virtual_set_ellis_sexton_scale
@ %def virtual_set_ellis_sexton_scale
@ The virtual-subtracted matrix element is given by the equation
\begin{equation}
\label{eqn:virt_sub}
\mathcal{V} = \frac{\alpha_s}{2\pi}\left(\mathcal{Q}\mathcal{B} +
\sum \mathcal{I}_{ij}\mathcal{B}_{ij} + \mathcal{V}_{fin}\right),
\end{equation}
The expressions for $\mathcal{Q}$ can be found in equations
\ref{eqn:virt_Q_isr} and \ref{eqn:virt_Q_fsr}.
The expressions for $\mathcal{I}_{ij}$ can be found in equations
(\ref{I_00}), (\ref{I_mm}), (\ref{I_0m}), depending on whether the
particles involved in the radiation process are massive or massless.
If two or more flavor structures would produce the same amplitude we
only compute one and use the [[eqv_index]] to copy the result to the
others (if [[reuse_amplitudes_fks]] is true).
The Ellis-Sexton scale is set when explicitly allocated; if not it
first is set to the renormalization scale; if that it is not set it
will be set to the factorization scale which is the scale used for the
virtual corrections.
<<Virtual: virtual: TBP>>=
procedure :: evaluate => virtual_evaluate
<<Virtual: sub interfaces>>=
module subroutine virtual_evaluate (virt, reg_data, alpha_coupling, &
p_born, separate_uborns, sqme_virt)
class(virtual_t), intent(inout) :: virt
type(region_data_t), intent(in) :: reg_data
real(default), dimension(2), intent(in) :: alpha_coupling
type(vector4_t), intent(in), dimension(:) :: p_born
logical, intent(in) :: separate_uborns
real(default), dimension(:), intent(inout) :: sqme_virt
end subroutine virtual_evaluate
<<Virtual: procedures>>=
module subroutine virtual_evaluate (virt, reg_data, alpha_coupling, &
p_born, separate_uborns, sqme_virt)
class(virtual_t), intent(inout) :: virt
type(region_data_t), intent(in) :: reg_data
real(default), dimension(2), intent(in) :: alpha_coupling
type(vector4_t), intent(in), dimension(:) :: p_born
logical, intent(in) :: separate_uborns
real(default), dimension(:), intent(inout) :: sqme_virt
integer, dimension(:), allocatable :: eqv_flv_index
real(default), dimension(:), allocatable :: sqme_virt_arr
real(default) :: s, s_o_Q2, es_scale2
real(default), dimension(reg_data%n_flv_born) :: QB, BI
integer :: i_flv, ii_flv, alr, i_corr
logical, dimension(:), allocatable :: flv_evaluated
integer, dimension(:), allocatable :: corr_index
logical :: alr_qcd, alr_ew
allocate (flv_evaluated(reg_data%n_flv_born))
allocate (sqme_virt_arr(reg_data%n_flv_born))
sqme_virt_arr = zero
flv_evaluated = .false.
if (virt%bad_point) return
if (allocated (virt%es_scale2)) then
es_scale2 = virt%es_scale2
else
if (allocated (virt%ren_scale)) then
es_scale2 = virt%ren_scale**2
else
es_scale2 = virt%fac_scale**2
end if
end if
if (debug2_active (D_VIRTUAL)) then
print *, 'Compute virtual component using alpha = ', alpha_coupling
print *, 'Virtual selection: ', char (virt%selection)
print *, 'virt%es_scale2 = ', es_scale2 !!! Debugging
end if
s = sum (p_born(1 : virt%n_in))**2
if (virt%settings%factorization_mode == FACTORIZATION_THRESHOLD) &
call set_s_for_threshold ()
s_o_Q2 = s / es_scale2 * virt%settings%fks_template%xi_cut**2
eqv_flv_index = reg_data%eqv_flv_index_born
do i_flv = 1, reg_data%n_flv_born
alr_qcd = .false.; alr_ew = .false.
do alr = 1, reg_data%n_regions
if (i_flv == reg_data%regions(alr)%uborn_index) then
if (reg_data%regions(alr)%nlo_correction_type == "QCD") then
alr_qcd = .true.
else if (reg_data%regions(alr)%nlo_correction_type == "EW") then
alr_ew = .true.
end if
end if
end do
if (alr_qcd .and. alr_ew) then
allocate (corr_index (2))
corr_index (1) = 1; corr_index (2) = 2
else
allocate (corr_index (1))
corr_index (1) = 0
if (alr_qcd) then
corr_index (1) = 1
else if (alr_ew) then
corr_index (1) = 2
end if
end if
if (.not. flv_evaluated(eqv_flv_index(i_flv)) .and. corr_index(1) > 0) then
if (virt%selection == var_str ("Full") .or. virt%selection == var_str ("OLP")) then
!!! A factor of alpha_coupling/twopi is assumed to be included in vfin
sqme_virt_arr(i_flv) = sqme_virt_arr(i_flv) + virt%sqme_virt_fin(i_flv)
end if
do i_corr = 1, size (corr_index)
QB = zero; BI = zero
if (virt%selection == var_str ("Full") .or. &
virt%selection == var_str ("Subtraction")) then
call virt%evaluate_initial_state (i_flv, corr_index (i_corr), reg_data, QB)
call virt%compute_collinear_contribution &
(i_flv, corr_index (i_corr), p_born, sqrt(s), reg_data, QB)
select case (virt%settings%factorization_mode)
case (FACTORIZATION_THRESHOLD)
call virt%compute_eikonals_threshold (i_flv, p_born, s_o_Q2, QB, BI)
case default
call virt%compute_massive_self_eikonals &
(i_flv, corr_index (i_corr), p_born, s_o_Q2, reg_data, QB)
call virt%compute_eikonals &
(i_flv, corr_index (i_corr), p_born, s_o_Q2, reg_data, BI)
end select
if (debug2_active (D_VIRTUAL)) then
if (corr_index (i_corr) == 1) then
print *, 'Correction type: QCD'
else
print *, 'Correction type: EW'
end if
print *, 'Evaluate i_flv: ', i_flv
print *, 'sqme_born: ', virt%sqme_born (i_flv)
print *, 'Q * sqme_born: ', alpha_coupling / twopi * QB(i_flv)
print *, 'BI: ', alpha_coupling / twopi * BI(i_flv)
print *, 'vfin: ', virt%sqme_virt_fin (i_flv)
end if
sqme_virt_arr(i_flv) = sqme_virt_arr(i_flv) &
+ alpha_coupling (corr_index (i_corr))/ twopi * (QB(i_flv) + BI(i_flv))
end if
end do
if (.not. (debug_active (D_VIRTUAL) .or. &
debug2_active (D_VIRTUAL))) flv_evaluated(eqv_flv_index(i_flv)) = .true.
else
sqme_virt_arr(i_flv) = sqme_virt_arr(eqv_flv_index(i_flv))
end if
if (separate_uborns) then
sqme_virt(i_flv) = sqme_virt(i_flv) + sqme_virt_arr(i_flv)
else
sqme_virt(1) = sqme_virt(1) + sqme_virt_arr(i_flv)
end if
deallocate (corr_index)
end do
if (debug2_active (D_VIRTUAL)) then
call msg_debug2 (D_VIRTUAL, "virtual-subtracted matrix element(s): ")
print *, sqme_virt
end if
do i_flv = 1, reg_data%n_flv_born
if (virt%n_is_neutrinos(i_flv) > 0) &
sqme_virt = sqme_virt * virt%n_is_neutrinos(i_flv) * two
end do
contains
subroutine set_s_for_threshold ()
use ttv_formfactors, only: m1s_to_mpole
real(default) :: mtop2
mtop2 = m1s_to_mpole (sqrt(s))**2
if (s < four * mtop2) s = four * mtop2
end subroutine set_s_for_threshold
end subroutine virtual_evaluate
@ %def virtual_evaluate
@
<<Virtual: virtual: TBP>>=
procedure :: compute_eikonals => virtual_compute_eikonals
<<Virtual: sub interfaces>>=
module subroutine virtual_compute_eikonals (virtual, i_flv, i_corr, &
p_born, s_o_Q2, reg_data, BI)
class(virtual_t), intent(inout) :: virtual
integer, intent(in) :: i_flv, i_corr
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: s_o_Q2
type(region_data_t), intent(in) :: reg_data
real(default), intent(inout), dimension(:) :: BI
end subroutine virtual_compute_eikonals
<<Virtual: procedures>>=
module subroutine virtual_compute_eikonals (virtual, i_flv, i_corr, &
p_born, s_o_Q2, reg_data, BI)
class(virtual_t), intent(inout) :: virtual
integer, intent(in) :: i_flv, i_corr
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: s_o_Q2
type(region_data_t), intent(in) :: reg_data
real(default), intent(inout), dimension(:) :: BI
integer :: i, j
real(default) :: I_ij, BI_tmp
BI_tmp = zero
! TODO vincent_r: Split the procedure into one computing QCD eikonals
! and one computing QED eikonals.
! TODO vincent_r: In the best case, remove the dependency on
! reg_data completely.
associate (flst_born => reg_data%flv_born(i_flv))
do i = 1, virtual%n_legs
do j = 1, virtual%n_legs
if (i /= j) then
if (i_corr == 1) then
if (flst_born%colored(i) .and. flst_born%colored(j)) then
I_ij = compute_eikonal_factor &
(p_born, flst_born%massive, i, j, s_o_Q2)
BI_tmp = BI_tmp + &
virtual%sqme_color_c (i, j, i_flv) * I_ij
if (debug2_active (D_VIRTUAL)) &
print *, 'b_ij: ', i, j, &
virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij
end if
else if (i_corr == 2) then
I_ij = compute_eikonal_factor (p_born, flst_born%massive, &
i, j, s_o_Q2)
BI_tmp = BI_tmp + virtual%sqme_charge_c (i, j, i_flv) * I_ij
if (debug2_active (D_VIRTUAL)) &
print *, 'b_ij: ', &
virtual%sqme_charge_c (i, j, i_flv), 'I_ij: ', I_ij
end if
else if (debug2_active (D_VIRTUAL)) then
if (i_corr == 1) then
print *, 'b_ij: ', i, j, &
virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij
else if (i_corr == 2) then
print *, 'b_ij: ', i, j, &
virtual%sqme_charge_c (i, j, i_flv), 'I_ij: ', I_ij
end if
end if
end do
end do
if (virtual%settings%use_internal_color_correlations .or. i_corr == 2) &
BI_tmp = BI_tmp * virtual%sqme_born (i_flv)
end associate
BI(i_flv) = BI(i_flv) + BI_tmp
end subroutine virtual_compute_eikonals
@ %def virtual_compute_eikonals
@
<<Virtual: virtual: TBP>>=
procedure :: compute_eikonals_threshold => virtual_compute_eikonals_threshold
<<Virtual: sub interfaces>>=
module subroutine virtual_compute_eikonals_threshold (virtual, i_flv, &
p_born, s_o_Q2, QB, BI)
class(virtual_t), intent(in) :: virtual
integer, intent(in) :: i_flv
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: s_o_Q2
real(default), intent(inout), dimension(:) :: QB
real(default), intent(inout), dimension(:) :: BI
end subroutine virtual_compute_eikonals_threshold
<<Virtual: procedures>>=
module subroutine virtual_compute_eikonals_threshold (virtual, i_flv, &
p_born, s_o_Q2, QB, BI)
class(virtual_t), intent(in) :: virtual
integer, intent(in) :: i_flv
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: s_o_Q2
real(default), intent(inout), dimension(:) :: QB
real(default), intent(inout), dimension(:) :: BI
type(vector4_t), dimension(4) :: p_thr
integer :: leg
BI = zero; p_thr = get_threshold_momenta (p_born)
call compute_massive_self_eikonals (virtual%sqme_born(i_flv), QB(i_flv))
do leg = 1, 2
BI(i_flv) = BI(i_flv) + evaluate_leg_pair (ASSOCIATED_LEG_PAIR(leg), i_flv)
end do
contains
subroutine compute_massive_self_eikonals (sqme_born, QB)
real(default), intent(in) :: sqme_born
real(default), intent(inout) :: QB
integer :: i
if (debug_on) call msg_debug2 (D_VIRTUAL, "compute_massive_self_eikonals")
if (debug_on) call msg_debug2 (D_VIRTUAL, "s_o_Q2", s_o_Q2)
if (debug_on) call msg_debug2 (D_VIRTUAL, "log (s_o_Q2)", log (s_o_Q2))
do i = 1, 4
QB = QB - (cf * (log (s_o_Q2) - 0.5_default * I_m_eps (p_thr(i)))) &
* sqme_born
end do
end subroutine compute_massive_self_eikonals
function evaluate_leg_pair (i_start, i_flv) result (b_ij_times_I)
real(default) :: b_ij_times_I
integer, intent(in) :: i_start, i_flv
real(default) :: I_ij
integer :: i, j
b_ij_times_I = zero
do i = i_start, i_start + 1
do j = i_start, i_start + 1
if (i /= j) then
I_ij = compute_eikonal_factor &
(p_thr, [.true., .true., .true., .true.], i, j, s_o_Q2)
b_ij_times_I = b_ij_times_I + &
virtual%sqme_color_c (i, j, i_flv) * I_ij
if (debug2_active (D_VIRTUAL)) &
print *, 'b_ij: ', virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij
end if
end do
end do
if (virtual%settings%use_internal_color_correlations) &
b_ij_times_I = b_ij_times_I * virtual%sqme_born (i_flv)
if (debug2_active (D_VIRTUAL)) then
print *, 'internal color: ', virtual%settings%use_internal_color_correlations
print *, 'b_ij_times_I = ', b_ij_times_I
print *, 'QB = ', QB
end if
end function evaluate_leg_pair
end subroutine virtual_compute_eikonals_threshold
@ %def virtual_compute_eikonals_threshold
@
<<Virtual: virtual: TBP>>=
procedure :: set_bad_point => virtual_set_bad_point
<<Virtual: sub interfaces>>=
module subroutine virtual_set_bad_point (virt, value)
class(virtual_t), intent(inout) :: virt
logical, intent(in) :: value
end subroutine virtual_set_bad_point
<<Virtual: procedures>>=
module subroutine virtual_set_bad_point (virt, value)
class(virtual_t), intent(inout) :: virt
logical, intent(in) :: value
virt%bad_point = value
end subroutine virtual_set_bad_point
@ %def virtual_set_bad_point
@ The collinear limit of $\tilde{\mathcal{R}}$ can be integrated over
the radiation degrees of freedom, giving the collinear contribution to
the virtual component. Its general structure is $\mathcal{Q} \cdot
\mathcal{B}$. The initial-state contribution to $\mathcal{Q}$ is
simply given by
\begin{equation}
\label{eqn:virt_Q_isr}
\mathcal{Q} = -\log\frac{\mu_F^2}{Q^2} \left(\gamma(\mathcal{I}_1) + 2 C
(\mathcal{I}_1) \log(\xi_{\text{cut}}) + \gamma(\mathcal{I}_2) + 2 C (\mathcal{I}_2)
\log(\xi_{\text{cut}}) \right),
\end{equation}
where $Q^2$ is the Ellis-Sexton scale and $\gamma$ is as in eqns. \ref{eqn:gamma(q)}
and \ref{eqn:gamma(g)}.\\
[[virtual_evaluate_initial_state]] computes this quantity. The loop over the
initial-state particles is only executed if we are
dealing with a scattering process, because for decays there are no virtual
initial-initial interactions.
<<Virtual: virtual: TBP>>=
procedure :: evaluate_initial_state => virtual_evaluate_initial_state
<<Virtual: sub interfaces>>=
module subroutine virtual_evaluate_initial_state &
(virt, i_flv, i_corr, reg_data, QB)
class(virtual_t), intent(inout) :: virt
type(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_flv, i_corr
real(default), intent(inout), dimension(:) :: QB
end subroutine virtual_evaluate_initial_state
<<Virtual: procedures>>=
module subroutine virtual_evaluate_initial_state &
(virt, i_flv, i_corr, reg_data, QB)
class(virtual_t), intent(inout) :: virt
type(region_data_t), intent(in) :: reg_data
integer, intent(in) :: i_flv, i_corr
real(default), intent(inout), dimension(:) :: QB
real(default) :: sqme_born_virt, es_scale2
integer :: i
if (allocated (virt%es_scale2)) then
es_scale2 = virt%es_scale2
else
if (allocated (virt%ren_scale)) then
es_scale2 = virt%ren_scale**2
else
es_scale2 = virt%fac_scale**2
end if
end if
sqme_born_virt = zero
if (reg_data%nlo_correction_type == "EW" .and. i_corr == 1 &
.and. qcd_ew_interferences (reg_data%flv_born(i_flv)%flst)) then
do i = 1, size (reg_data%flv_born(i_flv)%flst)
if (is_quark (reg_data%flv_born(i_flv)%flst (i))) then
sqme_born_virt = -virt%sqme_color_c (i, i, i_flv)/CF
exit
end if
end do
else
sqme_born_virt = virt%sqme_born (i_flv)
end if
if (virt%n_in == 2) then
do i = 1, virt%n_in
QB(i_flv) = QB(i_flv) - (virt%gamma_0 (i, i_flv, i_corr) &
+ two * virt%c_flv(i, i_flv, i_corr) &
* log (virt%settings%fks_template%xi_cut)) &
* log(virt%fac_scale**2 / es_scale2) * sqme_born_virt
end do
end if
end subroutine virtual_evaluate_initial_state
@ %def virtual_evaluate_initial_state
@ Same as above, but for final-state particles. The collinear limit
for final-state particles follows from the integral
\begin{equation*}
I_{+,\alpha_r} = \int d\Phi_{n+1}
\frac{\xi_+^{-1-2\epsilon}}{\xi^{-1-2\epsilon}}
\mathcal{R}_{\alpha_r}.
\end{equation*}
We can distinguish three situations:
\begin{enumerate}
\item $\alpha_r$ contains a massive emitter. In this case, no
collinear subtraction term is required and the integral above is
irrelevant.
\item $\alpha_r$ contains a massless emitter, but resonances are not
taken into account in the subtraction. Here, $\xi_{max} =
\frac{2E_{em}}{\sqrt{s}}$ is the upper bound on $\xi$.
\item $\alpha_r$ contains a massless emitter and resonance-aware
subtraction is used. Here, $\xi_{max} =
\frac{2E_{em}}{\sqrt{k_{res}^2}}$.
\end{enumerate}
Before version 2.4, only situations 1 and 2 were covered. The
difference between situation 2 and 3 comes from the expansion of the
plus-distribution in the integral above,
\begin{equation*}
\xi_+^{-1-2\epsilon} = \xi^{-1-2\epsilon} +
\frac{1}{2\epsilon}\delta(\xi) =
\xi_{max}^{-1-2\epsilon}\left[(1-z)^{-1-2\epsilon} +
\frac{\xi_{max}^{2\epsilon}}{2\epsilon}\delta(1-z)\right].
\end{equation*}
The expression from the standard FKS literature is given by
$\mathcal{Q}$ is given by
\begin{equation}
\label{eqn:virt_Q_fsr_old}
\begin{split}
\mathcal{Q} = \sum_{k=n_{in}}^{n_L^{(B)}} \left[\gamma'(\mathcal{I}_k)
- \log\frac{s\delta_o}{2Q^2}\left(\gamma(\mathcal{I}_k)
- 2C(\mathcal{I}_k)
\log\frac{2E_k}{\xi_{\text{cut}}\sqrt{s}}\right) \right.\\
+ \left. 2C(\mathcal{I}_k) \left( \log^2\frac{2E_k}{\sqrt{s}} -
\log^2 \xi_{\text{cut}} \right)
- 2\gamma(\mathcal{I}_k)\log\frac{2E_k}{\sqrt{s}}\right].
\end{split}
\end{equation}
$n_L^{(B)}$ is the number of legs at Born level. Here, $\xi_{max}$ is
implicitly present in the ratios in the logarithms. Using the
resonance-aware $\xi_{max}$ yields
\begin{equation}
\label{eqn:virt_Q_fsr}
\begin{split}
\mathcal{Q} = \sum_{k=n_{in}}^{n_L^{(B)}} \left[\gamma'(\mathcal{I}_k)
+ 2\left(\log\frac{\sqrt{s}}{2E_{em}} + \log\xi_{max}\right)
\left(\log\frac{\sqrt{s}}{2E_{em}} + \log\xi_{max} +
\log\frac{Q^2}{s}\right) C(\mathcal{I}_k) \right.\\
+ \left. 2 \log\xi_{max} \left(\log\xi_{max} -
\log\frac{Q^2}{k_{res}^2}\right) C(\mathcal{I}_k)
+ \left(\log\frac{Q^2}{k_{res}^2} - 2 \log\xi_{max}\right)
\gamma(\mathcal{I}_k)\right].
\end{split}
\end{equation}
Equation \ref{eqn:virt_Q_fsr} leads to \ref{eqn:virt_Q_fsr_old} with
the substitutions $\xi_{max} \rightarrow \frac{2E_{em}}{\sqrt{s}}$ and
$k_{res}^2 \rightarrow s$. [[virtual_compute_collinear_contribution]]
only implements the second one.
<<Virtual: virtual: TBP>>=
procedure :: compute_collinear_contribution &
=> virtual_compute_collinear_contribution
<<Virtual: sub interfaces>>=
module subroutine virtual_compute_collinear_contribution &
(virt, i_flv, i_corr, p_born, sqrts, reg_data, QB)
class(virtual_t), intent(inout) :: virt
integer, intent(in) :: i_flv, i_corr
type(vector4_t), dimension(:), intent(in) :: p_born
real(default), intent(in) :: sqrts
type(region_data_t), intent(in) :: reg_data
real(default), intent(inout), dimension(:) :: QB
end subroutine virtual_compute_collinear_contribution
<<Virtual: procedures>>=
module subroutine virtual_compute_collinear_contribution &
(virt, i_flv, i_corr, p_born, sqrts, reg_data, QB)
class(virtual_t), intent(inout) :: virt
integer, intent(in) :: i_flv, i_corr
type(vector4_t), dimension(:), intent(in) :: p_born
real(default), intent(in) :: sqrts
type(region_data_t), intent(in) :: reg_data
real(default), intent(inout), dimension(:) :: QB
real(default) :: s1, s2, s3, s4, s5
real(default) :: sqme_born_virt
integer :: alr, em, i
real(default) :: E_em, xi_max, log_xi_max, E_tot2, es_scale2
logical, dimension(virt%n_flv, virt%n_legs) :: evaluated
integer :: i_contr
type(vector4_t) :: k_res
type(lorentz_transformation_t) :: L_to_resonance
evaluated = .false.
if (allocated (virt%es_scale2)) then
es_scale2 = virt%es_scale2
else
if (allocated (virt%ren_scale)) then
es_scale2 = virt%ren_scale**2
else
es_scale2 = virt%fac_scale**2
end if
end if
sqme_born_virt = zero
if (reg_data%nlo_correction_type == "EW" .and. i_corr == 1 &
.and. qcd_ew_interferences (reg_data%flv_born(i_flv)%flst)) then
do i = 1, size (reg_data%flv_born(i_flv)%flst)
if (is_quark (reg_data%flv_born(i_flv)%flst (i))) then
sqme_born_virt = -virt%sqme_color_c (i, i, i_flv)/CF
exit
end if
end do
else
sqme_born_virt = virt%sqme_born (i_flv)
end if
do alr = 1, reg_data%n_regions
if (i_flv /= reg_data%regions(alr)%uborn_index) cycle
em = reg_data%regions(alr)%emitter
if (em <= virt%n_in) cycle
if (evaluated(i_flv, em)) cycle
!!! Collinear terms only for massless particles
if (reg_data%regions(alr)%flst_uborn%massive(em)) cycle
E_em = p_born(em)%p(0)
if (allocated (reg_data%alr_contributors)) then
i_contr = reg_data%alr_to_i_contributor (alr)
k_res = get_resonance_momentum (p_born, reg_data%alr_contributors(i_contr)%c)
E_tot2 = k_res%p(0)**2
L_to_resonance = inverse (boost (k_res, k_res**1))
xi_max = two * space_part_norm (L_to_resonance * p_born(em)) / k_res%p(0)
else
E_tot2 = sqrts**2
xi_max = two * E_em / sqrts
end if
log_xi_max = log (xi_max)
associate (xi_cut => virt%settings%fks_template%xi_cut, delta_o => virt%settings%fks_template%delta_o)
if (virt%settings%virtual_resonance_aware_collinear) then
if (debug_active (D_VIRTUAL)) &
call msg_debug (D_VIRTUAL, "Using resonance-aware collinear subtraction")
s1 = virt%gamma_p(em, i_flv, i_corr)
s2 = two * (log (sqrts / (two * E_em)) + log_xi_max) * &
(log (sqrts / (two * E_em)) + log_xi_max + log (es_scale2 / sqrts**2)) &
* virt%c_flv(em, i_flv, i_corr)
s3 = two * log_xi_max * &
(log_xi_max - log (es_scale2 / E_tot2)) * virt%c_flv(em, i_flv, i_corr)
s4 = (log (es_scale2 / E_tot2) - two * log_xi_max) &
* virt%gamma_0(em, i_flv, i_corr)
QB(i_flv) = QB(i_flv) + (s1 + s2 + s3 + s4) * sqme_born_virt
else
if (debug_active (D_VIRTUAL)) &
call msg_debug (D_VIRTUAL, "Using old-fashioned collinear subtraction")
s1 = virt%gamma_p(em, i_flv, i_corr)
s2 = log (delta_o * sqrts**2 / (two * es_scale2)) &
* virt%gamma_0(em,i_flv, i_corr)
s3 = log (delta_o * sqrts**2 / (two * es_scale2)) * two &
* virt%c_flv(em,i_flv, i_corr) * log (two * E_em / (xi_cut * sqrts))
! s4 = two * virt%c_flv(em,i_flv, i_corr) * (log (two * E_em / sqrts)**2 - log (xi_cut)**2)
s4 = two * virt%c_flv(em,i_flv, i_corr) * & ! a**2 - b**2 = (a - b) * (a + b), for better numerical performance
(log (two * E_em / sqrts) + log (xi_cut)) * (log (two * E_em / sqrts) - log (xi_cut))
s5 = two * virt%gamma_0(em,i_flv, i_corr) * log (two * E_em / sqrts)
QB(i_flv) = QB(i_flv) + (s1 - s2 + s3 + s4 - s5) * sqme_born_virt
end if
end associate
evaluated(i_flv, em) = .true.
end do
end subroutine virtual_compute_collinear_contribution
@ %def virtual_compute_collinear_contribution
@ For the massless-massive case and $i = j$ we get the massive
self-eikonal of (A.10) in arXiv:0908.4272, given as
\begin{equation}
\mathcal{I}_{ii} = \log \frac{\xi^2_{\text{cut}}s}{Q^2} -
\frac{1}{\beta} \log \frac{1 + \beta}{1 - \beta}.
\end{equation}
<<Virtual: virtual: TBP>>=
procedure :: compute_massive_self_eikonals => &
virtual_compute_massive_self_eikonals
<<Virtual: sub interfaces>>=
module subroutine virtual_compute_massive_self_eikonals (virt, &
i_flv, i_corr, p_born, s_over_Q2, reg_data, QB)
class(virtual_t), intent(inout) :: virt
integer, intent(in) :: i_flv, i_corr
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: s_over_Q2
type(region_data_t), intent(in) :: reg_data
real(default), intent(inout), dimension(:) :: QB
end subroutine virtual_compute_massive_self_eikonals
<<Virtual: procedures>>=
module subroutine virtual_compute_massive_self_eikonals (virt, &
i_flv, i_corr, p_born, s_over_Q2, reg_data, QB)
class(virtual_t), intent(inout) :: virt
integer, intent(in) :: i_flv, i_corr
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: s_over_Q2
type(region_data_t), intent(in) :: reg_data
real(default), intent(inout), dimension(:) :: QB
real(default) :: sqme_born_virt
integer :: i
logical :: massive
sqme_born_virt = zero
if (reg_data%nlo_correction_type == "EW" .and. i_corr == 1 &
.and. qcd_ew_interferences (reg_data%flv_born(i_flv)%flst)) then
do i = 1, size (reg_data%flv_born(i_flv)%flst)
if (is_quark (reg_data%flv_born(i_flv)%flst (i))) then
sqme_born_virt = -virt%sqme_color_c (i, i, i_flv)/CF
exit
end if
end do
else
sqme_born_virt = virt%sqme_born (i_flv)
end if
do i = 1, virt%n_legs
massive = reg_data%flv_born(i_flv)%massive(i)
if (massive) then
QB(i_flv) = QB(i_flv) - (virt%c_flv (i, i_flv, i_corr) &
* (log (s_over_Q2) - 0.5_default * I_m_eps (p_born(i)))) &
* sqme_born_virt
end if
end do
end subroutine virtual_compute_massive_self_eikonals
@ %def virtual_compute_massive_self_eikonals
@ The following code implements the $\mathcal{I}_{ij}$-function.
The complete formulas can be found in arXiv:0908.4272 (A.1-A.17) and are also discussed in arXiv:1002.2581 in Appendix A.
The implementation may differ in the detail from the formulas presented in the above paper.
The parameter $\xi_{\text{cut}}$ is unphysically and cancels with appropriate factors in the real subtraction.
We keep the additional parameter for debug usage.
The implemented formulas are then defined as follows:
\begin{itemize}
\item[massless-massless case]
$p^2 = 0, k^2 = 0,$
\begin{equation}
\begin{split}
\mathcal{I}_{ij} &= \frac{1}{2}\log^2\frac{\xi^2_{\text{cut}}s}{Q^2} + \log\frac{\xi^2_{\text{cut}}s}{Q^2}\log\frac{k_ik_j}{2E_iE_j} - \rm{Li}_2\left(\frac{k_ik_j}{2E_iE_j}\right) \\
&+ \frac{1}{2}\log^2\frac{k_ik_j}{2E_iE_j} - \log\left(1-\frac{k_ik_j}{2E_iE_j}\right) \log\frac{k_ik_j}{2E_iE_j}.
\end{split}
\label{I_00}
\end{equation}
\item[massive-massive case]
$p^2 \neq 0, k^2 \neq 0,$
\begin{equation}
\mathcal{I}_{ij} = \frac{1}{2}I_0(k_i, k_j)\log\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{1}{2}I_\epsilon(k_i,k_j)
\label{I_mm}
\end{equation}
with
\begin{equation}
I_0(k_i, k_j) = \frac{1}{\beta}\log\frac{1+\beta}{1-\beta}, \qquad \beta = \sqrt{1-\frac{k_i^2k_j^2}{(k_i \cdot k_j)^2}}
\end{equation}
and a rather involved expression for $I_\epsilon$:
\begin{align}
\allowdisplaybreaks
I_\epsilon(k_i, k_j) &= \left(K(z_j)-K(z_i)\right) \frac{1-\vec{\beta_i}\cdot\vec{\beta_j}}{\sqrt{a(1-b)}}, \\
\vec{\beta_i} &= \frac{\vec{k}_i}{k_i^0}, \\
a &= \beta_i^2 + \beta_j^2 - 2\vec{\beta}_i \cdot \vec{\beta}_j, \\
x_i &= \frac{\beta_i^2 -\vec{\beta}_i \cdot \vec{\beta}_j}{a}, \\
x_j &= \frac{\beta_j^2 -\vec{\beta}_i \cdot \vec{\beta}_j}{a} = 1-x_j, \\
b &= \frac{\beta_i^2\beta_j^2 - (\vec{\beta}_i\cdot\vec{\beta}_j)^2}{a}, \\
c &= \sqrt{\frac{b}{4a}}, \\
z_+ &= \frac{1+\sqrt{1-b}}{\sqrt{b}}, \\
z_- &= \frac{1-\sqrt{1-b}}{\sqrt{b}}, \\
z_i &= \frac{\sqrt{x_i^2 + 4c^2} - x_i}{2c}, \\
z_j &= \frac{\sqrt{x_j^2 + 4c^2} + x_j}{2c}, \\
K(z) = &-\frac{1}{2}\log^2\frac{(z-z_-)(z_+-z)}{(z_++z)(z_-+z)} - 2Li_2\left(\frac{2z_-(z_+-z)}{(z_+-z_-)(z_-+z)}\right) \\
&-2Li_2\left(-\frac{2z_+(z_-+z)}{(z_+-z_-)(z_+-z)}\right)
\end{align}
\item[massless-massive case]
$p^2 = 0, k^2 \neq 0,$
\begin{equation}
\mathcal{I}_{ij} = \frac{1}{2}\left[\frac{1}{2}\log^2\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{\pi^2}{6}\right] + \frac{1}{2}I_0(k_i,k_j)\log\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{1}{2}I_\epsilon(k_i,k_j)
\label{I_0m}
\end{equation}
with
\begin{align}
I_0(p,k) &= \log\frac{(\hat{p}\cdot\hat{k})^2}{\hat{k}^2}, \\
I_\varepsilon(p,k) &= -2\left[\frac{1}{4}\log^2\frac{1-\beta}{1+\beta} + \log\frac{\hat{p}\cdot\hat{k}}{1+\beta}\log\frac{\hat{p}\cdot\hat{k}}{1-\beta} + \rm{Li}_2\left(1-\frac{\hat{p}\cdot\hat{k}}{1+\beta}\right) + \rm{Li}_2\left(1-\frac{\hat{p}\cdot\hat{k}}{1-\beta}\right)\right],
\end{align}
using
\begin{align}
\hat{p} = \frac{p}{p^0}, \quad \hat{k} = \frac{k}{k^0}, \quad \beta = \frac{|\vec{k}|}{k_0}, \\
\rm{Li}_2(1 - x) + \rm{Li}_2(1 - x^{-1}) = -\frac{1}{2} \log^2 x.
\end{align}
\end{itemize}
<<Virtual: procedures>>=
function compute_eikonal_factor (p_born, massive, i, j, s_o_Q2) result (I_ij)
real(default) :: I_ij
type(vector4_t), intent(in), dimension(:) :: p_born
logical, dimension(:), intent(in) :: massive
integer, intent(in) :: i, j
real(default), intent(in) :: s_o_Q2
if (massive(i) .and. massive(j)) then
I_ij = compute_Imm (p_born(i), p_born(j), s_o_Q2)
else if (.not. massive(i) .and. massive(j)) then
I_ij = compute_I0m (p_born(i), p_born(j), s_o_Q2)
else if (massive(i) .and. .not. massive(j)) then
I_ij = compute_I0m (p_born(j), p_born(i), s_o_Q2)
else
I_ij = compute_I00 (p_born(i), p_born(j), s_o_Q2)
end if
end function compute_eikonal_factor
function compute_I00 (pi, pj, s_o_Q2) result (I)
type(vector4_t), intent(in) :: pi, pj
real(default), intent(in) :: s_o_Q2
real(default) :: I
real(default) :: Ei, Ej
real(default) :: pij, Eij
real(default) :: s1, s2, s3, s4, s5
real(default) :: arglog
real(default), parameter :: tiny_value = epsilon(1.0)
s1 = 0; s2 = 0; s3 = 0; s4 = 0; s5 = 0
Ei = pi%p(0); Ej = pj%p(0)
pij = pi * pj; Eij = Ei * Ej
s1 = 0.5_default * log(s_o_Q2)**2
s2 = log(s_o_Q2) * log(pij / (two * Eij))
s3 = Li2 (pij / (two * Eij))
s4 = 0.5_default * log (pij / (two * Eij))**2
arglog = one - pij / (two * Eij)
if (arglog > tiny_value) then
s5 = log(arglog) * log(pij / (two * Eij))
else
s5 = zero
end if
I = s1 + s2 - s3 + s4 - s5
end function compute_I00
function compute_I0m (ki, kj, s_o_Q2) result (I)
type(vector4_t), intent(in) :: ki, kj
real(default), intent(in) :: s_o_Q2
real(default) :: I
real(default) :: logsomu
real(default) :: s1, s2, s3
s1 = 0; s2 = 0; s3 = 0
logsomu = log(s_o_Q2)
s1 = 0.5 * (0.5 * logsomu**2 - pi**2 / 6)
s2 = 0.5 * I_0m_0 (ki, kj) * logsomu
s3 = 0.5 * I_0m_eps (ki, kj)
I = s1 + s2 - s3
end function compute_I0m
function compute_Imm (pi, pj, s_o_Q2) result (I)
type(vector4_t), intent(in) :: pi, pj
real(default), intent(in) :: s_o_Q2
real(default) :: I
real(default) :: s1, s2
s1 = 0.5 * log(s_o_Q2) * I_mm_0(pi, pj)
s2 = 0.5 * I_mm_eps(pi, pj)
I = s1 - s2
end function compute_Imm
function I_m_eps (p) result (I)
type(vector4_t), intent(in) :: p
real(default) :: I
real(default) :: beta
beta = space_part_norm (p)/p%p(0)
if (beta < tiny_07) then
I = four * (one + beta**2/3 + beta**4/5 + beta**6/7)
else
I = two * log((one + beta) / (one - beta)) / beta
end if
end function I_m_eps
function I_0m_eps (p, k) result (I)
type(vector4_t), intent(in) :: p, k
real(default) :: I
type(vector4_t) :: pp, kp
real(default) :: beta
pp = p / p%p(0); kp = k / k%p(0)
beta = sqrt (one - kp*kp)
I = -2*(log((one - beta) / (one + beta))**2/4 + log((pp*kp) / (one + beta))*log((pp*kp) / (one - beta)) &
+ Li2(one - (pp*kp) / (one + beta)) + Li2(one - (pp*kp) / (one - beta)))
end function I_0m_eps
function I_0m_0 (p, k) result (I)
type(vector4_t), intent(in) :: p, k
real(default) :: I
type(vector4_t) :: pp, kp
pp = p / p%p(0); kp = k / k%p(0)
I = log((pp*kp)**2 / kp**2)
end function I_0m_0
function I_mm_eps (p1, p2) result (I)
type(vector4_t), intent(in) :: p1, p2
real(default) :: I
type(vector3_t) :: beta1, beta2
real(default) :: a, b, b2
real(default) :: zp, zm, z1, z2, x1, x2
real(default) :: zmb, z1b
real(default) :: K1, K2
beta1 = space_part (p1) / energy(p1)
beta2 = space_part (p2) / energy(p2)
a = beta1**2 + beta2**2 - 2 * beta1 * beta2
b = beta1**2 * beta2**2 - (beta1 * beta2)**2
if (beta1**1 > beta2**1) call switch_beta (beta1, beta2)
if (beta1 == vector3_null) then
b2 = beta2**1
I = (-0.5 * log ((one - b2) / (one + b2))**2 - two * Li2 (-two * b2 / (one - b2))) &
* one / sqrt (a - b)
return
end if
x1 = beta1**2 - beta1 * beta2
x2 = beta2**2 - beta1 * beta2
zp = sqrt (a) + sqrt (a - b)
zm = sqrt (a) - sqrt (a - b)
zmb = one / zp
z1 = sqrt (x1**2 + b) - x1
z2 = sqrt (x2**2 + b) + x2
z1b = one / (sqrt (x1**2 + b) + x1)
K1 = - 0.5 * log (((z1b - zmb) * (zp - z1)) / ((zp + z1) * (z1b + zmb)))**2 &
- two * Li2 ((two * zmb * (zp - z1)) / ((zp - zm) * (zmb + z1b))) &
- two * Li2 ((-two * zp * (zm + z1)) / ((zp - zm) * (zp - z1)))
K2 = - 0.5 * log ((( z2 - zm) * (zp - z2)) / ((zp + z2) * (z2 + zm)))**2 &
- two * Li2 ((two * zm * (zp - z2)) / ((zp - zm) * (zm + z2))) &
- two * Li2 ((-two * zp * (zm + z2)) / ((zp - zm) * (zp - z2)))
I = (K2 - K1) * (one - beta1 * beta2) / sqrt (a - b)
contains
subroutine switch_beta (beta1, beta2)
type(vector3_t), intent(inout) :: beta1, beta2
type(vector3_t) :: beta_tmp
beta_tmp = beta1
beta1 = beta2
beta2 = beta_tmp
end subroutine switch_beta
end function I_mm_eps
function I_mm_0 (k1, k2) result (I)
type(vector4_t), intent(in) :: k1, k2
real(default) :: I
real(default) :: beta, kquotient
kquotient = k1**2 * k2**2 / (k1 * k2)**2
if (kquotient > tiny_13) then
beta = sqrt (one - kquotient)
I = log ((one + beta) / (one - beta)) / beta
else
beta = one - kquotient / two
I = log (two * (one + beta) / kquotient) / beta
end if
end function I_mm_0
@ %def I_mm_0
@
<<Virtual: virtual: TBP>>=
procedure :: final => virtual_final
<<Virtual: sub interfaces>>=
module subroutine virtual_final (virtual)
class(virtual_t), intent(inout) :: virtual
end subroutine virtual_final
<<Virtual: procedures>>=
module subroutine virtual_final (virtual)
class(virtual_t), intent(inout) :: virtual
if (allocated (virtual%gamma_0)) deallocate (virtual%gamma_0)
if (allocated (virtual%gamma_p)) deallocate (virtual%gamma_p)
if (allocated (virtual%c_flv)) deallocate (virtual%c_flv)
if (allocated (virtual%n_is_neutrinos)) deallocate (virtual%n_is_neutrinos)
end subroutine virtual_final
@ %def virtual_final
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Real Subtraction}
<<[[real_subtraction.f90]]>>=
<<File header>>
module real_subtraction
<<Use kinds with double>>
<<Use strings>>
use physics_defs
use lorentz
use flavors
use phs_fks, only: real_kinematics_t, isr_kinematics_t
use phs_fks, only: I_PLUS, I_MINUS
use phs_fks, only: SQRTS_VAR, SQRTS_FIXED
use phs_fks, only: phs_point_set_t
use fks_regions
use nlo_data
<<Standard module head>>
<<Real subtraction: public>>
<<Real subtraction: parameters>>
<<Real subtraction: types>>
<<Real subtraction: interfaces>>
interface
<<Real subtraction: sub interfaces>>
end interface
end module real_subtraction
@ %def real_subtraction
@
<<[[real_subtraction_sub.f90]]>>=
<<File header>>
submodule (real_subtraction) real_subtraction_s
<<Use debug>>
use io_units
use format_defs, only: FMT_15
use string_utils
use constants
use numeric_utils
use diagnostics
use pdg_arrays
use sm_physics
use models
use ttv_formfactors, only: m1s_to_mpole
implicit none
contains
<<Real subtraction: procedures>>
end submodule real_subtraction_s
@ %def real_subtraction_s
@
\subsubsection{Soft subtraction terms}
<<Real subtraction: parameters>>=
integer, parameter, public :: INTEGRATION = 0
integer, parameter, public :: FIXED_ORDER_EVENTS = 1
- integer, parameter, public :: POWHEG = 2
@ %def real subtraction parameters
@ Translates the NLO purpose into a string. However, this purpose is
never set and this routine is nowhere used.
<<Real subtraction: procedures>>=
function nlo_purpose (purpose) result (of_purpose)
type(string_t) :: of_purpose
integer, intent(in) :: purpose
select case (purpose)
case (INTEGRATION)
of_purpose = var_str ("Integration")
case (FIXED_ORDER_EVENTS)
of_purpose = var_str ("Fixed order NLO events")
- case (POWHEG)
- of_purpose = var_str ("Powheg events")
case default
of_purpose = var_str ("Undefined!")
end select
end function nlo_purpose
@ %def nlo_purpose
@
In the soft limit, the real matrix element behaves as
\begin{equation*}
\mathcal{R}_{\rm{soft}} = 4\pi\alpha_s \left[\sum_{i \neq j}
\mathcal{B}_{ij} \frac{k_i \cdot k_j}{(k_i \cdot k)(k_j \cdot k)}
- \mathcal{B} \sum_{i} \frac{k_i^2}{(k_i \cdot k)^2}C_i\right],
\end{equation*}
where $k$ denotes the momentum of the emitted parton. The quantity $\mathcal{B}_{ij}$ is called the color-correlated Born matrix element defined as
\begin{equation*}
\mathcal{B}_{ij} = \frac{1}{2s} \sum_{\stackrel{colors}{spins}} \mathcal{M}_{\{c_k\}}\left(\mathcal{M}^\dagger_{\{c_k\}}\right)_{\stackrel{c_i \rightarrow c_i'}{c_j \rightarrow c_j'}} T^a_{c_i,c_i'} T^a_{c_j,c_j'}.
\end{equation*}
<<Real subtraction: types>>=
type :: soft_subtraction_t
type(region_data_t), pointer :: reg_data => null ()
real(default), dimension(:,:), allocatable :: momentum_matrix
logical :: use_resonance_mappings = .false.
type(vector4_t) :: p_soft = vector4_null
logical :: use_internal_color_correlations = .true.
logical :: use_internal_spin_correlations = .false.
logical :: xi2_expanded = .true.
integer :: factorization_mode = NO_FACTORIZATION
contains
<<Real subtraction: soft sub: TBP>>
end type soft_subtraction_t
@ %def soft_subtraction_t
@
<<Real subtraction: soft sub: TBP>>=
procedure :: init => soft_subtraction_init
<<Real subtraction: sub interfaces>>=
module subroutine soft_subtraction_init (sub_soft, reg_data)
class(soft_subtraction_t), intent(inout) :: sub_soft
type(region_data_t), intent(in), target :: reg_data
end subroutine soft_subtraction_init
<<Real subtraction: procedures>>=
module subroutine soft_subtraction_init (sub_soft, reg_data)
class(soft_subtraction_t), intent(inout) :: sub_soft
type(region_data_t), intent(in), target :: reg_data
sub_soft%reg_data => reg_data
allocate (sub_soft%momentum_matrix (reg_data%n_legs_born, &
reg_data%n_legs_born))
end subroutine soft_subtraction_init
@ %def soft_subtraction_init
@
<<Real subtraction: soft sub: TBP>>=
procedure :: requires_boost => soft_subtraction_requires_boost
<<Real subtraction: sub interfaces>>=
module function soft_subtraction_requires_boost &
(sub_soft, sqrts) result (requires_boost)
logical :: requires_boost
class(soft_subtraction_t), intent(in) :: sub_soft
real(default), intent(in) :: sqrts
end function soft_subtraction_requires_boost
<<Real subtraction: procedures>>=
module function soft_subtraction_requires_boost &
(sub_soft, sqrts) result (requires_boost)
logical :: requires_boost
class(soft_subtraction_t), intent(in) :: sub_soft
real(default), intent(in) :: sqrts
real(default) :: mtop
logical :: above_threshold
if (sub_soft%factorization_mode == FACTORIZATION_THRESHOLD) then
mtop = m1s_to_mpole (sqrts)
above_threshold = sqrts**2 - four * mtop**2 > zero
else
above_threshold = .false.
end if
requires_boost = sub_soft%use_resonance_mappings .or. above_threshold
end function soft_subtraction_requires_boost
@ %def soft_subtraction_requires_boost
@ The treatment of the momentum $k$ follows the discussion about the
soft limit of the partition functions (see [1002.2581], p. 29 and
C. Weiss' PhD Thesis, p. 24). The parton momentum is
pulled out, $k = E \hat{k}$. In fact, we will substitute $\hat{k}$ for
$k$ throughout the code, because the energy will factor out of the
equation when the soft $\mathcal{S}$-function is multiplied. The
momentum [[p_soft]] represents the soft limit of the radiated particle
divided by its energy. It is a unit vector, because
$k^2 = \left(k^0\right)^2 - \left(k^0\right)^2\hat{\vec{k}}^2 = 0$.
The soft momentum is constructed by first creating a unit vector
parallel to the emitter's Born momentum. This unit vector is then
rotated about the corresponding angles $y$ and $\phi$ to match
the direction of the real radiation in the soft limit.
<<Real subtraction: soft sub: TBP>>=
procedure :: create_softvec_fsr => soft_subtraction_create_softvec_fsr
<<Real subtraction: sub interfaces>>=
module subroutine soft_subtraction_create_softvec_fsr &
(sub_soft, p_born, y, phi, emitter, xi_ref_momentum)
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: y, phi
integer, intent(in) :: emitter
type(vector4_t), intent(in) :: xi_ref_momentum
end subroutine soft_subtraction_create_softvec_fsr
<<Real subtraction: procedures>>=
module subroutine soft_subtraction_create_softvec_fsr &
(sub_soft, p_born, y, phi, emitter, xi_ref_momentum)
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: y, phi
integer, intent(in) :: emitter
type(vector4_t), intent(in) :: xi_ref_momentum
type(vector3_t) :: dir
type(vector4_t) :: p_em
type(lorentz_transformation_t) :: rot
type(lorentz_transformation_t) :: boost_to_rest_frame
logical :: requires_boost
associate (p_soft => sub_soft%p_soft)
p_soft%p(0) = one
requires_boost = sub_soft%requires_boost (two * p_born(1)%p(0))
if (requires_boost) then
boost_to_rest_frame = inverse (boost (xi_ref_momentum, xi_ref_momentum**1))
p_em = boost_to_rest_frame * p_born(emitter)
else
p_em = p_born(emitter)
end if
p_soft%p(1:3) = p_em%p(1:3) / space_part_norm (p_em)
dir = create_orthogonal (space_part (p_em))
rot = rotation (y, sqrt(one - y**2), dir)
p_soft = rot * p_soft
if (.not. vanishes (phi)) then
dir = space_part (p_em) / space_part_norm (p_em)
rot = rotation (cos(phi), sin(phi), dir)
p_soft = rot * p_soft
end if
if (requires_boost) p_soft = inverse (boost_to_rest_frame) * p_soft
end associate
end subroutine soft_subtraction_create_softvec_fsr
@ %def soft_subtraction_create_softvec_fsr
@ For initial-state emissions, the soft vector is just a unit vector
with the same direction as the radiated particle.
As $y$ for ISR is defined independently of the emitter, also [[p_soft]]
is the same for all initial state emitters.
<<Real subtraction: soft sub: TBP>>=
procedure :: create_softvec_isr => soft_subtraction_create_softvec_isr
<<Real subtraction: sub interfaces>>=
module subroutine soft_subtraction_create_softvec_isr (sub_soft, y, phi)
class(soft_subtraction_t), intent(inout) :: sub_soft
real(default), intent(in) :: y, phi
end subroutine soft_subtraction_create_softvec_isr
<<Real subtraction: procedures>>=
module subroutine soft_subtraction_create_softvec_isr (sub_soft, y, phi)
class(soft_subtraction_t), intent(inout) :: sub_soft
real(default), intent(in) :: y, phi
real(default) :: sin_theta
sin_theta = sqrt(one - y**2)
associate (p => sub_soft%p_soft%p)
p(0) = one
p(1) = sin_theta * sin(phi)
p(2) = sin_theta * cos(phi)
p(3) = y
end associate
end subroutine soft_subtraction_create_softvec_isr
@ %def soft_subtraction_create_softvec_isr
@ The soft vector for the real mismatch is basically the same as for
usual FSR, except for the scaling with the total gluon
energy. Moreover, the resulting vector is rotated into the frame where
the 3-axis points along the direction of the emitter. This is
necessary because in the collinear limit, the approximation
\begin{equation*}
k_i = \frac{k_i^0}{\bar{k}_j^0} \bar{k}_j =
\frac{\xi\sqrt{s}}{2\bar{k}_j^0}\bar{k}_j
\end{equation*}
is used. The collinear limit is not included in the soft mismatch yet,
but we keep the rotation for future usage here already (the
performance loss is negligible).
<<Real subtraction: soft sub: TBP>>=
procedure :: create_softvec_mismatch => &
soft_subtraction_create_softvec_mismatch
<<Real subtraction: sub interfaces>>=
module subroutine soft_subtraction_create_softvec_mismatch &
(sub_soft, E, y, phi, p_em)
class(soft_subtraction_t), intent(inout) :: sub_soft
real(default), intent(in) :: E, phi, y
type(vector4_t), intent(in) :: p_em
end subroutine soft_subtraction_create_softvec_mismatch
<<Real subtraction: procedures>>=
module subroutine soft_subtraction_create_softvec_mismatch &
(sub_soft, E, y, phi, p_em)
class(soft_subtraction_t), intent(inout) :: sub_soft
real(default), intent(in) :: E, phi, y
type(vector4_t), intent(in) :: p_em
real(default) :: sin_theta
type(lorentz_transformation_t) :: rot_em_off_3_axis
sin_theta = sqrt (one - y**2)
associate (p => sub_soft%p_soft%p)
p(0) = E
p(1) = E * sin_theta * sin(phi)
p(2) = E * sin_theta * cos(phi)
p(3) = E * y
end associate
rot_em_off_3_axis = rotation_to_2nd (3, space_part (p_em))
sub_soft%p_soft = rot_em_off_3_axis * sub_soft%p_soft
end subroutine soft_subtraction_create_softvec_mismatch
@ %def soft_subtraction_create_softvec_mismatch
@ Computation of the soft limit of $R_\alpha$. Note that what we are
actually integrating (in the case of final-state radiation) is the
quantity $f(0,y) / \xi$, where
\begin{equation*}
f(\xi,y) = \frac{J(\xi,y,\phi)}{\xi} \xi^2 R_\alpha.
\end{equation*}
$J/\xi$ is computed by the phase space generator. The additional factor
of $\xi^{-1}$ is supplied in the [[evaluate_region_fsr]]-routine. Thus,
we are left with a factor of $\xi^2$. A look on the expression for the
soft limit of $R_\alpha$ below reveals that we are factoring out the gluon
energy $E_i$ in the denominator. Therefore, we have a factor
$\xi^2 / E_i^2 = 4 / q^2$.
Note that the same routine is used also for the computation of the soft
mismatch. There, the gluon energy is not factored out from the soft vector,
so that we are left with the $\xi^2$-factor, which will eventually be
cancelled out again. So, we just multiply with 1. Both cases are
distinguished by the flag [[xi2_expanded]].
Note that for the soft subtraction term, also the S functions are
computed in the soft limit. The input momenta are thus the real
momenta in the soft limit, i.e. the Born momenta given by [[p_born]].
<<Real subtraction: soft sub: TBP>>=
procedure :: compute => soft_subtraction_compute
<<Real subtraction: sub interfaces>>=
module function soft_subtraction_compute (sub_soft, p_born, &
born_ij, y, q2, alpha_coupling, alr, emitter, i_res) result (sqme)
real(default) :: sqme
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in), dimension(:,:) :: born_ij
real(default), intent(in) :: y
real(default), intent(in) :: q2, alpha_coupling
integer, intent(in) :: alr, emitter, i_res
end function soft_subtraction_compute
<<Real subtraction: procedures>>=
module function soft_subtraction_compute (sub_soft, p_born, &
born_ij, y, q2, alpha_coupling, alr, emitter, i_res) result (sqme)
real(default) :: sqme
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in), dimension(:,:) :: born_ij
real(default), intent(in) :: y
real(default), intent(in) :: q2, alpha_coupling
integer, intent(in) :: alr, emitter, i_res
real(default) :: s_alpha_soft
real(default) :: kb
real(default) :: xi2_factor
if (.not. vector_set_is_cms (p_born, sub_soft%reg_data%n_in)) then
call vector4_write_set (p_born, show_mass = .true., &
check_conservation = .true.)
call msg_fatal ("Soft subtraction: phase space point must be in CMS")
end if
if (debug2_active (D_SUBTRACTION)) then
select case (char (sub_soft%reg_data%regions(alr)%nlo_correction_type))
case ("QCD")
print *, 'Compute soft subtraction using alpha_s = ', alpha_coupling
case ("EW")
print *, 'Compute soft subtraction using alpha_qed = ', alpha_coupling
end select
end if
s_alpha_soft = sub_soft%reg_data%get_svalue_soft (p_born, &
sub_soft%p_soft, alr, emitter, i_res)
if (s_alpha_soft > one + tiny_07) call msg_fatal ("s_alpha_soft > 1!")
if (debug2_active (D_SUBTRACTION)) &
call msg_print_color ('s_alpha_soft', s_alpha_soft, COL_YELLOW)
select case (sub_soft%factorization_mode)
case (NO_FACTORIZATION)
kb = sub_soft%evaluate_factorization_default (p_born, born_ij)
case (FACTORIZATION_THRESHOLD)
kb = sub_soft%evaluate_factorization_threshold (thr_leg(emitter), p_born, born_ij)
end select
if (debug_on) call msg_debug2 (D_SUBTRACTION, 'KB', kb)
sqme = four * pi * alpha_coupling * s_alpha_soft * kb
if (sub_soft%xi2_expanded) then
xi2_factor = four / q2
else
xi2_factor = one
end if
if (emitter <= sub_soft%reg_data%n_in) then
sqme = xi2_factor * (one - y**2) * sqme
else
sqme = xi2_factor * (one - y) * sqme
end if
if (sub_soft%reg_data%regions(alr)%double_fsr) sqme = sqme * two
end function soft_subtraction_compute
@ %def soft_subtraction_compute
@ We loop over all external legs and do not take care to leave out non-colored
ones because [[born_ij]] is constructed in such a way that it is only
non-zero for colored entries.
<<Real subtraction: soft sub: TBP>>=
procedure :: evaluate_factorization_default => &
soft_subtraction_evaluate_factorization_default
<<Real subtraction: sub interfaces>>=
module function soft_subtraction_evaluate_factorization_default &
(sub_soft, p, born_ij) result (kb)
real(default) :: kb
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in), dimension(:,:) :: born_ij
end function soft_subtraction_evaluate_factorization_default
<<Real subtraction: procedures>>=
module function soft_subtraction_evaluate_factorization_default &
(sub_soft, p, born_ij) result (kb)
real(default) :: kb
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in), dimension(:,:) :: born_ij
integer :: i, j
kb = zero
call sub_soft%compute_momentum_matrix (p)
do i = 1, size (p)
do j = 1, size (p)
kb = kb + sub_soft%momentum_matrix (i, j) * born_ij (i, j)
end do
end do
end function soft_subtraction_evaluate_factorization_default
@ %def soft_subtraction_evaluate_factorization_default
@ We have to multiply this with $\xi^2(1-y)$. Further, when applying
the soft $\mathcal{S}$-function, the energy of the radiated particle
is factored out. Thus we have $\xi^2/E_{em}^2(1-y) = 4/q_0^2(1-y)$.
Computes the quantity $\mathcal{K}_{ij} = \frac{k_i \cdot
k_j}{(k_i\cdot k)(k_j\cdot k)}$.
<<Real subtraction: soft sub: TBP>>=
procedure :: compute_momentum_matrix => &
soft_subtraction_compute_momentum_matrix
<<Real subtraction: sub interfaces>>=
module subroutine soft_subtraction_compute_momentum_matrix &
(sub_soft, p_born)
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p_born
end subroutine soft_subtraction_compute_momentum_matrix
<<Real subtraction: procedures>>=
module subroutine soft_subtraction_compute_momentum_matrix &
(sub_soft, p_born)
class(soft_subtraction_t), intent(inout) :: sub_soft
type(vector4_t), intent(in), dimension(:) :: p_born
real(default) :: num, deno1, deno2
integer :: i, j
do i = 1, sub_soft%reg_data%n_legs_born
do j = 1, sub_soft%reg_data%n_legs_born
if (i <= j) then
num = p_born(i) * p_born(j)
deno1 = p_born(i) * sub_soft%p_soft
deno2 = p_born(j) * sub_soft%p_soft
sub_soft%momentum_matrix(i, j) = num / (deno1 * deno2)
else
!!! momentum matrix is symmetric.
sub_soft%momentum_matrix(i, j) = sub_soft%momentum_matrix(j, i)
end if
end do
end do
end subroutine soft_subtraction_compute_momentum_matrix
@ %def soft_subtraction_compute_momentum_matrx
@
<<Real subtraction: soft sub: TBP>>=
procedure :: evaluate_factorization_threshold => &
soft_subtraction_evaluate_factorization_threshold
<<Real subtraction: sub interfaces>>=
module function soft_subtraction_evaluate_factorization_threshold &
(sub_soft, leg, p_born, born_ij) result (kb)
real(default) :: kb
class(soft_subtraction_t), intent(inout) :: sub_soft
integer, intent(in) :: leg
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in), dimension(:,:) :: born_ij
end function soft_subtraction_evaluate_factorization_threshold
<<Real subtraction: procedures>>=
module function soft_subtraction_evaluate_factorization_threshold &
(sub_soft, leg, p_born, born_ij) result (kb)
real(default) :: kb
class(soft_subtraction_t), intent(inout) :: sub_soft
integer, intent(in) :: leg
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in), dimension(:,:) :: born_ij
type(vector4_t), dimension(4) :: p
p = get_threshold_momenta (p_born)
kb = evaluate_leg_pair (ASSOCIATED_LEG_PAIR (leg))
if (debug2_active (D_SUBTRACTION)) call show_debug ()
contains
function evaluate_leg_pair (i_start) result (kbb)
real(default) :: kbb
integer, intent(in) :: i_start
integer :: i1, i2
real(default) :: numerator, deno1, deno2
kbb = zero
do i1 = i_start, i_start + 1
do i2 = i_start, i_start + 1
numerator = p(i1) * p(i2)
deno1 = p(i1) * sub_soft%p_soft
deno2 = p(i2) * sub_soft%p_soft
kbb = kbb + numerator * born_ij (i1, i2) / deno1 / deno2
end do
end do
if (debug2_active (D_SUBTRACTION)) then
do i1 = i_start, i_start + 1
do i2 = i_start, i_start + 1
call msg_print_color('i1', i1, COL_PEACH)
call msg_print_color('i2', i2, COL_PEACH)
call msg_print_color('born_ij (i1,i2)', born_ij (i1,i2), &
COL_PINK)
print *, 'Top momentum: ', p(1)%p
end do
end do
end if
end function evaluate_leg_pair
subroutine show_debug ()
integer :: i
call msg_print_color &
('soft_subtraction_evaluate_factorization_threshold', COL_GREEN)
do i = 1, 4
print *, 'sqrt(p(i)**2) = ', sqrt(p(i)**2)
end do
end subroutine show_debug
end function soft_subtraction_evaluate_factorization_threshold
@ %def soft_subtraction_evaluate_factorization_threshold
@
<<Real subtraction: soft sub: TBP>>=
procedure :: i_xi_ref => soft_subtraction_i_xi_ref
<<Real subtraction: sub interfaces>>=
module function soft_subtraction_i_xi_ref &
(sub_soft, alr, i_phs) result (i_xi_ref)
integer :: i_xi_ref
class(soft_subtraction_t), intent(in) :: sub_soft
integer, intent(in) :: alr, i_phs
end function soft_subtraction_i_xi_ref
<<Real subtraction: procedures>>=
module function soft_subtraction_i_xi_ref &
(sub_soft, alr, i_phs) result (i_xi_ref)
integer :: i_xi_ref
class(soft_subtraction_t), intent(in) :: sub_soft
integer, intent(in) :: alr, i_phs
if (sub_soft%use_resonance_mappings) then
i_xi_ref = sub_soft%reg_data%alr_to_i_contributor (alr)
else if (sub_soft%factorization_mode == FACTORIZATION_THRESHOLD) then
i_xi_ref = i_phs
else
i_xi_ref = 1
end if
end function soft_subtraction_i_xi_ref
@ %def soft_subtraction_i_xi_ref
@
<<Real subtraction: soft sub: TBP>>=
procedure :: final => soft_subtraction_final
<<Real subtraction: sub interfaces>>=
module subroutine soft_subtraction_final (sub_soft)
class(soft_subtraction_t), intent(inout) :: sub_soft
end subroutine soft_subtraction_final
<<Real subtraction: procedures>>=
module subroutine soft_subtraction_final (sub_soft)
class(soft_subtraction_t), intent(inout) :: sub_soft
if (associated (sub_soft%reg_data)) nullify (sub_soft%reg_data)
if (allocated (sub_soft%momentum_matrix)) &
deallocate (sub_soft%momentum_matrix)
end subroutine soft_subtraction_final
@ %def soft_subtraction_final
@
\subsection{Soft mismatch}
<<Real subtraction: public>>=
public :: soft_mismatch_t
<<Real subtraction: types>>=
type :: soft_mismatch_t
type(region_data_t), pointer :: reg_data => null ()
real(default), dimension(:), allocatable :: sqme_born
real(default), dimension(:,:,:), allocatable :: sqme_born_color_c
real(default), dimension(:,:,:), allocatable :: sqme_born_charge_c
type(real_kinematics_t), pointer :: real_kinematics => null ()
type(soft_subtraction_t) :: sub_soft
contains
<<Real subtraction: soft mismatch: TBP>>
end type soft_mismatch_t
@ %def soft_mismatch_t
@
<<Real subtraction: soft mismatch: TBP>>=
procedure :: init => soft_mismatch_init
<<Real subtraction: sub interfaces>>=
module subroutine soft_mismatch_init (soft_mismatch, reg_data, &
real_kinematics, factorization_mode)
class(soft_mismatch_t), intent(inout) :: soft_mismatch
type(region_data_t), intent(in), target :: reg_data
type(real_kinematics_t), intent(in), target :: real_kinematics
integer, intent(in) :: factorization_mode
end subroutine soft_mismatch_init
<<Real subtraction: procedures>>=
module subroutine soft_mismatch_init (soft_mismatch, reg_data, &
real_kinematics, factorization_mode)
class(soft_mismatch_t), intent(inout) :: soft_mismatch
type(region_data_t), intent(in), target :: reg_data
type(real_kinematics_t), intent(in), target :: real_kinematics
integer, intent(in) :: factorization_mode
soft_mismatch%reg_data => reg_data
allocate (soft_mismatch%sqme_born (reg_data%n_flv_born))
allocate (soft_mismatch%sqme_born_color_c (reg_data%n_legs_born, &
reg_data%n_legs_born, reg_data%n_flv_born))
allocate (soft_mismatch%sqme_born_charge_c (reg_data%n_legs_born, &
reg_data%n_legs_born, reg_data%n_flv_born))
call soft_mismatch%sub_soft%init (reg_data)
soft_mismatch%sub_soft%xi2_expanded = .false.
soft_mismatch%real_kinematics => real_kinematics
soft_mismatch%sub_soft%factorization_mode = factorization_mode
end subroutine soft_mismatch_init
@ %def soft_mismatch_init
@ Main routine to compute the soft mismatch. Loops over all singular
regions. There, it first creates the soft vector, then the necessary
soft real matrix element. These inputs are then used to get the
numerical value of the soft mismatch.
<<Real subtraction: soft mismatch: TBP>>=
procedure :: evaluate => soft_mismatch_evaluate
<<Real subtraction: sub interfaces>>=
module function soft_mismatch_evaluate &
(soft_mismatch, alpha_s) result (sqme_mismatch)
real(default) :: sqme_mismatch
class(soft_mismatch_t), intent(inout) :: soft_mismatch
real(default), intent(in) :: alpha_s
end function soft_mismatch_evaluate
<<Real subtraction: procedures>>=
module function soft_mismatch_evaluate &
(soft_mismatch, alpha_s) result (sqme_mismatch)
real(default) :: sqme_mismatch
class(soft_mismatch_t), intent(inout) :: soft_mismatch
real(default), intent(in) :: alpha_s
integer :: alr, i_born, emitter, i_res, i_phs, i_con
real(default) :: xi, y, q2, s
real(default) :: E_gluon
type(vector4_t) :: p_em
real(default) :: sqme_alr, sqme_soft
type(vector4_t), dimension(:), allocatable :: p_born
sqme_mismatch = zero
associate (real_kinematics => soft_mismatch%real_kinematics)
xi = real_kinematics%xi_mismatch
y = real_kinematics%y_mismatch
s = real_kinematics%cms_energy2
E_gluon = sqrt (s) * xi / two
if (debug_active (D_MISMATCH)) then
print *, 'Evaluating soft mismatch: '
print *, 'Phase space: '
call vector4_write_set (real_kinematics%p_born_cms%get_momenta(1), &
show_mass = .true.)
print *, 'xi: ', xi, 'y: ', y, 's: ', s, 'E_gluon: ', E_gluon
end if
allocate (p_born (soft_mismatch%reg_data%n_legs_born))
do alr = 1, soft_mismatch%reg_data%n_regions
i_phs = real_kinematics%alr_to_i_phs (alr)
if (soft_mismatch%reg_data%has_pseudo_isr ()) then
i_con = 1
p_born = &
soft_mismatch%real_kinematics%p_born_onshell%get_momenta(1)
else
i_con = soft_mismatch%reg_data%alr_to_i_contributor (alr)
p_born = soft_mismatch%real_kinematics%p_born_cms%get_momenta(1)
end if
q2 = real_kinematics%xi_ref_momenta(i_con)**2
emitter = soft_mismatch%reg_data%regions(alr)%emitter
p_em = p_born (emitter)
i_res = soft_mismatch%reg_data%regions(alr)%i_res
i_born = soft_mismatch%reg_data%regions(alr)%uborn_index
call print_debug_alr ()
call soft_mismatch%sub_soft%create_softvec_mismatch &
(E_gluon, y, real_kinematics%phi, p_em)
if (debug_active (D_MISMATCH)) &
print *, 'Created soft vector: ', &
soft_mismatch%sub_soft%p_soft%p
select type (fks_mapping => soft_mismatch%reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
call fks_mapping%set_resonance_momentum &
(real_kinematics%xi_ref_momenta(i_con))
end select
sqme_soft = soft_mismatch%sub_soft%compute &
(p_born, soft_mismatch%sqme_born_color_c(:,:,i_born), y, &
q2, alpha_s, alr, emitter, i_res)
sqme_alr = soft_mismatch%compute (alr, xi, y, p_em, &
real_kinematics%xi_ref_momenta(i_con), &
soft_mismatch%sub_soft%p_soft, &
soft_mismatch%sqme_born(i_born), sqme_soft, &
alpha_s, s)
if (debug_on) call msg_debug (D_MISMATCH, 'sqme_alr: ', sqme_alr)
sqme_mismatch = sqme_mismatch + sqme_alr
end do
end associate
contains
subroutine print_debug_alr ()
if (debug_active (D_MISMATCH)) then
print *, 'alr: ', alr
print *, 'i_phs: ', i_phs, 'i_con: ', i_con, 'i_res: ', i_res
print *, 'emitter: ', emitter, 'i_born: ', i_born
print *, 'emitter momentum: ', p_em%p
print *, 'resonance momentum: ', &
soft_mismatch%real_kinematics%xi_ref_momenta(i_con)%p
print *, 'q2: ', q2
end if
end subroutine print_debug_alr
end function soft_mismatch_evaluate
@ %def soft_mismatch_evaluate
@ Computes the soft mismatch in a given $\alpha_r$,
\begin{align*}
I_{s+,\alpha_r} &= \int d\Phi_B \int_0^\infty d\xi \int_{-1}^1 dy
\int_0^{2\pi} d\phi
\frac{s\xi}{(4\pi)^3} \\
&\times \left\lbrace\tilde{R}_{\alpha_r}
\left(e^{-\frac{2k_\gamma \cdot k_{res}}{k_{res}}^2} - e^{-\xi}\right)
- \frac{32 \pi \alpha_s C_{em}}{s\xi^2} B_{f_b(\alpha_r)} (1-y)^{-1}
\left[e^{-\frac{2\bar{k}_{em} \cdot k_{res}}{k_{res}^2}
\frac{k_\gamma^0}{k_{em}^0}} - e^{-\xi}\right]\right\rbrace.
\end{align*}
<<Real subtraction: soft mismatch: TBP>>=
procedure :: compute => soft_mismatch_compute
<<Real subtraction: sub interfaces>>=
module function soft_mismatch_compute &
(soft_mismatch, alr, xi, y, p_em, p_res, p_soft, &
sqme_born, sqme_soft, alpha_s, s) result (sqme_mismatch)
real(default) :: sqme_mismatch
class(soft_mismatch_t), intent(in) :: soft_mismatch
integer, intent(in) :: alr
real(default), intent(in) :: xi, y
type(vector4_t), intent(in) :: p_em, p_res, p_soft
real(default), intent(in) :: sqme_born, sqme_soft
real(default), intent(in) :: alpha_s, s
end function soft_mismatch_compute
<<Real subtraction: procedures>>=
module function soft_mismatch_compute &
(soft_mismatch, alr, xi, y, p_em, p_res, p_soft, &
sqme_born, sqme_soft, alpha_s, s) result (sqme_mismatch)
real(default) :: sqme_mismatch
class(soft_mismatch_t), intent(in) :: soft_mismatch
integer, intent(in) :: alr
real(default), intent(in) :: xi, y
type(vector4_t), intent(in) :: p_em, p_res, p_soft
real(default), intent(in) :: sqme_born, sqme_soft
real(default), intent(in) :: alpha_s, s
real(default) :: q2, expo, sm1, sm2, jacobian
q2 = p_res**2
expo = - two * p_soft * p_res / q2
!!! Divide by 1 - y to factor out the corresponding
!!! factor in the soft matrix element
sm1 = sqme_soft / (one - y) * ( exp(expo) - exp(- xi) )
if (debug_on) call msg_debug2 &
(D_MISMATCH, 'sqme_soft in mismatch ', sqme_soft)
sm2 = zero
if (soft_mismatch%reg_data%regions(alr)%has_collinear_divergence ()) then
expo = - two * p_em * p_res / q2 * &
p_soft%p(0) / p_em%p(0)
sm2 = 32 * pi * alpha_s * cf / (s * xi**2) * sqme_born * &
( exp(expo) - exp(- xi) ) / (one - y)
end if
jacobian = soft_mismatch%real_kinematics%jac_mismatch * &
s * xi / (8 * twopi3)
sqme_mismatch = (sm1 - sm2) * jacobian
end function soft_mismatch_compute
@ %def soft_mismatch_compute
@
<<Real subtraction: soft mismatch: TBP>>=
procedure :: final => soft_mismatch_final
<<Real subtraction: sub interfaces>>=
module subroutine soft_mismatch_final (soft_mismatch)
class(soft_mismatch_t), intent(inout) :: soft_mismatch
end subroutine soft_mismatch_final
<<Real subtraction: procedures>>=
module subroutine soft_mismatch_final (soft_mismatch)
class(soft_mismatch_t), intent(inout) :: soft_mismatch
call soft_mismatch%sub_soft%final ()
if (associated (soft_mismatch%reg_data)) nullify (soft_mismatch%reg_data)
if (allocated (soft_mismatch%sqme_born)) &
deallocate (soft_mismatch%sqme_born)
if (allocated (soft_mismatch%sqme_born_color_c)) &
deallocate (soft_mismatch%sqme_born_color_c)
if (allocated (soft_mismatch%sqme_born_charge_c)) &
deallocate (soft_mismatch%sqme_born_charge_c)
if (associated (soft_mismatch%real_kinematics)) &
nullify (soft_mismatch%real_kinematics)
end subroutine soft_mismatch_final
@ %def soft_mismatch_final
@
\subsection{Collinear and soft-collinear subtraction terms}
This data type deals with the calculation of the collinear and
soft-collinear contribution to the cross section.
<<Real subtraction: public>>=
public :: coll_subtraction_t
<<Real subtraction: types>>=
type :: coll_subtraction_t
integer :: n_in, n_alr
logical :: use_resonance_mappings = .false.
real(default) :: CA = 0, CF = 0, TR = 0
contains
<<Real subtraction: coll sub: TBP>>
end type coll_subtraction_t
@ %def coll_subtraction_t
@
<<Real subtraction: coll sub: TBP>>=
procedure :: init => coll_subtraction_init
<<Real subtraction: sub interfaces>>=
module subroutine coll_subtraction_init (coll_sub, n_alr, n_in)
class(coll_subtraction_t), intent(inout) :: coll_sub
integer, intent(in) :: n_alr, n_in
end subroutine coll_subtraction_init
<<Real subtraction: procedures>>=
module subroutine coll_subtraction_init (coll_sub, n_alr, n_in)
class(coll_subtraction_t), intent(inout) :: coll_sub
integer, intent(in) :: n_alr, n_in
coll_sub%n_in = n_in
coll_sub%n_alr = n_alr
end subroutine coll_subtraction_init
@ %def coll_subtraction_init
@ Set the corresponding algebra parameters of the underlying gauge group of the correction.
<<Real subtraction: coll sub: TBP>>=
procedure :: set_parameters => coll_subtraction_set_parameters
<<Real subtraction: sub interfaces>>=
module subroutine coll_subtraction_set_parameters (coll_sub, CA, CF, TR)
class(coll_subtraction_t), intent(inout) :: coll_sub
real(default), intent(in) :: CA, CF, TR
end subroutine coll_subtraction_set_parameters
<<Real subtraction: procedures>>=
module subroutine coll_subtraction_set_parameters (coll_sub, CA, CF, TR)
class(coll_subtraction_t), intent(inout) :: coll_sub
real(default), intent(in) :: CA, CF, TR
coll_sub%CA = CA
coll_sub%CF = CF
coll_sub%TR = TR
end subroutine coll_subtraction_set_parameters
@ %def coll_subtraction_set_parameters
@ This subroutine computes the collinear limit of $g^\alpha(\xi,y)$ introduced
in eq.~\ref{fks: sub: real}. Care is given to also enable the usage for
the soft-collinear limit. This, we write all formulas in terms of soft-finite
quantities.
We have to compute
\begin{equation*}
\frac{J(\Phi_n,\xi,y,\phi)}{\xi}
\left[(1-y)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]|_{y = 1}.
\end{equation*}
The Jacobian $J$ is proportional to $\xi$, due to the $d^3 k_{n+1} /
k_{n+1}^0$ factor in the integration measure. It cancels the factor of
$\xi$ in the denominator. The remaining part of the Jacobian is
multiplied in [[evaluate_region_fsr]] and is not relevant here.
Inserting the splitting functions exemplarily for $q \to qg$ yields
\begin{equation*}
g^\alpha = \frac{8\pi\alpha_s}{k_{\mathrm{em}}^2} C_F (1-y) \xi^2
\frac{1+(1-z)^2}{z} \mathcal{B},
\end{equation*}
where we have chosen $z = E_\mathrm{rad} / \bar{E}_\mathrm{em}$ and
$\bar{E}_\mathrm{em}$ denotes the emitter energy in the Born frame.
The collinear final state imposes $\bar{k}_n = k_{n} + k_{n + 1}$ for the
connection between $\Phi_n$- and $\Phi_{n+1}$-phasepace and we get $1
- z = E_\mathrm{em} / \bar{E}_\mathrm{em}$. The denominator can be
rewritten by the constraint $\bar{k}_n^2 = (k_n + k_{n+1})^2 = 0$ to
\begin{equation*}
k_{\mathrm{em}}^2 = 2 E_\mathrm{rad} E_\mathrm{em} (1-y)
\end{equation*}
which cancels the $(1-y)$ factor in the numerator, thus showing that
the whole expression is indeed collinear-finite. We can further transform
\begin{equation*}
E_\mathrm{rad} E_\mathrm{em} = z (1-z) \bar{E}_\mathrm{em}^2
\end{equation*}
so that in total we have
\begin{equation*}
g^\alpha = \frac{4\pi\alpha_s}{1-z} \frac{1}{\bar{k}_{\text{em}}^2}
C_F \left(\frac{\xi}{z}\right)^2
(1 + (1-z)^2) \mathcal{B}
\end{equation*}
Follow up calculations give us
\begin{align*}
g^{\alpha, g \rightarrow gg} & =
\frac{4\pi\alpha_s}{1-z}\frac{1}{\bar{k}_{\text{em}}^2}
C_{\mathrm{A}} \frac{\xi}{z} \left\lbrace 2 \left( \frac{z}{1 - z}
\xi + \frac{1 - z}{\frac{z}{\xi}} \right) \mathcal{B} + 4\xi z(1 -
z) \hat{k}_{\perp}^{\mu} \hat{k}_{\perp}^{\nu} \mathcal{B}_{\mu\nu}
\right\rbrace, \\
g^{\alpha, g \rightarrow qq} & = \frac{4\pi\alpha_s}{1-z}
\frac{1}{\bar{k}_{\text{em}}^2} T_{\mathrm{R}}
\frac{\xi}{z} \left\lbrace \xi
\mathcal{B} - 4\xi z(1 - z)
\hat{k}_{\perp}^{\mu}
\hat{k}_{\perp}^{\nu}
\mathcal{B}_{\mu\nu} \right\rbrace.
\end{align*}
The ratio $z / \xi$ is finite in the soft limit
\begin{equation*}
\frac{z}{\xi} = \frac{q^0}{2\bar{E}_\mathrm{em}}
\end{equation*}
so that $\xi$ does not appear explicitly in the computation.
The argumentation above is valid for $q \to qg$--splittings, but the
general factorization is valid for general splittings, also for those
involving spin correlations and QED splittings. Note that care has to
be given to the definition of $z$. Further, we have factored out a
factor of $z$ to include in the ratio $z/\xi$, which has to be taken
into account in the implementation of the splitting functions.
<<Real subtraction: coll sub: TBP>>=
procedure :: compute_fsr => coll_subtraction_compute_fsr
<<Real subtraction: sub interfaces>>=
module function coll_subtraction_compute_fsr (coll_sub, emitter, &
flst, p_res, p_born, sqme_born, mom_times_sqme_spin_c, &
xi, alpha_coupling, double_fsr) result (sqme)
real(default) :: sqme
class(coll_subtraction_t), intent(in) :: coll_sub
integer, intent(in) :: emitter
integer, dimension(:), intent(in) :: flst
type(vector4_t), intent(in) :: p_res
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: sqme_born, mom_times_sqme_spin_c
real(default), intent(in) :: xi, alpha_coupling
logical, intent(in) :: double_fsr
end function coll_subtraction_compute_fsr
<<Real subtraction: procedures>>=
module function coll_subtraction_compute_fsr (coll_sub, emitter, &
flst, p_res, p_born, sqme_born, mom_times_sqme_spin_c, &
xi, alpha_coupling, double_fsr) result (sqme)
real(default) :: sqme
class(coll_subtraction_t), intent(in) :: coll_sub
integer, intent(in) :: emitter
integer, dimension(:), intent(in) :: flst
type(vector4_t), intent(in) :: p_res
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: sqme_born, mom_times_sqme_spin_c
real(default), intent(in) :: xi, alpha_coupling
logical, intent(in) :: double_fsr
real(default) :: q0, z, p0, z_o_xi, onemz
integer :: nlegs, flv_em, flv_rad
nlegs = size (flst)
flv_rad = flst(nlegs); flv_em = flst(emitter)
q0 = p_res**1
p0 = p_res * p_born(emitter) / q0
!!! Here, z corresponds to 1-z in the formulas of arXiv:1002.2581;
!!! the integrand is symmetric under this variable change
z_o_xi = q0 / (two * p0)
z = xi * z_o_xi; onemz = one - z
if (is_gluon (flv_em) .and. is_gluon (flv_rad)) then
sqme = coll_sub%CA * ( two * ( z / onemz * xi + onemz / z_o_xi ) * sqme_born &
+ four * xi * z * onemz * mom_times_sqme_spin_c )
else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then
sqme = coll_sub%TR * xi * (sqme_born - four * z * onemz * mom_times_sqme_spin_c)
else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then
sqme = sqme_born * coll_sub%CF * (one + onemz**2) / z_o_xi
else
sqme = zero
end if
sqme = sqme / (p0**2 * onemz * z_o_xi)
sqme = sqme * four * pi * alpha_coupling
if (double_fsr) sqme = sqme * onemz * two
end function coll_subtraction_compute_fsr
@ %def coll_subtraction_compute_fsr
@ Like in the context of [[coll_subtraction_compute_fsr]] we compute
the quantity
\begin{equation*}
\lim_{y\to\pm1}{\left\{\frac{J(\Phi_n,\xi,y,\phi)}{\xi}
\left[(1-y^2)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]\right\}},
\end{equation*}
where the $(1-y^2)$ accounts for both $y=\pm1$. Again, the Jacobian is proportional to $\xi$, so we
drop the $J / \xi$ factor. Note that it is important to take into account this missing
factor of $\xi$ in the computation of the Jacobian during phase-space generation
both for fixed-beam and structure ISR. We consider only a $q \to qg$ splitting
arguing that other splittings are identical in terms of the
factors which cancel. It is given by
\begin{equation*}
g^\alpha = \frac{8\pi\alpha_s}{-k_{\mathrm{em}}^2} C_F (1-y^2) \xi^2
\frac{1+z^2}{1-z} \mathcal{B},
\end{equation*}
where $g^\alpha$ is defined akin to the one for FSR in eq.~\ref{fks: sub: real}.
Note the negative sign of $k_\mathrm{em}^2$ to compensate the negative
virtuality of the initial-state emitter. For ISR, $z$ is defined with
respect to the emitter energy entering the hard interaction, i.e.
\begin{equation*}
z = \frac{E_\mathrm{beam} - E_\mathrm{rad}}{E_\mathrm{beam}} =
1 - \frac{E_\mathrm{rad}}{E_\mathrm{beam}}.
\end{equation*}
Because $E_\mathrm{rad} = E_\mathrm{beam} \cdot \xi$, it is
$z = 1 - \xi$, thus one factor of $\xi$ is cancelled by $(1-z)$ in the
denominator of $g^\alpha$. The factor $k_\mathrm{em}^2$ in the
denominator is rewritten as
\begin{equation*}
k_\mathrm{em}^2 = \left(p_\mathrm{beam} - p_\mathrm{rad}\right)^2
= - 2 p_\mathrm{beam} \cdot p_\mathrm{rad}
= - 2 E_\mathrm{beam} E_\mathrm{rad} (1\pm y)
= - 2 E_\mathrm{beam}^2 (1-z) (1\pm y),
\end{equation*}
where we used
\begin{equation*}
E_\mathrm{beam} E_\mathrm{rad} = E_\mathrm{beam}^2 (1-z).
\end{equation*}
This leads to the cancellation of the corresponding $(1\pm y)$ factor in
$(1-y^2)$, with the other factor becoming a simple factor of $2$, and
the remaining factor of $\xi$ in the numerator. We thus end up with
\begin{equation*}
g^\alpha = \frac{8\pi\alpha_s}{E_\mathrm{beam}^2} C_F \left(1 +
z^2\right)\mathcal{B},
\end{equation*}
which is soft-finite.
Note that here in [[compute_isr]], [[sqme_born]] is supposed to be
the squared Born matrix element convoluted with the real PDF.
<<Real subtraction: coll sub: TBP>>=
procedure :: compute_isr => coll_subtraction_compute_isr
<<Real subtraction: sub interfaces>>=
module function coll_subtraction_compute_isr &
(coll_sub, emitter, flst, p_born, sqme_born, mom_times_sqme_spin_c, &
xi, alpha_coupling, isr_mode) result (sqme)
real(default) :: sqme
class(coll_subtraction_t), intent(in) :: coll_sub
integer, intent(in) :: emitter
integer, dimension(:), intent(in) :: flst
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: sqme_born
real(default), intent(in) :: mom_times_sqme_spin_c
real(default), intent(in) :: xi, alpha_coupling
integer, intent(in) :: isr_mode
end function coll_subtraction_compute_isr
<<Real subtraction: procedures>>=
module function coll_subtraction_compute_isr &
(coll_sub, emitter, flst, p_born, sqme_born, mom_times_sqme_spin_c, &
xi, alpha_coupling, isr_mode) result (sqme)
real(default) :: sqme
class(coll_subtraction_t), intent(in) :: coll_sub
integer, intent(in) :: emitter
integer, dimension(:), intent(in) :: flst
type(vector4_t), intent(in), dimension(:) :: p_born
real(default), intent(in) :: sqme_born
real(default), intent(in) :: mom_times_sqme_spin_c
real(default), intent(in) :: xi, alpha_coupling
integer, intent(in) :: isr_mode
real(default) :: z, onemz, p02
integer :: nlegs, flv_em, flv_rad
!!! p_born must be in lab frame.
nlegs = size (flst)
flv_rad = flst(nlegs); flv_em = flst(emitter)
!!! No need to pay attention to n_in = 1, because this case always has a
!!! massive initial-state particle and thus no collinear divergence.
p02 = p_born(1)%p(0) * p_born(2)%p(0) / two
z = one - xi; onemz = xi
if (is_massless_vector (flv_em) .and. is_massless_vector (flv_rad)) then
sqme = coll_sub%CA * (two * (z + z * onemz**2) * sqme_born + four * onemz**2 &
/ z * mom_times_sqme_spin_c)
else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then
sqme = coll_sub%CF * (one + z**2) * sqme_born
else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then
sqme = coll_sub%CF * (z * onemz * sqme_born + four * onemz**2 / z * mom_times_sqme_spin_c)
else if (is_massless_vector (flv_em) .and. is_fermion (flv_rad)) then
sqme = coll_sub%TR * (z**2 + onemz**2) * onemz * sqme_born
else
sqme = zero
end if
if (isr_mode == SQRTS_VAR) then
sqme = sqme / p02 * z
else
!!! We have no idea why this seems to work as there should be no factor
!!! of z for the fixed-beam settings. This should definitely be understood in the
!!! future!
sqme = sqme / p02 / z
end if
sqme = sqme * four * pi * alpha_coupling
end function coll_subtraction_compute_isr
@ %def coll_subtraction_compute_isr
@
<<Real subtraction: coll sub: TBP>>=
procedure :: final => coll_subtraction_final
<<Real subtraction: sub interfaces>>=
module subroutine coll_subtraction_final (sub_coll)
class(coll_subtraction_t), intent(inout) :: sub_coll
end subroutine coll_subtraction_final
<<Real subtraction: procedures>>=
module subroutine coll_subtraction_final (sub_coll)
class(coll_subtraction_t), intent(inout) :: sub_coll
sub_coll%use_resonance_mappings = .false.
end subroutine coll_subtraction_final
@ %def coll_subtraction_final
@
\subsection{Real Subtraction}
We store a pointer to the [[nlo_settings_t]] object which holds tuning parameters, e.g. cutoffs for the subtraction terms.
<<Real subtraction: public>>=
public :: real_subtraction_t
<<Real subtraction: types>>=
type :: real_subtraction_t
type(nlo_settings_t), pointer :: settings => null ()
type(region_data_t), pointer :: reg_data => null ()
type(real_kinematics_t), pointer :: real_kinematics => null ()
type(isr_kinematics_t), pointer :: isr_kinematics => null ()
real(default), dimension(:,:), allocatable :: sqme_real_non_sub
real(default), dimension(:), allocatable :: sqme_born
real(default), dimension(:,:), allocatable :: sf_factors
real(default), dimension(:,:,:), allocatable :: sqme_born_color_c
real(default), dimension(:,:,:), allocatable :: sqme_born_charge_c
real(default), dimension(:,:,:,:), allocatable :: sqme_born_spin_c
type(soft_subtraction_t) :: sub_soft
type(coll_subtraction_t) :: sub_coll
logical, dimension(:), allocatable :: sc_required
logical :: subtraction_deactivated = .false.
integer :: purpose = INTEGRATION
logical :: radiation_event = .true.
logical :: subtraction_event = .false.
integer, dimension(:), allocatable :: selected_alr
contains
<<Real subtraction: real subtraction: TBP>>
end type real_subtraction_t
@ %def real_subtraction_t
@ Initializer
<<Real subtraction: real subtraction: TBP>>=
procedure :: init => real_subtraction_init
<<Real subtraction: sub interfaces>>=
module subroutine real_subtraction_init (rsub, reg_data, settings)
class(real_subtraction_t), intent(inout), target :: rsub
type(region_data_t), intent(in), target :: reg_data
type(nlo_settings_t), intent(in), target :: settings
end subroutine real_subtraction_init
<<Real subtraction: procedures>>=
module subroutine real_subtraction_init (rsub, reg_data, settings)
class(real_subtraction_t), intent(inout), target :: rsub
type(region_data_t), intent(in), target :: reg_data
type(nlo_settings_t), intent(in), target :: settings
integer :: alr
if (debug_on) call msg_debug (D_SUBTRACTION, "real_subtraction_init")
if (debug_on) call msg_debug (D_SUBTRACTION, "n_in", reg_data%n_in)
if (debug_on) call msg_debug &
(D_SUBTRACTION, "nlegs_born", reg_data%n_legs_born)
if (debug_on) call msg_debug &
(D_SUBTRACTION, "nlegs_real", reg_data%n_legs_real)
if (debug_on) call msg_debug &
(D_SUBTRACTION, "reg_data%n_regions", reg_data%n_regions)
if (debug2_active (D_SUBTRACTION)) call reg_data%write ()
rsub%reg_data => reg_data
allocate (rsub%sqme_born (reg_data%n_flv_born))
rsub%sqme_born = zero
allocate (rsub%sf_factors (reg_data%n_regions, 0:reg_data%n_in))
rsub%sf_factors = zero
allocate (rsub%sqme_born_color_c &
(reg_data%n_legs_born, reg_data%n_legs_born, reg_data%n_flv_born))
rsub%sqme_born_color_c = zero
allocate (rsub%sqme_born_charge_c &
(reg_data%n_legs_born, reg_data%n_legs_born, reg_data%n_flv_born))
rsub%sqme_born_charge_c = zero
allocate (rsub%sqme_real_non_sub (reg_data%n_flv_real, reg_data%n_phs))
rsub%sqme_real_non_sub = zero
allocate (rsub%sc_required (reg_data%n_regions))
do alr = 1, reg_data%n_regions
rsub%sc_required(alr) = reg_data%regions(alr)%sc_required
end do
if (rsub%requires_spin_correlations ()) then
allocate (rsub%sqme_born_spin_c &
(1:3, 1:3, reg_data%n_legs_born, reg_data%n_flv_born))
rsub%sqme_born_spin_c = zero
end if
call rsub%sub_soft%init (reg_data)
call rsub%sub_coll%init (reg_data%n_regions, reg_data%n_in)
rsub%settings => settings
rsub%sub_soft%use_resonance_mappings = settings%use_resonance_mappings
rsub%sub_coll%use_resonance_mappings = settings%use_resonance_mappings
rsub%sub_soft%factorization_mode = settings%factorization_mode
end subroutine real_subtraction_init
@ %def real_subtraction_init
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: set_real_kinematics => real_subtraction_set_real_kinematics
<<Real subtraction: sub interfaces>>=
module subroutine real_subtraction_set_real_kinematics &
(rsub, real_kinematics)
class(real_subtraction_t), intent(inout) :: rsub
type(real_kinematics_t), intent(in), target :: real_kinematics
end subroutine real_subtraction_set_real_kinematics
<<Real subtraction: procedures>>=
module subroutine real_subtraction_set_real_kinematics (rsub, real_kinematics)
class(real_subtraction_t), intent(inout) :: rsub
type(real_kinematics_t), intent(in), target :: real_kinematics
rsub%real_kinematics => real_kinematics
end subroutine real_subtraction_set_real_kinematics
@ %def real_subtraction_set_real_kinematics
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: set_isr_kinematics => real_subtraction_set_isr_kinematics
<<Real subtraction: sub interfaces>>=
module subroutine real_subtraction_set_isr_kinematics (rsub, fractions)
class(real_subtraction_t), intent(inout) :: rsub
type(isr_kinematics_t), intent(in), target :: fractions
end subroutine real_subtraction_set_isr_kinematics
<<Real subtraction: procedures>>=
module subroutine real_subtraction_set_isr_kinematics (rsub, fractions)
class(real_subtraction_t), intent(inout) :: rsub
type(isr_kinematics_t), intent(in), target :: fractions
rsub%isr_kinematics => fractions
end subroutine real_subtraction_set_isr_kinematics
@ %def real_subtraction_set_isr_kinematics
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: get_i_res => real_subtraction_get_i_res
<<Real subtraction: sub interfaces>>=
module function real_subtraction_get_i_res (rsub, alr) result (i_res)
integer :: i_res
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr
end function real_subtraction_get_i_res
<<Real subtraction: procedures>>=
module function real_subtraction_get_i_res (rsub, alr) result (i_res)
integer :: i_res
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr
select type (fks_mapping => rsub%reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
i_res = fks_mapping%res_map%alr_to_i_res (alr)
class default
i_res = 0
end select
end function real_subtraction_get_i_res
@ %def real_subtraction_get_i_res
@
\subsection{The real contribution to the cross section}
In each singular region $\alpha$, the real contribution to $\sigma$ is
given by the second summand of eqn. \ref{fks: sub: complete},
\begin{equation}
\label{fks: sub: real}
\sigma^\alpha_{\text{real}} = \int d\Phi_n \int_0^{2\pi} d\phi
\int_{-1}^1 dy \int_0^{\xi_{\text{max}}} d\xi
\left(\frac{1}{\xi}\right)_+ \left(\frac{1}{1-y}\right)_+
\underbrace{\frac{J(\Phi_n, \xi, y, \phi)}{\xi}
\left[(1-y)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]}_{g^\alpha(\xi,y)}.
\end{equation}
Writing out the plus-distribution and introducing $\tilde{\xi} =
\xi/\xi_{\text{max}}$ to set the upper integration limit to 1, this
turns out to be equal to
\begin{equation}
\begin{split}
\sigma^\alpha_{\rm{real}} &= \int d\Phi_n \int_0^{2\pi}d\phi
\int_{-1}^1 \frac{dy}{1-y} \Bigg\{\int_0^1
d\tilde{\xi}\Bigg[\frac{g^\alpha(\tilde{\xi}\xi_{\rm{max}},y)}{\tilde{\xi}}
- \underbrace{\frac{g^\alpha(0,y)}{\tilde{\xi}}}_{\text{soft}} -
\underbrace{\frac{g^\alpha(\tilde{\xi}\xi_{\rm{max}},1)}{\tilde{\xi}}}_{\text{coll.}}
+
\underbrace{\frac{g^\alpha(0,1)}{\tilde{\xi}}}_{\text{coll.+soft}}\Bigg]
\\
&+ \left[\log\xi_{\rm{max}}(y)g^\alpha(0,y) - \log\xi_{\rm{max}}(1)g^\alpha(0,1)\right]\Bigg\}.
\end{split}
\end{equation}
This formula is implemented in \texttt{compute\_sqme\_real\_fin}
If two or more singular regions would produce the same amplitude we only compute
one and use the [[eqv_index]] to copy the result to the others (if [[reuse_amplitudes_fks]]
is true).
<<Real subtraction: real subtraction: TBP>>=
procedure :: compute => real_subtraction_compute
<<Real subtraction: sub interfaces>>=
module subroutine real_subtraction_compute (rsub, emitter, &
i_phs, alpha_s, alpha_qed, separate_alrs, sqme)
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: emitter, i_phs
logical, intent(in) :: separate_alrs
real(default), intent(inout), dimension(:) :: sqme
real(default), intent(in) :: alpha_s, alpha_qed
end subroutine real_subtraction_compute
<<Real subtraction: procedures>>=
module subroutine real_subtraction_compute (rsub, emitter, &
i_phs, alpha_s, alpha_qed, separate_alrs, sqme)
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: emitter, i_phs
logical, intent(in) :: separate_alrs
real(default), intent(inout), dimension(:) :: sqme
real(default), dimension(:), allocatable :: sqme_alr_arr
real(default), intent(in) :: alpha_s, alpha_qed
real(default) :: sqme_alr, alpha_coupling
integer :: alr, i_con, i_res, this_emitter
logical :: same_emitter
logical, dimension(:), allocatable :: alr_evaluated
allocate (alr_evaluated(rsub%reg_data%n_regions))
allocate (sqme_alr_arr(rsub%reg_data%n_regions))
sqme_alr_arr = zero
alr_evaluated = .false.
do alr = 1, rsub%reg_data%n_regions
if (.not. alr_evaluated(rsub%reg_data%regions(alr)%eqv_index)) then
if (allocated (rsub%selected_alr)) then
if (.not. any (rsub%selected_alr == alr)) cycle
end if
sqme_alr = zero
if (emitter > rsub%isr_kinematics%n_in) then
same_emitter = emitter == rsub%reg_data%regions(alr)%emitter
else
same_emitter = rsub%reg_data%regions(alr)%emitter <= rsub%isr_kinematics%n_in
end if
select case (char(rsub%reg_data%regions(alr)%nlo_correction_type))
case ("QCD")
alpha_coupling = alpha_s
case ("EW")
alpha_coupling = alpha_qed
end select
if (same_emitter .and. i_phs == rsub%real_kinematics%alr_to_i_phs (alr)) then
i_res = rsub%get_i_res (alr)
this_emitter = rsub%reg_data%regions(alr)%emitter
- sqme_alr = rsub%evaluate_emitter_region (alr, this_emitter, i_phs, i_res, &
- alpha_coupling)
- if (rsub%purpose == INTEGRATION .or. rsub%purpose == FIXED_ORDER_EVENTS) then
- i_con = rsub%get_i_contributor (alr)
- sqme_alr = sqme_alr * rsub%get_phs_factor (i_con)
- end if
+ sqme_alr = rsub%evaluate_emitter_region (alr, this_emitter, i_phs, &
+ i_res, alpha_coupling)
+ i_con = rsub%get_i_contributor (alr)
+ sqme_alr = sqme_alr * rsub%get_phs_factor (i_con)
end if
sqme_alr_arr(alr) = sqme_alr_arr(alr) + sqme_alr
if (.not. (debug_active (D_SUBTRACTION) .or. debug2_active (D_SUBTRACTION))) then
if (.not. allocated (rsub%selected_alr)) &
alr_evaluated(rsub%reg_data%regions(alr)%eqv_index) = .true.
end if
else
sqme_alr_arr(alr) = sqme_alr_arr(rsub%reg_data%regions(alr)%eqv_index)
end if
if (separate_alrs) then
sqme(alr) = sqme(alr) + sqme_alr_arr(alr)
else
sqme(1) = sqme(1) + sqme_alr_arr(alr)
end if
end do
if (debug_on) then
if (debug2_active (D_SUBTRACTION)) call check_s_alpha_consistency ()
end if
contains
subroutine check_s_alpha_consistency ()
real(default) :: sum_s_alpha, sum_s_alpha_soft
integer :: i_ftuple
if (debug_on) call msg_debug2 (D_SUBTRACTION, "Check consistency of s_alpha: ")
do alr = 1, rsub%reg_data%n_regions
sum_s_alpha = rsub%sum_up_s_alpha(alr, i_phs)
call msg_debug2 (D_SUBTRACTION, 'sum_s_alpha', sum_s_alpha)
if (.not. nearly_equal(sum_s_alpha, one)) then
call msg_bug ("The sum of all S functions should be equal to one!")
end if
sum_s_alpha_soft = rsub%sum_up_s_alpha_soft(alr, i_phs)
call msg_debug2 (D_SUBTRACTION, 'sum_s_alpha_soft', sum_s_alpha_soft)
if (.not. nearly_equal(sum_s_alpha_soft, one)) then
call msg_bug ("The sum of all soft S functions should be equal to one!")
end if
end do
end subroutine check_s_alpha_consistency
end subroutine real_subtraction_compute
@ %def real_subtraction_compute
@ The emitter is fixed. We now have to decide whether we evaluate in
ISR or FSR region, and also if resonances are used.
<<Real subtraction: real subtraction: TBP>>=
procedure :: evaluate_emitter_region => &
real_subtraction_evaluate_emitter_region
<<Real subtraction: sub interfaces>>=
module function real_subtraction_evaluate_emitter_region (rsub, alr, &
emitter, i_phs, i_res, alpha_coupling) result (sqme)
real(default) :: sqme
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
end function real_subtraction_evaluate_emitter_region
<<Real subtraction: procedures>>=
module function real_subtraction_evaluate_emitter_region (rsub, alr, &
emitter, i_phs, i_res, alpha_coupling) result (sqme)
real(default) :: sqme
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
if (emitter <= rsub%isr_kinematics%n_in) then
sqme = rsub%evaluate_region_isr &
(alr, emitter, i_phs, i_res, alpha_coupling)
else
select type (fks_mapping => rsub%reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
call fks_mapping%set_resonance_momenta &
(rsub%real_kinematics%xi_ref_momenta)
end select
sqme = rsub%evaluate_region_fsr (alr, emitter, i_phs, i_res, alpha_coupling)
end if
end function real_subtraction_evaluate_emitter_region
@ %def real_subtraction_evaluate_emitter_region
@ Sums up $\sum_{i_1, i_2} S_{i_1 i_2}$ for the given [[alr]].
<<Real subtraction: real subtraction: TBP>>=
procedure :: sum_up_s_alpha => real_subtraction_sum_up_s_alpha
<<Real subtraction: sub interfaces>>=
module function real_subtraction_sum_up_s_alpha &
(rsub, alr, i_phs) result (sum_s_alpha)
real(default) :: sum_s_alpha
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, i_phs
end function real_subtraction_sum_up_s_alpha
<<Real subtraction: procedures>>=
module function real_subtraction_sum_up_s_alpha &
(rsub, alr, i_phs) result (sum_s_alpha)
real(default) :: sum_s_alpha
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, i_phs
type(vector4_t), dimension(:), allocatable :: p_real
integer :: i_res, i_ftuple, i1, i2
allocate (p_real (rsub%reg_data%n_legs_real))
if (rsub%reg_data%has_pseudo_isr ()) then
p_real = rsub%real_kinematics%p_real_onshell(i_phs)%get_momenta (i_phs)
else
p_real = rsub%real_kinematics%p_real_cms%get_momenta (i_phs)
end if
i_res = rsub%get_i_res (alr)
sum_s_alpha = zero
do i_ftuple = 1, rsub%reg_data%regions(alr)%nregions
call rsub%reg_data%regions(alr)%ftuples(i_ftuple)%get (i1, i2)
sum_s_alpha = sum_s_alpha + rsub%reg_data%get_svalue (p_real, alr, i1, i2, i_res)
end do
end function real_subtraction_sum_up_s_alpha
@ %def real_subtraction_sum_up_s_alpha
@ Sums up $\sum_{i_1, i_2} S_{i_1 i_2}$ for the given [[alr]]. The
soft S functions take the real momenta in the soft limit, i.e. the
Born momenta. For each summand of [[sum_s_alpha_soft]] we take
[[p_soft]] constructed from the emitter of the given alpha region also
for ftuples in which the first integer [[i1]] does not coincide with
the emitter. This is necessary because only if we keep [[p_soft]]
fixed, all soft S functions are computed with the same denominator and
thus add up to 1.
<<Real subtraction: real subtraction: TBP>>=
procedure :: sum_up_s_alpha_soft => real_subtraction_sum_up_s_alpha_soft
<<Real subtraction: sub interfaces>>=
module function real_subtraction_sum_up_s_alpha_soft &
(rsub, alr, i_phs) result (sum_s_alpha_soft)
real(default) :: sum_s_alpha_soft
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, i_phs
end function real_subtraction_sum_up_s_alpha_soft
<<Real subtraction: procedures>>=
module function real_subtraction_sum_up_s_alpha_soft &
(rsub, alr, i_phs) result (sum_s_alpha_soft)
real(default) :: sum_s_alpha_soft
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, i_phs
type(vector4_t), dimension(:), allocatable :: p_born
integer :: i_res, i_ftuple, i1, i2, emitter, nlegs
allocate (p_born (rsub%reg_data%n_legs_born))
if (rsub%reg_data%has_pseudo_isr ()) then
p_born = rsub%real_kinematics%p_born_onshell%get_momenta (1)
else
p_born = rsub%real_kinematics%p_born_cms%get_momenta (1)
end if
i_res = rsub%get_i_res (alr)
emitter = rsub%reg_data%regions(alr)%emitter
associate (r => rsub%real_kinematics)
if (emitter > rsub%sub_soft%reg_data%n_in) then
call rsub%sub_soft%create_softvec_fsr (p_born, r%y_soft(i_phs), r%phi, &
emitter, r%xi_ref_momenta(rsub%sub_soft%i_xi_ref (alr, i_phs)))
else
call rsub%sub_soft%create_softvec_isr (r%y_soft(i_phs), r%phi)
end if
end associate
nlegs = rsub%reg_data%n_legs_real
sum_s_alpha_soft = zero
do i_ftuple = 1, rsub%reg_data%regions(alr)%nregions
call rsub%reg_data%regions(alr)%ftuples(i_ftuple)%get (i1, i2)
if (i2 == nlegs) then
sum_s_alpha_soft = sum_s_alpha_soft + rsub%reg_data%get_svalue_soft &
(p_born, rsub%sub_soft%p_soft, alr, i1, i_res)
end if
end do
end function real_subtraction_sum_up_s_alpha_soft
@ %def real_subtraction_sum_up_s_alpha_soft
@ This subroutine computes the finite part of the real matrix element in
an individual singular region.
First, the radiation variables are fetched and $\mathcal{R}$ is
multiplied by the appropriate $S_\alpha$-factors,
region multiplicities and double-FSR factors.
Then, it computes the soft, collinear, soft-collinear and remnant matrix
elements and supplies the corresponding factor $1/\xi/(1-y)$ as well as
the corresponding Jacobians.
<<Real subtraction: real subtraction: TBP>>=
procedure :: evaluate_region_fsr => real_subtraction_evaluate_region_fsr
<<Real subtraction: sub interfaces>>=
module function real_subtraction_evaluate_region_fsr (rsub, alr, &
emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
real(default) :: sqme_tot
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
end function real_subtraction_evaluate_region_fsr
<<Real subtraction: procedures>>=
module function real_subtraction_evaluate_region_fsr (rsub, alr, &
emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
real(default) :: sqme_tot
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
real(default) :: sqme_rad, sqme_soft, sqme_coll, sqme_cs, sqme_remn
sqme_rad = zero; sqme_soft = zero; sqme_coll = zero
sqme_cs = zero; sqme_remn = zero
associate (region => rsub%reg_data%regions(alr), &
template => rsub%settings%fks_template)
if (rsub%radiation_event) then
sqme_rad = rsub%sqme_real_non_sub &
(rsub%reg_data%get_matrix_element_index (alr), i_phs)
call evaluate_fks_factors (sqme_rad, rsub%reg_data, &
rsub%real_kinematics, alr, i_phs, emitter, i_res)
- call apply_kinematic_factors_radiation (sqme_rad, rsub%purpose, &
+ call apply_kinematic_factors_radiation (sqme_rad, &
rsub%real_kinematics, i_phs)
end if
if (rsub%subtraction_event .and. .not. (rsub%subtraction_deactivated &
.or. region%nlo_correction_type == "none")) then
if (debug2_active (D_SUBTRACTION)) then
print *, "[real_subtraction_evaluate_region_fsr]"
print *, "xi: ", rsub%real_kinematics%xi_max(i_phs) * &
rsub%real_kinematics%xi_tilde
print *, "y: ", rsub%real_kinematics%y(i_phs)
end if
call rsub%evaluate_subtraction_terms_fsr (alr, emitter, i_phs, &
i_res, alpha_coupling, sqme_soft, sqme_coll, sqme_cs)
call apply_kinematic_factors_subtraction_fsr (sqme_soft, &
sqme_coll, sqme_cs, rsub%real_kinematics, i_phs)
associate (symm_factor_fs => &
rsub%reg_data%born_to_real_symm_factor_fs (alr))
sqme_soft = sqme_soft * symm_factor_fs
sqme_coll = sqme_coll * symm_factor_fs
sqme_cs = sqme_cs * symm_factor_fs
end associate
sqme_remn = compute_sqme_remnant_fsr (sqme_soft, sqme_cs, &
rsub%real_kinematics%xi_max(i_phs), template%xi_cut, &
rsub%real_kinematics%xi_tilde)
sqme_tot = - sqme_soft - sqme_coll + sqme_cs + sqme_remn
else
sqme_tot = sqme_rad
end if
sqme_tot = sqme_tot * rsub%real_kinematics%jac_rand(i_phs)
sqme_tot = sqme_tot * rsub%reg_data%regions(alr)%mult
end associate
if (debug_active (D_SUBTRACTION) .and. .not. &
debug2_active (D_SUBTRACTION)) then
call real_subtraction_register_debug_sqme (rsub, alr, emitter, &
i_phs, sqme_rad, sqme_soft, sqme_coll=sqme_coll, sqme_cs=sqme_cs)
else if (debug2_active (D_SUBTRACTION)) then
call write_computation_status_fsr ()
end if
contains
<<Real subtraction: real subtraction evaluate region fsr: procedures>>
subroutine write_computation_status_fsr (passed, total, region_type, full)
integer, intent(in), optional :: passed, total
character(*), intent(in), optional :: region_type
integer :: i_born
integer :: u
real(default) :: xi
logical :: yorn
logical, intent(in), optional :: full
yorn = .true.
if (present (full)) yorn = full
if (debug_on) call msg_debug &
(D_SUBTRACTION, "real_subtraction_evaluate_region_fsr")
u = given_output_unit (); if (u < 0) return
i_born = rsub%reg_data%regions(alr)%uborn_index
xi = rsub%real_kinematics%xi_max (i_phs) * rsub%real_kinematics%xi_tilde
write (u,'(A,I2)') 'rsub%purpose: ', rsub%purpose
write (u,'(A,I4)') 'alr: ', alr
write (u,'(A,I3)') 'emitter: ', emitter
write (u,'(A,I3)') 'i_phs: ', i_phs
write (u,'(A,F6.4)') 'xi_max: ', rsub%real_kinematics%xi_max (i_phs)
write (u,'(A,F6.4)') 'xi_cut: ', rsub%real_kinematics%xi_max(i_phs) * &
rsub%settings%fks_template%xi_cut
write (u,'(A,F6.4,2X,A,F6.4)') 'xi: ', xi, 'y: ', &
rsub%real_kinematics%y (i_phs)
if (yorn) then
write (u,'(A,ES16.9)') 'sqme_born: ', rsub%sqme_born(i_born)
write (u,'(A,ES16.9)') 'sqme_real: ', sqme_rad
write (u,'(A,ES16.9)') 'sqme_soft: ', sqme_soft
write (u,'(A,ES16.9)') 'sqme_coll: ', sqme_coll
write (u,'(A,ES16.9)') 'sqme_coll-soft: ', sqme_cs
write (u,'(A,ES16.9)') 'sqme_remn: ', sqme_remn
write (u,'(A,ES16.9)') 'sqme_tot: ', sqme_tot
if (present (passed) .and. present (total) .and. &
present (region_type)) &
write (u,'(A)') char (str (passed) // " of " // str (total) // &
" " // region_type // " points passed in total")
end if
write (u,'(A,ES16.9)') 'jacobian - real: ', &
rsub%real_kinematics%jac(i_phs)%jac(1)
write (u,'(A,ES16.9)') 'jacobian - soft: ', &
rsub%real_kinematics%jac(i_phs)%jac(2)
write (u,'(A,ES16.9)') 'jacobian - coll: ', &
rsub%real_kinematics%jac(i_phs)%jac(3)
end subroutine write_computation_status_fsr
end function real_subtraction_evaluate_region_fsr
@ %def real_subtraction_evalute_region_fsr
@ Compares the real matrix element to the subtraction terms in the soft, the collinear
or the soft-collinear limits. Used for debug purposes if [[?test_anti_coll_limit]],
[[?test_coll_limit]] and/or [[?test_soft_limit]] are set in the Sindarin.
[[sqme_soft]] and [[sqme_cs]] need to be provided if called for FSR and [[sqme_coll_plus]],
[[sqme_coll_minus]], [[sqme_cs_plus]] as well as [[sqme_cs_minus]] need to be provided if called for ISR.
<<Real subtraction: procedures>>=
subroutine real_subtraction_register_debug_sqme (rsub, alr, emitter, i_phs, sqme_rad, sqme_soft,&
sqme_coll, sqme_cs, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
class(real_subtraction_t), intent(in) :: rsub
integer, intent(in) :: alr, emitter, i_phs
real(default), intent(in) :: sqme_rad, sqme_soft
real(default), intent(in), optional :: sqme_coll, sqme_cs, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus
real(default), dimension(:), allocatable, save :: sqme_rad_store
logical :: is_soft, is_collinear_plus, is_collinear_minus, is_fsr
real(default), parameter :: soft_threshold = 0.001_default
real(default), parameter :: coll_threshold = 0.99_default
real(default), parameter :: rel_smallness = 0.01_default
real(default) :: sqme_dummy, this_sqme_rad, y, xi_tilde
logical, dimension(:), allocatable, save :: count_alr
if (.not. allocated (sqme_rad_store)) then
allocate (sqme_rad_store (rsub%reg_data%n_regions))
sqme_rad_store = zero
end if
if (rsub%radiation_event) then
sqme_rad_store(alr) = sqme_rad
else
if (.not. allocated (count_alr)) then
allocate (count_alr (rsub%reg_data%n_regions))
count_alr = .false.
end if
if (is_massless_vector (rsub%reg_data%regions(alr)%flst_real%flst(rsub%reg_data%n_legs_real))) then
xi_tilde = rsub%real_kinematics%xi_tilde
is_soft = xi_tilde < soft_threshold
else
is_soft = .false.
end if
y = rsub%real_kinematics%y(i_phs)
is_collinear_plus = y > coll_threshold .and. &
rsub%reg_data%regions(alr)%has_collinear_divergence()
is_collinear_minus = -y > coll_threshold .and. &
rsub%reg_data%regions(alr)%has_collinear_divergence()
is_fsr = emitter > rsub%isr_kinematics%n_in
if (is_fsr) then
if (.not. present(sqme_coll) .or. .not. present(sqme_cs)) &
call msg_error ("real_subtraction_register_debug_sqme: Wrong arguments for FSR")
else
if (.not. present(sqme_coll_plus) .or. .not. present(sqme_coll_minus) &
.or. .not. present(sqme_cs_plus) .or. .not. present(sqme_cs_minus)) &
call msg_error ("real_subtraction_register_debug_sqme: Wrong arguments for ISR")
end if
this_sqme_rad = sqme_rad_store(alr)
if (is_soft .and. .not. is_collinear_plus .and. .not. is_collinear_minus) then
if ( .not. nearly_equal (this_sqme_rad, sqme_soft, &
abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
call msg_print_color (char ("Soft MEs do not match in region " // str (alr)), COL_RED)
else
call msg_print_color (char ("sqme_soft OK in region " // str (alr)), COL_GREEN)
end if
print *, 'this_sqme_rad, sqme_soft = ', this_sqme_rad, sqme_soft
end if
if (is_collinear_plus .and. .not. is_soft) then
if (is_fsr) then
if ( .not. nearly_equal (this_sqme_rad, sqme_coll, &
abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED)
else
call msg_print_color (char ("sqme_coll OK in region " // str (alr)), COL_GREEN)
end if
print *, 'this_sqme_rad, sqme_coll = ', this_sqme_rad, sqme_coll
else
if ( .not. nearly_equal (this_sqme_rad, sqme_coll_plus, &
abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED)
else
call msg_print_color (char ("sqme_coll_plus OK in region " // str (alr)), COL_GREEN)
end if
print *, 'this_sqme_rad, sqme_coll_plus = ', this_sqme_rad, sqme_coll_plus
end if
end if
if (is_collinear_minus .and. .not. is_soft) then
if (.not. is_fsr) then
if ( .not. nearly_equal (this_sqme_rad, sqme_coll_minus, &
abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED)
else
call msg_print_color (char ("sqme_coll_minus OK in region " // str (alr)), COL_GREEN)
end if
print *, 'this_sqme_rad, sqme_coll_minus = ', this_sqme_rad, sqme_coll_minus
end if
end if
if (is_soft .and. is_collinear_plus) then
if (is_fsr) then
if ( .not. nearly_equal (this_sqme_rad, sqme_cs, &
abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED)
else
call msg_print_color (char ("sqme_cs OK in region " // str (alr)), COL_GREEN)
end if
print *, 'this_sqme_rad, sqme_cs = ', this_sqme_rad, sqme_cs
else
if ( .not. nearly_equal (this_sqme_rad, sqme_cs_plus, &
abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED)
else
call msg_print_color (char ("sqme_cs_plus OK in region " // str (alr)), COL_GREEN)
end if
print *, 'this_sqme_rad, sqme_cs_plus = ', this_sqme_rad, sqme_cs_plus
end if
end if
if (is_soft .and. is_collinear_minus) then
if (.not. is_fsr) then
if ( .not. nearly_equal (this_sqme_rad, sqme_cs_minus, &
abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED)
else
call msg_print_color (char ("sqme_cs_minus OK in region " // str (alr)), COL_GREEN)
end if
print *, 'this_sqme_rad, sqme_cs_minus = ', this_sqme_rad, sqme_cs_minus
end if
end if
count_alr (alr) = .true.
if (all (count_alr)) then
deallocate (count_alr)
deallocate (sqme_rad_store)
end if
end if
end subroutine real_subtraction_register_debug_sqme
@ %def real_subtraction_register_debug_sqme
@ For final state radiation, the subtraction remnant cross section is
\begin{equation}
\sigma_{\text{remn}} = \left(\sigma_{\text{soft}} - \sigma_{\text{soft-coll}}\right)
\log (\xi_{\text{max}}) \cdot \frac{\tilde{\xi}}{\xi_{\text{cut}}}.
\end{equation}
There is only one factor of $\log (\xi_{\text{max}})$ for both limits
as $\xi_{\text{max}}$ does not depend on $y$ in the case of FSR.
We use the already computed [[sqme_soft]] and [[sqme_cs]] with a factor of
$\tilde{\xi}$ which we have to compensate. We also need a factor $1/\xi_{\text{cut}}$ here
to assure that the cross section is independent of this free cutoff parameter.
However, it still remains to be motivated analytically.
<<Real subtraction: real subtraction evaluate region fsr: procedures>>=
function compute_sqme_remnant_fsr (sqme_soft, sqme_cs, xi_max, xi_cut, xi_tilde) result (sqme_remn)
real(default) :: sqme_remn
real(default), intent(in) :: sqme_soft, sqme_cs, xi_max, xi_cut, xi_tilde
if (debug_on) call msg_debug (D_SUBTRACTION, "compute_sqme_remnant_fsr")
sqme_remn = (sqme_soft - sqme_cs) * log (xi_max) * xi_tilde / xi_cut
end function compute_sqme_remnant_fsr
@ %def compute_sqme_remnant_fsr
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: evaluate_region_isr => real_subtraction_evaluate_region_isr
<<Real subtraction: sub interfaces>>=
module function real_subtraction_evaluate_region_isr (rsub, alr, &
emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
real(default) :: sqme_tot
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
end function real_subtraction_evaluate_region_isr
<<Real subtraction: procedures>>=
module function real_subtraction_evaluate_region_isr (rsub, alr, &
emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
real(default) :: sqme_tot
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
real(default) :: sqme_rad, sqme_soft, sqme_coll_plus, sqme_coll_minus
real(default) :: sqme_cs_plus, sqme_cs_minus
real(default) :: sqme_remn
sqme_rad = zero; sqme_soft = zero;
sqme_coll_plus = zero; sqme_coll_minus = zero
sqme_cs_plus = zero; sqme_cs_minus = zero
sqme_remn = zero
associate (region => rsub%reg_data%regions(alr), template => rsub%settings%fks_template)
if (rsub%radiation_event) then
sqme_rad = rsub%sqme_real_non_sub (rsub%reg_data%get_matrix_element_index (alr), i_phs)
call evaluate_fks_factors (sqme_rad, rsub%reg_data, rsub%real_kinematics, &
alr, i_phs, emitter, i_res)
- call apply_kinematic_factors_radiation (sqme_rad, rsub%purpose, rsub%real_kinematics, i_phs)
+ call apply_kinematic_factors_radiation (sqme_rad, rsub%real_kinematics, i_phs)
end if
if (rsub%subtraction_event .and. .not. (rsub%subtraction_deactivated &
.or. region%nlo_correction_type == "none")) then
call rsub%evaluate_subtraction_terms_isr (alr, emitter, i_phs, i_res, alpha_coupling, &
sqme_soft, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
call apply_kinematic_factors_subtraction_isr (sqme_soft, sqme_coll_plus, &
sqme_coll_minus, sqme_cs_plus, sqme_cs_minus, rsub%real_kinematics, i_phs)
associate (symm_factor_fs => rsub%reg_data%born_to_real_symm_factor_fs (alr))
sqme_soft = sqme_soft * symm_factor_fs
sqme_coll_plus = sqme_coll_plus * symm_factor_fs
sqme_coll_minus = sqme_coll_minus * symm_factor_fs
sqme_cs_plus = sqme_cs_plus * symm_factor_fs
sqme_cs_minus = sqme_cs_minus * symm_factor_fs
end associate
sqme_remn = compute_sqme_remnant_isr (rsub%isr_kinematics%isr_mode, &
sqme_soft, sqme_cs_plus, sqme_cs_minus, &
rsub%isr_kinematics, rsub%real_kinematics, i_phs, template%xi_cut)
sqme_tot = - sqme_soft - sqme_coll_plus - sqme_coll_minus &
+ sqme_cs_plus + sqme_cs_minus + sqme_remn
else
sqme_tot = sqme_rad
end if
end associate
sqme_tot = sqme_tot * rsub%real_kinematics%jac_rand (i_phs)
sqme_tot = sqme_tot * rsub%reg_data%regions(alr)%mult
if (debug_active (D_SUBTRACTION) .and. .not. debug2_active (D_SUBTRACTION)) then
call real_subtraction_register_debug_sqme (rsub, alr, emitter, i_phs, sqme_rad,&
sqme_soft, sqme_coll_plus=sqme_coll_plus, sqme_coll_minus=sqme_coll_minus,&
sqme_cs_plus=sqme_cs_plus, sqme_cs_minus=sqme_cs_minus)
else if (debug2_active (D_SUBTRACTION)) then
call write_computation_status_isr ()
end if
contains
<<Real subtraction: evaluate region isr: procedures>>
subroutine write_computation_status_isr (unit)
integer, intent(in), optional :: unit
integer :: i_born
integer :: u
real(default) :: xi
u = given_output_unit (unit); if (u < 0) return
i_born = rsub%reg_data%regions(alr)%uborn_index
xi = rsub%real_kinematics%xi_max (i_phs) * rsub%real_kinematics%xi_tilde
write (u,'(A,I4)') 'alr: ', alr
write (u,'(A,I2)') 'emitter: ', emitter
write (u,'(A,F4.2)') 'xi_max: ', rsub%real_kinematics%xi_max (i_phs)
print *, 'xi: ', xi, 'y: ', rsub%real_kinematics%y (i_phs)
print *, 'xb1: ', rsub%isr_kinematics%x(1), 'xb2: ', rsub%isr_kinematics%x(2)
print *, 'random jacobian: ', rsub%real_kinematics%jac_rand (i_phs)
write (u,'(A,ES16.9)') 'sqme_born: ', rsub%sqme_born(i_born)
write (u,'(A,ES16.9)') 'sqme_real: ', sqme_rad
write (u,'(A,ES16.9)') 'sqme_soft: ', sqme_soft
write (u,'(A,ES16.9)') 'sqme_coll_plus: ', sqme_coll_plus
write (u,'(A,ES16.9)') 'sqme_coll_minus: ', sqme_coll_minus
write (u,'(A,ES16.9)') 'sqme_cs_plus: ', sqme_cs_plus
write (u,'(A,ES16.9)') 'sqme_cs_minus: ', sqme_cs_minus
write (u,'(A,ES16.9)') 'sqme_remn: ', sqme_remn
write (u,'(A,ES16.9)') 'sqme_tot: ', sqme_tot
write (u,'(A,ES16.9)') 'jacobian - real: ', rsub%real_kinematics%jac(i_phs)%jac(1)
write (u,'(A,ES16.9)') 'jacobian - soft: ', rsub%real_kinematics%jac(i_phs)%jac(2)
write (u,'(A,ES16.9)') 'jacobian - collplus: ', rsub%real_kinematics%jac(i_phs)%jac(3)
write (u,'(A,ES16.9)') 'jacobian - collminus: ', rsub%real_kinematics%jac(i_phs)%jac(4)
end subroutine write_computation_status_isr
end function real_subtraction_evaluate_region_isr
@ %def real_subtraction_evaluate_region_isr
@ Computes the soft remnant for ISR. The formulas can be found in arXiv:1002.2581, eq. 4.21.
and arXiv:0709.2092, sec. 5.1.2.
This results in
\begin{equation}
\sigma_{\text{remn}}^{\text{ISR}} = \log(\xi_{\text{max}}(y)) \sigma_{\text{soft}}
- \frac{1}{2} \log(\xi_{\text{max}}(1)) \sigma^{\text{soft-coll}}_{\oplus}
- \frac{1}{2} \log(\xi_{\text{max}}(-1)) \sigma^{\text{soft-coll}}_{\ominus}
\end{equation}
where for ISR, $\xi_{\text{max}}$ does explicitly depend on $y$
due to the rescaling of the $x$ values from the Born to the real partonic system according to
\begin{equation}
x_\oplus = \frac{\overline{x}_\oplus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1-y)}{2-\xi(1+y)}}
, \qquad
x_\ominus = \frac{\overline{x}_\ominus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1+y)}{2-\xi(1-y)}}
\end{equation}
As $\xi_{\text{max}}$ is determined by the fact that the real $x_\oplus,x_\ominus$ have to
stay in a physically meaningful regime, i.e. $x_\oplus,x_\ominus < 1$, this leads to
\begin{align}
\label{eqn:xi_max_isr}
\xi_\text{max} = 1 - \text{max}
&\left\{\frac{2(1+y)\overline{x}_\oplus^2}{\sqrt{(1+\overline{x}_\oplus^2)^2(1-y)^2 + 16y\overline{x}_\oplus^2} + (1-y)(1-\overline{x}_\oplus^2)}\right., \\
&\left.\frac{2(1-y)\overline{x}_\oplus^2}{\sqrt{(1+\overline{x}_\oplus^2)^2(1+y)^2 - 16y\overline{x}_\oplus^2} + (1+y)(1-\overline{x}_\oplus^2)}\right\}
\end{align}
and thus
\begin{align}
\xi_{\text{max}}(y=1) &= 1 - \overline{x}_\oplus \\
\xi_{\text{max}}(y=-1) &= 1 - \overline{x}_\ominus
\end{align}
So we need to use the unrescaled $\overline{x}_\oplus,\overline{x}_\ominus$ here.
Factors of $\frac{1}{2}$ and $\frac{1}{\tilde{\xi}}$
are already included in the matrix elements from [[apply_kinematic_factors_subtraction_isr]].
We keep the former and remove the latter by multiplying with $\tilde{\xi}$.
The factor $1/\xi_{\text{cut}}$ is probably needed to assure that the cross section is
independent of this free cutoff parameter in analogy to the FSR case.
However, it still remains to be motivated analytically and to be validated.
<<Real subtraction: evaluate region isr: procedures>>=
function compute_sqme_remnant_isr (isr_mode, sqme_soft, sqme_cs_plus, sqme_cs_minus, &
isr_kinematics, real_kinematics, i_phs, xi_cut) result (sqme_remn)
real(default) :: sqme_remn
integer, intent(in) :: isr_mode
real(default), intent(in) :: sqme_soft, sqme_cs_plus, sqme_cs_minus
type(isr_kinematics_t), intent(in) :: isr_kinematics
type(real_kinematics_t), intent(in) :: real_kinematics
integer, intent(in) :: i_phs
real(default), intent(in) :: xi_cut
real(default) :: xi_tilde, xi_max, xi_max_plus, xi_max_minus, xb_plus, xb_minus
xi_max = real_kinematics%xi_max (i_phs)
xi_tilde = real_kinematics%xi_tilde
select case (isr_mode)
case (SQRTS_VAR)
xb_plus = isr_kinematics%x(I_PLUS)
xb_minus = isr_kinematics%x(I_MINUS)
xi_max_plus = one - xb_plus
xi_max_minus = one - xb_minus
case (SQRTS_FIXED)
xi_max_plus = real_kinematics%xi_max (i_phs)
xi_max_minus = real_kinematics%xi_max (i_phs)
end select
sqme_remn = log (xi_max) * xi_tilde * sqme_soft &
- log (xi_max_plus) * xi_tilde * sqme_cs_plus &
- log (xi_max_minus) * xi_tilde * sqme_cs_minus
sqme_remn = sqme_remn / xi_cut
end function compute_sqme_remnant_isr
@ %def compute_sqme_remnant_isr
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: evaluate_subtraction_terms_fsr => &
real_subtraction_evaluate_subtraction_terms_fsr
<<Real subtraction: sub interfaces>>=
module subroutine real_subtraction_evaluate_subtraction_terms_fsr &
(rsub, alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, &
sqme_coll, sqme_cs)
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
real(default), intent(out) :: sqme_soft, sqme_coll, sqme_cs
end subroutine real_subtraction_evaluate_subtraction_terms_fsr
<<Real subtraction: procedures>>=
module subroutine real_subtraction_evaluate_subtraction_terms_fsr &
(rsub, alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, &
sqme_coll, sqme_cs)
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
real(default), intent(out) :: sqme_soft, sqme_coll, sqme_cs
if (debug_on) call msg_debug &
(D_SUBTRACTION, "real_subtraction_evaluate_subtraction_terms_fsr")
sqme_soft = zero; sqme_coll = zero; sqme_cs = zero
associate (xi_tilde => rsub%real_kinematics%xi_tilde, &
y => rsub%real_kinematics%y(i_phs), &
template => rsub%settings%fks_template)
if (template%xi_cut > xi_tilde) &
sqme_soft = rsub%compute_sub_soft &
(alr, emitter, i_phs, i_res, alpha_coupling)
if (y - 1 + template%delta_o > 0) &
sqme_coll = rsub%compute_sub_coll &
(alr, emitter, i_phs, alpha_coupling)
if (template%xi_cut > xi_tilde .and. y - 1 + template%delta_o > 0) &
sqme_cs = rsub%compute_sub_coll_soft &
(alr, emitter, i_phs, alpha_coupling)
if (debug2_active (D_SUBTRACTION)) then
print *, "FSR Cutoff:"
print *, "sub_soft: ", &
template%xi_cut > xi_tilde, "(ME: ", sqme_soft, ")"
print *, "sub_coll: ", &
(y - 1 + template%delta_o) > 0, "(ME: ", sqme_coll, ")"
print *, "sub_coll_soft: ", &
template%xi_cut > xi_tilde .and. (y - 1 + template%delta_o) > 0, &
"(ME: ", sqme_cs, ")"
end if
end associate
end subroutine real_subtraction_evaluate_subtraction_terms_fsr
@ %def real_subtraction_evaluate_subtraction_terms_fsr
@
<<Real subtraction: procedures>>=
subroutine evaluate_fks_factors (sqme, reg_data, real_kinematics, &
alr, i_phs, emitter, i_res)
real(default), intent(inout) :: sqme
type(region_data_t), intent(inout) :: reg_data
type(real_kinematics_t), intent(in), target :: real_kinematics
integer, intent(in) :: alr, i_phs, emitter, i_res
real(default) :: s_alpha
type(phs_point_set_t), pointer :: p_real => null ()
if (reg_data%has_pseudo_isr ()) then
p_real => real_kinematics%p_real_onshell (i_phs)
else
p_real => real_kinematics%p_real_cms
end if
s_alpha = reg_data%get_svalue (p_real%get_momenta(i_phs), alr, emitter, i_res)
if (debug2_active (D_SUBTRACTION)) call msg_print_color('s_alpha', s_alpha, COL_YELLOW)
if (s_alpha > one + tiny_07) call msg_fatal ("s_alpha > 1!")
sqme = sqme * s_alpha
associate (region => reg_data%regions(alr))
if (emitter > reg_data%n_in) then
if (debug2_active (D_SUBTRACTION)) &
print *, 'Double FSR: ', region%double_fsr_factor (p_real%get_momenta(i_phs))
sqme = sqme * region%double_fsr_factor (p_real%get_momenta(i_phs))
end if
end associate
end subroutine evaluate_fks_factors
@ %def evaluate_fks_factors
-@ Applies the Jacobian to the squared matrix element. During
-integration and when generating fixed order events, the non-kinematic
-part $\frac{s}{(4\pi)^3}$ is applied in [[real_subtraction_compute]] via
-[[get_phs_factor]]. For the purpose of generating POWHEG events, we do
-it here. The additional factor $\frac{\xi}{\tilde\xi}$ during
-integration comes from eq.~(4.19f) in arXiv:1002.2581.
-During integration, we sample $\tilde\xi \in [0,1]$ while we sample
-$\xi \in [p_T^2,\xi_\text{max}]$ for POWHEG matching.
-Thus, we are taking into account that $d\xi = d\tilde\xi
-\frac{\xi}{\tilde\xi}$.
+@ Applies the kinematic dependent part of the Jacobian
+to the squared matrix element. During integration and when generating
+fixed order events, the non-kinematic part $\frac{s}{(4\pi)^3}$ is applied
+in [[real_subtraction_compute]] via [[get_phs_factor]].
+The additional factor $\frac{\xi}{\tilde\xi}$ comes from
+eq.~(4.19f) in arXiv:1002.2581.
<<Real subtraction: procedures>>=
- subroutine apply_kinematic_factors_radiation (sqme, purpose, &
+ subroutine apply_kinematic_factors_radiation (sqme, &
real_kinematics, i_phs)
real(default), intent(inout) :: sqme
- integer, intent(in) :: purpose
type(real_kinematics_t), intent(in) :: real_kinematics
integer, intent(in) :: i_phs
real(default) :: xi, xi_tilde, s_b
xi_tilde = real_kinematics%xi_tilde
xi = xi_tilde * real_kinematics%xi_max (i_phs)
- select case (purpose)
- case (INTEGRATION, FIXED_ORDER_EVENTS)
- sqme = sqme * xi**2 / xi_tilde * real_kinematics%jac(i_phs)%jac(1)
- case (POWHEG)
- s_b = real_kinematics%cms_energy2
- sqme = sqme * xi * s_b / (8 * twopi3) * real_kinematics%jac(i_phs)%jac(1)
- end select
+ sqme = sqme * xi**2 / xi_tilde * real_kinematics%jac(i_phs)%jac(1)
end subroutine apply_kinematic_factors_radiation
@ %def apply_kinematic_factors_radiation
@ This routine applies the factors in the integrand of eq. 4.20
in arXiv:1002.2581 to the matrix elements.
<<Real subtraction: procedures>>=
subroutine apply_kinematic_factors_subtraction_fsr &
(sqme_soft, sqme_coll, sqme_cs, real_kinematics, i_phs)
real(default), intent(inout) :: sqme_soft, sqme_coll, sqme_cs
type(real_kinematics_t), intent(in) :: real_kinematics
integer, intent(in) :: i_phs
real(default) :: xi_tilde, onemy
xi_tilde = real_kinematics%xi_tilde
onemy = one - real_kinematics%y(i_phs)
sqme_soft = sqme_soft / onemy / xi_tilde
sqme_coll = sqme_coll / onemy / xi_tilde
sqme_cs = sqme_cs / onemy / xi_tilde
associate (jac => real_kinematics%jac(i_phs)%jac)
sqme_soft = sqme_soft * jac(2)
sqme_coll = sqme_coll * jac(3)
sqme_cs = sqme_cs * jac(2)
end associate
end subroutine apply_kinematic_factors_subtraction_fsr
@ %def apply_kinematic_factors_subtraction_fsr
@ This routine applies the factors in the integrand of eq. 4.21
in arXiv:1002.2581 to the matrix elements.
<<Real subtraction: procedures>>=
subroutine apply_kinematic_factors_subtraction_isr &
(sqme_soft, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, &
sqme_cs_minus, real_kinematics, i_phs)
real(default), intent(inout) :: sqme_soft, sqme_coll_plus, sqme_coll_minus
real(default), intent(inout) :: sqme_cs_plus, sqme_cs_minus
type(real_kinematics_t), intent(in) :: real_kinematics
integer, intent(in) :: i_phs
real(default) :: xi_tilde, y, onemy, onepy
xi_tilde = real_kinematics%xi_tilde
y = real_kinematics%y (i_phs)
onemy = one - y; onepy = one + y
associate (jac => real_kinematics%jac(i_phs)%jac)
sqme_soft = sqme_soft / (one - y**2) / xi_tilde * jac(2)
sqme_coll_plus = sqme_coll_plus / onemy / xi_tilde / two * jac(3)
sqme_coll_minus = sqme_coll_minus / onepy / xi_tilde / two * jac(4)
sqme_cs_plus = sqme_cs_plus / onemy / xi_tilde / two * jac(2)
sqme_cs_minus = sqme_cs_minus / onepy / xi_tilde / two * jac(2)
end associate
end subroutine apply_kinematic_factors_subtraction_isr
@ %def apply_kinematic_factors_subtraction_isr
@ This subroutine evaluates the soft and collinear subtraction terms for ISR.
References:
\begin{itemize}
\item arXiv:0709.2092, sec. 2.4.2
\item arXiv:0908.4272, sec. 4.2
\end{itemize}
For the collinear terms, the procedure is as follows:
If the emitter is 0, then a gluon was radiated from one of the
incoming partons. Gluon emissions require two counter terms:
One for emission in the direction of the first incoming parton
$\oplus$ and a second for emission in the direction of the second
incoming parton $\ominus$ because in both cases, there are divergent
diagrams contributing to the matrix element. So in this case both,
[[sqme_coll_plus]] and [[sqme_coll_minus]], are non-zero.
If the emitter is 1 or 2, then a quark was emitted instead of a
gluon. This only leads to a divergence collinear to the emitter
because for anti-collinear quark emission, there are simply no
divergent diagrams in the same region as two collinear quarks that
cannot originate in the same splitting are non-divergent. This means
that in case the emitter is 1, we need non-zero [[sqme_coll_plus]]
and in case the emitter is 2, we need non-zero [[sqme_coll_minus]].
At this point, we want to remind ourselves that in case of initial
state divergences, $y$ is just the polar angle, so the
[[sqme_coll_minus]] terms are there to counter emissions in the
direction of the second incoming parton $\ominus$ and {\em not} to
counter in general anti-collinear divergences.
<<Real subtraction: real subtraction: TBP>>=
procedure :: evaluate_subtraction_terms_isr => &
real_subtraction_evaluate_subtraction_terms_isr
<<Real subtraction: sub interfaces>>=
module subroutine real_subtraction_evaluate_subtraction_terms_isr (rsub, &
alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, sqme_coll_plus, &
sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
real(default), intent(out) :: sqme_soft
real(default), intent(out) :: sqme_coll_plus, sqme_coll_minus
real(default), intent(out) :: sqme_cs_plus, sqme_cs_minus
end subroutine real_subtraction_evaluate_subtraction_terms_isr
<<Real subtraction: procedures>>=
module subroutine real_subtraction_evaluate_subtraction_terms_isr (rsub, &
alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, sqme_coll_plus, &
sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
real(default), intent(out) :: sqme_soft
real(default), intent(out) :: sqme_coll_plus, sqme_coll_minus
real(default), intent(out) :: sqme_cs_plus, sqme_cs_minus
sqme_coll_plus = zero; sqme_cs_plus = zero
sqme_coll_minus = zero; sqme_cs_minus = zero
associate (xi_tilde => rsub%real_kinematics%xi_tilde, &
y => rsub%real_kinematics%y(i_phs), &
template => rsub%settings%fks_template)
if (template%xi_cut > xi_tilde) &
sqme_soft = rsub%compute_sub_soft &
(alr, emitter, i_phs, i_res, alpha_coupling)
if (emitter /= 2) then
if (y - 1 + template%delta_i > 0) then
sqme_coll_plus = &
rsub%compute_sub_coll (alr, 1, i_phs, alpha_coupling)
if (template%xi_cut > xi_tilde) then
sqme_cs_plus = &
rsub%compute_sub_coll_soft (alr, 1, i_phs, alpha_coupling)
end if
end if
end if
if (emitter /= 1) then
if (-y - 1 + template%delta_i > 0) then
sqme_coll_minus = &
rsub%compute_sub_coll (alr, 2, i_phs, alpha_coupling)
if (template%xi_cut > xi_tilde) then
sqme_cs_minus = &
rsub%compute_sub_coll_soft (alr, 2, i_phs, alpha_coupling)
end if
end if
end if
if (debug2_active (D_SUBTRACTION)) then
print *, "ISR Cutoff:"
print *, "y: ", y
print *, "delta_i: ", template%delta_i
print *, "emitter: ", emitter
print *, "sub_soft: ", &
template%xi_cut > xi_tilde, "(ME: ", sqme_soft, ")"
print *, "sub_coll_plus: ", &
(y - 1 + template%delta_i) > 0, "(ME: ", sqme_coll_plus, ")"
print *, "sub_coll_minus: ", &
(-y - 1 + template%delta_i) > 0, "(ME: ", sqme_coll_minus, ")"
print *, "sub_coll_soft_plus: ", template%xi_cut > xi_tilde .and. &
(y - 1 + template%delta_i) > 0, "(ME: ", sqme_cs_plus, ")"
print *, "sub_coll_soft_minus: ", template%xi_cut > xi_tilde .and. &
(-y - 1 + template%delta_i) > 0, "(ME: ", sqme_cs_minus, ")"
end if
end associate
end subroutine real_subtraction_evaluate_subtraction_terms_isr
@ %def real_subtraction_evaluate_subtraction_terms_isr
@ This is basically the global part of the real Jacobian corresponding to
\begin{equation*}
\frac{q^2}{8 (2\pi)^3}.
\end{equation*}
We interpret it as the additional phase space factor of the real component,
to be more consistent with the evaluation of the Born phase space.
We specifically use the Born center-of-mass energy here.
The real center-of-mass energy is only different from the Born center-of-mass
energy in case of ISR. The missing factor $\frac{1}{1 - \xi}$ for this
conversion is supplied in [[phs_fks_generator_generate_isr]].
<<Real subtraction: real subtraction: TBP>>=
procedure :: get_phs_factor => real_subtraction_get_phs_factor
<<Real subtraction: sub interfaces>>=
module function real_subtraction_get_phs_factor &
(rsub, i_con) result (factor)
real(default) :: factor
class(real_subtraction_t), intent(in) :: rsub
integer, intent(in) :: i_con
end function real_subtraction_get_phs_factor
<<Real subtraction: procedures>>=
module function real_subtraction_get_phs_factor (rsub, i_con) result (factor)
real(default) :: factor
class(real_subtraction_t), intent(in) :: rsub
integer, intent(in) :: i_con
real(default) :: s
s = rsub%real_kinematics%xi_ref_momenta (i_con)**2
factor = s / (8 * twopi3)
end function real_subtraction_get_phs_factor
@ %def real_subtraction_get_phs_factor
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: get_i_contributor => real_subtraction_get_i_contributor
<<Real subtraction: sub interfaces>>=
module function real_subtraction_get_i_contributor &
(rsub, alr) result (i_con)
integer :: i_con
class(real_subtraction_t), intent(in) :: rsub
integer, intent(in) :: alr
end function real_subtraction_get_i_contributor
<<Real subtraction: procedures>>=
module function real_subtraction_get_i_contributor (rsub, alr) result (i_con)
integer :: i_con
class(real_subtraction_t), intent(in) :: rsub
integer, intent(in) :: alr
if (allocated (rsub%reg_data%alr_to_i_contributor)) then
i_con = rsub%reg_data%alr_to_i_contributor (alr)
else
i_con = 1
end if
end function real_subtraction_get_i_contributor
@ %def real_subtraction_get_i_contributor
@ Computes the soft subtraction term.
If there is an initial state emission having a soft divergence, then a gluon
has to have been emitted. A gluon can always be emitted from both IS partons
and thus, we can take the [[sf_factor]] for emitter $0$ in this case.
Be aware that this approach will not work for $pe$ collisions.
<<Real subtraction: real subtraction: TBP>>=
procedure :: compute_sub_soft => real_subtraction_compute_sub_soft
<<Real subtraction: sub interfaces>>=
module function real_subtraction_compute_sub_soft (rsub, alr, emitter, &
i_phs, i_res, alpha_coupling) result (sqme_soft)
real(default) :: sqme_soft
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
end function real_subtraction_compute_sub_soft
<<Real subtraction: procedures>>=
module function real_subtraction_compute_sub_soft (rsub, alr, emitter, &
i_phs, i_res, alpha_coupling) result (sqme_soft)
real(default) :: sqme_soft
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, emitter, i_phs, i_res
real(default), intent(in) :: alpha_coupling
integer :: i_xi_ref, i_born
real(default) :: q2, sf_factor
type(vector4_t), dimension(:), allocatable :: p_born
associate (real_kinematics => rsub%real_kinematics, &
nlo_corr_type => rsub%reg_data%regions(alr)%nlo_correction_type, &
sregion => rsub%reg_data%regions(alr))
sqme_soft = zero
if (sregion%has_soft_divergence ()) then
i_xi_ref = rsub%sub_soft%i_xi_ref (alr, i_phs)
q2 = real_kinematics%xi_ref_momenta (i_xi_ref)**2
allocate (p_born (rsub%reg_data%n_legs_born))
if (rsub%reg_data%has_pseudo_isr ()) then
p_born = real_kinematics%p_born_onshell%get_momenta (1)
else
p_born = real_kinematics%p_born_cms%get_momenta (1)
end if
if (emitter > rsub%sub_soft%reg_data%n_in) then
call rsub%sub_soft%create_softvec_fsr &
(p_born, real_kinematics%y_soft(i_phs), &
real_kinematics%phi, emitter, &
real_kinematics%xi_ref_momenta(i_xi_ref))
sf_factor = one
else
call rsub%sub_soft%create_softvec_isr &
(real_kinematics%y_soft(i_phs), real_kinematics%phi)
sf_factor = rsub%sf_factors(alr, 0)
end if
i_born = sregion%uborn_index
select case (char (nlo_corr_type))
case ("QCD")
sqme_soft = rsub%sub_soft%compute &
(p_born, rsub%sqme_born_color_c(:,:,i_born) * &
sf_factor, real_kinematics%y(i_phs), &
q2, alpha_coupling, alr, emitter, i_res)
case ("EW")
sqme_soft = rsub%sub_soft%compute &
(p_born, rsub%sqme_born_charge_c(:,:,i_born) * &
sf_factor, real_kinematics%y(i_phs), &
q2, alpha_coupling, alr, emitter, i_res)
end select
end if
end associate
if (debug2_active (D_SUBTRACTION)) call check_soft_vector ()
contains
subroutine check_soft_vector ()
!!! p_soft = p_gluon / E_gluon only in the soft limit
!!! This check only has to be passed for ISR or for FSR if ?test_soft_limit = true is set.
type(vector4_t) :: p_gluon
if (debug_on) call msg_debug2 (D_SUBTRACTION, "Compare soft vector: ")
print *, 'p_soft: ', rsub%sub_soft%p_soft%p
print *, 'Normalized gluon momentum: '
if (rsub%reg_data%has_pseudo_isr ()) then
p_gluon = rsub%real_kinematics%p_real_onshell(thr_leg(emitter))%get_momentum &
(i_phs, rsub%reg_data%n_legs_real)
else
p_gluon = rsub%real_kinematics%p_real_cms%get_momentum &
(i_phs, rsub%reg_data%n_legs_real)
end if
call vector4_write (p_gluon / p_gluon%p(0), show_mass = .true.)
end subroutine check_soft_vector
end function real_subtraction_compute_sub_soft
@ %def real_subtraction_compute_sub_soft
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: get_spin_correlation_term => &
real_subtraction_get_spin_correlation_term
<<Real subtraction: sub interfaces>>=
module function real_subtraction_get_spin_correlation_term &
(rsub, alr, i_born, emitter) result (mom_times_sqme)
real(default) :: mom_times_sqme
class(real_subtraction_t), intent(in) :: rsub
integer, intent(in) :: alr, i_born, emitter
end function real_subtraction_get_spin_correlation_term
<<Real subtraction: procedures>>=
module function real_subtraction_get_spin_correlation_term &
(rsub, alr, i_born, emitter) result (mom_times_sqme)
real(default) :: mom_times_sqme
class(real_subtraction_t), intent(in) :: rsub
integer, intent(in) :: alr, i_born, emitter
real(default), dimension(0:3) :: k_perp
integer :: mu, nu
if (rsub%sc_required(alr)) then
if (debug2_active(D_SUBTRACTION)) call check_me_consistency ()
associate (real_kin => rsub%real_kinematics)
if (emitter > rsub%reg_data%n_in) then
k_perp = real_subtraction_compute_k_perp_fsr ( &
real_kin%p_born_lab%get_momentum(1, emitter), &
rsub%real_kinematics%phi)
else
k_perp = real_subtraction_compute_k_perp_isr ( &
real_kin%p_born_lab%get_momentum(1, emitter), &
rsub%real_kinematics%phi)
end if
end associate
mom_times_sqme = zero
do mu = 1, 3
do nu = 1, 3
mom_times_sqme = mom_times_sqme + &
k_perp(mu) * k_perp(nu) * rsub%sqme_born_spin_c (mu, nu, emitter, i_born)
end do
end do
else
mom_times_sqme = zero
end if
contains
subroutine check_me_consistency ()
real(default) :: sqme_sum
if (debug_on) call msg_debug2 (D_SUBTRACTION, "Spin-correlation: Consistency check")
sqme_sum = &
- rsub%sqme_born_spin_c(1,1,emitter,i_born) &
- rsub%sqme_born_spin_c(2,2,emitter,i_born) &
- rsub%sqme_born_spin_c(3,3,emitter,i_born)
if (.not. nearly_equal (sqme_sum, -rsub%sqme_born(i_born))) then
print *, 'Spin-correlated matrix elements are not consistent: '
print *, 'emitter: ', emitter
print *, 'g^{mu,nu} B_{mu,nu}: ', -sqme_sum
print *, 'all Born matrix elements: ', rsub%sqme_born
call msg_fatal ("FAIL")
else
call msg_print_color ("Success", COL_GREEN)
end if
end subroutine check_me_consistency
end function real_subtraction_get_spin_correlation_term
@ %def real_subtraction_get_spin_correlation_term
@ Construct a normalised momentum perpendicular to momentum [[p]] and
rotate by an arbitrary angle [[phi]]. The angular conventions we use
here are equivalent to those used by POWHEG.
<<Real subtraction: public>>=
public :: real_subtraction_compute_k_perp_fsr
public :: real_subtraction_compute_k_perp_isr
<<Real subtraction: sub interfaces>>=
module function real_subtraction_compute_k_perp_fsr &
(p, phi) result (k_perp_fsr)
real(default), dimension(0:3) :: k_perp_fsr
type(vector4_t), intent(in) :: p
real(default), intent(in) :: phi
end function real_subtraction_compute_k_perp_fsr
module function real_subtraction_compute_k_perp_isr &
(p, phi) result (k_perp_isr)
real(default), dimension(0:3) :: k_perp_isr
type(vector4_t), intent(in) :: p
real(default), intent(in) :: phi
end function real_subtraction_compute_k_perp_isr
<<Real subtraction: procedures>>=
module function real_subtraction_compute_k_perp_fsr &
(p, phi) result (k_perp_fsr)
real(default), dimension(0:3) :: k_perp_fsr
type(vector4_t), intent(in) :: p
real(default), intent(in) :: phi
type(vector4_t) :: k
type(vector3_t) :: vec
type(lorentz_transformation_t) :: rot
vec = p%p(1:3) / p%p(0)
k%p(0) = zero
k%p(1) = p%p(1); k%p(2) = p%p(2)
k%p(3) = - (p%p(1)**2 + p%p(2)**2) / p%p(3)
rot = rotation (cos(phi), sin(phi), vec)
k = rot * k
k%p(1:3) = k%p(1:3) / space_part_norm (k)
k_perp_fsr = k%p
end function real_subtraction_compute_k_perp_fsr
module function real_subtraction_compute_k_perp_isr &
(p, phi) result (k_perp_isr)
real(default), dimension(0:3) :: k_perp_isr
type(vector4_t), intent(in) :: p
real(default), intent(in) :: phi
k_perp_isr(0) = zero
k_perp_isr(1) = sin(phi)
k_perp_isr(2) = cos(phi)
k_perp_isr(3) = zero
end function real_subtraction_compute_k_perp_isr
@ %def real_subtraction_compute_k_perp_fsr, real_subtraction_compute_k_perp_isr
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: compute_sub_coll => real_subtraction_compute_sub_coll
<<Real subtraction: sub interfaces>>=
module function real_subtraction_compute_sub_coll &
(rsub, alr, em, i_phs, alpha_coupling) result (sqme_coll)
real(default) :: sqme_coll
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, em, i_phs
real(default), intent(in) :: alpha_coupling
end function real_subtraction_compute_sub_coll
<<Real subtraction: procedures>>=
module function real_subtraction_compute_sub_coll &
(rsub, alr, em, i_phs, alpha_coupling) result (sqme_coll)
real(default) :: sqme_coll
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, em, i_phs
real(default), intent(in) :: alpha_coupling
real(default) :: xi, xi_max
real(default) :: mom_times_sqme_spin_c, sqme_born_coll
real(default) :: N_col
integer :: i_con, i
real(default) :: pfr
associate (sregion => rsub%reg_data%regions(alr))
sqme_coll = zero
sqme_born_coll = zero
N_col = 1
if (sregion%has_collinear_divergence ()) then
xi = rsub%real_kinematics%xi_tilde * rsub%real_kinematics%xi_max(i_phs)
if (rsub%sub_coll%use_resonance_mappings) then
i_con = rsub%reg_data%alr_to_i_contributor (alr)
else
i_con = 1
end if
mom_times_sqme_spin_c = &
rsub%get_spin_correlation_term (alr, sregion%uborn_index, em)
if (rsub%reg_data%nlo_correction_type == "EW" .and. &
sregion%nlo_correction_type == "QCD" .and. &
qcd_ew_interferences (sregion%flst_uborn%flst)) then
do i = 1, size (sregion%flst_uborn%flst)
if (is_quark (sregion%flst_uborn%flst (i))) then
sqme_born_coll = &
-rsub%sqme_born_color_c (i, i, sregion%uborn_index)/CF
exit
end if
end do
else
sqme_born_coll = rsub%sqme_born(sregion%uborn_index)
end if
if (em <= rsub%sub_coll%n_in) then
select case (rsub%isr_kinematics%isr_mode)
case (SQRTS_FIXED)
xi_max = rsub%real_kinematics%xi_max(i_phs)
case (SQRTS_VAR)
xi_max = one - rsub%isr_kinematics%x(em)
end select
xi = rsub%real_kinematics%xi_tilde * xi_max
if (sregion%nlo_correction_type == "QCD") then
call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
else if (sregion%nlo_correction_type == "EW") then
if (is_quark (sregion%flst_real%flst(size(sregion%flst_real%flst)))) N_col = 3
call rsub%sub_coll%set_parameters (CA = zero, &
CF = sregion%flst_real%charge(em)**2, &
TR = N_col*sregion%flst_real%charge(size(sregion%flst_real%flst))**2)
end if
sqme_coll = rsub%sub_coll%compute_isr (em, sregion%flst_real%flst, &
rsub%real_kinematics%p_born_lab%phs_point(1)%get (), &
sqme_born_coll * rsub%sf_factors(alr, em), &
mom_times_sqme_spin_c * rsub%sf_factors(alr, em), &
xi, alpha_coupling, rsub%isr_kinematics%isr_mode)
else
if (sregion%nlo_correction_type == "QCD") then
call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
else if (sregion%nlo_correction_type == "EW") then
if (is_quark (sregion%flst_real%flst(sregion%emitter))) N_col = 3
call rsub%sub_coll%set_parameters (CA = zero, &
CF = sregion%flst_real%charge(sregion%emitter)**2, &
TR = N_col*sregion%flst_real%charge(sregion%emitter)**2)
end if
sqme_coll = rsub%sub_coll%compute_fsr (sregion%emitter, &
sregion%flst_real%flst, &
rsub%real_kinematics%xi_ref_momenta (i_con), &
rsub%real_kinematics%p_born_lab%get_momenta(1), &
sqme_born_coll, &
mom_times_sqme_spin_c, &
xi, alpha_coupling, sregion%double_fsr)
if (rsub%sub_coll%use_resonance_mappings) then
select type (fks_mapping => rsub%reg_data%fks_mapping)
type is (fks_mapping_resonances_t)
pfr = fks_mapping%get_resonance_weight (alr, &
rsub%real_kinematics%p_born_cms%get_momenta(1))
end select
sqme_coll = sqme_coll * pfr
end if
end if
end if
end associate
end function real_subtraction_compute_sub_coll
@ %def real_subtraction_compute_sub_coll
@ Computes the soft-collinear subtraction term. For alpha regions with emitter
$0$, this routine is called with [[em == 1]] and [[em == 2]] separately.
To still be able to use the unrescaled pdf factors stored in [[sf_factors(alr, 0)]]
in this case, we need to differentiate between [[em]] and [[em_pdf = 0]].
<<Real subtraction: real subtraction: TBP>>=
procedure :: compute_sub_coll_soft => real_subtraction_compute_sub_coll_soft
<<Real subtraction: sub interfaces>>=
module function real_subtraction_compute_sub_coll_soft &
(rsub, alr, em, i_phs, alpha_coupling) result (sqme_cs)
real(default) :: sqme_cs
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, em, i_phs
real(default), intent(in) :: alpha_coupling
end function real_subtraction_compute_sub_coll_soft
<<Real subtraction: procedures>>=
module function real_subtraction_compute_sub_coll_soft &
(rsub, alr, em, i_phs, alpha_coupling) result (sqme_cs)
real(default) :: sqme_cs
class(real_subtraction_t), intent(inout) :: rsub
integer, intent(in) :: alr, em, i_phs
real(default), intent(in) :: alpha_coupling
real(default) :: mom_times_sqme_spin_c, sqme_born_coll
real(default) :: N_col
integer :: i_con, em_pdf, i
associate (sregion => rsub%reg_data%regions(alr))
sqme_cs = zero
sqme_born_coll = zero
N_col = 1
if (sregion%has_collinear_divergence ()) then
if (rsub%sub_coll%use_resonance_mappings) then
i_con = rsub%reg_data%alr_to_i_contributor (alr)
else
i_con = 1
end if
mom_times_sqme_spin_c = rsub%get_spin_correlation_term (alr, sregion%uborn_index, em)
if (rsub%reg_data%nlo_correction_type == "EW" .and. &
sregion%nlo_correction_type == "QCD" .and. &
qcd_ew_interferences (sregion%flst_uborn%flst)) then
do i = 1, size (sregion%flst_uborn%flst)
if (is_quark (sregion%flst_uborn%flst (i))) then
sqme_born_coll = -rsub%sqme_born_color_c (i, i, sregion%uborn_index)/CF
exit
end if
end do
else
sqme_born_coll = rsub%sqme_born(sregion%uborn_index)
end if
if (em <= rsub%sub_coll%n_in) then
em_pdf = 0
if (sregion%nlo_correction_type == "QCD") then
call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
else if (sregion%nlo_correction_type == "EW") then
if (is_quark (sregion%flst_real%flst(size(sregion%flst_real%flst)))) N_col = 3
call rsub%sub_coll%set_parameters (CA = zero, &
CF = sregion%flst_real%charge(em)**2, &
TR = N_col*sregion%flst_real%charge(size(sregion%flst_real%flst))**2)
end if
sqme_cs = rsub%sub_coll%compute_isr (em, sregion%flst_real%flst, &
rsub%real_kinematics%p_born_lab%phs_point(1)%get (), &
sqme_born_coll * rsub%sf_factors(alr, em_pdf), &
mom_times_sqme_spin_c * rsub%sf_factors(alr, em_pdf), &
zero, alpha_coupling, rsub%isr_kinematics%isr_mode)
else
if (sregion%nlo_correction_type == "QCD") then
call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
else if (sregion%nlo_correction_type == "EW") then
if (is_quark (sregion%flst_real%flst(sregion%emitter))) N_col = 3
call rsub%sub_coll%set_parameters (CA = zero, &
CF = sregion%flst_real%charge(sregion%emitter)**2, &
TR = N_col*sregion%flst_real%charge(sregion%emitter)**2)
end if
sqme_cs = rsub%sub_coll%compute_fsr (sregion%emitter, sregion%flst_real%flst, &
rsub%real_kinematics%xi_ref_momenta(i_con), &
rsub%real_kinematics%p_born_lab%phs_point(1)%get (), &
sqme_born_coll, &
mom_times_sqme_spin_c, &
zero, alpha_coupling, sregion%double_fsr)
end if
end if
end associate
end function real_subtraction_compute_sub_coll_soft
@ %def real_subtraction_compute_sub_coll_soft
<<Real subtraction: real subtraction: TBP>>=
procedure :: requires_spin_correlations => &
real_subtraction_requires_spin_correlations
<<Real subtraction: sub interfaces>>=
module function real_subtraction_requires_spin_correlations &
(rsub) result (val)
logical :: val
class(real_subtraction_t), intent(in) :: rsub
end function real_subtraction_requires_spin_correlations
<<Real subtraction: procedures>>=
module function real_subtraction_requires_spin_correlations &
(rsub) result (val)
logical :: val
class(real_subtraction_t), intent(in) :: rsub
val = any (rsub%sc_required)
end function real_subtraction_requires_spin_correlations
@ %def real_subtraction_requires_spin_correlations
@
<<Real subtraction: real subtraction: TBP>>=
procedure :: final => real_subtraction_final
<<Real subtraction: sub interfaces>>=
module subroutine real_subtraction_final (rsub)
class(real_subtraction_t), intent(inout) :: rsub
end subroutine real_subtraction_final
<<Real subtraction: procedures>>=
module subroutine real_subtraction_final (rsub)
class(real_subtraction_t), intent(inout) :: rsub
call rsub%sub_soft%final ()
call rsub%sub_coll%final ()
!!! Finalization of region data is done in pcm_nlo_final
if (associated (rsub%reg_data)) nullify (rsub%reg_data)
!!! Finalization of real kinematics is done in pcm_instance_nlo_final
if (associated (rsub%real_kinematics)) nullify (rsub%real_kinematics)
if (associated (rsub%isr_kinematics)) nullify (rsub%isr_kinematics)
if (allocated (rsub%sqme_real_non_sub)) deallocate (rsub%sqme_real_non_sub)
if (allocated (rsub%sqme_born)) deallocate (rsub%sqme_born)
if (allocated (rsub%sf_factors)) deallocate (rsub%sf_factors)
if (allocated (rsub%sqme_born_color_c)) deallocate (rsub%sqme_born_color_c)
if (allocated (rsub%sqme_born_charge_c)) deallocate (rsub%sqme_born_charge_c)
if (allocated (rsub%sc_required)) deallocate (rsub%sc_required)
if (allocated (rsub%selected_alr)) deallocate (rsub%selected_alr)
end subroutine real_subtraction_final
@ %def real_subtraction_final
@ \subsubsection{Partitions of the real matrix element and Powheg damping}
<<Real subtraction: public>>=
public :: real_partition_t
<<Real subtraction: types>>=
type, abstract :: real_partition_t
contains
<<Real subtraction: real partition: TBP>>
end type real_partition_t
@ %def real partition_t
@
<<Real subtraction: real partition: TBP>>=
procedure (real_partition_init), deferred :: init
<<Real subtraction: interfaces>>=
abstract interface
subroutine real_partition_init (partition, scale, reg_data)
import
class(real_partition_t), intent(out) :: partition
real(default), intent(in) :: scale
type(region_data_t), intent(in) :: reg_data
end subroutine real_partition_init
end interface
@ %def real_partition_init
@
<<Real subtraction: real partition: TBP>>=
procedure (real_partition_write), deferred :: write
<<Real subtraction: interfaces>>=
abstract interface
subroutine real_partition_write (partition, unit)
import
class(real_partition_t), intent(in) :: partition
integer, intent(in), optional :: unit
end subroutine real_partition_write
end interface
@ %def real_partition_write
@ To allow really arbitrary damping functions, [[get_f]] should get the
full real phase space as argument and not just some [[pt2]] that is
extracted higher up.
<<Real subtraction: real partition: TBP>>=
procedure (real_partition_get_f), deferred :: get_f
<<Real subtraction: interfaces>>=
abstract interface
function real_partition_get_f (partition, p) result (f)
import
real(default) :: f
class(real_partition_t), intent(in) :: partition
type(vector4_t), intent(in), dimension(:) :: p
end function real_partition_get_f
end interface
@ %def real_partition_get_f
@
<<Real subtraction: public>>=
public :: powheg_damping_simple_t
<<Real subtraction: types>>=
type, extends (real_partition_t) :: powheg_damping_simple_t
real(default) :: h2 = 5._default
integer :: emitter
contains
<<Real subtraction: powheg damping simple: TBP>>
end type powheg_damping_simple_t
@ %def powheg_damping_simple_t
@
<<Real subtraction: powheg damping simple: TBP>>=
procedure :: get_f => powheg_damping_simple_get_f
<<Real subtraction: sub interfaces>>=
module function powheg_damping_simple_get_f (partition, p) result (f)
real(default) :: f
class(powheg_damping_simple_t), intent(in) :: partition
type(vector4_t), intent(in), dimension(:) :: p
end function powheg_damping_simple_get_f
<<Real subtraction: procedures>>=
module function powheg_damping_simple_get_f (partition, p) result (f)
real(default) :: f
class(powheg_damping_simple_t), intent(in) :: partition
type(vector4_t), intent(in), dimension(:) :: p
!!! real(default) :: pt2
f = 1
call msg_bug ("Simple damping currently not available")
!!! TODO (cw-2017-03-01) Compute pt2 from emitter)
!!! f = partition%h2 / (pt2 + partition%h2)
end function powheg_damping_simple_get_f
@ %def powheg_damping_simple_get_f
@
<<Real subtraction: powheg damping simple: TBP>>=
procedure :: init => powheg_damping_simple_init
<<Real subtraction: sub interfaces>>=
module subroutine powheg_damping_simple_init (partition, scale, reg_data)
class(powheg_damping_simple_t), intent(out) :: partition
real(default), intent(in) :: scale
type(region_data_t), intent(in) :: reg_data
end subroutine powheg_damping_simple_init
<<Real subtraction: procedures>>=
module subroutine powheg_damping_simple_init (partition, scale, reg_data)
class(powheg_damping_simple_t), intent(out) :: partition
real(default), intent(in) :: scale
type(region_data_t), intent(in) :: reg_data
partition%h2 = scale**2
end subroutine powheg_damping_simple_init
@ %def powheg_damping_simple_init
@
<<Real subtraction: powheg damping simple: TBP>>=
procedure :: write => powheg_damping_simple_write
<<Real subtraction: sub interfaces>>=
module subroutine powheg_damping_simple_write (partition, unit)
class(powheg_damping_simple_t), intent(in) :: partition
integer, intent(in), optional :: unit
end subroutine powheg_damping_simple_write
<<Real subtraction: procedures>>=
module subroutine powheg_damping_simple_write (partition, unit)
class(powheg_damping_simple_t), intent(in) :: partition
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "Powheg damping simple: "
write (u, "(1x,A, "// FMT_15 // ")") "scale h2: ", partition%h2
end subroutine powheg_damping_simple_write
@ %def powheg_damping_simple_write
@
<<Real subtraction: public>>=
public :: real_partition_fixed_order_t
<<Real subtraction: types>>=
type, extends (real_partition_t) :: real_partition_fixed_order_t
real(default) :: scale
type(ftuple_t), dimension(:), allocatable :: fks_pairs
contains
<<Real subtraction: real partition fixed order: TBP>>
end type real_partition_fixed_order_t
@ %def real_partition_fixed_order_t
@
<<Real subtraction: real partition fixed order: TBP>>=
procedure :: init => real_partition_fixed_order_init
<<Real subtraction: sub interfaces>>=
module subroutine real_partition_fixed_order_init &
(partition, scale, reg_data)
class(real_partition_fixed_order_t), intent(out) :: partition
real(default), intent(in) :: scale
type(region_data_t), intent(in) :: reg_data
end subroutine real_partition_fixed_order_init
<<Real subtraction: procedures>>=
module subroutine real_partition_fixed_order_init (partition, scale, reg_data)
class(real_partition_fixed_order_t), intent(out) :: partition
real(default), intent(in) :: scale
type(region_data_t), intent(in) :: reg_data
end subroutine real_partition_fixed_order_init
@ %def real_partition_fixed_order_init
@
<<Real subtraction: real partition fixed order: TBP>>=
procedure :: write => real_partition_fixed_order_write
<<Real subtraction: sub interfaces>>=
module subroutine real_partition_fixed_order_write (partition, unit)
class(real_partition_fixed_order_t), intent(in) :: partition
integer, intent(in), optional :: unit
end subroutine real_partition_fixed_order_write
<<Real subtraction: procedures>>=
module subroutine real_partition_fixed_order_write (partition, unit)
class(real_partition_fixed_order_t), intent(in) :: partition
integer, intent(in), optional :: unit
end subroutine real_partition_fixed_order_write
@ %def real_partition_fixed_order_write
@ Implements the suppression factor
\begin{equation}
F(\Phi_{n+1}) = 1 - \prod_{(i,j) \in P_{FKS}} \theta \left[ m_i + m_j + h - \sqrt{(p_j + p_j)^2} \right]
\end{equation}
to split the real matrix element into singular and finite part.
<<Real subtraction: real partition fixed order: TBP>>=
procedure :: get_f => real_partition_fixed_order_get_f
<<Real subtraction: sub interfaces>>=
module function real_partition_fixed_order_get_f (partition, p) result (f)
real(default) :: f
class(real_partition_fixed_order_t), intent(in) :: partition
type(vector4_t), intent(in), dimension(:) :: p
end function real_partition_fixed_order_get_f
<<Real subtraction: procedures>>=
module function real_partition_fixed_order_get_f (partition, p) result (f)
real(default) :: f
class(real_partition_fixed_order_t), intent(in) :: partition
type(vector4_t), intent(in), dimension(:) :: p
integer :: i, em
f = zero
PAIRS: do i = 1, size (partition%fks_pairs)
associate (ii => partition%fks_pairs(i)%ireg)
if (ii(1) == 0) then
IS: do em = 1, 2
if ((p(em) + p(ii(2)))**1 < p(em)**1 + p(ii(2))**1 + &
partition%scale) then
f = one
exit PAIRS
end if
end do IS
else
if ((p(ii(1)) + p(ii(2)))**1 < p(ii(1))**1 + p(ii(2))**1 + &
partition%scale) then
f = one
exit PAIRS
end if
end if
end associate
end do PAIRS
end function real_partition_fixed_order_get_f
@ %def real_partition_fixed_order_get_f
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[real_subtraction_ut.f90]]>>=
<<File header>>
module real_subtraction_ut
use unit_tests
use real_subtraction_uti
<<Standard module head>>
<<Real subtraction: public test>>
contains
<<Real subtraction: test driver>>
end module real_subtraction_ut
@ %def real_subtraction_ut
@
<<[[real_subtraction_uti.f90]]>>=
<<File header>>
module real_subtraction_uti
<<Use kinds>>
use physics_defs
use lorentz
use numeric_utils
use real_subtraction
<<Standard module head>>
<<Real subtraction: test declarations>>
contains
<<Real subtraction: tests>>
end module real_subtraction_uti
@ %def real_subtraction_ut
@ API: driver for the unit tests below.
<<Real subtraction: public test>>=
public :: real_subtraction_test
<<Real subtraction: test driver>>=
subroutine real_subtraction_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Real subtraction: execute tests>>
end subroutine real_subtraction_test
@ %def real_subtraction_test
@ Test the final-state collinear subtraction.
<<Real subtraction: execute tests>>=
call test (real_subtraction_1, "real_subtraction_1", &
"final-state collinear subtraction", &
u, results)
<<Real subtraction: test declarations>>=
public :: real_subtraction_1
<<Real subtraction: tests>>=
subroutine real_subtraction_1 (u)
integer, intent(in) :: u
type(coll_subtraction_t) :: coll_sub
real(default) :: sqme_coll
type(vector4_t) :: p_res
type(vector4_t), dimension(5) :: p_born
real(default), dimension(4) :: k_perp
real(default), dimension(4,4) :: b_munu
integer :: mu, nu
real(default) :: born, born_c
integer, dimension(6) :: flst
p_born(1)%p = [500, 0, 0, 500]
p_born(2)%p = [500, 0, 0, -500]
p_born(3)%p = [3.7755E+02, 2.2716E+02, -95.4172, 2.8608E+02]
p_born(4)%p = [4.9529E+02, -2.739E+02, 84.8535, -4.0385E+02]
p_born(5)%p = [1.2715E+02, 46.7375, 10.5637, 1.1778E+02]
p_res = p_born(1) + p_born(2)
flst = [11, -11 , -2, 2, -2, 2]
b_munu(1, :) = [0., 0., 0., 0.]
b_munu(2, :) = [0., 1., 1., 1.]
b_munu(3, :) = [0., 1., 1., 1.]
b_munu(4, :) = [0., 1., 1., 1.]
k_perp = real_subtraction_compute_k_perp_fsr (p = p_born(5), phi = 0.5_default)
born = - b_munu(1, 1) + b_munu(2, 2) + b_munu(3, 3) + b_munu(4, 4)
born_c = 0.
do mu = 1, 4
do nu = 1, 4
born_c = born_c + k_perp(mu) * k_perp(nu) * b_munu(mu, nu)
end do
end do
write (u, "(A)") "* Test output: real_subtraction_1"
write (u, "(A)") "* Purpose: final-state collinear subtraction"
write (u, "(A)")
write (u, "(A, L1)") "* vanishing scalar-product of 3-momenta k_perp and p_born(emitter): ", &
nearly_equal (dot_product (p_born(5)%p(1:3), k_perp(2:4)), 0._default)
call coll_sub%init (n_alr = 1, n_in = 2)
call coll_sub%set_parameters (CA, CF, TR)
write (u, "(A)")
write (u, "(A)") "* g -> qq splitting"
write (u, "(A)")
sqme_coll = coll_sub%compute_fsr(5, flst, p_res, p_born, &
born, born_c, 0.5_default, 0.25_default, .false.)
write (u, "(A,F15.12)") "ME: ", sqme_coll
write (u, "(A)")
write (u, "(A)") "* g -> gg splitting"
write (u, "(A)")
b_munu(1, :) = [0., 0., 0., 0.]
b_munu(2, :) = [0., 0., 0., 1.]
b_munu(3, :) = [0., 0., 1., 1.]
b_munu(4, :) = [0., 0., 1., 1.]
k_perp = real_subtraction_compute_k_perp_fsr (p = p_born(5), phi = 0.5_default)
born = - b_munu(1, 1) + b_munu(2, 2) + b_munu(3, 3) + b_munu(4, 4)
born_c = 0.
do mu = 1, 4
do nu = 1, 4
born_c = born_c + k_perp(mu) * k_perp(nu) * b_munu(mu, nu)
end do
end do
flst = [11, -11, 2, -2, 21, 21]
sqme_coll = coll_sub%compute_fsr(5, flst, p_res, p_born, &
born, born_c, 0.5_default, 0.25_default, .true.)
write (u, "(A,F15.12)") "ME: ", sqme_coll
write (u, "(A)")
write (u, "(A)") "* Test output end: real_subtraction_1"
write (u, "(A)")
end subroutine real_subtraction_1
@ %def real_subtraction_1
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Contribution of divergencies due to PDF Evolution}
References:
\begin{itemize}
\item arXiv:hep-ph/9512328, (2.1)-(2.5), (4.29)-(4.53)
\item arXiv:0709.2092, (2.102)-(2.106)
\end{itemize}
The parton distrubition densities have to be evaluated at NLO, too.
The NLO PDF evolution is given by
\begin{equation}
\label{eqn:pdf_nlo}
f (\bar{x}) = \int_0^1 \int_0^1 dx dz f(x) \Gamma(z) \delta (\bar{x} - x z),
\end{equation}
where $\Gamma$ are the DGLAP evolution kernels for an $a \to d$ splitting,
\begin{equation}
\label{eqn:dglap}
\Gamma_a^{(d)} = \delta_{ad}\delta(1-x) - \frac{\alpha_s}{2\pi}
\left(\frac{1}{\epsilon} P_{ad}(x,0) - K_{ad}(x)\right) +
\mathcal{O}(\alpha_s^2).
\end{equation}
$K_{ad}$ is a renormalization scheme matching factor, which is exactly
zero in $\overline{\text{MS}}$. Let the leading-order hadronic cross
section be given by
\begin{equation}
\label{eqn:xsec_hadro_lo}
d\sigma^{(0)}(s) = \int dx_\oplus dx_\ominus f_\oplus (x_\oplus)
f_\ominus (x_\ominus) d\tilde{\sigma}^{(0)} (x_\oplus x_\ominus s),
\end{equation}
then the NLO hadronic cross section is
\begin{equation}
\label{eqn:xsec_hadro_nlo}
d\sigma^{(1)}(s) = \int dx_\oplus dx_\ominus dz_\oplus dz_\ominus
f_\oplus (x_\oplus) f_\ominus (x_\ominus)
\underbrace{\Gamma_\oplus (z_\oplus) \Gamma_\ominus (z_\ominus)
d\tilde{\sigma}^{(1)} (z_\oplus z_\ominus
s)}_{d\hat{\sigma}^{(1)}}.
\end{equation}
$d\hat{\sigma}$ is called the subtracted partonic cross
section. Expanding in $\alpha_s$ we find
\begin{align}
d\hat{\sigma}^{(0)}_{ab}(k_1, k_2) &= d\tilde{\sigma}_{ab}^{(0)} (k_1, k_2), \\
d\hat{\sigma}^{(1)}_{ab}(k_1, k_2) &= d\tilde{\sigma}_{ab}^{(1)} (k_1, k_2) \\
&+ \frac{\alpha_s}{2\pi} \sum_d
\int dx \left (\frac{1}{\epsilon} P_{da}(x,0) - K_{da}(x)\right)
d\tilde{\sigma}_{db}^{(0)}(xk_1, k_2)\\
&+ \frac{\alpha_s}{2\pi} \sum_d \int \left (\frac{1}{\epsilon}
P_{db} (x, 0) - K_{db}(x)\right) d\tilde{\sigma}_{ad}^{(0)}(k_1,
xk_2).\\
&= d\tilde{\sigma}_{ab}^{(1)} + d\tilde{\sigma}_{ab}^{(cnt,+)} +
d\tilde{\sigma}_{ab}^{(cnt,-)}
\end{align}
Let us now turn to the soft-subtracted real part of the cross
section. For ease of notation, it is constrained to one singular
region,
\begin{align*}
\label{eqn:R-in}
d\sigma^{(in)}_\alpha &= \left[\left(\frac{1}{\xi}\right)_{c} -
2\epsilon\left(\frac{\log \xi}{\xi}\right)_{c}\right] (1-y^2)\xi^2
\mathcal{R}_\alpha \mathcal{S}_\alpha \\
&\times \frac{1}{2(2\pi)^{3-2\epsilon}}
\left(\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} \left( 1 -
y^2\right)^{-1-\epsilon} d\phi d\xi dy d\Omega^{2-2\epsilon},
\end{align*}
where we regularize collinear divergencies using the identity
\begin{equation*}
\left (1 - y^2 \right)^{-1-\epsilon} =
-\frac{2^{-\epsilon}}{2\epsilon} \left (\delta(1-y) +
\delta(1+y)\right)
+ \underbrace{\frac{1}{2} \left[ \left (\frac {1}{1-y}\right)_{c}
+ \left (\frac{1}{1+y}\right)_{c} \right]}_{\mathcal{P}(y)}.
\end{equation*}
This enables us to split the cross section into a finite and a
singular part. The latter can further be separated into a contribution
of the incoming and of the outgoing particles,
\begin{equation*}
d\sigma^{(in)}_\alpha = d\sigma^{(in,+)}_\alpha +
d\sigma^{(in,-)}_\alpha + d\sigma^{(in,f)}_\alpha.
\end{equation*}
They are given by
\begin{align}
d\sigma^{(in,f)}_\alpha = & \mathcal{P}(y)
\left[\left(\frac{1}{\xi}\right)_{c} - 2\epsilon
\left(\frac{\log\xi}{\xi}\right)_{c}\right]
\frac{1}{2(2\pi)^{3-2\epsilon}}
\left(\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} \nonumber\\
& \times (1-y^2)\xi^2 \mathcal{R}_\alpha \mathcal{S}_\alpha d\phi
d\xi dy d\Omega^{2-2\epsilon}
\label{eqn:sigma-f}
\end{align}
and
\begin{align}
d\sigma^{(in,\pm)}_\alpha &= -\frac{2^{-\epsilon}}{2\epsilon} \delta
(1 \mp y) \left[ \left( \frac{1}{\xi}\right)_{c} - 2\epsilon
\left(\frac{\log\xi}{\xi}\right)_{c}\right] \nonumber\\
& \times \frac{1}{2(2\pi)^{3-2\epsilon}} \left(
\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} (1-y^2)\xi^2
\mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy
d\Omega^{2-2\epsilon}.
\label{eqn:sigma-pm}
\end{align}
Equation \ref{eqn:sigma-f} is the contribution to the real cross
section which is computed in [[evaluate_region_isr]]. It is
regularized both in the soft and collinear limit via the plus
distributions. Equation \ref{eqn:sigma-pm} is a different
contribution. It is only present exactly in the collinear limit, due
to the delta function. The divergences present in this term do not
completely cancel out divergences in the virtual matrix element,
because the beam axis is distinguished. Thus, the conditions in which
the KLN theorem applies are not met. To see this, we carry out the
collinear limit, obtaining
\begin{equation*}
\lim_{y \to 1} (1-y^2)\xi^2\mathcal{R}_\alpha = 8\pi\alpha_s
\mu^{2\epsilon} \left(\frac{2}{\sqrt{s}}\right)^2 \xi P^<(1-\xi,
\epsilon) \mathcal{R}_\alpha,
\end{equation*}
with the Altarelli-Parisi splitting kernel for $z < 1$,
$P^<(z,\epsilon)$. Moreover, $\lim_{\vec{k} \parallel \vec{k}_1} d\phi
= d\phi_3$ violates spatial averaging. The integration over the
spherical angle $d\Omega$ can be carried out easily, yielding a factor
of $2\pi^{1-\epsilon} / \Gamma(1-\epsilon)$. This allows us to
redefine $\epsilon$,
\begin{equation}
\frac{1}{\epsilon} - \gamma_E + \log(4\pi) \to \frac{1}{\epsilon}.
\end{equation}
Coming back to $d\tilde{\sigma}_{ab}^{(cnt,+)}$ in order to make a
connection to $d{\sigma}^{(in,+)}_\alpha$, we relate $P_{ab}(z,0)$ to
$P^<_{ab}(z,0)$ via the equation
\begin{equation*}
P_{ab}(z,0) = (1-z)P_{ab}^<(z,0)\left(\frac{1}{1-z}\right)_+ +
\gamma(a)\delta_{ab}\delta(1-z),
\end{equation*}
which yields
\begin{equation} \label{eqn:sigma-cnt}
d\tilde{\sigma}^{(cnt,+)}_{\alpha} = \frac{\alpha_s}{2\pi} \sum_d
\left\lbrace -K_{da}(1-\xi) + \frac{1}{\epsilon}
\left[\left(\frac{1}{\xi}\right)_+ \xi P_{da}^<(1-\xi,0)
+ \delta_{da}\delta(\xi)\gamma(d)\right]\right\rbrace
\mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy.
\end{equation}
This term has the same pole structure as eqn. \ref{eqn:sigma-pm}. This
makes clear that the quantity
\begin{equation}
d\hat{\sigma}^{(in,+)} = d\tilde{\sigma}^{(in,+)} +
d\tilde{\sigma}^{(cnt,+)}
\end{equation}
has no collinear poles. Therefore, our task is to add up
eqns. \ref{eqn:sigma-pm} and \ref{eqn:sigma-cnt} in order to compute
the finite remainder. This is the integrand which is evaluated in the
[[dglap_remnant]] component.
So, we have to perform an expansion of $d\hat{\sigma}^{(in,+)}$ in
$\epsilon$. Hereby, we must not neglect the implicit
$\epsilon$-dependence of $P^<$, which leads to additional terms
involving the first derivative,
\begin{equation*}
P_{ab}^<(z,\epsilon) = P_{ab}^<(z,0) + \epsilon \frac{\partial
P_{ab}^<(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} +
\mathcal{O}(\alpha_s^2).
\end{equation*}
This finally gives us the equation for the collinear remnant. Note
that there is still one soft $1/\epsilon$-pole, which cancels out with
the corresponding expression in the soft-virtual terms.
\begin{align} \label{eqn:sigma-in-p-final}
d\hat{\sigma}^{(in,+)} &= \frac{\alpha_s}{2\pi} \frac{1}{\epsilon}
\gamma(a) \mathcal{R}_\alpha \mathcal{S}_\alpha \nonumber\\
&+ \frac{\alpha_s}{2\pi} \sum_d \left\lbrace (1-z)
P_{da}^<(z,0)\left[\left(\frac{1}{1-z}\right)_{c}
\log\frac{s\delta_{\mathrm{I}}}{2\mu^2} + 2
\left(\frac{\log(1-z)}{1-z}\right)_{c}\right] \right. \nonumber\\
&\left . -(1-z)\frac{\partial P_{da}^<(z,\epsilon)}{\partial
\epsilon} \left(\frac{1}{1-z}\right)_{c} - K_{da}(z)\right\rbrace
\mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy
\end{align}
<<[[dglap_remnant.f90]]>>=
<<File header>>
module dglap_remnant
<<Use kinds with double>>
<<Use strings>>
use phs_fks, only: isr_kinematics_t
use fks_regions, only: region_data_t
use nlo_data
<<Standard module head>>
<<DGLAP remnant: public>>
<<DGLAP remnant: types>>
interface
<<DGLAP remnant: sub interfaces>>
end interface
end module dglap_remnant
@ %def module dglap_remnant
@
<<[[dglap_remnant_sub.f90]]>>=
<<File header>>
submodule (dglap_remnant) dglap_remnant_s
use numeric_utils
use diagnostics
use constants
use physics_defs
use pdg_arrays
implicit none
contains
<<DGLAP remnant: procedures>>
end submodule dglap_remnant_s
@ %def dglap_remnant_s
@
<<DGLAP remnant: public>>=
public :: dglap_remnant_t
<<DGLAP remnant: types>>=
type :: dglap_remnant_t
type(nlo_settings_t), pointer :: settings => null ()
type(region_data_t), pointer :: reg_data => null ()
type(isr_kinematics_t), pointer :: isr_kinematics => null ()
real(default) :: CA = 0, CF = 0, TR = 0
real(default), dimension(:), allocatable :: sqme_born
real(default), dimension(:,:), allocatable :: sf_factors
real(default), dimension(:,:,:), allocatable :: sqme_color_c_extra
contains
<<DGLAP remnant: dglap remnant: TBP>>
end type dglap_remnant_t
@ %def dglap_remnant_t
@
<<DGLAP remnant: dglap remnant: TBP>>=
procedure :: init => dglap_remnant_init
<<DGLAP remnant: sub interfaces>>=
module subroutine dglap_remnant_init &
(dglap, settings, reg_data, isr_kinematics)
class(dglap_remnant_t), intent(inout) :: dglap
type(nlo_settings_t), intent(in), target :: settings
type(region_data_t), intent(in), target :: reg_data
type(isr_kinematics_t), intent(in), target :: isr_kinematics
end subroutine dglap_remnant_init
<<DGLAP remnant: procedures>>=
module subroutine dglap_remnant_init &
(dglap, settings, reg_data, isr_kinematics)
class(dglap_remnant_t), intent(inout) :: dglap
type(nlo_settings_t), intent(in), target :: settings
type(region_data_t), intent(in), target :: reg_data
integer :: n_flv_born
type(isr_kinematics_t), intent(in), target :: isr_kinematics
dglap%reg_data => reg_data
n_flv_born = reg_data%get_n_flv_born ()
allocate (dglap%sf_factors (reg_data%n_regions, 0:reg_data%n_in))
dglap%sf_factors = zero
dglap%settings => settings
allocate (dglap%sqme_born(n_flv_born))
dglap%sqme_born = zero
allocate (dglap%sqme_color_c_extra (reg_data%n_legs_born, &
reg_data%n_legs_born, reg_data%n_flv_born))
dglap%sqme_color_c_extra = zero
dglap%isr_kinematics => isr_kinematics
end subroutine dglap_remnant_init
@ %def dglap_remnant_init
<<DGLAP remnant: dglap remnant: TBP>>=
procedure :: set_parameters => dglap_remnant_set_parameters
<<DGLAP remnant: sub interfaces>>=
module subroutine dglap_remnant_set_parameters (dglap, CA, CF, TR)
class(dglap_remnant_t), intent(inout) :: dglap
real(default), intent(in) :: CA, CF, TR
end subroutine dglap_remnant_set_parameters
<<DGLAP remnant: procedures>>=
module subroutine dglap_remnant_set_parameters (dglap, CA, CF, TR)
class(dglap_remnant_t), intent(inout) :: dglap
real(default), intent(in) :: CA, CF, TR
dglap%CA = CA
dglap%CF = CF
dglap%TR = TR
end subroutine dglap_remnant_set_parameters
@ %def dglap_remnant_set_parameters
@ Evaluates formula \ref{eqn:sigma-in-p-final}. Note that, as also in
the case for the real subtraction, we have to take into account an
additional term, occuring because the integral the plus distribution
is evaluated over is not constrained on the interval $[0,1]$.
Explicitly, this means (see JHEP 06(2010)043, (4.11)-(4.12))
\begin{align}
\int_{\bar{x}_\oplus}^1 dz \left( \frac{1}{1-z} \right)_{\xi_{\text{cut}}} & =
\log \frac{1-\bar{x}_\oplus}{\xi_{\text{cut}}} f(1) + \int_{\bar{x}_\oplus}^1
\frac{f(z) - f(1)}{1-z}, \\
\int_{\bar{x}_\oplus}^1 dz
\left(\frac{\log(1-z)}{1-z}\right)_{\xi_{\text{cut}}} f(z) & =
\frac{1}{2}\left( \log^2(1-\bar{x}_\oplus) - \log^2
(\xi_{\text{cut}}) \right)f(1) +
\int_{\bar{x}_\oplus}^1 \frac{\log(1-z)[f(z) - f(1)]}{1-z},
\end{align}
and the same of course for $\bar{x}_\ominus$. These two terms are
stored in the [[plus_dist_remnant]] variable below.
The option [[separate_uborns]] allows to compute the contribution of
the DGLAP remnant separately for each underlying Born flavor
structure. We need this option during event generation to generate
counter events with a specific Born flavor structure.
<<DGLAP remnant: dglap remnant: TBP>>=
procedure :: evaluate => dglap_remnant_evaluate
<<DGLAP remnant: sub interfaces>>=
module subroutine dglap_remnant_evaluate &
(dglap, alpha_coupling, separate_uborns, sqme_dglap)
class(dglap_remnant_t), intent(inout) :: dglap
real(default), dimension(2), intent(in) :: alpha_coupling
logical, intent(in) :: separate_uborns
real(default), intent(inout), dimension(:) :: sqme_dglap
end subroutine dglap_remnant_evaluate
<<DGLAP remnant: procedures>>=
module subroutine dglap_remnant_evaluate &
(dglap, alpha_coupling, separate_uborns, sqme_dglap)
class(dglap_remnant_t), intent(inout) :: dglap
real(default), dimension(2), intent(in) :: alpha_coupling
logical, intent(in) :: separate_uborns
real(default), intent(inout), dimension(:) :: sqme_dglap
integer :: alr, emitter, i_corr
real(default) :: sqme_alr
logical, dimension(:,:,:), allocatable :: evaluated
real(default) :: sb, fac_scale2
sb = dglap%isr_kinematics%sqrts_born**2
fac_scale2 = dglap%isr_kinematics%fac_scale**2
allocate (evaluated(dglap%reg_data%get_n_flv_born (), &
dglap%reg_data%get_n_flv_real (), dglap%reg_data%n_in))
evaluated = .false.
do alr = 1, dglap%reg_data%n_regions
i_corr = 0
if (dglap%reg_data%regions(alr)%nlo_correction_type == "QCD") then
i_corr = 1
else if (dglap%reg_data%regions(alr)%nlo_correction_type == "EW") then
i_corr = 2
end if
if (allocated (dglap%settings%selected_alr)) then
if (.not. any (dglap%settings%selected_alr == alr)) cycle
end if
sqme_alr = zero
emitter = dglap%reg_data%regions(alr)%emitter
if (emitter > dglap%reg_data%n_in .or. i_corr == 0) cycle
associate (i_flv_born => dglap%reg_data%regions(alr)%uborn_index, &
i_flv_real => dglap%reg_data%regions(alr)%real_index)
if (emitter == 0) then
do emitter = 1, 2
if (evaluated(i_flv_born, i_flv_real, emitter)) cycle
call evaluate_alr (alr, emitter, i_flv_born, &
i_flv_real, sqme_alr, evaluated)
end do
else if (emitter > 0) then
if (evaluated(i_flv_born, i_flv_real, emitter)) cycle
call evaluate_alr (alr, emitter, i_flv_born, &
i_flv_real, sqme_alr, evaluated)
end if
if (separate_uborns) then
sqme_dglap(i_flv_born) = sqme_dglap(i_flv_born) &
+ alpha_coupling (i_corr)/ twopi * sqme_alr
else
sqme_dglap(1) = sqme_dglap(1) &
+ alpha_coupling (i_corr) / twopi * sqme_alr
end if
end associate
end do
contains
<<DGLAP remnant: dglap remnant evaluate: procedures>>
end subroutine dglap_remnant_evaluate
@ %def dglap_remnant_evaluate
@ We introduce $\hat{P}(z, \epsilon) = (1 - z) P(z, \epsilon)$ and have
\begin{align}
\hat{P}_{g\to gg}(z) & = 2C_A \left[z + \frac{(1-z)^2}{z} + z(1-z)^2\right], \\
\hat{P}_{g\to qq}(z) & = C_F (1-z) \frac{1 + (1-z)^2}{z}, \\
\hat{P}_{q\to gq}(z) & = T_F (1 - z - 2z(1-z)^2), \\
\hat{P}_{q\to qg}(z) & = C_F (1 + z^2).
\end{align}
<<DGLAP remnant: dglap remnant evaluate: procedures>>=
function p_hat_gtogg (z)
real(default) :: p_hat_gtogg
<<p variables>>
p_hat_gtogg = two * dglap%CA * (z + onemz**2 / z + z * onemz**2)
end function p_hat_gtogg
function p_hat_gtoqq (z)
real(default) :: p_hat_gtoqq
<<p variables>>
p_hat_gtoqq = dglap%CF * onemz / z * (one + onemz**2)
end function p_hat_gtoqq
function p_hat_qtogq (z)
real(default) :: p_hat_qtogq
<<p variables>>
p_hat_qtogq = dglap%TR * (onemz - two * z * onemz**2)
end function p_hat_qtogq
function p_hat_qtoqg (z)
real(default) :: p_hat_qtoqg
real(default), intent(in) :: z
p_hat_qtoqg = dglap%CF * (one + z**2)
end function p_hat_qtoqg
@ %def p_hat_qtoqg, p_hat_qtogq, p_hat_gtoqq, p_hat_gtogg
@
\begin{align}
\frac{\partial P_{g\to gg}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = 0, \\
\frac{\partial P_{g\to qq}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = -C_F z, \\
\frac{\partial P_{q\to gq}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = -
2 T_F z (1-z), \\
\frac{\partial P_{q\to qg}(z,\epsilon)}{\partial \epsilon}|_{\epsilon = 0} & = -C_F (1-z).\\
\end{align}
<<DGLAP remnant: dglap remnant evaluate: procedures>>=
function p_derived_gtogg (z)
real(default) :: p_derived_gtogg
real(default), intent(in) :: z
p_derived_gtogg = zero
end function p_derived_gtogg
function p_derived_gtoqq (z)
real(default) :: p_derived_gtoqq
real(default), intent(in) :: z
p_derived_gtoqq = -dglap%CF * z
end function p_derived_gtoqq
function p_derived_qtogq (z)
real(default) :: p_derived_qtogq
<<p variables>>
p_derived_qtogq = -two * dglap%TR * z * onemz
end function p_derived_qtogq
function p_derived_qtoqg (z)
real(default) :: p_derived_qtoqg
<<p variables>>
p_derived_qtoqg = -dglap%CF * onemz
end function p_derived_qtoqg
@ %def p_derived_gtogg, p_derived_gtoqq, p_derived_qtogq, p_derived_qtoqg
@
<<DGLAP remnant: dglap remnant evaluate: procedures>>=
subroutine evaluate_alr (alr, emitter, i_flv_born, i_flv_real, sqme_alr, evaluated)
integer, intent(in) :: alr, emitter, i_flv_born, i_flv_real
real(default), intent(inout) :: sqme_alr
logical, intent(inout), dimension(:,:,:) :: evaluated
real(default) :: z, jac
real(default) :: factor, factor_soft, plus_dist_remnant
real(default) :: xb, onemz
real(default) :: sqme_scaled, sqme_born_dglap
real(default) :: charge_rad2, charge_em2
integer :: flv_em, flv_rad, N_col, i
N_col = 1
sqme_born_dglap = zero
associate (template => dglap%settings%fks_template)
z = dglap%isr_kinematics%z(emitter)
flv_rad = dglap%reg_data%regions(alr)%flst_real%flst(dglap%reg_data%n_legs_real)
flv_em = dglap%reg_data%regions(alr)%flst_real%flst(emitter)
charge_rad2 = dglap%reg_data%regions(alr)%flst_real%charge(dglap%reg_data%n_legs_real)**2
charge_em2 = dglap%reg_data%regions(alr)%flst_real%charge(emitter)**2
if (dglap%reg_data%regions(alr)%nlo_correction_type == "QCD") then
call dglap%set_parameters (CA = CA, CF = CF, TR = TR)
else if (dglap%reg_data%regions(alr)%nlo_correction_type == "EW") then
if (is_quark(flv_rad)) N_col = NC
call dglap%set_parameters (CA = zero, CF = charge_em2, TR = N_col*charge_rad2)
end if
jac = dglap%isr_kinematics%jacobian(emitter)
onemz = one - z
factor = log (sb * template%delta_i / two / z / fac_scale2) / &
onemz + two * log (onemz) / onemz
factor_soft = log (sb * template%delta_i / two / fac_scale2) / &
onemz + two * log (onemz) / onemz
xb = dglap%isr_kinematics%x(emitter)
plus_dist_remnant = log ((one - xb) / template%xi_cut) * log (sb * template%delta_i / &
two / fac_scale2) + (log (one - xb)**2 - log (template%xi_cut)**2)
end associate
if (dglap%reg_data%nlo_correction_type == "EW" .and. &
dglap%reg_data%regions(alr)%nlo_correction_type == "QCD" .and. &
qcd_ew_interferences (dglap%reg_data%regions(alr)%flst_uborn%flst)) then
do i = 1, size (dglap%reg_data%regions(alr)%flst_uborn%flst)
if (is_quark (dglap%reg_data%regions(alr)%flst_uborn%flst (i))) then
sqme_born_dglap = -dglap%sqme_color_c_extra (i, i, i_flv_born)/CF
exit
end if
end do
else
sqme_born_dglap = dglap%sqme_born(i_flv_born)
end if
sqme_scaled = sqme_born_dglap * dglap%sf_factors(alr, emitter)
if (is_massless_vector (flv_em) .and. is_massless_vector (flv_rad)) then
sqme_alr = sqme_alr + p_hat_gtogg(z) * factor / z * sqme_scaled * jac &
- p_hat_gtogg(one) * factor_soft * sqme_born_dglap * jac &
+ p_hat_gtogg(one) * plus_dist_remnant * sqme_born_dglap
else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then
sqme_alr = sqme_alr + p_hat_qtoqg(z) * factor / z * sqme_scaled * jac &
- p_derived_qtoqg(z) / z * sqme_scaled * jac &
- p_hat_qtoqg(one) * factor_soft * sqme_born_dglap * jac &
+ p_hat_qtoqg(one) * plus_dist_remnant * sqme_born_dglap
else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then
sqme_alr = sqme_alr + (p_hat_gtoqq(z) * factor - p_derived_gtoqq(z)) / z * jac * &
sqme_scaled
else if (is_massless_vector (flv_em) .and. is_fermion (flv_rad)) then
sqme_alr = sqme_alr + (p_hat_qtogq(z) * factor - p_derived_qtogq(z)) / z * sqme_scaled * jac
else
sqme_alr = sqme_alr + zero
end if
evaluated(i_flv_born, i_flv_real, emitter) = .true.
end subroutine evaluate_alr
@ %dglap_remnant_evaluate_alr
@
<<p variables>>=
real(default), intent(in) :: z
real(default) :: onemz
onemz = one - z
@ %def variables
@
<<DGLAP remnant: dglap remnant: TBP>>=
procedure :: final => dglap_remnant_final
<<DGLAP remnant: sub interfaces>>=
module subroutine dglap_remnant_final (dglap)
class(dglap_remnant_t), intent(inout) :: dglap
end subroutine dglap_remnant_final
<<DGLAP remnant: procedures>>=
module subroutine dglap_remnant_final (dglap)
class(dglap_remnant_t), intent(inout) :: dglap
if (associated (dglap%isr_kinematics)) nullify (dglap%isr_kinematics)
if (associated (dglap%reg_data)) nullify (dglap%reg_data)
if (associated (dglap%settings)) nullify (dglap%settings)
if (allocated (dglap%sqme_born)) deallocate (dglap%sqme_born)
if (allocated (dglap%sf_factors)) deallocate (dglap%sf_factors)
end subroutine dglap_remnant_final
@ %def dglap_remnant_final
@
\section{Dispatch}
@
<<[[dispatch_fks.f90]]>>=
<<File header>>
module dispatch_fks
<<Use kinds>>
<<Use strings>>
use variables, only: var_list_t
use nlo_data, only: fks_template_t, FKS_DEFAULT, FKS_RESONANCES
<<Standard module head>>
<<Dispatch fks: public>>
interface
<<Dispatch fks: sub interfaces>>
end interface
end module dispatch_fks
@ %def dispatch_fks
@
<<[[dispatch_fks_sub.f90]]>>=
<<File header>>
submodule (dispatch_fks) dispatch_fks_s
use string_utils, only: split_string
implicit none
contains
<<Dispatch fks: procedures>>
end submodule dispatch_fks_s
@ %def dispatch_fks_s
@ Initialize parameters used to optimize FKS calculations.
<<Dispatch fks: public>>=
public :: dispatch_fks_setup
<<Dispatch fks: sub interfaces>>=
module subroutine dispatch_fks_setup (fks_template, var_list)
type(fks_template_t), intent(inout) :: fks_template
type(var_list_t), intent(in) :: var_list
end subroutine dispatch_fks_setup
<<Dispatch fks: procedures>>=
module subroutine dispatch_fks_setup (fks_template, var_list)
type(fks_template_t), intent(inout) :: fks_template
type(var_list_t), intent(in) :: var_list
real(default) :: fks_dij_exp1, fks_dij_exp2
type(string_t) :: fks_mapping_type
logical :: subtraction_disabled
type(string_t) :: exclude_from_resonance
fks_dij_exp1 = &
var_list%get_rval (var_str ("fks_dij_exp1"))
fks_dij_exp2 = &
var_list%get_rval (var_str ("fks_dij_exp2"))
fks_mapping_type = &
var_list%get_sval (var_str ("$fks_mapping_type"))
subtraction_disabled = &
var_list%get_lval (var_str ("?disable_subtraction"))
exclude_from_resonance = &
var_list%get_sval (var_str ("$resonances_exclude_particles"))
if (exclude_from_resonance /= var_str ("default")) &
call split_string (exclude_from_resonance, var_str (":"), &
fks_template%excluded_resonances)
call fks_template%set_parameters ( &
exp1 = fks_dij_exp1, exp2 = fks_dij_exp2, &
xi_min = var_list%get_rval (var_str ("fks_xi_min")), &
y_max = var_list%get_rval (var_str ("fks_y_max")), &
xi_cut = var_list%get_rval (var_str ("fks_xi_cut")), &
delta_o = var_list%get_rval (var_str ("fks_delta_o")), &
delta_i = var_list%get_rval (var_str ("fks_delta_i")))
select case (char (fks_mapping_type))
case ("default")
call fks_template%set_mapping_type (FKS_DEFAULT)
case ("resonances")
call fks_template%set_mapping_type (FKS_RESONANCES)
end select
fks_template%subtraction_disabled = subtraction_disabled
fks_template%n_f = var_list%get_ival (var_str ("alphas_nf"))
end subroutine dispatch_fks_setup
@ %def dispatch_fks_setup
@
Index: trunk/src/matching/matching.nw
===================================================================
--- trunk/src/matching/matching.nw (revision 8819)
+++ trunk/src/matching/matching.nw (revision 8820)
@@ -1,5547 +1,5643 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: Matching and Merging
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Matching}
\includemodulegraph{matching}
<<[[matching_base.f90]]>>=
<<File header>>
module matching_base
<<Use strings>>
use sm_qcd
use model_data
use particles
use variables
use shower_base
use instances, only: process_instance_t
use rng_base
<<Standard module head>>
<<Matching base: public>>
<<Matching base: parameters>>
<<Matching base: types>>
<<Matching base: interfaces>>
interface
<<Matching base: sub interfaces>>
end interface
end module matching_base
@ %def matching_base
@
<<[[matching_base_sub.f90]]>>=
<<File header>>
submodule (matching_base) matching_base_s
<<Use debug>>
use diagnostics
implicit none
contains
<<Matching base: procedures>>
end submodule matching_base_s
@ %def matching_base_s
@
\section{Abstract Matching Type}
A matching will need access to the [[shower]] as well as matrix elements
that we currently get over [[process_instace]]. The [[model]] is
intended for the backup [[model_hadrons]].
<<Matching base: public>>=
public :: matching_t
<<Matching base: types>>=
type, abstract :: matching_t
logical :: is_hadron_collision = .false.
type(qcd_t) :: qcd
class(shower_base_t), pointer :: shower => null ()
type(process_instance_t), pointer :: process_instance => null ()
class(model_data_t), pointer :: model => null ()
class(rng_t), allocatable :: rng
type(string_t) :: process_name
contains
<<Matching base: matching: TBP>>
end type matching_t
@ %def matching_t
@
<<Matching base: matching: TBP>>=
procedure (matching_init), deferred :: init
<<Matching base: interfaces>>=
abstract interface
subroutine matching_init (matching, var_list, process_name)
import
class(matching_t), intent(out) :: matching
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_name
end subroutine matching_init
end interface
@ %def matching_init
@ If we use a polymorphic settings type, this boilerplate wouldn't be
necessary but then we introduce [[select type]] statements all over the place.
<<default matching init>>=
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_name
if (debug_on) call msg_debug (D_MATCHING, "matching_init")
call matching%settings%init (var_list)
matching%process_name = process_name
@
<<Matching base: matching: TBP>>=
procedure (matching_write), deferred :: write
<<Matching base: interfaces>>=
abstract interface
subroutine matching_write (matching, unit)
import
class(matching_t), intent(in) :: matching
integer, intent(in), optional :: unit
end subroutine matching_write
end interface
@ %def matching_write
@
<<Matching base: matching: TBP>>=
procedure :: import_rng => matching_import_rng
<<Matching base: sub interfaces>>=
pure module subroutine matching_import_rng (matching, rng)
class(matching_t), intent(inout) :: matching
class(rng_t), allocatable, intent(inout) :: rng
end subroutine matching_import_rng
<<Matching base: procedures>>=
pure module subroutine matching_import_rng (matching, rng)
class(matching_t), intent(inout) :: matching
class(rng_t), allocatable, intent(inout) :: rng
call move_alloc (from = rng, to = matching%rng)
end subroutine matching_import_rng
@ %def matching_import_rng
@
<<Matching base: matching: TBP>>=
procedure :: connect => matching_connect
procedure :: base_connect => matching_connect
<<Matching base: sub interfaces>>=
module subroutine matching_connect &
(matching, process_instance, model, shower)
class(matching_t), intent(inout) :: matching
type(process_instance_t), intent(in), target :: process_instance
class(model_data_t), intent(in), target, optional :: model
class(shower_base_t), intent(in), target, optional :: shower
end subroutine matching_connect
<<Matching base: procedures>>=
module subroutine matching_connect (matching, process_instance, model, shower)
class(matching_t), intent(inout) :: matching
type(process_instance_t), intent(in), target :: process_instance
class(model_data_t), intent(in), target, optional :: model
class(shower_base_t), intent(in), target, optional :: shower
if (debug_on) call msg_debug (D_MATCHING, "matching_connect")
matching%process_instance => process_instance
if (present (model)) matching%model => model
if (present (shower)) matching%shower => shower
end subroutine matching_connect
@ %def matching_base_connect
@
<<Matching base: matching: TBP>>=
procedure (matching_before_shower), deferred :: before_shower
<<Matching base: interfaces>>=
abstract interface
subroutine matching_before_shower (matching, particle_set, vetoed)
import
class(matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine matching_before_shower
end interface
@ %def matching_before_shower
@
<<Matching base: matching: TBP>>=
procedure (matching_after_shower), deferred :: after_shower
<<Matching base: interfaces>>=
abstract interface
subroutine matching_after_shower (matching, particle_set, vetoed)
import
class(matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine matching_after_shower
end interface
@ %def matching_after_shower
@ Per default, do nothing here.
<<Matching base: matching: TBP>>=
procedure :: prepare_for_events => matching_prepare_for_events
<<Matching base: sub interfaces>>=
module subroutine matching_prepare_for_events (matching)
class(matching_t), intent(inout), target :: matching
end subroutine matching_prepare_for_events
<<Matching base: procedures>>=
module subroutine matching_prepare_for_events (matching)
class(matching_t), intent(inout), target :: matching
end subroutine matching_prepare_for_events
@ %def matching_prepare_for_events
@
<<Matching base: matching: TBP>>=
procedure :: first_event => matching_first_event
<<Matching base: sub interfaces>>=
module subroutine matching_first_event (matching)
class(matching_t), intent(inout), target :: matching
end subroutine matching_first_event
<<Matching base: procedures>>=
module subroutine matching_first_event (matching)
class(matching_t), intent(inout), target :: matching
end subroutine matching_first_event
@ %def matching_first_event
@
<<Matching base: matching: TBP>>=
procedure (matching_get_method), deferred :: get_method
<<Matching base: interfaces>>=
abstract interface
function matching_get_method (matching) result (method)
import
type(string_t) :: method
class(matching_t), intent(in) :: matching
end function matching_get_method
end interface
@ %def matching_after_shower
@
<<Matching base: matching: TBP>>=
procedure :: final => matching_final
<<Matching base: sub interfaces>>=
module subroutine matching_final (matching)
class(matching_t), intent(in) :: matching
end subroutine matching_final
<<Matching base: procedures>>=
module subroutine matching_final (matching)
class(matching_t), intent(in) :: matching
end subroutine matching_final
@ %def matching_final
@
\subsection{Matching implementations}
<<Matching base: public>>=
public :: MATCH_MLM, MATCH_CKKW, MATCH_POWHEG
<<Matching base: parameters>>=
integer, parameter :: MATCH_MLM = 1
integer, parameter :: MATCH_CKKW = 2
integer, parameter :: MATCH_POWHEG = 3
integer, parameter :: MATCH_UNDEFINED = 17
@ %def MATCH_MLM MATCH_CKKW MATCH_POWHEG MATCH_UNDEFINED
@ A dictionary
<<Matching base: public>>=
public :: matching_method
<<Matching base: interfaces>>=
interface matching_method
module procedure matching_method_of_string
module procedure matching_method_to_string
end interface
<<Matching base: sub interfaces>>=
elemental module function matching_method_of_string (string) result (i)
integer :: i
type(string_t), intent(in) :: string
end function matching_method_of_string
elemental module function matching_method_to_string (i) result (string)
type(string_t) :: string
integer, intent(in) :: i
end function matching_method_to_string
<<Matching base: procedures>>=
elemental module function matching_method_of_string (string) result (i)
integer :: i
type(string_t), intent(in) :: string
select case (char (string))
case ("MLM")
i = MATCH_MLM
case ("CKKW")
i = MATCH_CKKW
case ("POWHEG")
i = MATCH_POWHEG
case default
i = MATCH_UNDEFINED
end select
end function matching_method_of_string
elemental module function matching_method_to_string (i) result (string)
type(string_t) :: string
integer, intent(in) :: i
select case (i)
case (MATCH_MLM)
string = "MLM"
case (MATCH_CKKW)
string = "CKKW"
case (MATCH_POWHEG)
string = "POWHEG"
case default
string = "UNDEFINED"
end select
end function matching_method_to_string
@ %def matching_method
@
\section{MLM Matching}
<<[[mlm_matching.f90]]>>=
<<File header>>
module mlm_matching
<<Use kinds with double>>
<<Use strings>>
use constants
use lorentz
use particles
use variables
use matching_base
<<Standard module head>>
<<MLM matching: public>>
<<MLM matching: types>>
interface
<<MLM matching: sub interfaces>>
end interface
end module mlm_matching
@ %def mlm_matching
@
<<[[mlm_matching_sub.f90]]>>=
<<File header>>
submodule (mlm_matching) mlm_matching_s
<<Use debug>>
use io_units
use format_utils, only: write_separator
use diagnostics
use file_utils
use subevents, only: PRT_OUTGOING
use shower_base
use ktclus
implicit none
contains
<<MLM matching: procedures>>
end submodule mlm_matching_s
@ %def mlm_matching_s
@
<<MLM matching: public>>=
public :: mlm_matching_settings_t
<<MLM matching: types>>=
type :: mlm_matching_settings_t
real(default) :: mlm_Qcut_ME = one
real(default) :: mlm_Qcut_PS = one
real(default) :: mlm_ptmin, mlm_etamax, mlm_Rmin, mlm_Emin
real(default) :: mlm_ETclusfactor = 0.2_default
real(default) :: mlm_ETclusminE = five
real(default) :: mlm_etaclusfactor = one
real(default) :: mlm_Rclusfactor = one
real(default) :: mlm_Eclusfactor = one
integer :: kt_imode_hadronic = 4313
integer :: kt_imode_leptonic = 1111
integer :: mlm_nmaxMEjets = 0
contains
<<MLM matching: mlm matching settings: TBP>>
end type mlm_matching_settings_t
@ %def mlm_matching_settings_t
@
<<MLM matching: mlm matching settings: TBP>>=
procedure :: init => mlm_matching_settings_init
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_settings_init (settings, var_list)
class(mlm_matching_settings_t), intent(out) :: settings
type(var_list_t), intent(in) :: var_list
end subroutine mlm_matching_settings_init
<<MLM matching: procedures>>=
module subroutine mlm_matching_settings_init (settings, var_list)
class(mlm_matching_settings_t), intent(out) :: settings
type(var_list_t), intent(in) :: var_list
settings%mlm_Qcut_ME = &
var_list%get_rval (var_str ("mlm_Qcut_ME"))
settings%mlm_Qcut_PS = &
var_list%get_rval (var_str ("mlm_Qcut_PS"))
settings%mlm_ptmin = &
var_list%get_rval (var_str ("mlm_ptmin"))
settings%mlm_etamax = &
var_list%get_rval (var_str ("mlm_etamax"))
settings%mlm_Rmin = &
var_list%get_rval (var_str ("mlm_Rmin"))
settings%mlm_Emin = &
var_list%get_rval (var_str ("mlm_Emin"))
settings%mlm_nmaxMEjets = &
var_list%get_ival (var_str ("mlm_nmaxMEjets"))
settings%mlm_ETclusfactor = &
var_list%get_rval (var_str ("mlm_ETclusfactor"))
settings%mlm_ETclusminE = &
var_list%get_rval (var_str ("mlm_ETclusminE"))
settings%mlm_etaclusfactor = &
var_list%get_rval (var_str ("mlm_etaclusfactor"))
settings%mlm_Rclusfactor = &
var_list%get_rval (var_str ("mlm_Rclusfactor"))
settings%mlm_Eclusfactor = &
var_list%get_rval (var_str ("mlm_Eclusfactor"))
end subroutine mlm_matching_settings_init
@ %def mlm_matching_settings_init
@
<<MLM matching: mlm matching settings: TBP>>=
procedure :: write => mlm_matching_settings_write
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_settings_write (settings, unit)
class(mlm_matching_settings_t), intent(in) :: settings
integer, intent(in), optional :: unit
end subroutine mlm_matching_settings_write
<<MLM matching: procedures>>=
module subroutine mlm_matching_settings_write (settings, unit)
class(mlm_matching_settings_t), intent(in) :: settings
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(3x,A,ES19.12)") &
"mlm_Qcut_ME = ", settings%mlm_Qcut_ME
write (u, "(3x,A,ES19.12)") &
"mlm_Qcut_PS = ", settings%mlm_Qcut_PS
write (u, "(3x,A,ES19.12)") &
"mlm_ptmin = ", settings%mlm_ptmin
write (u, "(3x,A,ES19.12)") &
"mlm_etamax = ", settings%mlm_etamax
write (u, "(3x,A,ES19.12)") &
"mlm_Rmin = ", settings%mlm_Rmin
write (u, "(3x,A,ES19.12)") &
"mlm_Emin = ", settings%mlm_Emin
write (u, "(3x,A,1x,I0)") &
"mlm_nmaxMEjets = ", settings%mlm_nmaxMEjets
write (u, "(3x,A,ES19.12)") &
"mlm_ETclusfactor (D=0.2) = ", settings%mlm_ETclusfactor
write (u, "(3x,A,ES19.12)") &
"mlm_ETclusminE (D=5.0) = ", settings%mlm_ETclusminE
write (u, "(3x,A,ES19.12)") &
"mlm_etaclusfactor (D=1.0) = ", settings%mlm_etaClusfactor
write (u, "(3x,A,ES19.12)") &
"mlm_Rclusfactor (D=1.0) = ", settings%mlm_RClusfactor
write (u, "(3x,A,ES19.12)") &
"mlm_Eclusfactor (D=1.0) = ", settings%mlm_EClusfactor
end subroutine mlm_matching_settings_write
@ %def mlm_matching_settings_write
@ This is a container for the (colored) parton momenta as well as the
jet momenta.
<<MLM matching: public>>=
public :: mlm_matching_t
<<MLM matching: types>>=
type, extends (matching_t) :: mlm_matching_t
type(vector4_t), dimension(:), allocatable, public :: P_ME
type(vector4_t), dimension(:), allocatable, public :: P_PS
type(vector4_t), dimension(:), allocatable, private :: JETS_ME
type(vector4_t), dimension(:), allocatable, private :: JETS_PS
type(mlm_matching_settings_t) :: settings
contains
<<MLM matching: mlm matching: TBP>>
end type mlm_matching_t
@ %def mlm_matching_t
@
<<MLM matching: mlm matching: TBP>>=
procedure :: init => mlm_matching_init
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_init (matching, var_list, process_name)
class(mlm_matching_t), intent(out) :: matching
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_name
end subroutine mlm_matching_init
<<MLM matching: procedures>>=
module subroutine mlm_matching_init (matching, var_list, process_name)
class(mlm_matching_t), intent(out) :: matching
<<default matching init>>
end subroutine mlm_matching_init
@ %def mlm_matching_init
@
<<MLM matching: mlm matching: TBP>>=
procedure :: write => mlm_matching_write
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_write (matching, unit)
class(mlm_matching_t), intent(in) :: matching
integer, intent(in), optional :: unit
end subroutine mlm_matching_write
<<MLM matching: procedures>>=
module subroutine mlm_matching_write (matching, unit)
class(mlm_matching_t), intent(in) :: matching
integer, intent(in), optional :: unit
integer :: i, u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "MLM matching:"
call matching%settings%write (u)
write (u, "(3x,A)") "Momenta of ME partons:"
if (allocated (matching%P_ME)) then
do i = 1, size (matching%P_ME)
write (u, "(4x)", advance = "no")
call vector4_write (matching%P_ME(i), unit = u)
end do
else
write (u, "(5x,A)") "[empty]"
end if
call write_separator (u)
write (u, "(3x,A)") "Momenta of ME jets:"
if (allocated (matching%JETS_ME)) then
do i = 1, size (matching%JETS_ME)
write (u, "(4x)", advance = "no")
call vector4_write (matching%JETS_ME(i), unit = u)
end do
else
write (u, "(5x,A)") "[empty]"
end if
call write_separator (u)
write(u, "(3x,A)") "Momenta of shower partons:"
if (allocated (matching%P_PS)) then
do i = 1, size (matching%P_PS)
write (u, "(4x)", advance = "no")
call vector4_write (matching%P_PS(i), unit = u)
end do
else
write (u, "(5x,A)") "[empty]"
end if
call write_separator (u)
write (u, "(3x,A)") "Momenta of shower jets:"
if (allocated (matching%JETS_PS)) then
do i = 1, size (matching%JETS_PS)
write (u, "(4x)", advance = "no")
call vector4_write (matching%JETS_PS(i), unit = u)
end do
else
write (u, "(5x,A)") "[empty]"
end if
call write_separator (u)
end subroutine mlm_matching_write
@ %def mlm_matching_write
@
<<MLM matching: mlm matching: TBP>>=
procedure :: get_method => mlm_matching_get_method
<<MLM matching: sub interfaces>>=
module function mlm_matching_get_method (matching) result (method)
type(string_t) :: method
class(mlm_matching_t), intent(in) :: matching
end function mlm_matching_get_method
<<MLM matching: procedures>>=
module function mlm_matching_get_method (matching) result (method)
type(string_t) :: method
class(mlm_matching_t), intent(in) :: matching
method = matching_method (MATCH_MLM)
end function mlm_matching_get_method
@ %def mlm_matching_get_method
@
<<MLM matching: mlm matching: TBP>>=
procedure :: before_shower => mlm_matching_before_shower
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_before_shower &
(matching, particle_set, vetoed)
class(mlm_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine mlm_matching_before_shower
<<MLM matching: procedures>>=
module subroutine mlm_matching_before_shower &
(matching, particle_set, vetoed)
class(mlm_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
vetoed = .false.
end subroutine mlm_matching_before_shower
@ %def mlm_matching_before_shower
@
<<MLM matching: mlm matching: TBP>>=
procedure :: after_shower => mlm_matching_after_shower
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_after_shower (matching, particle_set, vetoed)
class(mlm_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine mlm_matching_after_shower
<<MLM matching: procedures>>=
module subroutine mlm_matching_after_shower (matching, particle_set, vetoed)
class(mlm_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
if (debug_on) call msg_debug (D_MATCHING, "mlm_matching_after_shower")
call matching%shower%get_final_colored_ME_momenta (matching%P_ME)
call matching%fill_P_PS (particle_set)
!!! MLM stage 3 -> reconstruct and possibly reject
call matching%apply (vetoed)
if (debug_active (D_MATCHING)) call matching%write ()
if (allocated (matching%P_ME)) deallocate (matching%P_ME)
if (allocated (matching%P_PS)) deallocate (matching%P_PS)
if (allocated (matching%JETS_ME)) deallocate (matching%JETS_ME)
if (allocated (matching%JETS_PS)) deallocate (matching%JETS_PS)
end subroutine mlm_matching_after_shower
@ %def mlm_matching_after_shower
@ Transfer partons after parton shower to [[matching%P_PS]]
<<MLM matching: mlm matching: TBP>>=
procedure :: fill_P_PS => mlm_matching_fill_P_PS
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_fill_P_PS (matching, particle_set)
class(mlm_matching_t), intent(inout) :: matching
type(particle_set_t), intent(in) :: particle_set
end subroutine mlm_matching_fill_P_PS
<<MLM matching: procedures>>=
module subroutine mlm_matching_fill_P_PS (matching, particle_set)
class(mlm_matching_t), intent(inout) :: matching
type(particle_set_t), intent(in) :: particle_set
integer :: i, j, n_jets_PS
integer, dimension(2) :: col
type(particle_t) :: tempprt
real(double) :: eta
type(vector4_t) :: p_tmp
!!! loop over particles and extract final colored ones with eta<etamax
n_jets_PS = 0
do i = 1, particle_set%get_n_tot ()
if (signal_is_pending ()) return
tempprt = particle_set%get_particle (i)
if (tempprt%get_status () /= PRT_OUTGOING) cycle
col = tempprt%get_color ()
if (all (col == 0)) cycle
! TODO: (bcn 2015-04-28) where is the corresponding part for lepton colliders?
if (matching%is_hadron_collision) then
p_tmp = tempprt%get_momentum ()
if (energy (p_tmp) - longitudinal_part (p_tmp) < 1.E-10_default .or. &
energy (p_tmp) + longitudinal_part (p_tmp) < 1.E-10_default) then
eta = pseudorapidity (p_tmp)
else
eta = rapidity (p_tmp)
end if
if (eta > matching%settings%mlm_etaClusfactor * &
matching%settings%mlm_etamax) then
if (debug_active (D_MATCHING)) then
call msg_debug (D_MATCHING, "Rejecting this particle")
call tempprt%write ()
end if
cycle
end if
end if
n_jets_PS = n_jets_PS + 1
end do
allocate (matching%P_PS(1:n_jets_PS))
if (debug_on) call msg_debug (D_MATCHING, "n_jets_ps", n_jets_ps)
j = 1
do i = 1, particle_set%get_n_tot ()
tempprt = particle_set%get_particle (i)
if (tempprt%get_status () /= PRT_OUTGOING) cycle
col = tempprt%get_color ()
if (all(col == 0)) cycle
! TODO: (bcn 2015-04-28) where is the corresponding part for lepton colliders?
if (matching%is_hadron_collision) then
p_tmp = tempprt%get_momentum ()
if (energy (p_tmp) - longitudinal_part (p_tmp) < 1.E-10_default .or. &
energy (p_tmp) + longitudinal_part (p_tmp) < 1.E-10_default) then
eta = pseudorapidity (p_tmp)
else
eta = rapidity (p_tmp)
end if
if (eta > matching%settings%mlm_etaClusfactor * &
matching%settings%mlm_etamax) cycle
end if
matching%P_PS(j) = tempprt%get_momentum ()
j = j + 1
end do
end subroutine mlm_matching_fill_P_PS
@ %def mlm_matching_fill_P_PS
@
<<MLM matching: mlm matching: TBP>>=
procedure :: apply => mlm_matching_apply
<<MLM matching: sub interfaces>>=
module subroutine mlm_matching_apply (matching, vetoed)
class(mlm_matching_t), intent(inout) :: matching
logical, intent(out) :: vetoed
end subroutine mlm_matching_apply
<<MLM matching: procedures>>=
module subroutine mlm_matching_apply (matching, vetoed)
class(mlm_matching_t), intent(inout) :: matching
logical, intent(out) :: vetoed
integer :: i, j
integer :: n_jets_ME, n_jets_PS, n_jets_PS_atycut
real(double) :: ycut
real(double), dimension(:, :), allocatable :: PP
real(double), dimension(:), allocatable :: Y
real(double), dimension(:,:), allocatable :: P_JETS
real(double), dimension(:,:), allocatable :: P_ME
integer, dimension(:), allocatable :: JET
integer :: NJET, NSUB
integer :: imode
!!! TODO: (bcn 2014-03-26) Why is ECUT hard coded to 1?
!!! It is the denominator of the KT measure. Candidate for removal
real(double) :: ECUT = 1._double
integer :: ip1,ip2
! KTCLUS COMMON BLOCK
INTEGER NMAX,NUM,HIST
PARAMETER (NMAX=512)
DOUBLE PRECISION P,KT,KTP,KTS,ETOT,RSQ,KTLAST
COMMON /KTCOMM/ETOT,RSQ,P(9,NMAX),KTP(NMAX,NMAX),KTS(NMAX), &
KT(NMAX),KTLAST(NMAX),HIST(NMAX),NUM
vetoed = .true.
if (signal_is_pending ()) return
<<Set [[n_jets_ME/PS]] from [[matching]] (or equal zero)>>
<<Jet clustering for partons after matrix element>>
<<Jet clustering for partons after shower>>
<<Veto: too many or not enough jets after PS>>
<<Cluster ME jets with PS jets one at a time>>
vetoed = .false.
999 continue
end subroutine mlm_matching_apply
@ %def mlm_matching_apply
@
<<Set [[n_jets_ME/PS]] from [[matching]] (or equal zero)>>=
if (allocated (matching%P_ME)) then
! print *, "number of partons after ME: ", size(matching%P_ME)
n_jets_ME = size (matching%P_ME)
else
n_jets_ME = 0
end if
if (allocated (matching%p_PS)) then
! print *, "number of partons after PS: ", size(matching%p_PS)
n_jets_PS = size (matching%p_PS)
else
n_jets_PS = 0
end if
@
<<Jet clustering for partons after matrix element>>=
if (n_jets_ME > 0) then
ycut = (matching%settings%mlm_ptmin)**2
allocate (PP(1:4, 1:N_jets_ME))
do i = 1, n_jets_ME
PP(1:3,i) = matching%p_ME(i)%p(1:3)
PP(4,i) = matching%p_ME(i)%p(0)
end do
<<Set [[imode]] for lepton or hadron collisions>>
allocate (P_ME(1:4,1:n_jets_ME))
allocate (JET(1:n_jets_ME))
allocate (Y(1:n_jets_ME))
if (signal_is_pending ()) return
call KTCLUR (imode, PP, n_jets_ME, &
dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), ECUT, y, *999)
call KTRECO (1, PP, n_jets_ME, ECUT, ycut, ycut, P_ME, JET, &
NJET, NSUB, *999)
n_jets_ME = NJET
if (NJET > 0) then
allocate (matching%JETS_ME (1:NJET))
do i = 1, NJET
matching%JETS_ME(i) = vector4_moving (REAL(P_ME(4,i), default), &
vector3_moving([REAL(P_ME(1,i), default), &
REAL(P_ME(2,i), default), REAL(P_ME(3,i), default)]))
end do
end if
deallocate (P_ME)
deallocate (JET)
deallocate (Y)
deallocate (PP)
end if
@
<<Jet clustering for partons after shower>>=
if (n_jets_PS > 0) then
ycut = (matching%settings%mlm_ptmin + max (matching%settings%mlm_ETclusminE, &
matching%settings%mlm_ETclusfactor * matching%settings%mlm_ptmin))**2
allocate (PP(1:4, 1:n_jets_PS))
do i = 1, n_jets_PS
PP(1:3,i) = matching%p_PS(i)%p(1:3)
PP(4,i) = matching%p_PS(i)%p(0)
end do
<<Set [[imode]] for lepton or hadron collisions>>
allocate (P_JETS(1:4,1:n_jets_PS))
allocate (JET(1:n_jets_PS))
allocate (Y(1:n_jets_PS))
if (signal_is_pending ()) return
call KTCLUR (imode, PP, n_jets_PS, &
dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), &
ECUT, y, *999)
call KTRECO (1, PP, n_jets_PS, ECUT, ycut, ycut, P_JETS, JET, &
NJET, NSUB, *999)
n_jets_PS_atycut = NJET
if (n_jets_ME == matching%settings%mlm_nmaxMEjets .and. NJET > 0) then
! print *, " resetting ycut to ", Y(matching%settings%mlm_nmaxMEjets)
ycut = y(matching%settings%mlm_nmaxMEjets)
call KTRECO (1, PP, n_jets_PS, ECUT, ycut, ycut, P_JETS, JET, &
NJET, NSUB, *999)
end if
! !Sample of code for a FastJet interface
! palg = 1d0 ! 1.0d0 = kt, 0.0d0 = Cam/Aachen, -1.0d0 = anti-kt
! R = 0.7_double ! radius parameter
! f = 0.75_double ! overlap threshold
! !call fastjetppgenkt(PP,n,R,palg,P_JETS,NJET) ! KT-Algorithm
! !call fastjetsiscone(PP,n,R,f,P_JETS,NJET) ! SiSCone-Algorithm
if (NJET > 0) then
allocate (matching%JETS_PS(1:NJET))
do i = 1, NJET
matching%JETS_PS(i) = vector4_moving (REAL(P_JETS(4,i), default), &
vector3_moving([REAL(P_JETS(1,i), default), &
REAL(P_JETS(2,i), default), REAL(P_JETS(3,i), default)]))
end do
end if
deallocate (P_JETS)
deallocate (JET)
deallocate (Y)
else
n_jets_PS_atycut = 0
end if
@
<<Set [[imode]] for lepton or hadron collisions>>=
if (matching%is_hadron_collision) then
imode = matching%settings%kt_imode_hadronic
else
imode = matching%settings%kt_imode_leptonic
end if
@
<<Veto: too many or not enough jets after PS>>=
if (n_jets_PS_atycut < n_jets_ME) then
! print *, "DISCARDING: Not enough PS jets: ", n_jets_PS_atycut
return
end if
if (n_jets_PS_atycut > n_jets_ME .and. n_jets_ME /= matching%settings%mlm_nmaxMEjets) then
! print *, "DISCARDING: Too many PS jets: ", n_jets_PS_atycut
return
end if
@
<<Cluster ME jets with PS jets one at a time>>=
if (allocated(matching%JETS_PS)) then
! print *, "number of jets after PS: ", size(matching%JETS_PS)
n_jets_PS = size (matching%JETS_PS)
else
n_jets_PS = 0
end if
if (n_jets_ME > 0 .and. n_jets_PS > 0) then
n_jets_PS = size (matching%JETS_PS)
if (allocated (PP)) deallocate(PP)
allocate (PP(1:4, 1:n_jets_PS + 1))
do i = 1, n_jets_PS
if (signal_is_pending ()) return
PP(1:3,i) = matching%JETS_PS(i)%p(1:3)
PP(4,i) = matching%JETS_PS(i)%p(0)
end do
if (allocated (Y)) deallocate(Y)
allocate (Y(1:n_jets_PS + 1))
y = zero
do i = 1, n_jets_ME
PP(1:3,n_jets_PS + 2 - i) = matching%JETS_ME(i)%p(1:3)
PP(4,n_jets_PS + 2 - i) = matching%JETS_ME(i)%p(0)
!!! This makes more sense than hardcoding
! call KTCLUS (4313, PP, (n_jets_PS + 2 - i), 1.0_double, Y, *999)
call KTCLUR (imode, PP, (n_jets_PS + 2 - i), &
dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), &
ECUT, y, *999)
if (0.99 * y(n_jets_PS + 1 - (i - 1)).gt.ycut) then
! print *, "DISCARDING: Jet ", i, " not clusterd"
return
end if
!!! search for and remove PS jet clustered with ME Jet
ip1 = HIST(n_jets_PS + 2 - i) / NMAX
ip2 = mod(hist(n_jets_PS + 2 - i), NMAX)
if ((ip2 /= n_jets_PS + 2 - i) .or. (ip1 <= 0)) then
! print *, "DISCARDING: Jet ", i, " not clustered ", ip1, ip2, &
! hist(n_jets_PS + 2 - i)
return
else
! print *, "PARTON clustered", ip1, ip2, hist(n_jets_PS + 2 - i)
PP(:,IP1) = zero
do j = IP1, n_jets_PS - i
PP(:, j) = PP(:,j + 1)
end do
end if
end do
end if
@
\section{CKKW matching}
This module contains the CKKW matching.
The type [[ckkw_pseudo_shower_weights_t]] gives the (relative) weights
for different clusterings of the final particles, as given in Eq.~(2.7) of
hep-ph/0503281v1. Each particle has a binary labelling (power of 2)
(first particle = 1, second particle = 2, third particle = 4,
...). Each recombination therefore corresponds to an integer, that is
not a power of 2. Fur multiple subsequent recombinations, no different
weights for different sequences of clustering are stored. It is
assumed that the weight of a multiply recombined state is a
combination of the states with one fewer recombination and that these
states' contributions are proportional to their weights. For a $2->n$
event, the weights array thus has the size $2^{(2 + n) - 1}$. The
[[weights_by_type]] array gives the weights depending on the type of
the particle, the first index is the same as for weights, the second
index gives the type of the new mother particle:
\begin{itemize}
\item[0:] uncolored ($\gamma$, $Z$, $W$, Higgs)
\item[1:] colored (quark)
\item[2:] gluon
\item[3:] squark
\item[4:] gluino
\end{itemize}
[[alphaS]] gives the value for $alpha_s$ used in the generation of the
matrix element. This is needed for the reweighting using the values
for a running $alpha_s$ at the scales of the clusterings.
<<[[ckkw_matching.f90]]>>=
<<File header>>
module ckkw_matching
<<Use kinds with double>>
<<Use strings>>
use constants
use lorentz
use particles
use rng_base
use shower_base
use shower_partons
use variables
use matching_base
<<Standard module head>>
<<CKKW matching: public>>
<<CKKW matching: types>>
interface
<<CKKW matching: sub interfaces>>
end interface
end module ckkw_matching
@ %def ckkw_matching
@
<<[[ckkw_matching_sub.f90]]>>=
<<File header>>
submodule (ckkw_matching) ckkw_matching_s
<<Use debug>>
use io_units
use format_utils, only: write_separator
use diagnostics
use physics_defs
use shower_core
implicit none
contains
<<CKKW matching: procedures>>
end submodule ckkw_matching_s
@ %def ckkw_matching_s
@ The fundamental CKKW matching parameter are defined here:
<<CKKW matching: public>>=
public :: ckkw_matching_settings_t
<<CKKW matching: types>>=
type :: ckkw_matching_settings_t
real(default) :: alphaS = 0.118_default
real(default) :: Qmin = one
integer :: n_max_jets = 0
contains
<<CKKW matching: ckkw matching settings: TBP>>
end type ckkw_matching_settings_t
@ %def ckkw_matching_settings_t
@ This is empty for the moment.
<<CKKW matching: ckkw matching settings: TBP>>=
procedure :: init => ckkw_matching_settings_init
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_matching_settings_init (settings, var_list)
class(ckkw_matching_settings_t), intent(out) :: settings
type(var_list_t), intent(in) :: var_list
end subroutine ckkw_matching_settings_init
<<CKKW matching: procedures>>=
module subroutine ckkw_matching_settings_init (settings, var_list)
class(ckkw_matching_settings_t), intent(out) :: settings
type(var_list_t), intent(in) :: var_list
settings%alphaS = 1.0_default
settings%Qmin = 1.0_default
settings%n_max_jets = 3
end subroutine ckkw_matching_settings_init
@ %def ckkw_matching_settings_init
@
<<CKKW matching: ckkw matching settings: TBP>>=
procedure :: write => ckkw_matching_settings_write
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_matching_settings_write (settings, unit)
class(ckkw_matching_settings_t), intent(in) :: settings
integer, intent(in), optional :: unit
end subroutine ckkw_matching_settings_write
<<CKKW matching: procedures>>=
module subroutine ckkw_matching_settings_write (settings, unit)
class(ckkw_matching_settings_t), intent(in) :: settings
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "CKKW matching settings:"
call write_separator (u)
write (u, "(3x,A,1x,ES19.12)") &
"alphaS = ", settings%alphaS
write (u, "(3x,A,1x,ES19.12)") &
"Qmin = ", settings%Qmin
write (u, "(3x,A,1x,I0)") &
"n_max_jets = ", settings%n_max_jets
end subroutine ckkw_matching_settings_write
@ %def ckkw_matching_settings_write
@
<<CKKW matching: public>>=
public :: ckkw_pseudo_shower_weights_t
<<CKKW matching: types>>=
type :: ckkw_pseudo_shower_weights_t
real(default) :: alphaS
real(default), dimension(:), allocatable :: weights
real(default), dimension(:,:), allocatable :: weights_by_type
contains
<<CKKW matching: ckkw pseudo shower weights: TBP>>
end type ckkw_pseudo_shower_weights_t
@ %def ckkw_pseudo_shower_weights_t
@
<<CKKW matching: ckkw pseudo shower weights: TBP>>=
procedure :: init => ckkw_pseudo_shower_weights_init
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_pseudo_shower_weights_init (weights)
class(ckkw_pseudo_shower_weights_t), intent(out) :: weights
end subroutine ckkw_pseudo_shower_weights_init
<<CKKW matching: procedures>>=
module subroutine ckkw_pseudo_shower_weights_init (weights)
class(ckkw_pseudo_shower_weights_t), intent(out) :: weights
weights%alphaS = zero
end subroutine ckkw_pseudo_shower_weights_init
@ %def ckkw_pseudo_shower_weights_init
@
<<CKKW matching: ckkw pseudo shower weights: TBP>>=
procedure :: write => ckkw_pseudo_shower_weights_write
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_pseudo_shower_weights_write (weights, unit)
class(ckkw_pseudo_shower_weights_t), intent(in) :: weights
integer, intent(in), optional :: unit
end subroutine ckkw_pseudo_shower_weights_write
<<CKKW matching: procedures>>=
module subroutine ckkw_pseudo_shower_weights_write (weights, unit)
class(ckkw_pseudo_shower_weights_t), intent(in) :: weights
integer, intent(in), optional :: unit
integer :: s, i, u
u = given_output_unit (unit); if (u < 0) return
s = size (weights%weights)
write (u, "(1x,A)") "CKKW (pseudo) shower weights: "
do i = 1, s
write (u, "(3x,I0,2(ES19.12))") i, weights%weights(i), &
weights%weights_by_type(i,:)
end do
write (u, "(3x,A,1x,I0)") "alphaS =", weights%alphaS
end subroutine ckkw_pseudo_shower_weights_write
@ %def ckkw_pseudo_shower_weights_write
@ Generate fake ckkw weights. This can be dropped, once information
from the matrix element generation is available.
<<CKKW matching: ckkw pseudo shower weights: TBP>>=
procedure :: fake => ckkw_pseudo_shower_weights_fake
<<CKKW matching: sub interfaces>>=
pure module subroutine ckkw_pseudo_shower_weights_fake &
(weights, particle_set)
class(ckkw_pseudo_shower_weights_t), intent(inout) :: weights
type(particle_set_t), intent(in) :: particle_set
end subroutine ckkw_pseudo_shower_weights_fake
<<CKKW matching: procedures>>=
pure module subroutine ckkw_pseudo_shower_weights_fake (weights, particle_set)
class(ckkw_pseudo_shower_weights_t), intent(inout) :: weights
type(particle_set_t), intent(in) :: particle_set
integer :: i, j, n
type(vector4_t) :: momentum
n = 2**particle_set%n_tot
if (allocated (weights%weights)) then
deallocate (weights%weights)
end if
allocate (weights%weights (1:n))
do i = 1, n
momentum = vector4_null
do j = 1, particle_set%n_tot
if (btest (i,j-1)) then
momentum = momentum + particle_set%prt(j)%p
end if
end do
if (momentum**1 > 0.0) then
weights%weights(i) = 1.0 / (momentum**2)
end if
end do
! equally distribute the weights by type
if (allocated (weights%weights_by_type)) then
deallocate (weights%weights_by_type)
end if
allocate (weights%weights_by_type (1:n, 0:4))
do i = 1, n
do j = 0, 4
weights%weights_by_type(i,j) = 0.2 * weights%weights(i)
end do
end do
end subroutine ckkw_pseudo_shower_weights_fake
@ %def ckkw_pseudo_shower_weights_fake
@
<<CKKW matching: public>>=
public :: ckkw_matching_t
<<CKKW matching: types>>=
type, extends (matching_t) :: ckkw_matching_t
type(ckkw_matching_settings_t) :: settings
type(ckkw_pseudo_shower_weights_t) :: weights
contains
<<CKKW matching: ckkw matching: TBP>>
end type ckkw_matching_t
@ %def ckkw_matching_t
@
<<CKKW matching: ckkw matching: TBP>>=
procedure :: init => ckkw_matching_init
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_matching_init (matching, var_list, process_name)
class(ckkw_matching_t), intent(out) :: matching
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_name
end subroutine ckkw_matching_init
<<CKKW matching: procedures>>=
module subroutine ckkw_matching_init (matching, var_list, process_name)
class(ckkw_matching_t), intent(out) :: matching
<<default matching init>>
end subroutine ckkw_matching_init
@ %def ckkw_matching_init
@
<<CKKW matching: ckkw matching: TBP>>=
procedure :: write => ckkw_matching_write
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_matching_write (matching, unit)
class(ckkw_matching_t), intent(in) :: matching
integer, intent(in), optional :: unit
end subroutine ckkw_matching_write
<<CKKW matching: procedures>>=
module subroutine ckkw_matching_write (matching, unit)
class(ckkw_matching_t), intent(in) :: matching
integer, intent(in), optional :: unit
call matching%settings%write (unit)
call matching%weights%write (unit)
end subroutine ckkw_matching_write
@ %def ckkw_matching_write
@
<<CKKW matching: ckkw matching: TBP>>=
procedure :: get_method => ckkw_matching_get_method
<<CKKW matching: sub interfaces>>=
module function ckkw_matching_get_method (matching) result (method)
type(string_t) :: method
class(ckkw_matching_t), intent(in) :: matching
end function ckkw_matching_get_method
<<CKKW matching: procedures>>=
module function ckkw_matching_get_method (matching) result (method)
type(string_t) :: method
class(ckkw_matching_t), intent(in) :: matching
method = matching_method (MATCH_CKKW)
end function ckkw_matching_get_method
@ %def ckkw_matching_get_method
@
<<CKKW matching: ckkw matching: TBP>>=
procedure :: before_shower => ckkw_matching_before_shower
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_matching_before_shower &
(matching, particle_set, vetoed)
class(ckkw_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine ckkw_matching_before_shower
<<CKKW matching: procedures>>=
module subroutine ckkw_matching_before_shower &
(matching, particle_set, vetoed)
class(ckkw_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
call matching%weights%init ()
call matching%weights%fake (particle_set)
select type (shower => matching%shower)
type is (shower_t)
call ckkw_matching_apply (shower%partons, &
matching%settings, &
matching%weights, matching%rng, vetoed)
class default
call msg_bug ("CKKW matching only works with WHIZARD shower.")
end select
end subroutine ckkw_matching_before_shower
@ %def ckkw_matching_before_shower
@
<<CKKW matching: public>>=
public :: ckkw_matching_apply
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_matching_apply &
(partons, settings, weights, rng, vetoed)
type(parton_pointer_t), dimension(:), intent(inout), allocatable :: &
partons
type(ckkw_matching_settings_t), intent(in) :: settings
type(ckkw_pseudo_shower_weights_t), intent(in) :: weights
class(rng_t), intent(inout), allocatable :: rng
logical, intent(out) :: vetoed
end subroutine ckkw_matching_apply
<<CKKW matching: procedures>>=
module subroutine ckkw_matching_apply &
(partons, settings, weights, rng, vetoed)
type(parton_pointer_t), dimension(:), intent(inout), allocatable :: &
partons
type(ckkw_matching_settings_t), intent(in) :: settings
type(ckkw_pseudo_shower_weights_t), intent(in) :: weights
class(rng_t), intent(inout), allocatable :: rng
logical, intent(out) :: vetoed
real(default), dimension(:), allocatable :: scales
real(double) :: weight, sf
real(default) :: rand
integer :: i, n_partons
if (signal_is_pending ()) return
weight = one
n_partons = size (partons)
do i = 1, n_partons
call partons(i)%p%write ()
end do
!!! the pseudo parton shower is already simulated by shower_add_interaction
!!! get the respective clustering scales
allocate (scales (1:n_partons))
do i = 1, n_partons
if (.not. associated (partons(i)%p)) cycle
if (partons(i)%p%type == INTERNAL) then
scales(i) = two * min (partons(i)%p%child1%momentum%p(0), &
partons(i)%p%child2%momentum%p(0))**2 * &
(1.0 - (space_part (partons(i)%p%child1%momentum) * &
space_part (partons(i)%p%child2%momentum)) / &
(space_part (partons(i)%p%child1%momentum)**1 * &
space_part (partons(i)%p%child2%momentum)**1))
scales(i) = sqrt (scales(i))
partons(i)%p%ckkwscale = scales(i)
print *, scales(i)
end if
end do
print *, " scales finished"
!!! if (highest multiplicity) -> reweight with PDF(mu_F) / PDF(mu_cut)
do i = 1, n_partons
call partons(i)%p%write ()
end do
!!! Reweight and possibly veto the whole event
!!! calculate the relative alpha_S weight
!! calculate the Sudakov weights for internal lines
!! calculate the Sudakov weights for external lines
do i = 1, n_partons
if (signal_is_pending ()) return
if (.not. associated (partons(i)%p)) cycle
if (partons(i)%p%type == INTERNAL) then
!!! get type
!!! check that all particles involved are colored
if ((partons(i)%p%is_colored () .or. &
partons(i)%p%ckkwtype > 0) .and. &
(partons(i)%p%child1%is_colored () .or. &
partons(i)%p%child1%ckkwtype > 0) .and. &
(partons(i)%p%child1%is_colored () .or. &
partons(i)%p%child1%ckkwtype > 0)) then
print *, "reweight with alphaS(" , partons(i)%p%ckkwscale, &
") for particle ", partons(i)%p%nr
if (partons(i)%p%belongstoFSR) then
print *, "FSR"
weight = weight * D_alpha_s_fsr (partons(i)%p%ckkwscale**2, &
partons(i)%p%settings) / settings%alphas
else
print *, "ISR"
weight = weight * &
D_alpha_s_isr (partons(i)%p%ckkwscale**2, &
partons(i)%p%settings) / settings%alphas
end if
else
print *, "no reweight with alphaS for ", partons(i)%p%nr
end if
if (partons(i)%p%child1%type == INTERNAL) then
print *, "internal line from ", &
partons(i)%p%child1%ckkwscale, &
" to ", partons(i)%p%ckkwscale, &
" for type ", partons(i)%p%child1%ckkwtype
if (partons(i)%p%child1%ckkwtype == 0) then
sf = 1.0
else if (partons(i)%p%child1%ckkwtype == 1) then
sf = SudakovQ (partons(i)%p%child1%ckkwscale, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFQ = ", sf
else if (partons(i)%p%child1%ckkwtype == 2) then
sf = SudakovG (partons(i)%p%child1%ckkwscale, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFG = ", sf
else
print *, "SUSY not yet implemented"
end if
weight = weight * min (one, sf)
else
print *, "external line from ", settings%Qmin, &
partons(i)%p%ckkwscale
if (partons(i)%p%child1%is_quark ()) then
sf = SudakovQ (settings%Qmin, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFQ = ", sf
else if (partons(i)%p%child1%is_gluon ()) then
sf = SudakovG (settings%Qmin, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFG = ", sf
else
print *, "not yet implemented (", &
partons(i)%p%child2%type, ")"
sf = one
end if
weight = weight * min (one, sf)
end if
if (partons(i)%p%child2%type == INTERNAL) then
print *, "internal line from ", partons(i)%p%child2%ckkwscale, &
" to ", partons(i)%p%ckkwscale, &
" for type ", partons(i)%p%child2%ckkwtype
if (partons(i)%p%child2%ckkwtype == 0) then
sf = 1.0
else if (partons(i)%p%child2%ckkwtype == 1) then
sf = SudakovQ (partons(i)%p%child2%ckkwscale, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFQ = ", sf
else if (partons(i)%p%child2%ckkwtype == 2) then
sf = SudakovG (partons(i)%p%child2%ckkwscale, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFG = ", sf
else
print *, "SUSY not yet implemented"
end if
weight = weight * min (one, sf)
else
print *, "external line from ", settings%Qmin, &
partons(i)%p%ckkwscale
if (partons(i)%p%child2%is_quark ()) then
sf = SudakovQ (settings%Qmin, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFQ = ", sf
else if (partons(i)%p%child2%is_gluon ()) then
sf = SudakovG (settings%Qmin, &
partons(i)%p%ckkwscale, &
partons(i)%p%settings, .true., rng)
print *, "SFG = ", sf
else
print *, "not yet implemented (", &
partons(i)%p%child2%type, ")"
sf = one
end if
weight = weight * min (one, sf)
end if
end if
end do
call rng%generate (rand)
print *, "final weight: ", weight
!!!!!!! WRONG
vetoed = .false.
! vetoed = (rand > weight)
if (vetoed) then
return
end if
!!! finally perform the parton shower
!!! veto emissions that are too hard
deallocate (scales)
end subroutine ckkw_matching_apply
@ %def ckkw_matching_apply
@
@
<<CKKW matching: ckkw matching: TBP>>=
procedure :: after_shower => ckkw_matching_after_shower
<<CKKW matching: sub interfaces>>=
module subroutine ckkw_matching_after_shower &
(matching, particle_set, vetoed)
class(ckkw_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine ckkw_matching_after_shower
<<CKKW matching: procedures>>=
module subroutine ckkw_matching_after_shower (matching, particle_set, vetoed)
class(ckkw_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
vetoed = .false.
end subroutine ckkw_matching_after_shower
@ %def ckkw_matching_after_shower
<<CKKW matching: procedures>>=
function GammaQ (smallq, largeq, settings, fsr) result (gamma)
real(default), intent(in) :: smallq, largeq
type(shower_settings_t), intent(in) :: settings
logical, intent(in) :: fsr
real(default) :: gamma
gamma = (8._default / three) / (pi * smallq)
gamma = gamma * (log(largeq / smallq) - 0.75)
if (fsr) then
gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
else
gamma = gamma * D_alpha_s_isr (smallq**2, settings)
end if
end function GammaQ
@ %def GammaQ
@
<<CKKW matching: procedures>>=
function GammaG (smallq, largeq, settings, fsr) result (gamma)
real(default), intent(in) :: smallq, largeq
type(shower_settings_t), intent(in) :: settings
logical, intent(in) :: fsr
real(default) :: gamma
gamma = 6._default / (pi * smallq)
gamma = gamma *( log(largeq / smallq) - 11.0 / 12.0)
if (fsr) then
gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
else
gamma = gamma * D_alpha_s_isr (smallq**2, settings)
end if
end function GammaG
@ %def GammaG
@
<<CKKW matching: procedures>>=
function GammaF (smallq, settings, fsr) result (gamma)
real(default), intent(in) :: smallq
type(shower_settings_t), intent(in) :: settings
logical, intent(in) :: fsr
real(default) :: gamma
gamma = number_of_flavors (smallq, settings%max_n_flavors, &
settings%min_virtuality) / (three * pi * smallq)
if (fsr) then
gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
else
gamma = gamma * D_alpha_s_isr (smallq**2, settings)
end if
end function GammaF
@ %def GammaF
@
<<CKKW matching: procedures>>=
function SudakovQ (Q1, Q, settings, fsr, rng) result (sf)
real(default), intent(in) :: Q1, Q
type(shower_settings_t), intent(in) :: settings
class(rng_t), intent(inout), allocatable :: rng
logical, intent(in) :: fsr
real(default) :: sf
real(default) :: integral
integer, parameter :: NTRIES = 100
integer :: i
real(default) :: rand
integral = zero
do i = 1, NTRIES
call rng%generate (rand)
integral = integral + GammaQ (Q1 + rand * (Q - Q1), Q, settings, fsr)
end do
integral = integral / NTRIES
sf = exp (-integral)
end function SudakovQ
@ %def SudakovQ
@
<<CKKW matching: procedures>>=
function SudakovG (Q1, Q, settings, fsr, rng) result (sf)
real(default), intent(in) :: Q1, Q
type(shower_settings_t), intent(in) :: settings
logical, intent(in) :: fsr
real(default) :: sf
real(default) :: integral
class(rng_t), intent(inout), allocatable :: rng
integer, parameter :: NTRIES = 100
integer :: i
real(default) :: rand
integral = zero
do i = 1, NTRIES
call rng%generate (rand)
integral = integral + &
GammaG (Q1 + rand * (Q - Q1), Q, settings, fsr) + &
GammaF (Q1 + rand * (Q - Q1), settings, fsr)
end do
integral = integral / NTRIES
sf = exp (-integral)
end function SudakovG
@ %def SudakovG
@
\section{POWHEG}
This module generates radiation according to the POWHEG Sudakov form factor
\begin{equation}
\Delta^{f_b} (\Phi_n, p_\text{T}) = \prod_{\alpha_r \in \{\alpha_r |f_b \}}
\Delta^{f_b}_{\alpha_r} (\Phi_n,
p_\text{T}),
\end{equation}
with
\begin{equation}
\Delta^{f_b}_{\alpha_r} (\Phi_n, p_\text{T}) = \exp \left\{ - \left[ \int d
\Phi_{\text{rad}} \,\frac{R (\Phi_{n+1})}{B^{f_b} (\Phi_n)}
\,\theta( k_\text{T} (\Phi_{n+1}) - p_\text{T}) \right]^{\bar{\bf \Phi}_n^{\alpha_r} =
\Phi_n}_{\alpha_r} \right\}
\end{equation}
We expect that an underlying Born flavor structure $f_b$ has been
generated with a probability proportional to its contribution to the
$\tilde B$ at the given kinematic point.
<<[[powheg_matching.f90]]>>=
<<File header>>
module powheg_matching
use, intrinsic :: iso_fortran_env
<<Use kinds with double>>
<<Use strings>>
use diagnostics
use constants, only: ZERO, ONE, TWO, THREE, FOUR, FIVE, TINY_07, PI, TWOPI
use pdf, only: pdf_data_t
use lorentz
use phs_points, only: assignment(=), operator(*)
use sm_qcd, only: qcd_t, alpha_qcd_from_scale_t, alpha_qcd_from_lambda_t
use particles
use grids
use solver
use rng_base
use variables
use phs_fks, only: phs_fks_generator_t, compute_dalitz_bounds, beta_emitter
use phs_fks, only: phs_point_set_t, phs_identifier_t, phs_fks_t
use phs_fks, only: get_xi_max_isr
use phs_fks, only: I_XI, I_Y, I_PLUS, I_MINUS, UBF_FSR_SIMPLE, UBF_FSR_MASSIVE, UBF_FSR_MASSLESS_RECOIL, UBF_ISR
use matching_base
use instances, only: process_instance_t, process_instance_hook_t
use pcm, only: pcm_nlo_t, pcm_nlo_workspace_t
<<Standard module head>>
<<POWHEG matching: public>>
-<<POWHEG matching: parameters>>
-
<<POWHEG matching: types>>
<<POWHEG matching: interfaces>>
interface
<<POWHEG matching: sub interfaces>>
end interface
contains
<<POWHEG matching: main procedures>>
end module powheg_matching
@ %def powheg_matching
@
<<[[powheg_matching_sub.f90]]>>=
<<File header>>
submodule (powheg_matching) powheg_matching_s
<<Use mpi f08>>
<<Use debug>>
use io_units, only: given_output_unit, free_unit
use format_utils, only: write_separator
use format_defs, only: FMT_16, FMT_19
use string_utils, only: str
use numeric_utils
use os_interface, only: os_file_exist
- use physics_defs, only: CA, BORN, NLO_REAL
+ use physics_defs, only: CA, BORN, NLO_REAL, MZ_REF
use pdg_arrays, only: is_gluon, is_quark
use sf_lhapdf, only: alpha_qcd_lhapdf_t
- use sm_physics, only: Li2
+ use sm_physics, only: Li2, coeff_b0, lambda_qcd
use subevents, only: PRT_INCOMING, PRT_OUTGOING
use colors
use process_config, only: COMP_REAL_FIN
implicit none
contains
<<POWHEG matching: procedures>>
end submodule powheg_matching_s
@ %def powheg_matching_s
@
\subsection{Base types for settings and data}
-[[lambda]] enters for now as the lowest scale
-$2 \Lambda^(5)_{\bar{\text{MS}}}$ where the radiation
-$\alpha_s^\text{rad}$ is still larger than the true $\alpha_s$.
+[[lambda]] is the lowest scale $\Lambda^(5)_{\bar{\text{MS}}}$
+where the radiation $\alpha_s^\text{rad}$ is still larger than
+the true $\alpha_s$. We relate $\alpha_s^\text{rad}$ and
+$\alpha_s^\text{true}$ at the scale $2\Lambda^(5)_{\bar{\text{MS}}}$.
<<POWHEG matching: public>>=
public :: powheg_settings_t
<<POWHEG matching: types>>=
type :: powheg_settings_t
real(default) :: pt2_min = zero
real(default) :: lambda = zero
integer :: size_grid_xi = 0
integer :: size_grid_y = 0
integer :: upper_bound_func_type = UBF_FSR_SIMPLE
logical :: test_sudakov = .false.
logical :: disable_sudakov = .false.
logical :: singular_jacobian = .false.
contains
<<POWHEG matching: powheg settings: TBP>>
end type powheg_settings_t
@ %def powheg_settings_t
@
<<POWHEG matching: powheg settings: TBP>>=
procedure :: init => powheg_settings_init
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_settings_init (settings, var_list)
class(powheg_settings_t), intent(out) :: settings
type(var_list_t), intent(in) :: var_list
end subroutine powheg_settings_init
<<POWHEG matching: procedures>>=
module subroutine powheg_settings_init (settings, var_list)
class(powheg_settings_t), intent(out) :: settings
type(var_list_t), intent(in) :: var_list
settings%pt2_min = &
var_list%get_rval (var_str ("powheg_pt_min"))**2
settings%size_grid_xi = &
var_list%get_ival (var_str ("powheg_grid_size_xi"))
settings%size_grid_y = &
var_list%get_ival (var_str ("powheg_grid_size_y"))
settings%lambda = var_list%get_rval (var_str ("powheg_lambda"))
settings%singular_jacobian = &
var_list%get_lval (var_str ("?powheg_use_singular_jacobian"))
settings%test_sudakov = &
var_list%get_lval (var_str ("?powheg_test_sudakov"))
settings%disable_sudakov = &
var_list%get_lval (var_str ("?powheg_disable_sudakov"))
end subroutine powheg_settings_init
@ %def powheg_settings_init
@
<<POWHEG matching: powheg settings: TBP>>=
procedure :: write => powheg_settings_write
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_settings_write (powheg_settings, unit)
class(powheg_settings_t), intent(in) :: powheg_settings
integer, intent(in), optional :: unit
end subroutine powheg_settings_write
<<POWHEG matching: procedures>>=
module subroutine powheg_settings_write (powheg_settings, unit)
class(powheg_settings_t), intent(in) :: powheg_settings
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1X,A)") "POWHEG settings:"
write (u, "(3X,A," // FMT_16 //")") "pt2_min = ", powheg_settings%pt2_min
write (u, "(3X,A," // FMT_16 //")") "lambda = ", powheg_settings%lambda
write (u, "(3X,A,I12)") "size_grid_xi = ", powheg_settings%size_grid_xi
write (u, "(3X,A,I12)") "size_grid_y = ", powheg_settings%size_grid_y
write (u, "(3X,A,I12)") "upper_bound_func_type = ", powheg_settings%upper_bound_func_type
end subroutine powheg_settings_write
@ %def powheg_settings_write
@
<<POWHEG matching: public>>=
public :: radiation_t
<<POWHEG matching: types>>=
type :: radiation_t
real(default) :: xi, y, phi, pt2
integer :: alr
logical :: valid = .false.
contains
<<POWHEG matching: radiation: TBP>>
end type radiation_t
@ %def radiation_t
@
<<POWHEG matching: radiation: TBP>>=
procedure :: write => radiation_write
<<POWHEG matching: sub interfaces>>=
module subroutine radiation_write (radiation, unit)
class(radiation_t), intent(in) :: radiation
integer, intent(in), optional :: unit
end subroutine radiation_write
<<POWHEG matching: procedures>>=
module subroutine radiation_write (radiation, unit)
class(radiation_t), intent(in) :: radiation
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1X, A)") "Radiation:"
write (u, "(3X, A," // FMT_16 // ")") "xi = ", radiation%xi
write (u, "(3X, A," // FMT_16 // ")") "y = ", radiation%y
write (u, "(3X, A," // FMT_16 // ")") "phi = ", radiation%phi
write (u, "(3X, A," // FMT_16 // ")") "pt2 = ", radiation%pt2
write (u, "(3X, A, I12)") "alr = ", radiation%alr
end subroutine radiation_write
@ %def radiation_write
@ [[lambda2_gen]] is the scale used in the (log integrated) upper bounding
-functions. It is not equivalent to [[lambda]] which is the reference
+functions. It is not equivalent to [[lambda5MSB]] which is a reference
scale for the $\alpha_s$ evolution.
<<POWHEG matching: public>>=
public :: process_deps_t
<<POWHEG matching: types>>=
type :: process_deps_t
- real(default) :: lambda2_gen, sqrts
+ real(default) :: lambda2_gen, lambda5MSB, sqrts
integer :: n_alr
integer :: alpha_power, alphas_power
logical :: lab_is_cm = .true.
type(pdf_data_t) :: pdf_data
type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
integer, dimension(:), allocatable :: alr_to_i_phs
integer :: i_term_born
integer, dimension(:), allocatable :: i_term_real
contains
<<POWHEG matching: process deps: TBP>>
end type process_deps_t
@ %def process_deps_t
@
<<POWHEG matching: process deps: TBP>>=
procedure :: write => process_deps_write
<<POWHEG matching: sub interfaces>>=
module subroutine process_deps_write (process_deps, unit)
class(process_deps_t), intent(in) :: process_deps
integer, intent(in), optional :: unit
end subroutine process_deps_write
<<POWHEG matching: procedures>>=
module subroutine process_deps_write (process_deps, unit)
class(process_deps_t), intent(in) :: process_deps
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(1X,A)") "Process dependencies:"
write (u, "(3X,A," // FMT_19 // ")") "lambda2_gen = ", &
process_deps%lambda2_gen
+ write (u, "(3X,A," // FMT_19 // ")") "lambda5MSB = ", &
+ process_deps%lambda5MSB
write (u, "(3X,A, I12)") "n_alr = ", process_deps%n_alr
write (u, "(3X,A, L12)") "lab_is_cm = ", process_deps%lab_is_cm
write (u, "(3X,A, I10)") "alpha_power = ", process_deps%alpha_power
write (u, "(3X,A, I9)") "alphas_power = ", process_deps%alphas_power
write (u, "(3X,A, I10)") "i_term_born = ", process_deps%i_term_born
do i = 1, size(process_deps%i_term_real)
write (u, "(3X,A,I2,A, I6)") "i_term_real(",i,") = ", &
process_deps%i_term_real(i)
end do
call process_deps%pdf_data%write(u)
end subroutine process_deps_write
@ %def process_deps_write
@
<<POWHEG matching: public>>=
public :: event_deps_t
<<POWHEG matching: types>>=
type :: event_deps_t
real(default) :: s_hat
real(default), dimension(2) :: x_born
real(default) :: s_had
type(phs_point_set_t) :: p_born_cms
type(phs_point_set_t) :: p_born_lab
type(phs_point_set_t) :: p_real_cms
type(phs_point_set_t) :: p_real_lab
real(default) :: sqme_born
contains
<<POWHEG matching: event deps: TBP>>
end type event_deps_t
@ %def event_deps_t
@
<<POWHEG matching: event deps: TBP>>=
procedure :: write => event_deps_write
<<POWHEG matching: sub interfaces>>=
module subroutine event_deps_write (event_deps, unit)
class(event_deps_t), intent(in) :: event_deps
integer, intent(in), optional :: unit
end subroutine event_deps_write
<<POWHEG matching: procedures>>=
module subroutine event_deps_write (event_deps, unit)
class(event_deps_t), intent(in) :: event_deps
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1X,A)") "Event dependencies:"
write (u, "(3X,A," // FMT_19 // ")") "s_hat = ", event_deps%s_hat
write (u, "(3X,A," // FMT_19 // ")") "x(+) = ", event_deps%x_born(I_PLUS)
write (u, "(3X,A," // FMT_19 // ")") "x(-) = ", event_deps%x_born(I_MINUS)
write (u, "(3X,A," // FMT_19 // ")") "s_had = ", event_deps%s_had
write (u, "(3X,A," // FMT_19 // ")") "sqme_born = ", event_deps%sqme_born
end subroutine event_deps_write
@ %def event_deps_write
@
<<POWHEG matching: event deps: TBP>>=
procedure :: update => event_deps_update
<<POWHEG matching: sub interfaces>>=
module subroutine event_deps_update (event_deps, sqme_born, &
p_born, x_born, lt_lab_to_cms)
class(event_deps_t), intent(inout) :: event_deps
real(default), intent(in) :: sqme_born
type(vector4_t), dimension(:), intent(in) :: p_born
real(default), dimension(2), intent(in) :: x_born
type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
end subroutine event_deps_update
<<POWHEG matching: procedures>>=
module subroutine event_deps_update (event_deps, sqme_born, &
p_born, x_born, lt_lab_to_cms)
class(event_deps_t), intent(inout) :: event_deps
real(default), intent(in) :: sqme_born
type(vector4_t), dimension(:), intent(in) :: p_born
real(default), dimension(2), intent(in) :: x_born
type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
integer :: n_born
event_deps%sqme_born = sqme_born
n_born = size (p_born)
if (debug_active (D_MATCHING)) then
if (n_born /= event_deps%p_born_lab%get_n_particles (1)) then
call msg_fatal &
("event_deps_update: number of born_momenta has changed")
end if
end if
call event_deps%p_born_lab%set_momenta (1, p_born)
call event_deps%set_cms (lt_lab_to_cms)
event_deps%x_born = x_born
event_deps%s_had = event_deps%s_hat / ( x_born(I_PLUS) * x_born(I_MINUS) )
end subroutine event_deps_update
@ %def event_deps_update
@ Sets the Born momenta in the CMS boosting them if necessary.
<<POWHEG matching: event deps: TBP>>=
procedure :: set_cms => event_deps_set_cms
<<POWHEG matching: sub interfaces>>=
module subroutine event_deps_set_cms (event_deps, lt_lab_to_cms)
class(event_deps_t), intent(inout) :: event_deps
type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
end subroutine event_deps_set_cms
<<POWHEG matching: procedures>>=
module subroutine event_deps_set_cms (event_deps, lt_lab_to_cms)
class(event_deps_t), intent(inout) :: event_deps
type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
associate (pp => event_deps%p_born_lab%phs_point(1))
event_deps%s_hat = pp%get_msq ([1,2])
if (present (lt_lab_to_cms)) then
event_deps%p_born_cms%phs_point(1) = lt_lab_to_cms * pp
else
event_deps%p_born_cms%phs_point(1) = pp
end if
end associate
end subroutine event_deps_set_cms
@ %def event_deps_set_cms
@
<<POWHEG matching: types>>=
type :: veto_counter_t
integer :: n_ubf = 0
- integer :: n_first_fail = 0
- integer :: n_alpha_s = 0
integer :: n_xi_max = 0
integer :: n_norm = 0
integer :: n_sqme = 0
integer :: n_veto_ubf = 0
- integer :: n_veto_alpha_s = 0
integer :: n_veto_xi_max = 0
integer :: n_veto_norm = 0
integer :: n_veto_sqme = 0
integer :: n_fail_ubf = 0
contains
<<POWHEG matching: veto counter: TBP>>
end type veto_counter_t
@ %def veto_counter_t
@
<<POWHEG matching: veto counter: TBP>>=
procedure :: record_ubf => veto_counter_record_ubf
<<POWHEG matching: sub interfaces>>=
pure module subroutine veto_counter_record_ubf (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
end subroutine veto_counter_record_ubf
<<POWHEG matching: procedures>>=
pure module subroutine veto_counter_record_ubf (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
counter%n_ubf = counter%n_ubf + 1
if (vetoed) counter%n_veto_ubf = counter%n_veto_ubf + 1
end subroutine veto_counter_record_ubf
@ %def veto_counter_record_ubf
@
<<POWHEG matching: veto counter: TBP>>=
- procedure :: record_first_fail => veto_counter_record_first_fail
-<<POWHEG matching: sub interfaces>>=
- module subroutine veto_counter_record_first_fail (counter)
- class(veto_counter_t), intent(inout) :: counter
- end subroutine veto_counter_record_first_fail
-<<POWHEG matching: procedures>>=
- module subroutine veto_counter_record_first_fail (counter)
- class(veto_counter_t), intent(inout) :: counter
- counter%n_first_fail = counter%n_first_fail + 1
- end subroutine veto_counter_record_first_fail
-
-@ %def veto_counter_record_first_fail
-@
-<<POWHEG matching: veto counter: TBP>>=
- procedure :: record_alpha_s => veto_counter_record_alpha_s
-<<POWHEG matching: sub interfaces>>=
- module subroutine veto_counter_record_alpha_s (counter, vetoed)
- class(veto_counter_t), intent(inout) :: counter
- logical, intent(in) :: vetoed
- end subroutine veto_counter_record_alpha_s
-<<POWHEG matching: procedures>>=
- module subroutine veto_counter_record_alpha_s (counter, vetoed)
- class(veto_counter_t), intent(inout) :: counter
- logical, intent(in) :: vetoed
- counter%n_alpha_s = counter%n_alpha_s + 1
- if (vetoed) counter%n_veto_alpha_s = counter%n_veto_alpha_s + 1
- end subroutine veto_counter_record_alpha_s
-
-@ %def veto_counter_record_alpha_s
-@
-<<POWHEG matching: veto counter: TBP>>=
procedure :: record_xi_max => veto_counter_record_xi_max
<<POWHEG matching: sub interfaces>>=
module subroutine veto_counter_record_xi_max (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
end subroutine veto_counter_record_xi_max
<<POWHEG matching: procedures>>=
module subroutine veto_counter_record_xi_max (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
counter%n_xi_max = counter%n_xi_max + 1
if (vetoed) counter%n_veto_xi_max = counter%n_veto_xi_max + 1
end subroutine veto_counter_record_xi_max
@ %def veto_counter_record_xi_max
@
<<POWHEG matching: veto counter: TBP>>=
procedure :: record_norm => veto_counter_record_norm
<<POWHEG matching: sub interfaces>>=
module subroutine veto_counter_record_norm (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
end subroutine veto_counter_record_norm
<<POWHEG matching: procedures>>=
module subroutine veto_counter_record_norm (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
counter%n_norm = counter%n_norm + 1
if (vetoed) counter%n_veto_norm = counter%n_veto_norm + 1
end subroutine veto_counter_record_norm
@ %def veto_counter_record_norm
@
<<POWHEG matching: veto counter: TBP>>=
procedure :: record_sqme => veto_counter_record_sqme
<<POWHEG matching: sub interfaces>>=
module subroutine veto_counter_record_sqme (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
end subroutine veto_counter_record_sqme
<<POWHEG matching: procedures>>=
module subroutine veto_counter_record_sqme (counter, vetoed)
class(veto_counter_t), intent(inout) :: counter
logical, intent(in) :: vetoed
counter%n_sqme = counter%n_sqme + 1
if (vetoed) counter%n_veto_sqme = counter%n_veto_sqme + 1
end subroutine veto_counter_record_sqme
@ %def veto_counter_record_sqme
@
<<POWHEG matching: veto counter: TBP>>=
procedure :: record_ubf_fail => veto_counter_record_ubf_fail
<<POWHEG matching: sub interfaces>>=
module subroutine veto_counter_record_ubf_fail (counter)
class(veto_counter_t), intent(inout) :: counter
end subroutine veto_counter_record_ubf_fail
<<POWHEG matching: procedures>>=
module subroutine veto_counter_record_ubf_fail (counter)
class(veto_counter_t), intent(inout) :: counter
counter%n_fail_ubf = counter%n_fail_ubf + 1
end subroutine veto_counter_record_ubf_fail
@ %def veto_counter_record_ubf_fail
@ This routine fills the POWHEG veto log file with content showing how many
events have been vetoed in which step of the sudakov veto algorithm.
<<POWHEG matching: veto counter: TBP>>=
procedure :: write => veto_counter_write
<<POWHEG matching: sub interfaces>>=
module subroutine veto_counter_write (counter, unit)
class(veto_counter_t), intent(in) :: counter
integer, intent(in), optional :: unit
end subroutine veto_counter_write
<<POWHEG matching: procedures>>=
module subroutine veto_counter_write (counter, unit)
class(veto_counter_t), intent(in) :: counter
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(A29,I10)") "Nr. of ubf-veto calls: ", counter%n_ubf
write (u, "(A29,I10)") "Nr. of ubf-vetos: ", counter%n_veto_ubf
if (counter%n_ubf > 0) &
write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
one * counter%n_veto_ubf / counter%n_ubf * 100, "%"
call write_separator (u)
- write (u, "(A29,I10)") "Nr. of alpha_s-veto calls: ", counter%n_alpha_s
- write (u, "(A29,I10)") "Nr. of alpha_s-vetos: ", counter%n_veto_alpha_s
- if (counter%n_alpha_s > 0) &
- write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
- one * counter%n_veto_alpha_s / counter%n_alpha_s * 100, "%"
- call write_separator (u)
-
write (u, "(A29,I10)") "Nr. of xi_max-veto calls: ", counter%n_xi_max
write (u, "(A29,I10)") "Nr. of xi_max-vetos: ", counter%n_veto_xi_max
- if (counter%n_alpha_s > 0) &
+ if (counter%n_xi_max > 0) &
write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
one * counter%n_veto_xi_max / counter%n_xi_max * 100, "%"
call write_separator (u)
write (u, "(A29,I10)") "Nr. of norm-veto calls: ", counter%n_norm
write (u, "(A29,I10)") "Nr. of norm-vetos: ", counter%n_veto_norm
if (counter%n_norm > 0) &
write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
one * counter%n_veto_norm / counter%n_norm * 100, "%"
call write_separator (u)
write (u, "(A29,I10)") "Nr. of sqme-veto calls: ", counter%n_sqme
write (u, "(A29,I10)") "Nr. of sqme-vetos: ", counter%n_veto_sqme
if (counter%n_sqme > 0) &
write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
one * counter%n_veto_sqme / counter%n_sqme * 100, "%"
call write_separator (u)
write (u, "(A29,I10)") "Nr. of upper-bound failures: ", &
counter%n_fail_ubf
if (counter%n_sqme > 0) &
write (u, "(A29,F9.2,A1)") "Fraction of failed points: ", &
one * counter%n_fail_ubf / counter%n_sqme * 100, "%"
end subroutine veto_counter_write
@ %def veto_counter_write
@
\subsection{Upper bounding functions and [[sudakov]]s}
\subsubsection{Abstract version}
This contains the pieces that depend on the radiation region $\alpha_r$
<<POWHEG matching: public>>=
public :: sudakov_t
<<POWHEG matching: types>>=
type, abstract, extends (solver_function_t) :: sudakov_t
type(process_deps_t), pointer :: process_deps => null()
type(event_deps_t), pointer :: event_deps => null()
type(powheg_settings_t), pointer :: powheg_settings => null()
type(phs_fks_generator_t), pointer :: phs_fks_generator => null()
type(qcd_t) :: qcd
class(rng_t), pointer :: rng => null()
real(default) :: xi2_max = zero
real(default) :: norm_max = zero
real(default) :: current_pt2_max = zero
real(default) :: sum_log_rands = zero
real(default) :: random = zero
type(veto_counter_t) :: veto_counter
integer :: i_phs = 0
contains
<<POWHEG matching: sudakov: TBP>>
end type sudakov_t
@ %def sudakov_t
@
<<POWHEG matching: sudakov: TBP>>=
procedure :: write => sudakov_write
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_write (sudakov, unit)
class(sudakov_t), intent(in) :: sudakov
integer, intent(in), optional :: unit
end subroutine sudakov_write
<<POWHEG matching: procedures>>=
module subroutine sudakov_write (sudakov, unit)
class(sudakov_t), intent(in) :: sudakov
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(3X,A," // FMT_19 // ")") "xi2_max = ", sudakov%xi2_max
write (u, "(3X,A," // FMT_19 // ")") "norm_max = ", sudakov%norm_max
write (u, "(3X,A," // FMT_19 // ")") &
"current_pt2_max = ", sudakov%current_pt2_max
write (u, "(3X,A," // FMT_19 // ")") "sum_log_rands = ", sudakov%sum_log_rands
write (u, "(3X,A," // FMT_19 // ")") "random = ", sudakov%random
end subroutine sudakov_write
@ %def sudakov_write
@ To allow for arrays of this class
<<POWHEG matching: public>>=
public :: sudakov_wrapper_t
<<POWHEG matching: types>>=
type :: sudakov_wrapper_t
class(sudakov_t), allocatable :: s
end type sudakov_wrapper_t
@ %def sudakov_wrapper_t
@
<<POWHEG matching: sudakov: TBP>>=
procedure :: init => sudakov_init
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_init (sudakov, process_deps, event_deps, &
powheg_settings, qcd, phs_fks_generator, rng)
class(sudakov_t), intent(out) :: sudakov
type(process_deps_t), target, intent(in) :: process_deps
type(event_deps_t), target, intent(in) :: event_deps
type(powheg_settings_t), target, intent(in) :: powheg_settings
type(qcd_t), intent(in) :: qcd
type(phs_fks_generator_t), target, intent(in) :: phs_fks_generator
class(rng_t), target, intent(in), optional :: rng
end subroutine sudakov_init
<<POWHEG matching: procedures>>=
module subroutine sudakov_init (sudakov, process_deps, event_deps, &
powheg_settings, qcd, phs_fks_generator, rng)
class(sudakov_t), intent(out) :: sudakov
type(process_deps_t), target, intent(in) :: process_deps
type(event_deps_t), target, intent(in) :: event_deps
type(powheg_settings_t), target, intent(in) :: powheg_settings
type(qcd_t), intent(in) :: qcd
type(phs_fks_generator_t), target, intent(in) :: phs_fks_generator
class(rng_t), target, intent(in), optional :: rng
sudakov%process_deps => process_deps
sudakov%event_deps => event_deps
sudakov%powheg_settings => powheg_settings
sudakov%qcd = qcd
sudakov%phs_fks_generator => phs_fks_generator
if (present (rng)) sudakov%rng => rng
end subroutine sudakov_init
@ %def sudakov_init
@ This has to be done after the grids are initialized.
<<POWHEG matching: sudakov: TBP>>=
procedure :: set_normalization => sudakov_set_normalization
<<POWHEG matching: sub interfaces>>=
pure module subroutine sudakov_set_normalization (sudakov, norm_max)
class(sudakov_t), intent(inout) :: sudakov
real(default), intent(in) :: norm_max
end subroutine sudakov_set_normalization
<<POWHEG matching: procedures>>=
pure module subroutine sudakov_set_normalization (sudakov, norm_max)
class(sudakov_t), intent(inout) :: sudakov
real(default), intent(in) :: norm_max
sudakov%norm_max = norm_max
end subroutine sudakov_set_normalization
@ %def sudakov_set_normalization
@
<<POWHEG matching: sudakov: TBP>>=
procedure :: update_xi2_max => sudakov_update_xi2_max
<<POWHEG matching: sub interfaces>>=
pure module subroutine sudakov_update_xi2_max (sudakov, xi2_max)
class(sudakov_t), intent(inout) :: sudakov
real(default), intent(in) :: xi2_max
end subroutine sudakov_update_xi2_max
<<POWHEG matching: procedures>>=
pure module subroutine sudakov_update_xi2_max (sudakov, xi2_max)
class(sudakov_t), intent(inout) :: sudakov
real(default), intent(in) :: xi2_max
sudakov%xi2_max = xi2_max
end subroutine sudakov_update_xi2_max
@ %def sudakov_update_xi2_max
@ [[upper_bound_func]] does \emph{not} contain the normalization $N$
which is given by the grids. In the notation of [[1002.2581]], it is
thus $\frac 1 N U(\xi,y)$
<<POWHEG matching: sudakov: TBP>>=
procedure (sudakov_upper_bound_func), deferred :: upper_bound_func
<<POWHEG matching: interfaces>>=
abstract interface
pure function sudakov_upper_bound_func (sudakov, xi, y, alpha_s) result (u)
import
real(default) :: u
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
end function sudakov_upper_bound_func
end interface
@ %def sudakov_upper_bound_func
@ Similar to the [[upper_bound_func]], this is
$-\frac 1 N \log\Delta(p_T^2)$ where
\begin{equation}
- \Delta^{(U)} (p_T) = \exp\left[-\int U(\xi,y)\theta(k_T - p_T) \; d\xi \, dy \, d\phi \right]
+ \Delta^{(U)} (p_T) = \exp\left[-N \int U(\xi,y)\theta(k_T - p_T) \; d\xi \, dy \, d\phi \right]
\end{equation}
<<POWHEG matching: sudakov: TBP>>=
procedure (sudakov_log_integrated_ubf), deferred :: log_integrated_ubf
<<POWHEG matching: interfaces>>=
abstract interface
pure function sudakov_log_integrated_ubf (sudakov, pt2) result (y)
import
real(default) :: y
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_log_integrated_ubf
end interface
@ %def sudakov_log_integrated_ubf
@
<<POWHEG matching: sudakov: TBP>>=
procedure (sudakov_generate_xi_and_y_and_phi), deferred :: generate_xi_and_y_and_phi
<<POWHEG matching: interfaces>>=
abstract interface
subroutine sudakov_generate_xi_and_y_and_phi (sudakov, r)
import
class(sudakov_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_generate_xi_and_y_and_phi
end interface
@ %def sudakov_generate_xi_and_y_and_phi
@ Generating $\phi$ can be performed in a generic way for all UBF types.
<<POWHEG matching: sudakov: TBP>>=
procedure :: generate_phi => sudakov_generate_phi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_generate_phi (sudakov, r)
class(sudakov_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_generate_phi
<<POWHEG matching: procedures>>=
module subroutine sudakov_generate_phi (sudakov, r)
class(sudakov_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
call sudakov%rng%generate (sudakov%random)
r%phi = sudakov%random * twopi
end subroutine sudakov_generate_phi
@ %def sudakov_generate_phi
@
<<POWHEG matching: sudakov: TBP>>=
procedure (sudakov_kt2), deferred :: kt2
<<POWHEG matching: interfaces>>=
abstract interface
function sudakov_kt2 (sudakov, xi, y) result (kt2)
import
real(default) :: kt2
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
end function sudakov_kt2
end interface
@ %def sudakov_kt2
@
<<POWHEG matching: sudakov: TBP>>=
procedure (sudakov_kt2_max), deferred :: kt2_max
<<POWHEG matching: interfaces>>=
abstract interface
pure function sudakov_kt2_max (sudakov) result (kt2_max)
import
real(default) :: kt2_max
class(sudakov_t), intent(in) :: sudakov
end function sudakov_kt2_max
end interface
@ %def sudakov_kt2_max
@ Veto routine for an overestimation of the UBF
performed to simplify the log integrated UBF
<<POWHEG matching: sudakov: TBP>>=
procedure (sudakov_reweight_ubf), deferred :: reweight_ubf
<<POWHEG matching: interfaces>>=
abstract interface
function sudakov_reweight_ubf (sudakov, pt2) result (accepted)
import
logical :: accepted
class(sudakov_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_reweight_ubf
end interface
@ %def sudakov_reweight_ubf
@ Veto routine to correct for an overestimation of $\xi_\text{max}$
performed in the case of massive emitters.
<<POWHEG matching: sudakov: TBP>>=
procedure (sudakov_reweight_xi_max), deferred :: reweight_xi_max
<<POWHEG matching: interfaces>>=
abstract interface
function sudakov_reweight_xi_max (sudakov, xi) result (accepted)
import
logical :: accepted
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: xi
end function sudakov_reweight_xi_max
end interface
@ %def sudakov_reweight_xi_max
@ In the generation of $p_T^2$ via [[log_integrated_ubf]], we use the
simplified version $\alpha_s^\text{rad}$ while the grids take the
improved version.
<<POWHEG matching: sudakov: TBP>>=
procedure :: alpha_s => sudakov_alpha_s
<<POWHEG matching: sub interfaces>>=
- module function sudakov_alpha_s (sudakov, kT2, use_correct) result (a)
+ module function sudakov_alpha_s (sudakov, kT2, use_correct, improve_nll) result (a)
real(default) :: a
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: kT2
- logical, intent(in), optional :: use_correct
+ logical, intent(in), optional :: use_correct, improve_nll
end function sudakov_alpha_s
<<POWHEG matching: procedures>>=
- module function sudakov_alpha_s (sudakov, kT2, use_correct) result (a)
+ module function sudakov_alpha_s (sudakov, kT2, use_correct, improve_nll) result (a)
real(default) :: a
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: kT2
- logical, intent(in), optional :: use_correct
- logical :: yorn
- yorn = .false.; if (present (use_correct)) yorn = use_correct
- if (yorn) then
- a = get_alpha_s (sudakov%qcd, kT2)
+ logical, intent(in), optional :: use_correct, improve_nll
+ logical :: correct, nll
+ correct = .false.; if (present (use_correct)) correct = use_correct
+ nll = .true.; if (present(improve_nll)) nll = improve_nll
+ if (correct) then
+ a = get_alpha_s (sudakov%qcd, kT2, improve_nll_opt=nll)
else
a = sudakov%alpha_s_rad (kT2)
end if
end function sudakov_alpha_s
@ %def sudakov_alpha_s
@ To generate the transverse momentum, we have to solve the equation
\begin{equation*}
\frac{\Delta^{(U)}(p_T)}{\Delta^{(U)}(p_T^{\mathrm{max}})} = r_1
\end{equation*}
iteratively for $p_T$.
In log space and with initially $\Delta^{(U)}(p_T^{\mathrm{max}}) = 1$, this is
\begin{equation*}
\log\Delta^{(U)}(p_T) = \log r_1
\end{equation*}
If no solution is found, we set $p_T = p_T^{\mathrm{min}}$ to exit the event
generation loop and generate an emissionless event.
If a solution is found but the current emission is not accepted,
we set $p_T = p_T^{\mathrm{max}}$ and thus
in the next step it is $\Delta^{(U)}(p_T^{\mathrm{max}}) = r_1$,
so that we have to solve the equation
\begin{equation*}
\log\Delta^{(U)}(p_T) = \log r_1 + \log r_2
\end{equation*}
using another random number $r_2$. We use [[sum_log_rands]] to remember
the sum of the logarithms of all previous random numbers used for this event.
<<POWHEG matching: sudakov: TBP>>=
procedure :: generate_pt2 => sudakov_generate_pt2
<<POWHEG matching: sub interfaces>>=
module function sudakov_generate_pt2 (sudakov) result (pt2)
real(default) :: pt2
class(sudakov_t), intent(inout) :: sudakov
end function sudakov_generate_pt2
<<POWHEG matching: procedures>>=
module function sudakov_generate_pt2 (sudakov) result (pt2)
real(default) :: pt2
class(sudakov_t), intent(inout) :: sudakov
logical :: success
success = .false.
if (sudakov%current_pt2_max > sudakov%powheg_settings%pt2_min) then
call sudakov%rng%generate (sudakov%random)
sudakov%sum_log_rands = sudakov%sum_log_rands + log(sudakov%random)
pt2 = solve_interval (sudakov, &
sudakov%powheg_settings%pt2_min, &
sudakov%current_pt2_max, success, &
0.001_default)
end if
if (.not. success) then
pt2 = sudakov%powheg_settings%pt2_min
end if
end function sudakov_generate_pt2
@ %def sudakov_generate_pt2
@ This could be activated [[if (debug_active (MATCHING))]].
<<POWHEG matching: sudakov: TBP>>=
procedure :: check_solution_interval => sudakov_check_solution_interval
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_check_solution_interval (sudakov)
class(sudakov_t), intent(inout) :: sudakov
end subroutine sudakov_check_solution_interval
<<POWHEG matching: procedures>>=
module subroutine sudakov_check_solution_interval (sudakov)
class(sudakov_t), intent(inout) :: sudakov
real(default) :: r
real(default), parameter :: dr = 0.05
real(default) :: pt2
logical :: success
r = 0._default
do
r = r + dr
sudakov%random = r
pt2 = solve_interval (sudakov, &
sudakov%powheg_settings%pt2_min, &
sudakov%current_pt2_max, success, &
0.001_default)
if (success) then
print *, 'r: ', r, ' zero found'
else
print *, 'r: ', r, 'no zero found'
end if
if (r >= 1._default) exit
end do
end subroutine sudakov_check_solution_interval
@ %def sudakov_check_solution_interval
@ Generates the FKS variables $(\xi, y,\phi)$ and sets the emission hardness scale.
In debug mode, we assert that the [[pt2]] saved in the [[radiation_t]]
and the massive hardness scale are equal.
This should hold as we compute [[kt2]] with the [[y]] we got from generating
[[pt2]] so that this is a full circle.
It then initiates the generation of the transverse momentum followed by
a sequence of veto steps to get the correct distribution.
<<POWHEG matching: sudakov: TBP>>=
procedure :: generate_emission => sudakov_generate_emission
<<POWHEG matching: sub interfaces>>=
- module subroutine sudakov_generate_emission (sudakov, r)
+ module subroutine sudakov_generate_emission (sudakov, r, r_max)
class(sudakov_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
+ type(radiation_t), intent(in) :: r_max
end subroutine sudakov_generate_emission
<<POWHEG matching: procedures>>=
- module subroutine sudakov_generate_emission (sudakov, r)
+ module subroutine sudakov_generate_emission (sudakov, r, r_max)
class(sudakov_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
+ type(radiation_t), intent(in) :: r_max
logical :: accepted
sudakov%current_pt2_max = r%pt2
if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_generate_emission")
if (debug_on) call msg_debug2 (D_MATCHING, "sqrt (sudakov%current_pt2_max)", &
sqrt (sudakov%current_pt2_max))
if (debug_on) call msg_debug2 (D_MATCHING, "sudakov%sum_log_rands", sudakov%sum_log_rands)
LOOP_UNTIL_ACCEPTED: do
if (signal_is_pending ()) return
r%valid = .false.
r%pt2 = sudakov%generate_pt2 ()
if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_generate_emission: after generate_pt2")
if (debug_on) call msg_debug2 (D_MATCHING, "sqrt (r%pt2)", sqrt (r%pt2))
if (debug_on) call msg_debug2 (D_MATCHING, "sudakov%sum_log_rands", sudakov%sum_log_rands)
- if (r%pt2 <= sudakov%powheg_settings%pt2_min) then
+ if (r%pt2 <= sudakov%powheg_settings%pt2_min .or. r%pt2 <= r_max%pt2) then
exit
end if
accepted = sudakov%reweight_ubf (r%pt2)
call sudakov%veto_counter%record_ubf (.not. accepted)
if (.not. accepted) then
sudakov%current_pt2_max = r%pt2
cycle
end if
- accepted = sudakov%reweight_alpha_s (r%pt2)
- call sudakov%veto_counter%record_alpha_s (.not. accepted)
- if (.not. accepted) then
- sudakov%current_pt2_max = r%pt2
- cycle
- end if
call sudakov%generate_xi_and_y_and_phi (r)
accepted = sudakov%reweight_xi_max (r%xi)
call sudakov%veto_counter%record_xi_max (.not. accepted)
if (.not. accepted) then
sudakov%current_pt2_max = r%pt2
cycle
end if
if (debug_active (D_MATCHING)) then
call assert_equal (OUTPUT_UNIT, r%pt2, &
sudakov%kt2 (r%xi, r%y), &
"sudakov_generate_xi_and_y_and_phi: pt2 inconsistency")
end if
r%valid = .true.
exit
end do LOOP_UNTIL_ACCEPTED
end subroutine sudakov_generate_emission
@ %def sudakov_generate_emission
@ Evaluates the Sudakov as needed for [[solve_interval]] to generate a $p_T$ value.
<<POWHEG matching: sudakov: TBP>>=
procedure :: evaluate => sudakov_evaluate
<<POWHEG matching: sub interfaces>>=
module function sudakov_evaluate (solver_f, x) result (f)
complex(default) :: f
class(sudakov_t), intent(in) :: solver_f
real(default), intent(in) :: x
end function sudakov_evaluate
<<POWHEG matching: procedures>>=
module function sudakov_evaluate (solver_f, x) result (f)
complex(default) :: f
class(sudakov_t), intent(in) :: solver_f
real(default), intent(in) :: x
f = solver_f%sum_log_rands + &
solver_f%norm_max * solver_f%log_integrated_ubf (x)
end function sudakov_evaluate
@ %def sudakov_evaluate
@
<<POWHEG matching: sudakov: TBP>>=
procedure :: associated_emitter => sudakov_associated_emitter
<<POWHEG matching: sub interfaces>>=
elemental module function sudakov_associated_emitter &
(sudakov) result (emitter)
integer :: emitter
class(sudakov_t), intent(in) :: sudakov
end function sudakov_associated_emitter
<<POWHEG matching: procedures>>=
elemental module function sudakov_associated_emitter &
(sudakov) result (emitter)
integer :: emitter
class(sudakov_t), intent(in) :: sudakov
emitter = sudakov%process_deps%phs_identifiers(sudakov%i_phs)%emitter
end function sudakov_associated_emitter
@ %def sudakov_associated_emitter
@
<<POWHEG matching: sudakov: TBP>>=
procedure :: set_i_phs => sudakov_set_i_phs
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_set_i_phs (sudakov, alr)
class(sudakov_t), intent(inout) :: sudakov
integer, intent(in) :: alr
end subroutine sudakov_set_i_phs
<<POWHEG matching: procedures>>=
module subroutine sudakov_set_i_phs (sudakov, alr)
class(sudakov_t), intent(inout) :: sudakov
integer, intent(in) :: alr
sudakov%i_phs = sudakov%process_deps%alr_to_i_phs(alr)
end subroutine sudakov_set_i_phs
@ %def sudakov_set_i_phs
@
\subsubsection{Simple FSR}
This corresponds to Appendix C of [[1002.2581]].
<<POWHEG matching: public>>=
public :: sudakov_simple_fsr_t
<<POWHEG matching: types>>=
type, extends (sudakov_t) :: sudakov_simple_fsr_t
contains
<<POWHEG matching: sudakov simple fsr: TBP>>
end type sudakov_simple_fsr_t
@ %def sudakov_simple_fsr_t
@ The simplest upper bounding function for final-state radiation is
\begin{equation}
\mathtt{upper\_bound\_func} = \frac {U(\xi,y)} N
= \frac {\alpha_s}{\xi (1-y)}
\end{equation}
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: upper_bound_func => sudakov_simple_fsr_upper_bound_func
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_simple_fsr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
end function sudakov_simple_fsr_upper_bound_func
<<POWHEG matching: procedures>>=
pure module function sudakov_simple_fsr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
u = alpha_s / (xi * (1 - y))
end function sudakov_simple_fsr_upper_bound_func
@ %def sudakov_simple_fsr_upper_bound_func
@ The above upper bounding function corresponds to the transverse momentum scale
\begin{equation}
k_T^2 = \frac{s}{2} \xi^2 (1-y).
\end{equation}
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: kt2 => sudakov_simple_fsr_kt2
<<POWHEG matching: sub interfaces>>=
module function sudakov_simple_fsr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
end function sudakov_simple_fsr_kt2
<<POWHEG matching: procedures>>=
module function sudakov_simple_fsr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
(sudakov%i_phs, sudakov%associated_emitter (), UBF_FSR_SIMPLE, xi, y)
end function sudakov_simple_fsr_kt2
@ %def sudakov_simple_fsr_kt2
@ For massless emitters, the upper bound on the radiated energy is
\begin{equation*}
t_{\mathrm{max}} = \xi_{\mathrm{max}}^2 \hat{s}
\end{equation*}
We use this as largest possible scale for the radiation.
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: kt2_max => sudakov_simple_fsr_kt2_max
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_simple_fsr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_simple_fsr_t), intent(in) :: sudakov
end function sudakov_simple_fsr_kt2_max
<<POWHEG matching: procedures>>=
pure module function sudakov_simple_fsr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default) :: s_hat
s_hat = sudakov%event_deps%s_hat
kt2_max = sudakov%xi2_max * s_hat
end function sudakov_simple_fsr_kt2_max
@ %def sudakov_simple_fsr_kt2_max
@ This is
\begin{equation}
- \frac{\log{\Delta^{(U)}}(p_T)}{N} =
\frac\pi{b_0} \theta\left(\xi_\text{max}^2-\frac{p_T^2}s\right)
\left[\log{\frac{\xi^2_\text{max}s}{\Lambda^2}}
\log{\frac{\log{{\xi^2_\text{max}s}/{\Lambda^2}}}
{\log{p_T^2/\Lambda^2}}} -
\log{\frac{\xi^2_\text{max}s}{p_T^2}}\right]
\end{equation}
with $p_\text{T,max}^2=\xi_\text{max}^2 s$.
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: log_integrated_ubf => sudakov_simple_fsr_log_integrated_ubf
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_simple_fsr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_simple_fsr_log_integrated_ubf
<<POWHEG matching: procedures>>=
pure module function sudakov_simple_fsr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
real(default) :: kt2_max, kt2_maxl, pt2l
logical :: within_boundaries
within_boundaries = pt2 <= sudakov%kt2_max () &
.and. pt2 >= sudakov%powheg_settings%pt2_min
if (within_boundaries) then
kt2_max = sudakov%kt2_max ()
kt2_maxl = kt2_max / sudakov%process_deps%lambda2_gen
pt2l = pt2 / sudakov%process_deps%lambda2_gen
- log_sudakov = pi / b0rad * (log (kt2_maxl) * &
+ log_sudakov = pi / b0rad () * (log (kt2_maxl) * &
log (log (kt2_maxl) / log (pt2l)) - &
log (kt2_max / pt2))
else
log_sudakov = 0
end if
end function sudakov_simple_fsr_log_integrated_ubf
@ %def sudakov_simple_fsr_log_integrated_ubf
-@ No further veto needed for this upper bounding function.
+@ For this upper bounding function, we just overestimated $\alpha_s$.
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: reweight_ubf => sudakov_simple_fsr_reweight_ubf
<<POWHEG matching: sub interfaces>>=
module function sudakov_simple_fsr_reweight_ubf &
(sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_simple_fsr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
+ real(default) :: alpha_s_true, alpha_s_rad
+ logical :: alpha_s_equal
end function sudakov_simple_fsr_reweight_ubf
<<POWHEG matching: procedures>>=
module function sudakov_simple_fsr_reweight_ubf &
(sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_simple_fsr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
- accepted = .true.
+ real(default) :: alpha_s_true, alpha_s_rad
+ logical :: alpha_s_equal
+ if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_simple_fsr_reweight_ubf")
+ alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
+ alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
+ call sudakov%rng%generate (sudakov%random)
+ alpha_s_equal = nearly_equal (alpha_s_true, alpha_s_rad)
+ accepted = alpha_s_equal .or. sudakov%random < alpha_s_true / alpha_s_rad
+ if (debug2_active (D_MATCHING)) then
+ print *, ' sqrt(pt2) = ', sqrt(pt2)
+ print *, ' alpha_s_true = ', alpha_s_true
+ print *, ' sudakov%process_deps%lambda2_gen = ', &
+ sudakov%process_deps%lambda2_gen
+ print *, ' alpha_s_rad = ', alpha_s_rad
+ print *, ' sudakov%random = ', sudakov%random
+ print *, ' accepted = ', accepted
+ if (alpha_s_rad < alpha_s_true .and. .not. alpha_s_equal) then
+ call msg_fatal ("sudakov_simple_fsr_reweight_ubf: &
+ &This should never happen. &
+ &Have you chosen a running alpha_s?")
+ end if
+ end if
end function sudakov_simple_fsr_reweight_ubf
@ %def sudakov_simple_fsr_reweight_ubf
@
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: reweight_xi_max => sudakov_simple_fsr_reweight_xi_max
<<POWHEG matching: sub interfaces>>=
module function sudakov_simple_fsr_reweight_xi_max &
(sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
end function sudakov_simple_fsr_reweight_xi_max
<<POWHEG matching: procedures>>=
module function sudakov_simple_fsr_reweight_xi_max &
(sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_simple_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
accepted = .true.
end function sudakov_simple_fsr_reweight_xi_max
@ %def sudakov_simple_fsr_reweight_xi_max
@ This depends on the choice of $p_T$ and is tested in the assertion.
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: generate_xi_and_y_and_phi => &
sudakov_simple_fsr_generate_xi_and_y_and_phi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_simple_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi
<<POWHEG matching: procedures>>=
module subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_simple_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: s
s = sudakov%event_deps%s_hat
call sudakov%generate_xi (r)
r%y = one - (two * r%pt2) / (s * r%xi**2)
call sudakov%generate_phi (r)
end subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi
@ %def sudakov_generate_xi_and_y_and_phi
@ We generate $\xi \in [\frac{p_\text{T}}{\sqrt{s}}, \xi_\text{max}]$
with a density $1 / \xi$ i.e. uniformly in $\log(\xi)$.
<<POWHEG matching: sudakov simple fsr: TBP>>=
procedure :: generate_xi => sudakov_simple_fsr_generate_xi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_simple_fsr_generate_xi (sudakov, r)
class(sudakov_simple_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_simple_fsr_generate_xi
<<POWHEG matching: procedures>>=
module subroutine sudakov_simple_fsr_generate_xi (sudakov, r)
class(sudakov_simple_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: s, xi2_max
s = sudakov%event_deps%s_hat
xi2_max = sudakov%xi2_max
call sudakov%rng%generate (sudakov%random)
r%xi = exp (((one - sudakov%random) * log (r%pt2 / s) + &
sudakov%random * log (xi2_max)) / two)
end subroutine sudakov_simple_fsr_generate_xi
@ %def sudakov_simple_fsr_generate_xi
@
\subsubsection{Dijet production at lepton colliders}
In the POWHEG method paper, $e^+e^-\to q\bar{q}$ requires a UBF different
from the simple one to account for an additional divergence for $(\xi,y) \to (1,-1)$.
<<POWHEG matching: public>>=
public :: sudakov_eeqq_fsr_t
<<POWHEG matching: types>>=
type, extends (sudakov_t) :: sudakov_eeqq_fsr_t
contains
<<POWHEG matching: sudakov eeqq fsr: TBP>>
end type sudakov_eeqq_fsr_t
@ %def sudakov_eeqq_fsr_t
@ This $k_T$ measure is the same as in the case for simple FSR up to
$\mathcal{O}(\theta^4)$ when $y=\cos(\theta)$. It differs by just a factor
of $2$ w.r.t. [[sudakov_simple_fsr_kt2]].
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: kt2 => sudakov_eeqq_fsr_kt2
<<POWHEG matching: sub interfaces>>=
module function sudakov_eeqq_fsr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
end function sudakov_eeqq_fsr_kt2
<<POWHEG matching: procedures>>=
module function sudakov_eeqq_fsr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
(sudakov%i_phs, sudakov%associated_emitter(), &
UBF_FSR_MASSLESS_RECOIL, xi, y)
end function sudakov_eeqq_fsr_kt2
@ %def sudakov_eeqq_fsr_kt2
@ For [[eeqq]], the shower starts at $k_\text{max} = \frac{q^0}{2}$.
(c.f. eq. (7.86) in [0709.2092].)
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: kt2_max => sudakov_eeqq_fsr_kt2_max
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_eeqq_fsr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
end function sudakov_eeqq_fsr_kt2_max
<<POWHEG matching: procedures>>=
pure module function sudakov_eeqq_fsr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
kt2_max = 0.25_default * sudakov%event_deps%s_hat
end function sudakov_eeqq_fsr_kt2_max
@ %def sudakov_eeqq_fsr_kt2_max
@ This covers also the singularity at $(\xi,y)\to(1,-1)$ that occurs for
a massless recoiling system.
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: upper_bound_func => sudakov_eeqq_fsr_upper_bound_func
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_eeqq_fsr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
end function sudakov_eeqq_fsr_upper_bound_func
<<POWHEG matching: procedures>>=
pure module function sudakov_eeqq_fsr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
u = alpha_s / (xi * (1 - y**2))
end function sudakov_eeqq_fsr_upper_bound_func
@ %def sudakov_eeqq_fsr_upper_bound_func
@ The logarithmic integrated UBF in the [[eeqq]] case as explained in
[0709.2092], eq. (7.98), is given by
\begin{align}
-\frac{1}{N} \log\left[ \Delta^{U}(p_T) \right]
&= 2 \pi \int_0^{k_\text{max}} \alpha_s(k_T)
\log \left[ \frac{4k_\text{max}^2}{k_T^2} \right] \theta(k_T - p_T)
\frac{dk_T}{k_T} \nonumber \\
&= \frac{\pi}{b_0} \left( \log \left[ \frac{4k_\text{max}^2}{k_T^2} \right]
\log \left[ \frac{\log(k_\text{max}^2/\Lambda^2)}{\log(p_T^2/\Lambda^2)} \right]
- \log \left[ \frac{k_\text{max}^2}{p_T^2} \right] \right)
\end{align}
with $k_\text{max}=\frac{q^0}{2}$.
We see that for these logarithms to be well defined, we need to set a lower bound
for the transverse momentum $p_{T,\text{min}} > \Lambda =$ [[lambda2_gen]].
% (PS 2021-05-05) Status: unvalidated
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: log_integrated_ubf => sudakov_eeqq_fsr_log_integrated_ubf
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_eeqq_fsr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_eeqq_fsr_log_integrated_ubf
<<POWHEG matching: procedures>>=
pure module function sudakov_eeqq_fsr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
- real(default) :: k_max2, Lambda2
+ real(default) :: kt2_max, Lambda2
logical :: within_boundaries
- k_max2 = sudakov%kt2_max ()
+ kt2_max = sudakov%kt2_max ()
within_boundaries = pt2 >= sudakov%powheg_settings%pt2_min &
- .and. pt2 <= k_max2
+ .and. pt2 <= kt2_max
if (within_boundaries) then
Lambda2 = sudakov%process_deps%lambda2_gen
- log_sudakov = pi / b0rad * ( log (4 * k_max2 / Lambda2) * &
- log (log (k_max2/Lambda2) / log (pt2/Lambda2)) - log(k_max2/pt2) )
+ log_sudakov = pi / b0rad () * ( log (4 * kt2_max / Lambda2) * &
+ log (log (kt2_max/Lambda2) / log (pt2/Lambda2)) - log(kt2_max/pt2) )
else
log_sudakov = 0
end if
end function sudakov_eeqq_fsr_log_integrated_ubf
@ %def sudakov_eeqq_fsr_log_integrated_ubf
@ In order to arrive at the log integrated Sudakov
implemented in [[sudakov_eeqq_fsr_log_integrated_ubf]], we overestimated
\begin{equation}
\log \left[ \frac{1 + \sqrt{1 - (k_T/k_\text{max})^2}}
{1 - \sqrt{1 - (k_T/k_\text{max})^2}} \right]
\leq \log \left[ \frac{4 k_\text{max}^2}{k_T^2} \right].
\end{equation}
We correct for this in this veto step.
+Additionally, we correct for overestimating $\alpha_s$.
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: reweight_ubf => sudakov_eeqq_fsr_reweight_ubf
<<POWHEG matching: sub interfaces>>=
module function sudakov_eeqq_fsr_reweight_ubf &
(sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_eeqq_fsr_reweight_ubf
<<POWHEG matching: procedures>>=
module function sudakov_eeqq_fsr_reweight_ubf (sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
real(default) :: log_bound, k_max2
+ real(default) :: alpha_s_true, alpha_s_rad
+ alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
+ alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
k_max2 = sudakov%kt2_max ()
log_bound = log((1 + sqrt(1 - (pt2/k_max2))) &
/ (1 - sqrt(1 - (pt2/k_max2))))
call sudakov%rng%generate (sudakov%random)
- accepted = sudakov%random * log( 4 * k_max2 / pt2 ) <= log_bound
+ accepted = sudakov%random * log( 4 * k_max2 / pt2 ) * alpha_s_rad &
+ <= log_bound * alpha_s_true
+ if (debug2_active (D_MATCHING)) then
+ print *, ' sqrt(pt2) = ', sqrt(pt2)
+ print *, ' alpha_s_true = ', alpha_s_true
+ print *, ' sudakov%process_deps%lambda2_gen = ', &
+ sudakov%process_deps%lambda2_gen
+ print *, ' alpha_s_rad = ', alpha_s_rad
+ print *, ' sudakov%random = ', sudakov%random
+ print *, ' accepted = ', accepted
+ if (log( 4 * k_max2 / pt2 ) * alpha_s_rad < log_bound * alpha_s_true) then
+ call msg_fatal ("sudakov_eeqq_fsr_reweight_ubf: &
+ &This should never happen. &
+ &Have you chosen a running alpha_s?")
+ end if
+ end if
end function sudakov_eeqq_fsr_reweight_ubf
@ %def sudakov_eeqq_fsr_reweight_ubf
@ In the eeqq case, we did not overestimate $\xi$ with $\xi_\text{max}$.
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: reweight_xi_max => sudakov_eeqq_fsr_reweight_xi_max
<<POWHEG matching: sub interfaces>>=
module function sudakov_eeqq_fsr_reweight_xi_max &
(sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
end function sudakov_eeqq_fsr_reweight_xi_max
<<POWHEG matching: procedures>>=
module function sudakov_eeqq_fsr_reweight_xi_max &
(sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
accepted = .true.
end function sudakov_eeqq_fsr_reweight_xi_max
@ %def sudakov_eeqq_fsr_reweight_xi_max
@ In the eeqq case, we generate $y$ from a random number and afterwards compute
$\xi(p_T,y)$ so the sequence is reversed in comparison to the simple case.
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: generate_xi_and_y_and_phi => &
sudakov_eeqq_fsr_generate_xi_and_y_and_phi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi
<<POWHEG matching: procedures>>=
module subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
call sudakov%generate_y (r)
call sudakov%generate_xi (r)
call sudakov%generate_phi (r)
end subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi
@ %def sudakov_eeqq_fsr_generate_xi_and_y_and_phi
@ To generate $y$ for the [[eeqq]] UBF, we take a random number
\begin{equation}
-\log \left[ \frac{1 + \sqrt{1 - (p_T / k_\text{max})^2 }}
{1 - \sqrt{1 - (p_T / k_\text{max})^2 }} \right]
< r_y <
\log \left[ \frac{1 + \sqrt{1 - (p_T / k_\text{max})^2 }}
{1 - \sqrt{1 - (p_T / k_\text{max})^2 }} \right]
\end{equation}
and then compute
\begin{equation}
y(r_y) = \frac{e^{r_y} - 1}{e^{r_y} + 1}
\end{equation}
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: generate_y => sudakov_eeqq_fsr_generate_y
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_eeqq_fsr_generate_y (sudakov, r)
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_eeqq_fsr_generate_y
<<POWHEG matching: procedures>>=
module subroutine sudakov_eeqq_fsr_generate_y (sudakov, r)
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: k_max2, log_bound, r_y
k_max2 = sudakov%kt2_max ()
call sudakov%rng%generate (sudakov%random)
log_bound = log((1 + sqrt(1 - (r%pt2/k_max2))) &
/ (1 - sqrt(1 - (r%pt2/k_max2))))
r_y = -log_bound + sudakov%random * (two * log_bound)
r%y = (exp(r_y) - 1) / (exp(r_y) + 1)
end subroutine sudakov_eeqq_fsr_generate_y
@ %def sudakov_eeqq_fsr_generate_y
@ We generate $\xi$ for the [[eeqq]] UBF according to
\begin{equation}
\xi(p_T, y) = \frac{2 p_T}{\sqrt{s} \sqrt{1-y^2}}
\end{equation}
<<POWHEG matching: sudakov eeqq fsr: TBP>>=
procedure :: generate_xi => sudakov_eeqq_fsr_generate_xi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_eeqq_fsr_generate_xi (sudakov, r)
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_eeqq_fsr_generate_xi
<<POWHEG matching: procedures>>=
module subroutine sudakov_eeqq_fsr_generate_xi (sudakov, r)
class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: q0
q0 = sqrt(sudakov%event_deps%s_hat)
r%xi = (2 * sqrt(r%pt2)) / (q0 * sqrt(1 - r%y**2))
end subroutine sudakov_eeqq_fsr_generate_xi
@ %def sudakov_eeqq_fsr_generate_xi
@
\subsubsection{Massive FSR}
<<POWHEG matching: public>>=
public :: sudakov_massive_fsr_t
<<POWHEG matching: types>>=
type, extends (sudakov_t) :: sudakov_massive_fsr_t
real(default) :: z, z1, z2 = 0._default
real(default) :: xi_1, xi_min, xi_m = 0._default
real(default) :: xi_max_extended = 1._default
contains
<<POWHEG matching: sudakov massive fsr: TBP>>
end type sudakov_massive_fsr_t
@ %def sudakov_massive_fsr_t
@ According to eq. A.42 [[1202.0465]], during the radiation generation,
an alternative expression for $\xi_{\mathrm{max}}$,
\begin{equation*}
\xi_{\mathrm{max}} = 1 - \frac{(m+m_{\mathrm{rec}})^2}{q^2},
\end{equation*}
is used, which corresponds to an extended Dalitz region.
Phase space points outside of the original Dalitz region
will be vetoed afterwards in [[sudakov_massive_fsr_reweight_xi_max]].
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: compute_xi_max_extended &
=> sudakov_massive_fsr_compute_xi_max_extended
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_massive_fsr_compute_xi_max_extended &
(sudakov, i_phs)
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
integer, intent(in) :: i_phs
end subroutine sudakov_massive_fsr_compute_xi_max_extended
<<POWHEG matching: procedures>>=
module subroutine sudakov_massive_fsr_compute_xi_max_extended (sudakov, i_phs)
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
integer, intent(in) :: i_phs
real(default) :: m, mrec
real(default) :: q0
type(vector4_t) :: p
q0 = sqrt(sudakov%event_deps%s_hat)
p = sudakov%event_deps%p_born_lab%get_momentum &
(1, sudakov%associated_emitter())
m = p**1
mrec = sqrt ((q0 - p%p(0))**2 - p%p(1)**2 - p%p(2)**2 - p%p(3)**2)
sudakov%xi_max_extended = one - (m + mrec)**2 / q0**2
end subroutine sudakov_massive_fsr_compute_xi_max_extended
@ %def sudakov_massive_fsr_compute_xi_max_extended
@ As described in [[1202.0465]], App. A.5., for massive emitters,
the radiation variable $\xi$ is constructed as follows. First,
\begin{equation}
\xi_{\mathrm{min}}(K_T^2)
= \frac{\sqrt{K_T^2 \left(K_T^2z_2^2 + 8\bar{p}^0q(1-z_2)\right)} - K_T^2z_2}{2q^2(1-z_2)}
\end{equation}
is computed where $K_T$ is a hardness scale for the radiation that determines the
upper limit of the integral for the Sudakov form factor and coincides with the
usual one, i.e. the transverse momentum of the radiated particle, in the massless limit.
Then $\xi_1$ is computed according to the same equation with $z_2 \leftrightarrow z_1$.
Finally, $\xi$ is generated according to
\begin{equation}
\xi = \frac{1}{q^2}\left(\exp\left[\log\left(\xi_{\rm{min}}q^2-K_T^2\right)
+ r\log\frac{\xi_m q^2 - K_T^2}{\xi_{\rm{min}}q^2-K_T^2}\right] + K_T^2\right),
\end{equation}
where $\xi_m = \rm{min}\left(\xi_{\rm{max}}, \xi_1\right)$.
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: generate_xi => sudakov_massive_fsr_generate_xi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_massive_fsr_generate_xi (sudakov, r)
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_massive_fsr_generate_xi
<<POWHEG matching: procedures>>=
module subroutine sudakov_massive_fsr_generate_xi (sudakov, r)
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: pt2, q0, q02
real(default) :: E_em, xi_max_ext
real(default) :: xi_1, xi_min, xi_m
pt2 = r%pt2
E_em = sudakov%event_deps%p_born_lab%get_energy &
(1, sudakov%associated_emitter())
q02 = sudakov%event_deps%s_hat; q0 = sqrt(q02)
xi_max_ext = sudakov%xi_max_extended
associate (z1 => sudakov%z1, z2 => sudakov%z2)
xi_1 = (sqrt(pt2 * (pt2 * z1**2 + 8 * E_em * q0 * (one - z1))) - pt2 * z1) / &
(two * q02 * (one - z1))
xi_min = (sqrt(pt2 * (pt2 * z2**2 + 8 * E_em * q0 * (one - z2))) - pt2 * z2) / &
(two * q02 * (one - z2))
end associate
xi_m = min (xi_max_ext, xi_1)
call sudakov%rng%generate (sudakov%random)
r%xi = (exp (log(xi_min * q02 - pt2) + sudakov%random * &
log((xi_m * q02 - pt2) / (xi_min * q02 - pt2))) + pt2) / q02
end subroutine sudakov_massive_fsr_generate_xi
@ %def sudakov_massive_fsr_generate_xi
@ Generates the FKS variables in the case of a massive emitter and
additionally computes $z$ and $z_{1/2}$ as well as $\xi_\text{max}$
to be stored in the Sudakov for later use when reweighting [[xi_max]]
and retrieving the norm from the POWHEG grid.
The corresponding derivations can be found in [[1202.0465]], App. A.
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: generate_xi_and_y_and_phi => &
sudakov_massive_fsr_generate_xi_and_y_and_phi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi
<<POWHEG matching: procedures>>=
module subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: q0
real(default) :: m2, mrec2, k0_rec_max
real(default) :: E_em
type(vector4_t) :: p_emitter
q0 = sqrt (sudakov%event_deps%s_hat)
p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
(1, sudakov%associated_emitter())
associate (p => p_emitter%p)
mrec2 = (q0 - p(0))**2 - p(1)**2 - p(2)**2 - p(3)**2
E_em = p(0)
end associate
m2 = p_emitter**2
call compute_dalitz_bounds (q0, m2, mrec2, sudakov%z1, sudakov%z2, k0_rec_max)
call sudakov%generate_xi (r)
sudakov%z = (two * r%pt2 * E_em - r%xi**2 * q0**3) / &
(r%pt2 * r%xi * q0 - r%xi**2 * q0**3)
sudakov%xi2_max = - (q0**2 * sudakov%z**2 - two * q0 * k0_rec_max * sudakov%z + mrec2) / &
(q0**2 * sudakov%z * (one - sudakov%z))
sudakov%xi2_max = sudakov%xi2_max**2
r%y = two * (sudakov%z2 - sudakov%z) / (sudakov%z2 - sudakov%z1) - one
call sudakov%generate_phi (r)
end subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi
@ %def sudakov_massive_fsr_generate_xi_and_y_and_phi
@ Computes the hardness scale as discussed in [[1202.0465]], App. A.2.
\begin{equation}
K_T^2 = \frac{\xi^2q^3 (1-z)}{2\bar{p}_{\rm{em}}^0 - z\xi q}
\label{eq:HardnessMassiveFSR}
\end{equation}
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: kt2 => sudakov_massive_fsr_kt2
<<POWHEG matching: sub interfaces>>=
module function sudakov_massive_fsr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
end function sudakov_massive_fsr_kt2
<<POWHEG matching: procedures>>=
module function sudakov_massive_fsr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
(sudakov%i_phs, sudakov%associated_emitter(), UBF_FSR_MASSIVE, xi, y)
end function sudakov_massive_fsr_kt2
@ %def sudakov_massive_fsr_kt2
@ For massive emitters, the upper bound on the radiated $p_T$ is
\begin{equation*}
t_{\mathrm{max}} = \frac{\xi_{\mathrm{max}}^2q^3(1-z_2)}{2 \cdot \bar{p}^0 - z_2\xi_{\mathrm{max}}q}
\end{equation*}
For this, we have to compute $z_2$ from the Dalitz bounds as [[sudakov%z2]]
has not yet been set for the current event.
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: kt2_max => sudakov_massive_fsr_kt2_max
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_massive_fsr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_massive_fsr_t), intent(in) :: sudakov
end function sudakov_massive_fsr_kt2_max
<<POWHEG matching: procedures>>=
pure module function sudakov_massive_fsr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default) :: q0, E_em, xi_max, z1, z2, m2, mrec2, k0_rec_max
type(vector4_t) :: p_emitter
q0 = sqrt(sudakov%event_deps%s_hat)
p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
(1, sudakov%associated_emitter())
associate (p => p_emitter%p)
mrec2 = (q0 - p(0))**2 - p(1)**2 - p(2)**2 - p(3)**2
E_em = p(0)
end associate
m2 = p_emitter**2
call compute_dalitz_bounds (q0, m2, mrec2, z1, z2, k0_rec_max)
xi_max = sudakov%xi_max_extended
kt2_max = (xi_max**2 * q0**3 * (one - z2)) / (two * E_em - z2 * xi_max * q0)
end function sudakov_massive_fsr_kt2_max
@ %def sudakov_massive_fsr_kt2_max
@ The upper bounding function for massive emitters according to Eq. A.56 in [1202.0465]
(disregarding a possible factor of $\alpha_s$) is
\begin{equation}
U(\xi, y) \sim \frac{\sqrt{s}}{\bar{p}_{\rm{em}}} \frac{1}{\xi(1-z)}
\label{eq:UBFMassiveFSR}
\end{equation}
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: upper_bound_func => sudakov_massive_fsr_upper_bound_func
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_massive_fsr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
end function sudakov_massive_fsr_upper_bound_func
<<POWHEG matching: procedures>>=
pure module function sudakov_massive_fsr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
real(default) :: q, p_em
q = sqrt (sudakov%event_deps%s_hat)
p_em = space_part_norm &
(sudakov%event_deps%p_born_lab%get_momentum (1, &
sudakov%associated_emitter()))
u = alpha_s * q / p_em * one / (xi * (one - sudakov%z))
end function sudakov_massive_fsr_upper_bound_func
@ %def sudakov_massive_fsr_upper_bound_func
@ The integrated upper-bounding function for massive final-state emitters is given by
\begin{align*}
I(t) &= \frac{q}{\bar{p}_{\rm{em}}}\left[\log\xi\log\left[(1-z_2)\frac{q}{k_T^2}\right] +
\frac{1}{2} \log^2\xi + G(-k_T^2,q^2,\xi) - G(2\bar{p}_{\rm{em}},-q,\xi)\right]
^{\rm{min}(\xi_1(k_T^2),\xi_{\rm{max}})}_{\xi_{\rm{min}}} \\
&+ \frac{q}{\bar{p}_{\rm{em}}} \theta (\xi_{\rm{max}} - \xi_1(k_T^2))
\log\frac{\xi_{\rm{max}}}{\xi_1(k_T^2)}\log\frac{1-z_2}{1-z_1},
\end{align*}
where the function $G(a,b,\xi)$ is given by
\begin{equation}
G(a,b,\xi) = \log(a+b\xi)\log\left(1-\frac{a+b\xi}{a}\right) + Li_2\left(\frac{a+b\xi}{a}\right),
\label{GMinusMassiveFSR}
\end{equation}
for $a < 0$ and by
\begin{equation}
G(a,b,\xi) = \log\left|\frac{b\xi}{a}\right|\log a - Li_2\left(-\frac{b\xi}{a}\right) + \frac{\pi^2}{6},
\label{GPlusMassiveFSR}
\end{equation}
for $a > 0$.
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: log_integrated_ubf => sudakov_massive_fsr_log_integrated_ubf
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_massive_fsr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_massive_fsr_log_integrated_ubf
<<POWHEG matching: procedures>>=
pure module function sudakov_massive_fsr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
real(default) :: xi, xi_max, xi_1, xi_min
real(default) :: q0, p_em, E_em, m2, mrec2, k0_rec_max
type(vector4_t) :: p_emitter
real(default) :: log_sudakov_up, log_sudakov_down, z1, z2
logical :: within_boundaries
within_boundaries = pt2 >= sudakov%powheg_settings%pt2_min &
.and. pt2 <= sudakov%kt2_max ()
if (within_boundaries) then
q0 = sqrt (sudakov%event_deps%s_hat)
p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
(1, sudakov%associated_emitter())
associate (p => p_emitter%p)
mrec2 = (q0 - p(0))**2 - p(1)**2 - p(2)**2 - p(3)**2
E_em = p(0)
end associate
m2 = p_emitter**2
call compute_dalitz_bounds (q0, m2, mrec2, z1, z2, k0_rec_max)
p_em = space_part_norm (p_emitter)
xi_max = sudakov%xi_max_extended
xi_1 = (sqrt (pt2 * (pt2 * z1**2 + 8 * E_em * q0 * (one - z1))) - pt2 * z1) / &
(two * q0**2 * (one - z1))
xi_min = (sqrt (pt2 * (pt2 * z2**2 + 8 * E_em * q0 * (one - z2))) - pt2 * z2) / &
(two * q0**2 * (one - z2))
xi = min (xi_1, xi_max)
log_sudakov_up = log(xi) * log((one - z2) * q0 / pt2) + log(xi)**2 / two + &
G_FSR(-pt2, q0**2, xi) - G_FSR(two * E_em, -q0, xi)
xi = xi_min
log_sudakov_down = log(xi) * log((one - z2) * q0 / pt2) + log(xi)**2/two + &
G_FSR(-pt2, q0**2, xi) - G_FSR(two * E_em, -q0, xi)
log_sudakov = log_sudakov_up - log_sudakov_down
if (xi_max > xi_1) &
log_sudakov = log_sudakov + log(xi_max / xi_1) * log((one - z2) / (one - z1))
log_sudakov = twopi * q0 / p_em * log_sudakov
else
log_sudakov = 0
end if
end function sudakov_massive_fsr_log_integrated_ubf
@ %def sudakov_massive_fsr_log_integrated_ubf
-@ No further ubf veto needed for now.
+@ For this UBF, we just overestimated $\alpha_s$.
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: reweight_ubf => sudakov_massive_fsr_reweight_ubf
<<POWHEG matching: sub interfaces>>=
module function sudakov_massive_fsr_reweight_ubf &
(sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_massive_fsr_reweight_ubf
<<POWHEG matching: procedures>>=
module function sudakov_massive_fsr_reweight_ubf &
(sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_massive_fsr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
- accepted = .true.
+ real(default) :: alpha_s_true, alpha_s_rad
+ logical :: alpha_s_equal
+ if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_massive_fsr_reweight_ubf")
+ alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
+ alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
+ call sudakov%rng%generate (sudakov%random)
+ alpha_s_equal = nearly_equal (alpha_s_true, alpha_s_rad)
+ accepted = alpha_s_equal .or. sudakov%random < alpha_s_true / alpha_s_rad
+ if (debug2_active (D_MATCHING)) then
+ print *, ' sqrt(pt2) = ', sqrt(pt2)
+ print *, ' alpha_s_true = ', alpha_s_true
+ print *, ' sudakov%process_deps%lambda2_gen = ', &
+ sudakov%process_deps%lambda2_gen
+ print *, ' alpha_s_rad = ', alpha_s_rad
+ print *, ' sudakov%random = ', sudakov%random
+ print *, ' accepted = ', accepted
+ if (alpha_s_rad < alpha_s_true .and. .not. alpha_s_equal) then
+ call msg_fatal ("sudakov_massive_fsr_reweight_ubf: &
+ &This should never happen. &
+ &Have you chosen a running alpha_s?")
+ end if
+ end if
end function sudakov_massive_fsr_reweight_ubf
@ %def sudakov_massive_fsr_reweight_ubf
@
In the massive case, we generated $0 < \xi < $[[xi_max_extended]]
and thus we need to veto values of $\xi$ larger than $\xi_{\mathrm{max}}$
in this extra veto step.
<<POWHEG matching: sudakov massive fsr: TBP>>=
procedure :: reweight_xi_max => sudakov_massive_fsr_reweight_xi_max
<<POWHEG matching: sub interfaces>>=
module function sudakov_massive_fsr_reweight_xi_max &
(sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
end function sudakov_massive_fsr_reweight_xi_max
<<POWHEG matching: procedures>>=
module function sudakov_massive_fsr_reweight_xi_max &
(sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_massive_fsr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
accepted = xi < sqrt (sudakov%xi2_max)
end function sudakov_massive_fsr_reweight_xi_max
@ %def sudakov_massive_fsr_reweight_xi_max
@
\subsubsection{Auxiliary functions}
Implements the function $G(a,b,\xi)$ given in eq. (\ref{GPlusMassiveFSR})
and eq. (\ref{GMinusMassiveFSR}). Cannot be evaluated for $a = 0$.
<<POWHEG matching: procedures>>=
elemental function G_FSR (a,b,xi)
real(default) :: G_FSR
real(default), intent(in) :: a, b, xi
if (a > 0) then
G_FSR = G_FSR_Plus (a,b,xi)
else if (a < 0) then
G_FSR = G_FSR_Minus (a,b,xi)
end if
end function G_FSR
elemental function G_FSR_Minus (a,b,xi)
real(default) :: G_FSR_Minus
real(default), intent(in) :: a, b, xi
G_FSR_Minus = log(a+b*xi)*log(one - (a+b*xi)/a) + Li2((a+b*xi)/a)
end function G_FSR_Minus
elemental function G_FSR_Plus (a,b,xi)
real(default) :: G_FSR_Plus
real(default), intent(in) :: a, b, xi
G_FSR_Plus = log(abs(b*xi/a))*log(a) - Li2(-b*xi/a) + pi**2/6
end function G_FSR_Plus
@ %def G_FSR, G_FSR_Minus, G_FSR_Plus
@
\subsubsection{ISR}
This is the Sudakov for ISR. This corresponds to [[1002.2581]], App. D.
+The [[ubf_variant]] determines which [[log_integrated_ubf]] is used.
<<POWHEG matching: public>>=
public :: sudakov_isr_t
<<POWHEG matching: types>>=
type, extends (sudakov_t) :: sudakov_isr_t
real(default) :: xi_max_extended = 1._default
+ integer :: ubf_variant = 2
contains
<<POWHEG matching: sudakov isr: TBP>>
end type sudakov_isr_t
@ %def sudakov_isr_t
@ This $k_T$ measure differs by a factor of $\frac{1}{1-\xi}$ w.r.t.
[[sudakov_eeqq_fsr_kt2]] to account for
$s_\text{born} = s_\text{real} * (1 - \xi)$.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: kt2 => sudakov_isr_kt2
<<POWHEG matching: sub interfaces>>=
module function sudakov_isr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
end function sudakov_isr_kt2
<<POWHEG matching: procedures>>=
module function sudakov_isr_kt2 (sudakov, xi, y) result (kt2)
real(default) :: kt2
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y
kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
(sudakov%i_phs, sudakov%associated_emitter(), UBF_ISR, xi, y)
end function sudakov_isr_kt2
@ %def sudakov_isr_kt2
@ The maximal transverse momentum is given by (D.4) in [1002.2581].
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: kt2_max => sudakov_isr_kt2_max
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_isr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_isr_t), intent(in) :: sudakov
end function sudakov_isr_kt2_max
<<POWHEG matching: procedures>>=
pure module function sudakov_isr_kt2_max (sudakov) result (kt2_max)
real(default) :: kt2_max
class(sudakov_isr_t), intent(in) :: sudakov
real(default) :: s_hat, xb_plus, xb_minus
s_hat = sudakov%event_deps%s_hat
xb_plus = sudakov%event_deps%x_born(I_PLUS)
xb_minus = sudakov%event_deps%x_born(I_MINUS)
kt2_max = s_hat * (1 - xb_plus**2) * (1 - xb_minus**2) &
/ (xb_plus + xb_minus)**2
end function sudakov_isr_kt2_max
@ %def sudakov_isr_kt2_max
@ This covers the soft singularity for $\xi \to 0$ and the collinear
singularities to both beam axes $y \to \pm 1$.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: upper_bound_func => sudakov_isr_upper_bound_func
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_isr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
end function sudakov_isr_upper_bound_func
<<POWHEG matching: procedures>>=
pure module function sudakov_isr_upper_bound_func &
(sudakov, xi, y, alpha_s) result (u)
real(default) :: u
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: xi, y, alpha_s
u = alpha_s / (xi * (1 - y**2))
end function sudakov_isr_upper_bound_func
@ %def sudakov_isr_upper_bound_func
-@ This is eq. (D.14) in [1002.2581]. It is similar to the eeqq case
+@ This is eq. (D.14) and (D.18) in [1002.2581]. It is similar to the eeqq case
with the only difference beeing that the first log here includes both,
$k^2_\text{T, max}$ and $s_b$ via $q^2$.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: log_integrated_ubf => sudakov_isr_log_integrated_ubf
<<POWHEG matching: sub interfaces>>=
pure module function sudakov_isr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_isr_log_integrated_ubf
<<POWHEG matching: procedures>>=
pure module function sudakov_isr_log_integrated_ubf &
(sudakov, pt2) result (log_sudakov)
real(default) :: log_sudakov
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: pt2
- real(default) :: kT_max2, Lambda2, s_hat, q2
+ real(default) :: kt2_max, Lambda2, s_hat, q2
logical :: within_boundaries
- kT_max2 = sudakov%kt2_max ()
+ kt2_max = sudakov%kt2_max ()
s_hat = sudakov%event_deps%s_hat
- q2 = kT_max2 + s_hat
+ q2 = kt2_max + s_hat
+ Lambda2 = sudakov%process_deps%lambda2_gen
within_boundaries = pt2 >= sudakov%powheg_settings%pt2_min &
- .and. pt2 <= kT_max2
+ .and. pt2 <= kt2_max
if (within_boundaries) then
- Lambda2 = sudakov%process_deps%lambda2_gen
- log_sudakov = pi / b0rad * ( log (q2 / Lambda2) * &
- log (log (kT_max2/Lambda2) / log (pt2/Lambda2)) - log(kT_max2/pt2) )
+ if (sudakov%ubf_variant == 1) then
+ log_sudakov = pi / b0rad () * ( log (q2/Lambda2) * &
+ log (log (kt2_max/Lambda2) / log (pt2/Lambda2)) - log (kt2_max/pt2) )
+ elseif (sudakov%ubf_variant == 2) then
+ if (pt2 < s_hat) then
+ if (s_hat < kt2_max) then
+ log_sudakov = pi / b0rad () * &
+ ( log (two * s_hat / Lambda2) &
+ * log (log (s_hat / Lambda2) / log (pt2 / Lambda2)) &
+ - log (s_hat / pt2) &
+ + log (two) * log ( log (kt2_max / Lambda2) / log (s_hat / Lambda2) ))
+ else
+ log_sudakov = pi / b0rad () * &
+ (log (two * s_hat / Lambda2) &
+ * log (log (kt2_max / Lambda2) / log (pt2 / Lambda2)) &
+ - log (kt2_max / pt2) )
+ end if
+ else
+ log_sudakov = pi / b0rad () * &
+ (log (two) * log (log (kt2_max / Lambda2) / log (pt2 / Lambda2)))
+ end if
+ end if
else
log_sudakov = 0
end if
end function sudakov_isr_log_integrated_ubf
@ %def sudakov_isr_log_integrated_ubf
@ In order to arrive at the log integrated Sudakov
implemented in [[sudakov_isr_log_integrated_ubf]], we overestimated
\begin{equation}
\log \left[ \frac{\sqrt{x_+ - \rho} + \sqrt{x_- - \rho}}
{\sqrt{x_+ - \rho} - \sqrt{x_- - \rho}} \right]
\leq \log \left[ \frac{\sqrt{x_+} + \sqrt{x_-}}
{\sqrt{x_+} - \sqrt{x_-}} \right]
= \frac12 \log \left[ \frac{k_T^2 + s_b}{k_T^2} \right]
\leq \frac12 \log \left[ \frac{q^2}{k_T^2} \right]
\end{equation}
with
\begin{equation}
x_\pm = \left( \sqrt{1 + \frac{k_T^2}{s_b}} \pm \frac{k_T}{\sqrt{s_b}} \right)^2
\quad , \quad \rho = \frac{s_b}{S}
\quad \text{and} \quad q^2 = k^2_{T, \text{max}} + s_b.
\end{equation}
We correct for this in this veto step.
+Additionally, we correct for overestimating $\alpha_s$.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: reweight_ubf => sudakov_isr_reweight_ubf
<<POWHEG matching: sub interfaces>>=
module function sudakov_isr_reweight_ubf (sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_isr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
end function sudakov_isr_reweight_ubf
<<POWHEG matching: procedures>>=
module function sudakov_isr_reweight_ubf (sudakov, pt2) result (accepted)
logical :: accepted
class(sudakov_isr_t), intent(inout) :: sudakov
real(default), intent(in) :: pt2
real(default) :: log_bound, kT_max2, s_hat, s_had, rho, x_plus, x_minus, q2
+ real(default) :: alpha_s_true, alpha_s_rad
+ alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
+ alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
s_hat = sudakov%event_deps%s_hat
s_had = sudakov%event_deps%s_had
rho = s_hat / s_had
kT_max2 = sudakov%kt2_max ()
q2 = kT_max2 + s_hat
x_plus = ( sqrt( 1 + pt2 / s_hat ) + sqrt( pt2 / s_hat ) )**2
x_minus = ( sqrt( 1 + pt2 / s_hat ) - sqrt( pt2 / s_hat ) )**2
!!! These are not the ISR x values!
+ call sudakov%rng%generate (sudakov%random)
log_bound = log ((sqrt( x_plus - rho ) + sqrt( x_minus - rho )) &
/ (sqrt( x_plus - rho ) - sqrt( x_minus - rho )))
- call sudakov%rng%generate (sudakov%random)
- accepted = sudakov%random * log( q2 / pt2 ) <= 2 * log_bound
+ if (sudakov%ubf_variant == 1) then
+ accepted = sudakov%random * log( q2 / pt2 ) * alpha_s_rad &
+ <= 2 * log_bound * alpha_s_true
+ elseif (sudakov%ubf_variant == 2) then
+ if (pt2 < s_hat) then
+ accepted = sudakov%random * log( two * s_hat / pt2 ) * alpha_s_rad &
+ <= 2 * log_bound * alpha_s_true
+ else
+ accepted = sudakov%random * log( two ) * alpha_s_rad &
+ <= 2 * log_bound * alpha_s_true
+ end if
+ else
+ accepted = .false.
+ call msg_error("sudakov variant not implemented")
+ end if
+ if (debug2_active (D_MATCHING)) then
+ print *, 'sudakov_isr_reweight_ubf:'
+ print *, ' sqrt(pt2) = ', sqrt(pt2)
+ print *, ' alpha_s_true = ', alpha_s_true
+ print *, ' sudakov%process_deps%lambda2_gen = ', &
+ sudakov%process_deps%lambda2_gen
+ print *, ' alpha_s_rad = ', alpha_s_rad
+ print *, ' sudakov%random = ', sudakov%random
+ print *, ' accepted = ', accepted
+ if (log( q2 / pt2 ) * alpha_s_rad < 2 * log_bound * alpha_s_true) then
+ call msg_fatal ("sudakov_isr_reweight_ubf: This should never happen. &
+ &Have you chosen a running alpha_s?")
+ end if
+ end if
end function sudakov_isr_reweight_ubf
@ %def sudakov_isr_reweight_ubf
@ In the ISR case, we overestimated $\xi_\text{max}$ with
$\xi_\text{max}^{\text{ext}}$.
We veto too large $\xi$ in this veto step.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: reweight_xi_max => sudakov_isr_reweight_xi_max
<<POWHEG matching: sub interfaces>>=
module function sudakov_isr_reweight_xi_max (sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
end function sudakov_isr_reweight_xi_max
<<POWHEG matching: procedures>>=
module function sudakov_isr_reweight_xi_max (sudakov, xi) result (accepted)
logical :: accepted
class(sudakov_isr_t), intent(in) :: sudakov
real(default), intent(in) :: xi
accepted = xi < sqrt (sudakov%xi2_max)
+ if (debug2_active (D_MATCHING)) then
+ print *, 'sudakov_isr_reweight_xi_max:'
+ print *, ' xi = ', xi
+ print *, ' xi_max = ', sqrt (sudakov%xi2_max)
+ print *, ' xi accepted = ', accepted
+ end if
end function sudakov_isr_reweight_xi_max
@ %def sudakov_isr_reweight_xi_max
@ The actual $\xi_\text{max}$ for ISR is given by eq. (\ref{eqn:xi_max_isr})
and depends on $y$ which will be known only after we generated $\xi$.
We thus use an overestimated
\begin{equation*}
\xi_{\mathrm{max}}^{\text{ext}} = 1 - \frac{s_b}{S_\text{had}}
\end{equation*}
to generate both and veto $\xi > \xi_\text{max}$ later on
in [[sudakov_isr_reweight_xi_max]].
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: compute_xi_max_extended &
=> sudakov_isr_compute_xi_max_extended
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_isr_compute_xi_max_extended (sudakov)
class(sudakov_isr_t), intent(inout) :: sudakov
real(default) :: s_hat, s_had
end subroutine sudakov_isr_compute_xi_max_extended
<<POWHEG matching: procedures>>=
module subroutine sudakov_isr_compute_xi_max_extended (sudakov)
class(sudakov_isr_t), intent(inout) :: sudakov
real(default) :: s_hat, s_had
s_hat = sudakov%event_deps%s_hat
s_had = sudakov%event_deps%s_had
- sudakov%xi_max_extended = one - s_hat / s_had
- end subroutine sudakov_isr_compute_xi_max_extended
+ sudakov%xi_max_extended = one - s_hat / s_had
+ end subroutine sudakov_isr_compute_xi_max_extended
@ %def sudakov_isr_compute_xi_max_extended
@ In the ISR case, we generate $\xi$ from a random number and
afterwards compute $y(p_T,\xi)$ as in the simple case.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: generate_xi_and_y_and_phi => &
sudakov_isr_generate_xi_and_y_and_phi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_isr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_isr_generate_xi_and_y_and_phi
<<POWHEG matching: procedures>>=
module subroutine sudakov_isr_generate_xi_and_y_and_phi (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
call sudakov%generate_xi (r)
call sudakov%generate_y (r)
call sudakov%generate_phi (r)
call sudakov%compute_xi2_max (r)
end subroutine sudakov_isr_generate_xi_and_y_and_phi
@ %def sudakov_isr_generate_xi_and_y_and_phi
@ Inverting [[real_kinematics_kt2]], we find
\begin{equation}
|y(k_T^2, \xi)| = \sqrt{1 - \frac{4 (1 - \xi)}{\xi^2}\frac{k_T^2}{s_b}}.
\end{equation}
We then determine the sign randomly as there is no preferred direction.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: generate_y => sudakov_isr_generate_y
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_isr_generate_y (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_isr_generate_y
<<POWHEG matching: procedures>>=
module subroutine sudakov_isr_generate_y (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: s_hat
s_hat = sudakov%event_deps%s_hat
r%y = sqrt (1 - (4 * (1 - r%xi) * r%pt2 / (s_hat * r%xi**2)))
call sudakov%rng%generate (sudakov%random)
if (sudakov%random > 0.5_default) then
r%y = - r%y
end if
end subroutine sudakov_isr_generate_y
@ %def sudakov_isr_generate_y
@ We want to generate $x := 1 - \xi$ for the ISR UBF with probability density
\begin{equation}
f(x) = \frac{1}{\sqrt{(x_+ - x)(x_- - x)}}.
\end{equation}
within the limits
\begin{equation}
\frac{s_b}{S} = x_{b,\oplus} x_{b,\ominus} = \rho \leq x \leq x_- = x_-
= \left( \sqrt{1 + \frac{k_T^2}{s_b}} - \frac{k_T}{\sqrt{s_b}} \right)^2.
\end{equation}
To generate $x$ according to the distribution
\begin{equation}
F(x) = \int f(x) \, dx = = 2 \sinh^{-1} \left( \sqrt{ \frac{x_- - x}{x_+ - x_-} } \right)
\end{equation}
we use
\begin{equation}
x = x_- + (x_- - x_+) \sinh^2(\frac{r_x}{2})
\end{equation}
with a random number $r_x \in \text{Unif}[F(x_-),F(\rho)]
= \text{Unif}\left[0,2 \sinh^{-1} \left( \sqrt{ \frac{x_- - \rho}{x_+ - x_-} } \right)
\right]$.\\
+Alternatively, an implementation making extended use of rejection sampling is available.
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: generate_xi => sudakov_isr_generate_xi
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_isr_generate_xi (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_isr_generate_xi
<<POWHEG matching: procedures>>=
module subroutine sudakov_isr_generate_xi (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: s_hat, s_had, r_x, x, x_minus, x_plus, rho
+ integer :: variant = 1
+ logical :: valid
s_hat = sudakov%event_deps%s_hat
s_had = sudakov%event_deps%s_had
rho = 1 - sudakov%xi_max_extended
x_plus = ( sqrt( 1 + r%pt2 / s_hat ) + sqrt( r%pt2 / s_hat ) )**2
x_minus = ( sqrt( 1 + r%pt2 / s_hat ) - sqrt( r%pt2 / s_hat ) )**2
- call sudakov%rng%generate (sudakov%random)
- r_x = sudakov%random
- r_x = r_x * 2 * asinh (sqrt ( (x_minus - rho) / (x_plus - x_minus) ) )
- x = x_minus + (x_minus - x_plus) * sinh (r_x / 2)**2
+ if (variant == 1) then
+ call sudakov%rng%generate (sudakov%random)
+ r_x = sudakov%random
+ r_x = r_x * 2 * asinh (sqrt ( (x_minus - rho) / (x_plus - x_minus) ) )
+ x = x_minus + (x_minus - x_plus) * sinh (r_x / 2)**2
+ elseif (variant == 2) then
+ valid = .false.
+ do while (.not. valid)
+ if (signal_is_pending ()) return
+ call sudakov%rng%generate (sudakov%random)
+ r_x = sudakov%random
+ x = x_minus - (sqrt (x_minus - rho) * r_x)**2
+ call sudakov%rng%generate (sudakov%random)
+ r_x = sudakov%random
+ valid = r_x < sqrt ((x_plus - x_minus) / (x_plus - x))
+ end do
+ end if
r%xi = 1 - x
end subroutine sudakov_isr_generate_xi
@ %def sudakov_isr_generate_xi
@ Computes the actual [[xi2_max]] for ISR.
Can only be computed after y has been generated.
Needs to be called before [[sudakov_isr_reweight_xi_max]].
<<POWHEG matching: sudakov isr: TBP>>=
procedure :: compute_xi2_max => sudakov_isr_compute_xi2_max
<<POWHEG matching: sub interfaces>>=
module subroutine sudakov_isr_compute_xi2_max (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
end subroutine sudakov_isr_compute_xi2_max
<<POWHEG matching: procedures>>=
module subroutine sudakov_isr_compute_xi2_max (sudakov, r)
class(sudakov_isr_t), intent(inout) :: sudakov
type(radiation_t), intent(inout) :: r
real(default) :: xi_max
xi_max = get_xi_max_isr (sudakov%event_deps%x_born, r%y)
sudakov%xi2_max = xi_max**2
end subroutine sudakov_isr_compute_xi2_max
@ %def sudakov_isr_compute_xi2_max
@
\subsection{Main POWHEG class}
<<POWHEG matching: public>>=
public :: powheg_matching_t
<<POWHEG matching: types>>=
type, extends(matching_t) :: powheg_matching_t
type(grid_t) :: grid
type(phs_fks_generator_t) :: phs_fks_generator
type(powheg_settings_t) :: settings
type(event_deps_t) :: event_deps
type(process_deps_t) :: process_deps
type(sudakov_wrapper_t), dimension(:), allocatable :: sudakov
integer :: n_emissions = 0
logical :: active = .true.
contains
<<POWHEG matching: powheg matching: TBP>>
end type powheg_matching_t
@ %def powheg_matching_t
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: get_method => powheg_matching_get_method
<<POWHEG matching: sub interfaces>>=
module function powheg_matching_get_method (matching) result (method)
type(string_t) :: method
class(powheg_matching_t), intent(in) :: matching
end function powheg_matching_get_method
<<POWHEG matching: procedures>>=
module function powheg_matching_get_method (matching) result (method)
type(string_t) :: method
class(powheg_matching_t), intent(in) :: matching
method = matching_method (MATCH_POWHEG)
end function powheg_matching_get_method
@ %def powheg_matching_get_method
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: before_shower => powheg_matching_before_shower
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_before_shower &
(matching, particle_set, vetoed)
class(powheg_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine powheg_matching_before_shower
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_before_shower &
(matching, particle_set, vetoed)
class(powheg_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
if (debug_on) call msg_debug2 (D_MATCHING, "powheg_matching_before_shower")
if (signal_is_pending ()) return
if (.not. matching%active) return
call matching%update (particle_set)
if (matching%settings%test_sudakov) then
call matching%test_sudakov ()
stop
end if
if (.not. matching%settings%disable_sudakov) &
call matching%generate_emission (particle_set = particle_set)
vetoed = .false.
end subroutine powheg_matching_before_shower
@ %def powheg_matching_before_shower
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: first_event => powheg_matching_first_event
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_first_event (matching)
class(powheg_matching_t), intent(inout), target :: matching
end subroutine powheg_matching_first_event
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_first_event (matching)
class(powheg_matching_t), intent(inout), target :: matching
associate (instance => matching%process_instance)
matching%process_deps%lab_is_cm = instance%lab_is_cm (1)
end associate
call matching%setup_grids ()
end subroutine powheg_matching_first_event
@ %def powheg_matching_first_event
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: after_shower => powheg_matching_after_shower
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_after_shower &
(matching, particle_set, vetoed)
class(powheg_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
end subroutine powheg_matching_after_shower
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_after_shower &
(matching, particle_set, vetoed)
class(powheg_matching_t), intent(inout) :: matching
type(particle_set_t), intent(inout) :: particle_set
logical, intent(out) :: vetoed
vetoed = .false.
end subroutine powheg_matching_after_shower
@ %def powheg_matching_after_shower
@
\subsubsection{Output}
<<POWHEG matching: powheg matching: TBP>>=
procedure :: write => powheg_write
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_write (matching, unit)
class(powheg_matching_t), intent(in) :: matching
integer, intent(in), optional :: unit
end subroutine powheg_write
<<POWHEG matching: procedures>>=
module subroutine powheg_write (matching, unit)
class(powheg_matching_t), intent(in) :: matching
integer, intent(in), optional :: unit
integer :: u, alr
u = given_output_unit (unit); if (u < 0) return
call write_separator (u, 2)
write (u, "(1X,A)") "POWHEG Emission Generator"
write (u, "(1X,A)") "Process name: " // char (matching%process_name)
if (allocated (matching%rng)) then
call matching%rng%write (u)
else
write (u, "(1X,A)") "RNG not allocated"
end if
call matching%qcd%write (u)
call matching%settings%write (u)
call matching%event_deps%write (u)
call matching%process_deps%write (u)
do alr = 1, size (matching%sudakov)
call write_separator (u)
write (u, "(1X,A,I12,A)") "sudakov (alr = ", alr, ")"
call matching%sudakov(alr)%s%write (u)
end do
call write_separator (u, 2)
end subroutine powheg_write
@ %def powheg_write
@ Finalization of the POWHEG matching.
It creates a log file showing how many events failed at which stage of the
POWHEG veto algorithm. It also issues a warning if too many POWHEG
excess events occured. If this is the case, the chosen upper-bounding
function is unsuitable for the considered process.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: final => powheg_matching_final
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_final (matching)
class(powheg_matching_t), intent(in) :: matching
end subroutine powheg_matching_final
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_final (matching)
class(powheg_matching_t), intent(in) :: matching
integer :: u, alr, n_fail_ubf_total, n_sqme_total
real :: frac_ubf_fail
type(string_t) :: filename
n_fail_ubf_total = 0
n_sqme_total = 0
u = free_unit ()
filename = matching%process_name // "_veto.log"
open (file=char(filename), unit=u, action='write')
write (u, '(A)') "Summary of POWHEG veto procedure"
do alr = 1, matching%process_deps%n_alr
write(u,'(A,I0)') 'alr: ', alr
call matching%sudakov(alr)%s%veto_counter%write (u)
call write_separator (u)
n_fail_ubf_total = n_fail_ubf_total &
+ matching%sudakov(alr)%s%veto_counter%n_fail_ubf
n_sqme_total = n_sqme_total &
+ matching%sudakov(alr)%s%veto_counter%n_sqme
end do
write (u,'(A,I0)') "Total number of events which radiate a gluon: ", &
matching%n_emissions
close (u)
if (n_sqme_total > 0) then
frac_ubf_fail = one * n_fail_ubf_total / n_sqme_total * 100
if (frac_ubf_fail > 1) then
write (msg_buffer, "(A16,I4,A2,F6.2,A24)") "There have been ", &
n_fail_ubf_total,&
" (", frac_ubf_fail, "%) POWHEG grid excesses."
call msg_warning
end if
end if
end subroutine powheg_matching_final
@ %def powheg_matching_final
@
\subsubsection{Initialization and Finalization}
Setup the POWHEG grids. As they are filled during integration using
the POWHEG hook, we can load them from file here.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: setup_grids => powheg_matching_setup_grids
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_setup_grids (matching)
class(powheg_matching_t), intent(inout), target :: matching
end subroutine powheg_matching_setup_grids
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_setup_grids (matching)
class(powheg_matching_t), intent(inout), target :: matching
call matching%prepare_for_events ()
if (matching%check_grids ()) then
call matching%load_grids ()
else
call msg_fatal ("POWHEG: POWHEG grids are invalid.")
end if
call matching%grid%compute_and_write_mean_and_max ()
call matching%import_norms_from_grid ()
end subroutine powheg_matching_setup_grids
@ %def powheg_matching_setup_grids
@ Sets up the Sudakovs and chooses the correct UBF type.
To determine the UBF type, we check for massive or initial state emitters
for each ALR. For consistency, we thus also check the eeqq case for each ALR.
Gfortran 7/8/9 bug, has to remain in the main module:
<<POWHEG matching: powheg matching: TBP>>=
procedure :: setup_sudakovs => powheg_matching_setup_sudakovs
<<POWHEG matching: main procedures>>=
subroutine powheg_matching_setup_sudakovs (powheg)
class(powheg_matching_t), intent(inout), target :: powheg
integer :: alr, ubf_type, n_in, emitter
logical :: is_fsr, is_massive, is_eeqq
allocate (powheg%sudakov (powheg%process_deps%n_alr))
do alr = 1, powheg%process_deps%n_alr
select type (pcm => powheg%process_instance%pcm)
type is (pcm_nlo_t)
associate(reg_data => pcm%region_data, &
phs => powheg%phs_fks_generator)
n_in = reg_data%get_n_in()
emitter = reg_data%get_emitter (alr)
is_fsr = emitter > n_in
if (is_fsr) then
is_massive = phs%is_massive (emitter)
else
if (emitter == 0) then
is_massive = phs%is_massive (1) .or. phs%is_massive (2)
else
is_massive = phs%is_massive (emitter)
end if
if (is_massive) call msg_bug ("setup_sudakovs: ISR " // &
"off massive emitters not implemented.")
end if
is_eeqq = n_in == 2 .and. &
reg_data%n_legs_born == 4 .and. &
.not. phs%is_massive(3) .and. &
.not. phs%is_massive(4)
! (PS 2021-05-28) This includes FSR regions of pp -> jj.
end associate
end select
if (is_fsr) then
if (is_eeqq) then
ubf_type = UBF_FSR_MASSLESS_RECOIL
else if (is_massive) then
ubf_type = UBF_FSR_MASSIVE
else
ubf_type = powheg%settings%upper_bound_func_type
end if
select case (ubf_type)
case (UBF_FSR_SIMPLE)
allocate (sudakov_simple_fsr_t :: powheg%sudakov(alr)%s)
case (UBF_FSR_MASSLESS_RECOIL)
allocate (sudakov_eeqq_fsr_t :: powheg%sudakov(alr)%s)
case (UBF_FSR_MASSIVE)
allocate (sudakov_massive_fsr_t :: powheg%sudakov(alr)%s)
case default
call msg_fatal ("powheg_setup_sudakovs: Please choose " // &
"upper bounding function!")
end select
else
allocate (sudakov_isr_t :: powheg%sudakov(alr)%s)
end if
if (allocated (powheg%rng)) then
!!! generator mode
call powheg%sudakov(alr)%s%init (powheg%process_deps, &
powheg%event_deps, powheg%settings, &
powheg%qcd, powheg%phs_fks_generator, powheg%rng)
else
!!! lookup mode
call powheg%sudakov(alr)%s%init (powheg%process_deps, &
powheg%event_deps, powheg%settings, &
powheg%qcd, powheg%phs_fks_generator)
end if
-
call powheg%sudakov(alr)%s%set_i_phs (alr)
end do
end subroutine powheg_matching_setup_sudakovs
@ %def powheg_matching_setup_sudakovs
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: init => powheg_matching_init
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_init (matching, var_list, process_name)
class(powheg_matching_t), intent(out) :: matching
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_name
end subroutine powheg_matching_init
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_init (matching, var_list, process_name)
class(powheg_matching_t), intent(out) :: matching
<<default matching init>>
end subroutine powheg_matching_init
@ %def powheg_matching_init
@ Updates the Born momenta and the Born matrix element stored in the event dependencies.
<<POWHEG matching: powheg matching: TBP>>=
generic :: update => update_momenta, &
update_particle_set
procedure :: update_momenta => powheg_matching_update_momenta
procedure :: update_particle_set => powheg_matching_update_particle_set
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_update_momenta (powheg, p_born)
class(powheg_matching_t), intent(inout) :: powheg
type(vector4_t), dimension(:), intent(in) :: p_born
end subroutine powheg_matching_update_momenta
module subroutine powheg_matching_update_particle_set (powheg, particle_set)
class(powheg_matching_t), intent(inout) :: powheg
type(particle_set_t), intent(in) :: particle_set
end subroutine powheg_matching_update_particle_set
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_update_momenta (powheg, p_born)
class(powheg_matching_t), intent(inout) :: powheg
type(vector4_t), dimension(:), intent(in) :: p_born
type(lorentz_transformation_t) :: lt_lab_to_cms
real(default) :: sqme_born
real(default), dimension(2) :: x_born
-
sqme_born = powheg%process_instance%get_sqme &
(powheg%process_deps%i_term_born)
x_born = powheg%phs_fks_generator%isr_kinematics%x
if (.not. powheg%process_deps%lab_is_cm) then
lt_lab_to_cms = powheg%process_instance%get_boost_to_cms (1)
call powheg%update_event_deps (sqme_born, p_born, x_born, lt_lab_to_cms)
else
call powheg%update_event_deps (sqme_born, p_born, x_born)
end if
end subroutine powheg_matching_update_momenta
module subroutine powheg_matching_update_particle_set (powheg, particle_set)
class(powheg_matching_t), intent(inout) :: powheg
type(particle_set_t), intent(in) :: particle_set
integer, dimension(:), allocatable :: indices
logical, dimension(:), allocatable :: in_out_mask
integer :: i
allocate (in_out_mask (particle_set%get_n_tot()))
do i = 1, particle_set%get_n_tot()
in_out_mask(i) = particle_set%prt(i)%get_status () == PRT_INCOMING &
.or. particle_set%prt(i)%get_status () == PRT_OUTGOING
end do
allocate (indices (size (particle_set%get_indices (in_out_mask))))
indices = particle_set%get_indices (in_out_mask)
call powheg%update_momenta (particle_set%get_momenta (indices))
end subroutine powheg_matching_update_particle_set
@ %def powheg_matching_update
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: update_event_deps => powheg_matching_update_event_deps
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_update_event_deps &
(powheg, sqme_born, p_born, x_born, lt_lab_to_cms)
class(powheg_matching_t), intent(inout) :: powheg
real(default), intent(in) :: sqme_born
type(vector4_t), dimension(:), intent(in) :: p_born
real(default), dimension(2), intent(in) :: x_born
type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
end subroutine powheg_matching_update_event_deps
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_update_event_deps &
(powheg, sqme_born, p_born, x_born, lt_lab_to_cms)
class(powheg_matching_t), intent(inout) :: powheg
real(default), intent(in) :: sqme_born
type(vector4_t), dimension(:), intent(in) :: p_born
real(default), dimension(2), intent(in) :: x_born
type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
call powheg%event_deps%update (sqme_born, p_born, x_born, lt_lab_to_cms)
end subroutine powheg_matching_update_event_deps
@ %def powheg_matching_update_event_deps
-@
+@ Boosts the real momenta to the LAB frame.
+ We call this only for FSR so we can take the boost from the Born term.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: boost_preal_to_lab_frame => &
powheg_matching_boost_preal_to_lab_frame
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_boost_preal_to_lab_frame (powheg, i_phs)
class(powheg_matching_t), intent(inout) :: powheg
integer, intent(in) :: i_phs
end subroutine powheg_matching_boost_preal_to_lab_frame
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_boost_preal_to_lab_frame (powheg, i_phs)
class(powheg_matching_t), intent(inout) :: powheg
type(lorentz_transformation_t) :: lt_cms_to_lab
integer, intent(in) :: i_phs
associate (event_deps => powheg%event_deps)
if (powheg%process_deps%lab_is_cm) then
event_deps%p_real_lab%phs_point(i_phs) = &
event_deps%p_real_cms%phs_point(i_phs)
else
lt_cms_to_lab = powheg%process_instance%get_boost_to_lab (1)
event_deps%p_real_lab%phs_point(i_phs) = &
lt_cms_to_lab * event_deps%p_real_cms%phs_point(i_phs)
end if
end associate
end subroutine powheg_matching_boost_preal_to_lab_frame
@ %def powheg_matching_boost_preal_to_lab_frame
-@
+@ Boosts the real momenta to the CM frame.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: boost_preal_to_cms => powheg_matching_boost_preal_to_cms
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_boost_preal_to_cms (powheg, i_phs)
class(powheg_matching_t), intent(inout) :: powheg
integer, intent(in) :: i_phs
end subroutine powheg_matching_boost_preal_to_cms
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_boost_preal_to_cms (powheg, i_phs)
class(powheg_matching_t), intent(inout) :: powheg
type(lorentz_transformation_t) :: lt
type(vector4_t), dimension(:), allocatable :: p_real
integer, intent(in) :: i_phs
real(default) :: sqrts_real
type(vector4_t) :: p0, p1
associate (event_deps => powheg%event_deps)
if (powheg%process_deps%lab_is_cm) then
event_deps%p_real_cms%phs_point(i_phs) = event_deps%p_real_lab%phs_point(i_phs)
else
p_real = event_deps%p_real_lab%phs_point(i_phs)
p0 = p_real(1) + p_real(2)
sqrts_real = (p0)**1
lt = boost (p0, sqrts_real)
p1 = inverse(lt) * p_real(1)
lt = lt * rotation_to_2nd (3, space_part (p1))
p_real = inverse (lt) * p_real
event_deps%p_real_cms%phs_point(i_phs) = p_real
end if
end associate
end subroutine powheg_matching_boost_preal_to_cms
@ %def powheg_matching_boost_preal_to_cms
@ This is the last step of the Sudakov veto algorithm removing the dependence on
the normalization factor $N(\xi_i,y_i)$ and the upper bounding function
$U(\xi,y,\alpha_s)$ from the final result.
In cases where the Born kinematic failed the cuts, $\mathcal{B}$ was
artificially set to zero, so we cannot use it in a denominator.
We assume that the generator cuts applied for parton showering are weak cuts to
avoid divergent phase space regions, thus $\mathcal{B}$ would have been large and
the reweighting would have failed.
Here, we can compute [[sqme_real]] directly with scale $p_T$
but we still need to correct [[sqme_born]].
<<POWHEG matching: powheg matching: TBP>>=
procedure :: reweight_matrix_elements => &
powheg_matching_reweight_matrix_elements
<<POWHEG matching: sub interfaces>>=
module function powheg_matching_reweight_matrix_elements &
(powheg, r) result (accepted)
logical :: accepted
class(powheg_matching_t), intent(inout) :: powheg
type(radiation_t), intent(in) :: r
end function powheg_matching_reweight_matrix_elements
<<POWHEG matching: procedures>>=
module function powheg_matching_reweight_matrix_elements &
(powheg, r) result (accepted)
logical :: accepted
class(powheg_matching_t), intent(inout) :: powheg
type(radiation_t), intent(in) :: r
integer :: emitter, n_in, i_phs, i_term_born, alphas_power, em
- real(default) :: sqme_real_x_jacobian, sqme_born
+ real(default) :: sqme_real_x_jac, sqme_born
real(default) :: norm, ubf, ubound, random, weight
- real(default) :: alpha_s_kt, alpha_s_muren, muren, mufac, pt2
+ real(default) :: alpha_s_kt, alpha_s_muren, alpha_s_kt_noNLL
+ real(default) :: muren, mufac, pt2
integer, dimension(2) :: flv_born
real(double), dimension(-6:6) :: pdf_dbl
real(double) :: x_dbl, q_dbl
type(vector4_t), dimension(:), allocatable :: p_real_cms, p_real_lab
real(default), dimension(2) :: pdf_born_mufac, pdf_born_kt
if (debug_on) call msg_debug (D_MATCHING, "reweight_matrix_elements")
sqme_born = powheg%event_deps%sqme_born
- if (sqme_born == 0) then
+ if (nearly_equal(sqme_born,zero) .or. sqme_born < 0) then
accepted = .false.
return
end if
call powheg%rng%generate (random)
i_phs = powheg%process_deps%alr_to_i_phs (r%alr)
select type (pcm => powheg%process_instance%pcm)
type is (pcm_nlo_t)
emitter = pcm%region_data%get_emitter (r%alr)
n_in = pcm%region_data%get_n_in()
if (emitter <= n_in) then
allocate(p_real_lab(pcm%region_data%get_n_legs_real()))
call powheg%phs_fks_generator%generate_isr_from_xi_and_y (&
r%xi, sqrt (powheg%sudakov(r%alr)%s%xi2_max), r%y, &
r%phi, i_phs, powheg%event_deps%p_born_lab%get_momenta(1), &
p_real_lab)
powheg%event_deps%p_real_lab%phs_point(i_phs) = p_real_lab
call powheg%boost_preal_to_cms (i_phs)
else
allocate(p_real_cms(pcm%region_data%get_n_legs_real()))
call powheg%phs_fks_generator%generate_fsr_from_xi_and_y (r%xi, r%y, &
r%phi, emitter, i_phs, &
powheg%event_deps%p_born_cms%get_momenta(1), &
p_real_cms)
powheg%event_deps%p_real_cms%phs_point(i_phs) = p_real_cms
call powheg%boost_preal_to_lab_frame (i_phs)
end if
if (debug_active (D_MATCHING)) then
if (emitter <= n_in) then
pt2 = (transverse_part (p_real_lab (size(p_real_lab))))**2
else
pt2 = (transverse_part (p_real_cms (size(p_real_cms))))**2
end if
call assert_equal (OUTPUT_UNIT, r%pt2, pt2, &
"reweight_matrix_elements: generated p_real does not fit to sudakovs pt2")
end if
call powheg%copy_momenta (i_phs)
norm = powheg%norm_from_xi_and_y (r)
associate (s => powheg%sudakov(r%alr)%s)
alpha_s_kt = s%alpha_s (r%pt2, use_correct=.true.)
+ alpha_s_kt_noNLL = s%alpha_s (r%pt2, use_correct=.true., improve_nll=.false.)
i_term_born = powheg%process_deps%i_term_born
muren = powheg%process_instance%term(i_term_born)%get_ren_scale ()
mufac = powheg%process_instance%term(i_term_born)%get_fac_scale ()
- alpha_s_muren = s%alpha_s (muren**2, use_correct=.true.)
+ alpha_s_muren = s%alpha_s (muren**2, use_correct=.true., improve_nll=.false.)
ubf = s%upper_bound_func (r%xi, r%y, alpha_s_kt)
- sqme_real_x_jacobian = powheg%compute_sqme_real (r%alr, sqrt(r%pt2))
- !!! Correct all factors of alphas(muren) to alphas(kt).
+ sqme_real_x_jac = powheg%compute_sqme_real (r%alr, sqrt(r%pt2))
+
+ select type (pcm_work => powheg%process_instance%pcm_work)
+ class is (pcm_nlo_workspace_t)
+ sqme_real_x_jac = pcm_work%powheg_kinematic_factors_real &
+ (sqme_real_x_jac, r%alr)
+ end select
+
+ !!! Correct all factors of alphas to the NLL-corrected alphas(kt).
alphas_power = powheg%process_deps%alphas_power
sqme_born = (alpha_s_kt / alpha_s_muren)**alphas_power * sqme_born
+ sqme_real_x_jac = (alpha_s_kt / alpha_s_kt_noNLL)**(alphas_power+1) * sqme_real_x_jac
!!! Also correct the PDFs previously computed at mufac instead of kt
select type (pcm => powheg%process_instance%term(i_term_born)%pcm)
type is (pcm_nlo_t)
if (pcm%has_pdfs) then
associate (reg_data => pcm%region_data)
flv_born = reg_data%flv_born(i_term_born)%flst(1:2)
where (flv_born == 21) flv_born = 0
end associate
associate (pdf_data => powheg%process_deps%pdf_data, &
x_born => powheg%event_deps%x_born)
do em = 1, 2
x_dbl = x_born(em); q_dbl = mufac
call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
pdf_born_mufac(em) = pdf_dbl(flv_born(em)) / x_born(em)
x_dbl = x_born(em); q_dbl = sqrt(r%pt2)
call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
pdf_born_kt(em) = pdf_dbl(flv_born(em)) / x_born(em)
end do
sqme_born = pdf_born_kt(1) * pdf_born_kt(2) / &
(pdf_born_mufac(1) * pdf_born_mufac(2)) * sqme_born
end associate
end if
end select
+ if (nearly_equal(sqme_born,zero) .or. sqme_born < 0) then
+ accepted = .false.
+ return
+ end if
ubound = sqme_born * ubf * norm
- weight = sqme_real_x_jacobian / ubound
+ weight = sqme_real_x_jac / ubound
if (weight > 1) call s%veto_counter%record_ubf_fail()
if (debug_active (D_MATCHING)) then
if (weight < 0) call msg_warning ("R/B < 0!")
end if
accepted = random < weight
end associate
+
if (debug_active (D_MATCHING)) then
print *, ' r%alr = ', r%alr
print *, ' r%xi = ', r%xi
print *, ' r%y = ', r%y
+ print *, ' r%phi = ', r%phi
+ print *, ' r%pt = ', sqrt(r%pt2)
print *, ' emitter = ', emitter
print *, ' random = ', random
- print *, ' sqme_real_x_jacobian = ', sqme_real_x_jacobian
print *, ' sqme_born = ', sqme_born
+ print *, ' sqme_real_x_jac = ', sqme_real_x_jac
print *, ' ubf = ', ubf
print *, ' norm = ', norm
print *, ' ubound = ', ubound
- print *, ' matrix element accepted = ', accepted
+ print *, ' matrix element accepted = ', accepted
end if
end select
end function powheg_matching_reweight_matrix_elements
-@ %def powheg_matching_reweight_matrix_element
+@ %def powheg_matching_reweight_matrix_elements
@
\subsubsection{Generation algorithm and grid initialization}
[[compute_sqme_real]] is the projected real matrix element
$R_{\alpha_r} = S_{\alpha_r} R$ whereby the current $\alpha_r$ is
implied by the [[emitter]]. Furthermore, it is multiplied by the
-Jacobian.
+real and the random number Jacobian.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: compute_sqme_real => powheg_matching_compute_sqme_real
<<POWHEG matching: sub interfaces>>=
module function powheg_matching_compute_sqme_real &
(powheg, alr, scale) result (sqme)
real(default) :: sqme
class(powheg_matching_t), intent(inout) :: powheg
integer, intent(in) :: alr
real(default), intent(in), optional :: scale
end function powheg_matching_compute_sqme_real
<<POWHEG matching: procedures>>=
module function powheg_matching_compute_sqme_real &
(powheg, alr, scale) result (sqme)
real(default) :: sqme
class(powheg_matching_t), intent(inout) :: powheg
integer, intent(in) :: alr
real(default), intent(in), optional :: scale
real(default), allocatable :: q
integer :: i_phs, i_term
logical :: is_subtraction
is_subtraction = .false.
select type (pcm_work => powheg%process_instance%pcm_work)
class is (pcm_nlo_workspace_t)
i_phs = powheg%process_deps%alr_to_i_phs (alr)
- i_term = powheg%process_deps%i_term_real(i_phs)
+ i_term = powheg%process_deps%i_term_real (i_phs)
associate (instance => powheg%process_instance)
- select type (pcm_work => instance%term(i_term)%pcm_work)
- type is (pcm_nlo_workspace_t)
- call pcm_work%set_powheg_mode ()
- end select
if (present(scale)) then
if (.not. allocated (q)) then
allocate (q, source = scale)
else
q = scale
end if
call instance%compute_sqme_rad &
(i_term, i_phs, is_subtraction, scale_forced=q)
else
call instance%compute_sqme_rad (i_term, i_phs, is_subtraction)
end if
sqme = instance%get_sqme (i_term)
end associate
end select
end function powheg_matching_compute_sqme_real
@ %def powheg_matching_compute_sqme_real
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: set_scale => powheg_matching_set_scale
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_set_scale (powheg, pT2)
class(powheg_matching_t), intent(inout) :: powheg
real(default), intent(in) :: pT2
end subroutine powheg_matching_set_scale
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_set_scale (powheg, pT2)
class(powheg_matching_t), intent(inout) :: powheg
real(default), intent(in) :: pT2
call powheg%process_instance%set_fac_scale (sqrt(pT2))
end subroutine powheg_matching_set_scale
@ %def powheg_matching_set_scale
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: update_sudakovs => powheg_matching_update_sudakovs
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_update_sudakovs (powheg, alr, i_phs, y)
class(powheg_matching_t), intent(inout) :: powheg
integer, intent(in) :: alr, i_phs
real(default), intent(in) :: y
end subroutine powheg_matching_update_sudakovs
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_update_sudakovs (powheg, alr, i_phs, y)
class(powheg_matching_t), intent(inout) :: powheg
integer, intent(in) :: alr, i_phs
real(default), intent(in) :: y
real(default) :: q0, m2, mrec2, k0_rec_max
type(vector4_t) :: p_emitter
select type (s => powheg%sudakov(alr)%s)
type is (sudakov_massive_fsr_t)
q0 = sqrt (s%event_deps%s_hat)
p_emitter = s%event_deps%p_born_lab%get_momentum (1, &
s%associated_emitter ())
associate (p => p_emitter%p)
mrec2 = (q0 - p(0))**2 - p(1)**2 - p(2)**2 - p(3)**2
end associate
m2 = p_emitter**2
call compute_dalitz_bounds (q0, m2, mrec2, s%z1, s%z2, k0_rec_max)
s%z = s%z2 - (s%z2 - s%z1) * (one + y) / two
end select
end subroutine powheg_matching_update_sudakovs
@ %def powheg_matching_update_sudakovs
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: import_norms_from_grid => powheg_matching_import_norms_from_grid
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_import_norms_from_grid (powheg)
class(powheg_matching_t), intent(inout) :: powheg
end subroutine powheg_matching_import_norms_from_grid
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_import_norms_from_grid (powheg)
class(powheg_matching_t), intent(inout) :: powheg
integer :: alr
real(default) :: norm_max
do alr = 1, powheg%process_deps%n_alr
norm_max = powheg%grid%get_maximum_in_3d (alr)
call powheg%sudakov(alr)%s%set_normalization (norm_max)
end do
end subroutine powheg_matching_import_norms_from_grid
@ %def powheg_matching_import_norms_from_grid
@ We save the POWHEG grid to a file to be used for the event generation.
If it has no non-zero entries, we assume that the integration was skipped
because there were existing VAMP(2) and POWHEG grid files.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: save_grids => powheg_matching_save_grids
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_save_grids (powheg)
class(powheg_matching_t), intent(inout) :: powheg
end subroutine powheg_matching_save_grids
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_save_grids (powheg)
class(powheg_matching_t), intent(inout) :: powheg
type(string_t) :: filename, n_points
filename = powheg%process_name // ".pg"
if (powheg%grid%has_non_zero_entries()) then
call powheg%grid%save_to_file (char (filename))
else
call msg_warning("POWHEG grid not saved to file. An existing " // &
& char(filename) // " will be used for the events.")
end if
end subroutine powheg_matching_save_grids
@ %def powheg_matching_save_grids
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: load_grids => powheg_matching_load_grids
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_load_grids (powheg)
class(powheg_matching_t), intent(inout) :: powheg
end subroutine powheg_matching_load_grids
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_load_grids (powheg)
class(powheg_matching_t), intent(inout) :: powheg
type(string_t) :: filename, n_points
filename = powheg%process_name // ".pg"
call powheg%grid%load_from_file (char (filename))
if (powheg%grid%has_non_zero_entries()) then
write (msg_buffer, "(A,A,A)") "POWHEG: using grids from file '", &
char (filename), "'"
else
call msg_fatal("POWHEG grid in " // char(filename) // &
& " is zero and cannot be used for event generation.")
end if
call msg_message ()
end subroutine powheg_matching_load_grids
@ %def powheg_matching_load_grids
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: check_grids => powheg_matching_check_grids
<<POWHEG matching: sub interfaces>>=
module function powheg_matching_check_grids (powheg) result (ok)
logical :: ok
class(powheg_matching_t), intent(in) :: powheg
end function powheg_matching_check_grids
<<POWHEG matching: procedures>>=
module function powheg_matching_check_grids (powheg) result (ok)
logical :: ok
class(powheg_matching_t), intent(in) :: powheg
type(string_t) :: filename, n_points
filename = powheg%process_name // ".pg"
ok = os_file_exist (filename) .and. &
verify_points_for_grid (char (filename), &
[powheg%settings%size_grid_xi, &
powheg%settings%size_grid_y, &
powheg%process_deps%n_alr])
end function powheg_matching_check_grids
@ %def powheg_matching_check_grids
@ This routine implements the Sudakov veto algorithm as explained in
[[[1002.2581]]], Sec. 7.1 and Bijans thesis, Sec. 3.3 and B.2.
Here, we veto in order to correct for
\begin{enumerate}
\item an overestimation of parts of the upper bounding function
- for complicated UBFs in [[reweight_ubf]]
- \item the usage of $\alpha_s^\text{rad}$ instead of $\alpha_s^\text{true}$
- in [[reweight_alpha_s]]
+ for complicated UBFs in [[reweight_ubf]] as well as the usage of
+ $\alpha_s^\text{rad}$ instead of $\alpha_s^\text{true}$.
\item the usage of [[xi_max_extended]] instead of [[xi_max]] in [[reweight_xi_max]]
which is only non-trivial for massive FSR and ISR.
\item using the maximum of the entire POWHEG normalization grid $N_\text{max}$
when generating $p_T$ instead of the correct bin value $N(\xi_i,y_i)$ in [[reweight_norm]].
\item the normalization grid and the upper bounding function in the first place
in [[reweight_matrix_elements]] to retrieve the correct fraction
$\frac{\mathcal{R}(\xi,y) \mathcal{J}(\xi,y)}{\mathcal{B}}$.
\end{enumerate}
-By keeping the radiation with the largest [[pt2]], we are effectively
-implementing the highest bid procedure.
-The loop over ALRs implemented here should instead loop over all
-radiation regions [[i_phs]] for each underlying Born flavor structure $f_b$.
-We should then pick the ALR with probability proportional to the corresponding
-$\mathcal{R}_{\alpha_r}$. The version here works only for $ee \to t \overline{t}$
-as there is just a single $f_b$ and each ALR corresponds to its own real phase space.
+By looping over all ALRs and in the end choosing the ALR with the largest [[pt2]],
+we are effectively implementing the highest bid procedure.
+To save some time generating equivalent phase spaces again and again,
+we could instead loop over all radiation regions [[i_phs]],
+take the sum of all real matrix elements in the Sudakov and in the end
+pick the ALR with probability proportional to the corresponding
+$\mathcal{R}_{\alpha_r}$. We might implement this optimization in the future.
We need to compute [[xi2_max]] before [[kt2_max]] here.
In the simple case, it is given by $\xi_\text{max} = \frac{s-M_\text{rec}^2}{s}$
but we can also take the $\xi_\text{max}$ from the phase space computed before;
they coincide. This is possible already at this point because in the simple case,
$\xi_\text{max}$ only depends on the Born momentum of the emitter and not on the
real kinematics.
In the eeqq case, $M_\text{rec} = 0$, so $\xi_\text{max} = 1$ and in the massive
case as well as in the ISR case, we compute an extended $\xi_\text{max}^\text{ext}$
because the actual $\xi_\text{max}$ depends on the real kinematics.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: generate_emission => powheg_matching_generate_emission
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_generate_emission &
(powheg, particle_set, pt2_generated)
class(powheg_matching_t), intent(inout) :: powheg
type(particle_set_t), intent(inout), optional :: particle_set
real(default), intent(out), optional :: pt2_generated
end subroutine powheg_matching_generate_emission
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_generate_emission &
(powheg, particle_set, pt2_generated)
class(powheg_matching_t), intent(inout) :: powheg
type(particle_set_t), intent(inout), optional :: particle_set
real(default), intent(out), optional :: pt2_generated
type(radiation_t) :: r, r_max
real(default) :: xi2_max
integer :: alr
logical :: accepted
type(vector4_t), dimension(:), allocatable :: p_real_max
if (signal_is_pending ()) return
r_max%pt2 = zero
r_max%alr = 0
if (debug_on) call msg_debug (D_MATCHING, "powheg_matching_generate_emission")
select type (pcm => powheg%process_instance%pcm)
type is (pcm_nlo_t)
allocate (p_real_max (pcm%region_data%n_legs_real))
end select
select type (pcm_work => powheg%process_instance%pcm_work)
class is (pcm_nlo_workspace_t)
do alr = 1, powheg%process_deps%n_alr
if (signal_is_pending ()) return
associate (sudakov => powheg%sudakov(alr)%s)
select type (sudakov)
type is (sudakov_simple_fsr_t)
xi2_max = pcm_work%get_xi_max (alr)**2
call sudakov%update_xi2_max (xi2_max)
if (debug2_active (D_MATCHING)) then
call check_xi2_max (sudakov)
end if
type is (sudakov_eeqq_fsr_t)
call sudakov%update_xi2_max (one)
type is (sudakov_massive_fsr_t)
call sudakov%compute_xi_max_extended (sudakov%i_phs)
type is (sudakov_isr_t)
call sudakov%compute_xi_max_extended ()
class default
call msg_fatal ("powheg_matching_generate_emission: unknown Sudakov!")
end select
r%alr = alr
r%pt2 = sudakov%kt2_max ()
sudakov%sum_log_rands = 0
if (debug_on) call msg_debug (D_MATCHING, "Starting evolution at r%pt2", r%pt2)
PT_EVOLUTION: do
if (signal_is_pending ()) return
- call sudakov%generate_emission (r)
+ call sudakov%generate_emission (r, r_max)
if (signal_is_pending ()) return
if (r%valid) then
accepted = powheg%reweight_norm (r)
call sudakov%veto_counter%record_norm (.not. accepted)
if (.not. accepted) cycle PT_EVOLUTION
accepted = powheg%reweight_matrix_elements (r)
call sudakov%veto_counter%record_sqme (.not. accepted)
if (.not. accepted) cycle PT_EVOLUTION
end if
exit
end do PT_EVOLUTION
if (r%pt2 > r_max%pt2 .and. r%valid) then
r_max = r
p_real_max = powheg%event_deps%p_real_lab%get_momenta (sudakov%i_phs)
end if
end associate
end do
if (r_max%pt2 > powheg%settings%pt2_min) then
powheg%n_emissions = powheg%n_emissions + 1
call powheg%set_scale (r_max%pt2)
if (present (particle_set)) then
call powheg%build_particle_set (particle_set, &
- powheg%event_deps%p_born_lab%get_momenta (1), &
p_real_max, r_max%alr, r_max%y)
end if
if (present (pt2_generated)) pt2_generated = r_max%pt2
else
call powheg%set_scale (powheg%settings%pt2_min)
if (present (pt2_generated)) pt2_generated = powheg%settings%pt2_min
end if
end select
contains
subroutine check_xi2_max (sudakov)
class(sudakov_t), intent(in) :: sudakov
real(default) :: s_hat, mrec2, xi2_max
type(vector4_t) :: p_emitter
s_hat = sudakov%event_deps%s_hat
p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
(1, sudakov%associated_emitter())
associate (p => p_emitter%p)
mrec2 = (sqrt(s_hat) - p(0))**2 - p(1)**2 - p(2)**2 - p(3)**2
end associate
xi2_max = (s_hat - mrec2) / s_hat
xi2_max = xi2_max**2
call assert_equal (OUTPUT_UNIT, sudakov%xi2_max, xi2_max, &
"powheg_matching_generate_emission: xi_max inconsistent")
end subroutine check_xi2_max
end subroutine powheg_matching_generate_emission
@ %def generate_emission
@
<<POWHEG matching: powheg matching: TBP>>=
procedure :: build_particle_set => powheg_matching_build_particle_set
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_build_particle_set &
- (powheg, particle_set, p_born, p_real, alr, y)
+ (powheg, particle_set, p_real, alr, y)
class(powheg_matching_t), intent(inout) :: powheg
type(particle_set_t), intent(inout) :: particle_set
- type(vector4_t), dimension(:), intent(in) :: p_born, p_real
+ type(vector4_t), dimension(:), intent(in) :: p_real
integer, intent(in) :: alr
real(default), intent(in) :: y
end subroutine powheg_matching_build_particle_set
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_build_particle_set &
- (powheg, particle_set, p_born, p_real, alr, y)
+ (powheg, particle_set, p_real, alr, y)
class(powheg_matching_t), intent(inout) :: powheg
type(particle_set_t), intent(inout) :: particle_set
- type(vector4_t), dimension(:), intent(in) :: p_born, p_real
+ type(vector4_t), dimension(:), intent(in) :: p_real
integer, intent(in) :: alr
real(default), intent(in) :: y
integer, dimension(:), allocatable :: i_flvs_real, flv_radiated
real(default) :: r_col
integer :: emitter, i_flv_real
select type (pcm => powheg%process_instance%pcm)
type is (pcm_nlo_t)
i_flvs_real = pcm%region_data%get_flavor_indices (.false.)
i_flv_real = i_flvs_real (alr)
allocate (flv_radiated (size (pcm%region_data%get_flv_states_real (i_flv_real))))
flv_radiated = pcm%region_data%get_flv_states_real (i_flv_real)
emitter = pcm%region_data%get_emitter(alr)
if (emitter == 0) then
if (y > 0) then
emitter = 1
else
emitter = 2
end if
end if
end select
call powheg%rng%generate (r_col)
call particle_set%build_radiation (p_real, emitter, flv_radiated, &
powheg%process_instance%process%get_model_ptr (), r_col)
end subroutine powheg_matching_build_particle_set
@ %def powheg_matching_build_particle_set
@ When generating the transverse momentum in [[sudakov_generate_pt2]],
we used $N^\mathrm{max}$ as normalization. In this veto step, we correct
for this by keeping events with probability
\begin{equation*}
\frac{N(\xi_i,y_i)}{N^\mathrm{max}}.
\end{equation*}
<<POWHEG matching: powheg matching: TBP>>=
procedure :: reweight_norm => powheg_matching_reweight_norm
<<POWHEG matching: sub interfaces>>=
module function powheg_matching_reweight_norm (powheg, r) result (accepted)
logical :: accepted
class(powheg_matching_t), intent(inout) :: powheg
type(radiation_t), intent(in) :: r
end function powheg_matching_reweight_norm
<<POWHEG matching: procedures>>=
module function powheg_matching_reweight_norm (powheg, r) result (accepted)
logical :: accepted
class(powheg_matching_t), intent(inout) :: powheg
type(radiation_t), intent(in) :: r
real(default) :: random, norm_max, norm_true
if (debug_on) call msg_debug2 (D_MATCHING, "reweight_norm")
call powheg%rng%generate (random)
norm_true = powheg%norm_from_xi_and_y (r)
norm_max = powheg%sudakov(r%alr)%s%norm_max
accepted = random < norm_true / norm_max
if (debug2_active (D_MATCHING)) then
print *, ' r%alr = ', r%alr
print *, ' random = ', random
print *, ' norm_true = ', norm_true
print *, ' norm_max = ', norm_max
print *, ' norm accepted = ', accepted
end if
if (debug_active (D_MATCHING)) then
if (.not. (zero < r%xi .and. &
r%xi < sqrt(powheg%sudakov(r%alr)%s%xi2_max))) then
call msg_bug ("powheg_matching_reweight_norm: xi is out of bounds")
end if
if (norm_true > norm_max) then
call msg_bug ("powheg_matching_reweight_norm: norm shouldnt be larger than norm_max")
end if
end if
end function powheg_matching_reweight_norm
@ %def powheg_matching_reweight_norm
@ Retrieves the value of the norm for given $\xi$ and $y$ from the pre-computed POWHEG grid.
-To find the correct bin in the grid, we need to invert the
-generation of $\xi$ and $y$ from their corresponding random numbers.
-As the grid is filled during integration, the formulas here are the inverse of
-those in [[compute_y_from_emitter]] instead of those specific for POWHEG matching.
-There, we coompute $y$ with [[y = (one - two * r_y)]] and [[y = 1.5_default * (y - y**3 / 3)]].
-The inverse of this operation is given by
-\begin{align}
- r_y &=
- \begin{cases}
- \frac14 \left[ (i\sqrt{3}-1)A^{\frac13}
- - (i\sqrt{3}+1)A^{-\frac13} + 2 \right]
- \quad \text{for} \quad y < 0 \\
- \frac14 \left[-(i\sqrt{3}+1)A^{\frac13}
- + (i\sqrt{3}-1)A^{-\frac13} + 2 \right]
- \quad \text{for} \quad y > 0
- \end{cases}\nonumber\\
- &\text{with} \quad A = \sqrt{y^2-1} + y
-\end{align}
+To find the correct bin we need to map $(\xi,y)$ in some way to $[0,1]^2$.
+This mapping is to the most extend arbitrary. We choose
+$y \mapsto |y|$ and
+$\xi \mapsto \log(\frac{1}{1-\xi}) / \log(\frac{1}{1-\xi_{max}})$.
+It may be possible to improve these mappings to tune the performance for processes
+with expensive matrix elements.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: norm_from_xi_and_y => powheg_matching_norm_from_xi_and_y
<<POWHEG matching: sub interfaces>>=
module function powheg_matching_norm_from_xi_and_y &
(powheg, r) result (norm_true)
real(default) :: norm_true
class(powheg_matching_t), intent(inout) :: powheg
type(radiation_t), intent(in) :: r
end function powheg_matching_norm_from_xi_and_y
<<POWHEG matching: procedures>>=
module function powheg_matching_norm_from_xi_and_y &
(powheg, r) result (norm_true)
real(default) :: norm_true
class(powheg_matching_t), intent(inout) :: powheg
type(radiation_t), intent(in) :: r
- real(default) :: f_alr
+ real(default) :: f_alr, xi_max
real(default), dimension(2) :: rands
- real(default) :: beta
f_alr = (one * r%alr) / powheg%process_deps%n_alr - tiny_07
- rands(I_XI) = r%xi / sqrt (powheg%sudakov(r%alr)%s%xi2_max)
- select type (s => powheg%sudakov(r%alr)%s)
- type is (sudakov_simple_fsr_t)
- rands(I_Y) = map_y_to_rands_massless(r%y)
- type is (sudakov_massive_fsr_t)
- beta = beta_emitter (sqrt (powheg%event_deps%s_hat), &
- powheg%event_deps%p_born_lab%get_momentum (1, s%associated_emitter()))
- rands(I_Y) = - log((one - r%y * beta) / (one + beta)) / &
- log((one + beta) / (one - beta))
- type is (sudakov_eeqq_fsr_t)
- rands(I_Y) = map_y_to_rands_massless(r%y)
- type is (sudakov_isr_t)
- rands(I_Y) = map_y_to_rands_massless(r%y)
- class default
- call msg_fatal ("powheg_matching_norm_from_xi_and_y: unknown Sudakov!")
- end select
+ rands(I_Y) = abs(r%y)
+ xi_max = min(sqrt (powheg%sudakov(r%alr)%s%xi2_max), 1 - tiny_07)
+ if (r%xi > xi_max) then
+ rands(I_XI) = 1
+ else
+ rands(I_XI) = log(1 / (1 - r%xi)) / log(1 / (1 - xi_max))
+ end if
norm_true = powheg%grid%get_value ([rands, f_alr])
- contains
- function map_y_to_rands_massless (y) result (r_y)
- real(default), intent(in) :: y
- real(default) :: r_y
- complex(default) :: y_cmplx, A, r_y_cmplx
- y_cmplx = cmplx(y, 0, default)
- A = sqrt(y_cmplx**2 - 1) + y_cmplx
- if (y < 0) then
- r_y_cmplx = 0.25_default * (cmplx(-one,sqrt(three)) * A**(one/three) &
- - cmplx(one,sqrt(three)) * A**(-one/three) + two)
- else if (y == 0) then
- r_y_cmplx = cmplx(0.5_default,0)
- else if (y > 0) then
- r_y_cmplx = 0.25_default * (-cmplx(one,sqrt(three)) * A**(one/three) &
- + cmplx(-one,sqrt(three)) * A**(-one/three) + two)
- end if
- r_y = real(r_y_cmplx)
- end function map_y_to_rands_massless
end function powheg_matching_norm_from_xi_and_y
@ %def powheg_matching_norm_from_xi_and_y
@
\subsection{$\alpha_s$ and its reweighting}
The main point to ensure here is that the simple fixed-flavor-1-loop
expression $\alpha_s^\text{rad}$ is larger than the more accurate
$\alpha_s$ such that we can use a reweighting veto and use
$\alpha_s^\text{rad}$ for the generation of the emission. This can be
done by setting
\begin{equation}
\alpha_s^\text{rad}(\mu_0) = \alpha_s (\mu_0)
\end{equation}
whereby $\mu_0^2$ is the [[scale_to_relate2]] that is taken to be
-$p_{T,\text{min}}^2$.
+$(2 \Lambda^{(5)}_{\overline{MS}})^2$.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: prepare_for_events => powheg_matching_prepare_for_events
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_prepare_for_events (matching)
class(powheg_matching_t), intent(inout), target :: matching
end subroutine powheg_matching_prepare_for_events
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_prepare_for_events (matching)
class(powheg_matching_t), intent(inout), target :: matching
if (debug_on) call msg_debug &
(D_MATCHING, "powheg_matching_prepare_for_events")
call matching%setup_nlo_environment ()
call matching%grid%init ([matching%settings%size_grid_xi, &
matching%settings%size_grid_y, matching%process_deps%n_alr])
+ call matching%compute_lambda5MSB ()
call matching%compute_lambda2_gen ()
call matching%setup_sudakovs ()
end subroutine powheg_matching_prepare_for_events
@ %def powheg_matching_prepare_for_events
@ Computes the scale $\Lambda$ used for the (log integrated) UBFs.
By construction, it is always $p_{T,\text{min}} > \Lambda$.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: compute_lambda2_gen => powheg_matching_compute_lambda2_gen
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_compute_lambda2_gen (matching)
class(powheg_matching_t), intent(inout) :: matching
end subroutine powheg_matching_compute_lambda2_gen
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_compute_lambda2_gen (matching)
class(powheg_matching_t), intent(inout) :: matching
real(default) :: scale_to_relate2, alpha_s
- scale_to_relate2 = matching%settings%pt2_min
- alpha_s = get_alpha_s (matching%qcd, scale_to_relate2)
- matching%process_deps%lambda2_gen = exp (- one / (b0rad * alpha_s)) * &
+ scale_to_relate2 = (2*matching%process_deps%lambda5MSB)**2
+ alpha_s = get_alpha_s (matching%qcd, scale_to_relate2, 3)
+ matching%process_deps%lambda2_gen = exp (- one / (b0rad () * alpha_s)) * &
scale_to_relate2
end subroutine powheg_matching_compute_lambda2_gen
@ %def powheg_matching_compute_lambda2_gen
+@ Computes the scale $\Lambda^{(5)}_{\overline{MS}}$ used to determine the scale
+at which we relate $\alpha_s^{\text{rad}}$ and $\alpha_s^{\text{true}}$.
+<<POWHEG matching: powheg matching: TBP>>=
+ procedure :: compute_lambda5MSB => powheg_matching_compute_lambda5MSB
+<<POWHEG matching: sub interfaces>>=
+ module subroutine powheg_matching_compute_lambda5MSB (matching)
+ class(powheg_matching_t), intent(inout) :: matching
+ end subroutine powheg_matching_compute_lambda5MSB
+<<POWHEG matching: procedures>>=
+ module subroutine powheg_matching_compute_lambda5MSB (matching)
+ class(powheg_matching_t), intent(inout) :: matching
+ real(default) :: alpha_s
+ integer :: nf, order
+ logical :: print_once = .true.
+ if (matching%settings%lambda == 0) then
+ alpha_s = matching%qcd%alpha%get(MZ_REF)
+ select type (alpha => matching%qcd%alpha)
+ type is (alpha_qcd_from_scale_t)
+ order = alpha%order
+ type is (alpha_qcd_from_lambda_t)
+ order = alpha%order
+ type is (alpha_qcd_lhapdf_t)
+ if (print_once) then
+ call msg_warning ("compute_lambda5MSB: LHAPDF not fully supported" // &
+ " Assuming LO (1-loop) running!")
+ print_once = .false.
+ end if
+ !!! TODO (PS-2021-09-16) We'd need to get order from LHAPDF to continue here.
+ order = 1
+ class default
+ if (print_once) then
+ call msg_warning ("compute_lambda5MSB: alpha_qcd not running!" // &
+ " Assuming LO (1-loop) running!")
+ print_once = .false.
+ end if
+ order = 0
+ end select
+ nf = 5
+ matching%process_deps%lambda5MSB = lambda_qcd(alpha_s, MZ_REF, nf, order)
+ else if (matching%settings%lambda > 0) then
+ matching%process_deps%lambda5MSB = matching%settings%lambda
+ else
+ call msg_fatal ("compute_lambda5MSB: lambda5MSB < 0")
+ end if
+ end subroutine powheg_matching_compute_lambda5MSB
+
+@ %def powheg_matching_compute_lambda5MSB
@ This is the setup of the process dependencies stored for the matching.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: setup_nlo_environment => powheg_matching_setup_nlo_environment
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_setup_nlo_environment (matching)
class(powheg_matching_t), intent(inout) :: matching
end subroutine powheg_matching_setup_nlo_environment
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_setup_nlo_environment (matching)
class(powheg_matching_t), intent(inout) :: matching
integer :: n_tot_born, n_tot_real
integer :: i_phs, i_term_real, i_term
integer :: n_phs, nlo_type
if (debug_on) call msg_debug &
(D_MATCHING, "powheg_matching_setup_nlo_environment")
select type (pcm_work => matching%process_instance%pcm_work)
class is (pcm_nlo_workspace_t)
matching%process_deps%sqrts = matching%process_instance%get_sqrts ()
select type (pcm => matching%process_instance%pcm)
type is (pcm_nlo_t)
matching%process_deps%n_alr = pcm%region_data%n_regions
n_tot_born = pcm%region_data%n_legs_born
n_tot_real = pcm%region_data%n_legs_real
call pcm%setup_phs_generator (pcm_work, &
matching%phs_fks_generator, matching%process_deps%sqrts, &
singular_jacobian = matching%settings%singular_jacobian)
end select
associate (instance => matching%process_instance)
i_term_real = instance%process%get_first_real_component ()
associate (process_deps => matching%process_deps)
select type (phs => instance%kin(i_term_real)%phs)
type is (phs_fks_t)
n_phs = size (phs%phs_identifiers)
allocate (process_deps%phs_identifiers (n_phs))
process_deps%phs_identifiers = phs%phs_identifiers
end select
call instance%process%get_coupling_powers(process_deps%alpha_power, &
process_deps%alphas_power)
allocate (matching%process_deps%alr_to_i_phs &
(size (pcm_work%real_kinematics%alr_to_i_phs)))
process_deps%alr_to_i_phs = pcm_work%real_kinematics%alr_to_i_phs
allocate (process_deps%i_term_real (n_phs))
i_phs = 1
do i_term = 1, size (instance%term)
nlo_type = instance%term(i_term)%nlo_type
if (nlo_type == BORN) then
process_deps%i_term_born = i_term
else if (nlo_type == NLO_REAL) then
if (instance%kin(i_term)%emitter >= 0) then
process_deps%i_term_real(i_phs) = i_term
i_phs = i_phs + 1
end if
end if
end do
end associate
end associate
call matching%event_deps%p_born_lab%init (n_tot_born, 1)
call matching%event_deps%p_born_cms%init (n_tot_born, 1)
call matching%event_deps%p_real_lab%init (n_tot_real, n_phs)
call matching%event_deps%p_real_cms%init (n_tot_real, n_phs)
end select
end subroutine powheg_matching_setup_nlo_environment
@ %def powheg_matching_setup_nlo_environment
-@ Copy momenta from [[event_deps]] to [[real_kinematics]].
+@ Copy momenta from [[event_deps]] to [[real_kinematics]]
+for them to be available for the [[int_hard]] in [[compute_sqme_rad]].
<<POWHEG matching: powheg matching: TBP>>=
procedure :: copy_momenta => powheg_matching_copy_momenta
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_copy_momenta (matching, i_phs)
class(powheg_matching_t), intent(inout) :: matching
integer, intent(in) :: i_phs
end subroutine powheg_matching_copy_momenta
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_copy_momenta (matching, i_phs)
class(powheg_matching_t), intent(inout) :: matching
integer, intent(in) :: i_phs
select type (pcm_work => matching%process_instance%pcm_work)
class is (pcm_nlo_workspace_t)
call pcm_work%real_kinematics%p_real_cms%set_momenta &
(i_phs, matching%event_deps%p_real_cms%get_momenta (i_phs))
call pcm_work%real_kinematics%p_real_lab%set_momenta &
(i_phs, matching%event_deps%p_real_lab%get_momenta (i_phs))
end select
end subroutine powheg_matching_copy_momenta
@ %def powheg_matching_copy_momenta
@ [[qcd%alpha%get]] should implement a variable-flavor result and
-optionally return [[n_flavors]] that are active at the scale...
+optionally return [[n_flavors]] that are active at the scale.
+Optionally takes [[nf]] as input preceeding the PDFs value.
+We need this to compute $\alpha_s^{rad}$ always with [[nf=3]].
<<POWHEG matching: procedures>>=
- function get_alpha_s (qcd, scale2) result (alpha_s)
+ function get_alpha_s (qcd, scale2, nf_in, improve_nll_opt) result (alpha_s)
real(default) :: alpha_s
class(qcd_t), intent(in) :: qcd
real(default), intent(in) :: scale2
- integer :: nf, order
- ! TODO: (bcn 2015-01-30) implement variable flavor alpha_s
+ integer, optional, intent(in) :: nf_in
+ logical, optional, intent(in) :: improve_nll_opt
+ logical :: improve_nll
+ real(default) :: mb, mc
+ integer :: nf
+ logical :: print_once = .true.
+ ! TODO: (bcn 2015-01-30) implement variable flavor alpha_s for all types
+ improve_nll = .true.; if (present(improve_nll_opt)) improve_nll = improve_nll_opt
alpha_s = qcd%alpha%get (sqrt(scale2))
select type (alpha => qcd%alpha)
type is (alpha_qcd_from_scale_t)
nf = alpha%nf
- order = alpha%order
type is (alpha_qcd_from_lambda_t)
nf = alpha%nf
- order = alpha%order
type is (alpha_qcd_lhapdf_t)
- call msg_warning ("get_alpha_s for LHADPF not supported!" // &
- " Assuming 5-flavors and LO (1-loop) running!")
- !!! TODO (PS-2021-09-16) We'd need to get nf from LHAPDF to continue here.
- nf = 5
- order = 0
+ mc = alpha%get_qmass(4)
+ mb = alpha%get_qmass(5)
+ if (scale2 > mb**2) then
+ nf = 5
+ elseif (scale2 > mc**2) then
+ nf = 4
+ else
+ nf = 3
+ end if
class default
- call msg_warning ("get_alpha_s: QCD type is not running!" // &
- " Assuming 5-flavors and LO (1-loop) running!")
+ if (print_once) then
+ call msg_warning ("get_alpha_s: QCD type is not running!" // &
+ " Assuming 5-flavors and LO (1-loop) running!")
+ print_once = .false.
+ end if
nf = 5
- order = 0
end select
- if (order > 0) alpha_s = improve_nll_accuracy (alpha_s, nf)
+ if (present(nf_in)) then
+ nf = nf_in
+ end if
+ if (improve_nll) then
+ alpha_s = improve_nll_accuracy (alpha_s, nf)
+ end if
end function get_alpha_s
@ %def get_alpha_s
@ See Eq. (4.31) in [[0709.2092]]. Should be used everywhere in the Sudakov
exponent.
<<POWHEG matching: procedures>>=
pure function improve_nll_accuracy (alpha_s, n_flavors) result (alpha_s_imp)
real(default) :: alpha_s_imp
real(default), intent(in) :: alpha_s
integer, intent(in) :: n_flavors
alpha_s_imp = alpha_s * (one + alpha_s / (two*pi) * &
((67.0_default/18 - pi**2/6) * CA - five/9 * n_flavors))
end function improve_nll_accuracy
@ %def improve_nll_accuracy
-@ This is fixed to $n_f=5$ for radiation generation. It will be
+@ Wrapper for $b_0(n_f=5)$ from the [[sm_physics]] module.
+It is fixed to $n_f=5$ for radiation generation and will be
reweighted to the more precise $\alpha_s$.
-<<POWHEG matching: parameters>>=
- real(default), parameter :: b0rad = (33 - 2 * 5) / (12 * pi)
+<<POWHEG matching: procedures>>=
+ pure function b0rad () result (b0)
+ real(default) :: b0
+ b0 = coeff_b0(five)
+ end function b0rad
@ %def b0rad
-@
+@ Computes the overestimated $\alpha_s$ for the sudakov before the $\alpha_s$-Veto.
+We do not NLL-correct $\alpha_s$ again. We did so already when computing [[lambda2_gen]].
<<POWHEG matching: sudakov: TBP>>=
procedure :: alpha_s_rad => sudakov_alpha_s_rad
<<POWHEG matching: sub interfaces>>=
- elemental module function sudakov_alpha_s_rad (sudakov, scale2) result (y)
- real(default) :: y
+ elemental module function sudakov_alpha_s_rad (sudakov, scale2) result (alpha_s_rad)
+ real(default) :: alpha_s_rad
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: scale2
end function sudakov_alpha_s_rad
<<POWHEG matching: procedures>>=
- elemental module function sudakov_alpha_s_rad (sudakov, scale2) result (y)
- real(default) :: y
+ elemental module function sudakov_alpha_s_rad (sudakov, scale2) result (alpha_s_rad)
+ real(default) :: alpha_s_rad
class(sudakov_t), intent(in) :: sudakov
real(default), intent(in) :: scale2
- y = one / (b0rad * log (scale2 / sudakov%process_deps%lambda2_gen))
+ alpha_s_rad = one / (b0rad () * log (scale2 / sudakov%process_deps%lambda2_gen))
end function sudakov_alpha_s_rad
@ %def sudakov_alpha_s_rad
@
-<<POWHEG matching: sudakov: TBP>>=
- procedure :: reweight_alpha_s => sudakov_reweight_alpha_s
-<<POWHEG matching: sub interfaces>>=
- module function sudakov_reweight_alpha_s (sudakov, pt2) result (accepted)
- logical :: accepted
- class(sudakov_t), intent(inout) :: sudakov
- real(default), intent(in) :: pt2
- end function sudakov_reweight_alpha_s
-<<POWHEG matching: procedures>>=
- module function sudakov_reweight_alpha_s (sudakov, pt2) result (accepted)
- logical :: accepted
- class(sudakov_t), intent(inout) :: sudakov
- real(default), intent(in) :: pt2
- real(default) :: alpha_s_true, alpha_s_rad
- logical :: alpha_s_equal
- if (debug_on) call msg_debug2 (D_MATCHING, "reweight_alpha_s")
- alpha_s_true = get_alpha_s (sudakov%qcd, pt2)
- alpha_s_rad = sudakov%alpha_s_rad (pt2)
- call sudakov%rng%generate (sudakov%random)
- alpha_s_equal = nearly_equal (alpha_s_true, alpha_s_rad)
- accepted = alpha_s_equal .or. sudakov%random < alpha_s_true / alpha_s_rad
- if (debug2_active (D_MATCHING)) then
- print *, ' sudakov%random = ', sudakov%random
- print *, ' alpha_s_true = ', alpha_s_true
- print *, ' alpha_s_rad = ', alpha_s_rad
- print *, ' alpha_s accepted = ', accepted
- if (alpha_s_rad < alpha_s_true .and. .not. alpha_s_equal) then
- print *, 'pt2 = ', pt2
- print *, 'sudakov%process_deps%lambda2_gen = ', &
- sudakov%process_deps%lambda2_gen
- call msg_fatal ("sudakov_reweight_alpha_s: This should never happen. &
- &Have you chosen a running alpha_s?")
- end if
- end if
- end function sudakov_reweight_alpha_s
-
-@ %def sudakov_reweight_alpha_s
-@
\subsection{POWHEG hook}
We provide a POWHEG hook to be called by [[process_instance_evaluate]] to
prefill the adaptation grid.
We store the actual [[powheg]] object, which does the computations.
<<POWHEG matching: public>>=
public :: powheg_matching_hook_t
<<POWHEG matching: types>>=
type, extends(process_instance_hook_t) :: powheg_matching_hook_t
type(string_t) :: process_name
type(powheg_matching_t) :: powheg
contains
<<POWHEG matching: powheg matching hook: TBP>>
end type powheg_matching_hook_t
@ %def powheg_matching_t
@ Init the hook. The init procedure will be called in [[setup_process]], after
everything is set up.
Additionally, we have to include [[var_list]] in order to retrieve the grid size
in [[xi]] and [[y]].
<<POWHEG matching: powheg matching hook: TBP>>=
procedure :: init => powheg_matching_hook_init
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_hook_init (hook, var_list, &
instance, pdf_data)
class(powheg_matching_hook_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
type(pdf_data_t), intent(in), optional :: pdf_data
end subroutine powheg_matching_hook_init
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_hook_init (hook, var_list, &
instance, pdf_data)
class(powheg_matching_hook_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
type(pdf_data_t), intent(in), optional :: pdf_data
if (debug_on) call msg_debug (D_MATCHING, "powheg_matching_hook_init")
hook%process_name = instance%get_process_name ()
call hook%powheg%init (var_list, hook%process_name)
hook%powheg%qcd = instance%get_qcd ()
call hook%powheg%connect (instance)
hook%powheg%process_deps%lab_is_cm = &
hook%powheg%process_instance%lab_is_cm (1)
if (present(pdf_data)) then
hook%powheg%process_deps%pdf_data = pdf_data
end if
call hook%powheg%prepare_for_events ()
end subroutine powheg_matching_hook_init
@ %def powheg_matching_hook_init
@ We save the filled grid to file, such that it can be retrieved later on.
The hook object will be deallocated when the instance gets deallocated.
<<POWHEG matching: powheg matching hook: TBP>>=
procedure :: final => powheg_matching_hook_final
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_hook_final (hook)
class(powheg_matching_hook_t), intent(inout) :: hook
end subroutine powheg_matching_hook_final
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_hook_final (hook)
class(powheg_matching_hook_t), intent(inout) :: hook
type(string_t) :: filename
if (debug_on) call msg_debug (D_MATCHING, "powheg_matching_hook_final")
<<POWHEG matching: powheg matching hook final: reduce>>
call hook%powheg%save_grids ()
end subroutine powheg_matching_hook_final
@ %def powheg_matching_hook_final
@
<<POWHEG matching: powheg matching hook final: reduce>>=
@ Reduce all grids to a single grid by using [[MPI_MAX]] on each element.
<<MPI: POWHEG matching: powheg matching hook final: reduce>>=
call hook%powheg%grid%mpi_reduce (MPI_MAX)
@ This routine fills each bin of the POWHEG normalization grid $\{\tilde\xi, \tilde y\}$
@ such that
\begin{equation}
N(\{\tilde\xi, \tilde y\}) = \max_{\forall \xi,y \in \{\tilde\xi, \tilde y\}}
\frac{\mathcal{R}(\xi,y)\mathcal{J}(\xi,y)}{\mathcal{B}\,U(\xi,y,\alpha_s^\text{true})}
\end{equation}
where $\mathcal{R}(\xi,y)$ is the real cross section [[sqme_real]],
$\mathcal{B}$ is the Born cross section [[sqme_born]],
$\mathcal{J}$ is the Jacobian and $U$ the upper bounding function [[ubf]].
For each underlying Born $f_b$, there is a number of radiation regions.
A radiation region rr may correspond to multiple $\alpha_r$s. The phase
space only depends upon the radiation region kinematics rr and not on
the specific $\alpha_r$. $\alpha_r$ can be picked in the set
$\{\alpha_r|f_b,\text{rr}\}$ proportional to their $R_{\alpha_r}$.
For now, we simplify things though and just work with the $\alpha_r$.
References:
\begin{itemize}
\item \texttt{[1002.2581]}, Sec. 7.1
\item Bijans Thesis, Sec. 3.3 and B.2
\end{itemize}
In cases where just the Born kinematic failed the cuts, $\mathcal{B}$ was artificially set
to zero.
Unfortunately, we lost information about the value of [[sqme_born]] in these cases
but we assume that the generator cuts applied for parton showering are weak cuts to
avoid divergent phase space regions, thus $\mathcal{B}$ is large and does not influence $N$
so we can skip these phase space points.
A more appropriate way to solve this problem of Born zeroes is given by the real partition.
With real partition, there are two possible cases if $\mathcal{B} = 0$: if the real phase
space point belongs to the real singular, the real kinematic is Born-like and very likely
also fails the cuts. If the real kinematic is not Born-like, it belongs to the real finite.
In both cases, it is $\mathcal{R} = \mathcal{B} = 0$ and we can savely skip the phase space
point.
In cases where just the real kinematic failed the cuts, $\mathcal{R}$ was artificially set
to zero and we have no way to recover it. We skip these phase space points too. If we apply
the same cuts during integration and event generation, these points are not relevant.
We also skip points where either matrix element is negative. If just one of both is negative,
their ratio is negative and thus cannot possibly be relevant for the grid. If both are negative,
we are in an unphysical region for the PDFs.
-We need to divide the real matrix element by [[xi_max]] to correct for the
-difference in [[apply_kinematic_factors_radiation]] between the real matrix
-element when integrating and when POWHEG matching.
We also need to correct all scale dependences of [[sqme_born]] and [[sqme_real]] from
the process' scale to $p_T$ as this is the scale of the entire Sudakov.
+This affects the PDFs and also $\alpha_s$.
<<POWHEG matching: powheg matching hook: TBP>>=
procedure :: evaluate => powheg_matching_hook_evaluate
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_matching_hook_evaluate (hook, instance)
class(powheg_matching_hook_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
end subroutine powheg_matching_hook_evaluate
<<POWHEG matching: procedures>>=
module subroutine powheg_matching_hook_evaluate (hook, instance)
class(powheg_matching_hook_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
type(vector4_t), dimension(:), allocatable :: p_hard_born
real(default), dimension(:), allocatable :: x
real(default) :: kt2, xi, y, xi_max, onepy, onemy
real(default), dimension(2) :: x_real
- real(default) :: sqme_real, sqme_born
+ real(default) :: sqme_born, sqme_real_x_jac
real(default) :: muren_born, mufac_born, muren_real, mufac_real
real(default) :: alpha_s_kt, alpha_s_muren_born, alpha_s_muren_real
real(default) :: f_alr, norm, ubf
+ real(default) :: r_xi, r_y
real(double), dimension(-6:6) :: pdf_dbl
real(default), dimension(2) :: pdf_born_mufac, pdf_born_kt, &
pdf_real_mufac, pdf_real_kt
real(double) :: x_dbl, q_dbl
integer, dimension(2) :: flv_born, flv_real
- integer :: alr, i_phs, n_x, i_term_born, i_term_real, i_real, &
- emitter, em, n_in
+ integer :: alr, i_phs, n_x, i_term_born, i_term_real, i_real, em
integer :: alphas_power
logical :: is_isr
if (instance%get_active_component_type () == COMP_REAL_FIN) return
associate (powheg => hook%powheg)
allocate (p_hard_born (size (instance%get_p_hard (1))))
p_hard_born = instance%get_p_hard (1)
call powheg%update (p_hard_born)
do alr = 1, powheg%process_deps%n_alr
i_phs = powheg%process_deps%alr_to_i_phs (alr)
i_term_real = powheg%process_deps%i_term_real(i_phs)
i_term_born = powheg%process_deps%i_term_born
select type (phs => instance%kin(i_term_real)%phs)
type is (phs_fks_t)
call phs%generator%get_radiation_variables (i_phs, xi, y)
end select
call powheg%update_sudakovs (alr, i_phs, y)
if (powheg%sudakov(alr)%s%kt2 (xi, y) >= powheg%settings%pt2_min) then
+ sqme_born = instance%get_sqme (i_term_born)
+ sqme_real_x_jac = instance%get_sqme (i_term_real)
+ if (sqme_born <= 0 .or. sqme_real_x_jac <= 0) then
+ cycle
+ end if
+ is_isr = instance%kin(i_term_real)%emitter <= instance%kin(i_term_real)%n_in
select type (pcm_work => instance%pcm_work)
class is (pcm_nlo_workspace_t)
- xi_max = pcm_work%get_xi_max (alr)
+ sqme_real_x_jac = pcm_work%powheg_kinematic_factors_real &
+ (sqme_real_x_jac, alr)
end select
- sqme_born = instance%get_sqme (powheg%process_deps%i_term_born)
- if (debug_active (D_MATCHING)) then
- call assert_equal (OUTPUT_UNIT, sqme_born, &
- powheg%event_deps%sqme_born, "sqme_born " // &
- "stored in instance and event_deps do not coincide!")
- end if
- sqme_real = instance%get_sqme (i_term_real)
- if (sqme_born <= 0 .or. sqme_real <= 0) then
- cycle
- end if
- n_in = instance%kin(i_term_real)%n_in
- emitter = instance%kin(i_term_real)%emitter
- is_isr = emitter <= n_in
- sqme_real = sqme_real / xi_max
+
associate (s => powheg%sudakov(alr)%s)
kt2 = s%kt2(xi, y)
alpha_s_kt = s%alpha_s (kt2, use_correct=.true.)
muren_born = instance%term(i_term_born)%get_ren_scale ()
mufac_born = instance%term(i_term_born)%get_fac_scale ()
muren_real = instance%term(i_term_real)%get_ren_scale ()
mufac_real = instance%term(i_term_real)%get_fac_scale ()
- alpha_s_muren_born = s%alpha_s (muren_born**2, use_correct=.true.)
- alpha_s_muren_real = s%alpha_s (muren_real**2, use_correct=.true.)
+ alpha_s_muren_born = s%alpha_s (muren_born**2, use_correct=.true., improve_nll=.false.)
+ alpha_s_muren_real = s%alpha_s (muren_real**2, use_correct=.true., improve_nll=.false.)
ubf = s%upper_bound_func (xi, y, alpha_s_kt)
end associate
!!! Correct all factors of alphas(muren) to alphas(kt).
alphas_power = powheg%process_deps%alphas_power
sqme_born = (alpha_s_kt / alpha_s_muren_born)**alphas_power * sqme_born
- sqme_real = (alpha_s_kt / alpha_s_muren_real)**(alphas_power+1) * sqme_real
+ sqme_real_x_jac = (alpha_s_kt / alpha_s_muren_real)**(alphas_power+1) * sqme_real_x_jac
!!! Also correct the PDFs previously computed at mufac instead of kt
select type (pcm => instance%term(i_term_real)%pcm)
type is (pcm_nlo_t)
if (pcm%has_pdfs) then
associate (reg_data => pcm%region_data)
flv_born = reg_data%flv_born(i_term_born)%flst(1:2)
where (flv_born == 21) flv_born = 0
i_real = reg_data%regions(alr)%real_index
flv_real = reg_data%flv_real(i_real)%flst(1:2)
where (flv_real == 21) flv_real = 0
end associate
associate (pdf_data => powheg%process_deps%pdf_data, &
x_born => powheg%event_deps%x_born)
if (.not. pdfs_valid(instance, pdf_data, i_term_born, i_term_real, &
sqrt(kt2), x_born, is_isr)) cycle
do em = 1, 2
x_dbl = x_born(em) ; q_dbl = mufac_born
call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
pdf_born_mufac(em) = pdf_dbl(flv_born(em)) / x_born(em)
x_dbl = x_born(em) ; q_dbl = sqrt(kt2)
call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
pdf_born_kt(em) = pdf_dbl(flv_born(em)) / x_born(em)
end do
onepy = one + y; onemy = one - y
x_real(1) = x_born(1) * sqrt ((two - xi * onemy) / (two - xi * onepy))
x_real(2) = x_born(2) * sqrt ((two - xi * onepy) / (two - xi * onemy))
x_real = x_real / sqrt (one - xi)
do em = 1, 2
x_dbl = x_real(em) ; q_dbl = mufac_real
call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
pdf_real_mufac(em) = pdf_dbl(flv_real(em)) / x_real(em)
x_dbl = x_real(em) ; q_dbl = sqrt(kt2)
call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
pdf_real_kt(em) = pdf_dbl(flv_real(em)) / x_real(em)
end do
sqme_born = pdf_born_kt(1) * pdf_born_kt(2) / &
(pdf_born_mufac(1) * pdf_born_mufac(2)) * sqme_born
- sqme_real = pdf_real_kt(1) * pdf_real_kt(2) / &
- (pdf_real_mufac(1) * pdf_real_mufac(2)) * sqme_real
+ sqme_real_x_jac = pdf_real_kt(1) * pdf_real_kt(2) / &
+ (pdf_real_mufac(1) * pdf_real_mufac(2)) * sqme_real_x_jac
end associate
end if
end select
- norm = sqme_real / (sqme_born * ubf)
+ norm = sqme_real_x_jac / (sqme_born * ubf)
f_alr = (one * alr) / powheg%process_deps%n_alr - tiny_07
- if (.not. allocated (x)) &
- allocate (x(size (instance%get_x_process ())))
- x = instance%get_x_process ()
- n_x = size (x)
- call powheg%grid%update_maxima &
- ([x(n_x - 2 : n_x - 1), f_alr], norm)
+
+ r_y = abs(y)
+ select type (pcm_work => instance%pcm_work)
+ class is (pcm_nlo_workspace_t)
+ xi_max = min(pcm_work%get_xi_max (alr), 1 - tiny_07)
+ end select
+ if (xi > xi_max) then
+ r_xi = 1
+ else
+ r_xi = log(1 / (1 - xi)) / log(1 / (1 - xi_max))
+ end if
+ call powheg%grid%update_maxima ([r_xi, r_y, f_alr], norm)
end if
end do
end associate
contains
<<POWHEG matching: powheg matching hook: evaluate: contained>>
end subroutine powheg_matching_hook_evaluate
@ %def powheg_matching_hook_evaluate
-<<POWHEG matching: powheg matching hook: evaluate: contained>>=
@ In some phase space point, the quark PDF may vanish although the gluon PDF does not.
This may lead to very large ratios $\mathcal{R} / \mathcal{B}$ which may spoil
the reweighting performance of the POWHEG grid.
Excluding these values when filling the grid is a minor approximation
with a huge performance gain.
The PDF veto we perform is independent on the actual emitter to not artificially
favor specific ALRs.
<<POWHEG matching: powheg matching hook: evaluate: contained>>=
function pdfs_valid (instance, pdf_data, i_term_born, i_term_real, q, x, is_isr) result (valid)
logical :: valid
class(process_instance_t), intent(in), target :: instance
type(pdf_data_t), intent(inout) :: pdf_data
integer, intent(in) :: i_term_born, i_term_real
real(default), intent(in) :: q
real(default), dimension(2), intent(in) :: x
real(double) :: q_dbl
real(double), dimension(2) :: x_dbl
logical, intent(in) :: is_isr
real(default) :: sum_pdf_q
real(default), dimension(-6:6) :: pdf
real(double), dimension(-6:6) :: pdf_dbl
integer :: flv_born_em, em, i_q
logical :: warned_once = .false.
valid = .true.
if (is_isr) then
if (q**2 < two .or. any(x > 0.9_default)) then
valid = .false.
return
end if
x_dbl = x
q_dbl = q
do em = 1, 2
call pdf_data%evolve(x_dbl(em), q_dbl, pdf_dbl)
pdf = pdf_dbl / x(em)
select type (pcm => instance%term(i_term_real)%pcm)
type is (pcm_nlo_t)
flv_born_em = pcm%region_data%flv_born(i_term_born)%flst(em)
end select
if (is_gluon(flv_born_em)) then
sum_pdf_q = 0
do i_q = 1, 6
sum_pdf_q = sum_pdf_q + pdf(-i_q) + pdf(i_q)
end do
if (sum_pdf_q * x(em) * (1-x(em)) > 30._default * pdf(0)) then
valid = .false.
return
end if
elseif (is_quark(flv_born_em)) then
if (pdf(0) * x(em) * (1-x(em)) > 30._default * pdf(flv_born_em)) then
valid = .false.
return
end if
else
if (.not. warned_once) then
call msg_warning ("powheg_matching_hook_evaluate: unexpected emitter flavor")
warned_once = .true.
end if
end if
end do
end if
end function pdfs_valid
@ %def pdfs_valid
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[powheg_matching_ut.f90]]>>=
<<File header>>
module powheg_matching_ut
use unit_tests
use powheg_matching_uti
<<Standard module head>>
<<POWHEG matching: public test>>
contains
<<POWHEG matching: test driver>>
end module powheg_matching_ut
@ %def powheg_matching_ut
@
<<[[powheg_matching_uti.f90]]>>=
<<File header>>
module powheg_matching_uti
<<Use kinds>>
<<Use strings>>
use constants, only: zero, one
use lorentz
use physics_defs, only: LAMBDA_QCD_REF
use sm_qcd
use subevents, only: PRT_INCOMING, PRT_OUTGOING
use model_data
use particles
use rng_base
use variables
use shower_base
use shower_core
use powheg_matching
use rng_base_ut, only: rng_test_factory_t
<<Standard module head>>
<<POWHEG matching: test declarations>>
contains
<<POWHEG matching: tests>>
end module powheg_matching_uti
@ %def powheg_matching_ut
@ API: driver for the unit tests below.
<<POWHEG matching: public test>>=
public :: powheg_test
<<POWHEG matching: test driver>>=
subroutine powheg_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<POWHEG matching: execute tests>>
end subroutine powheg_test
@ %def powheg_test
@
\subsubsection{Initialization}
There are no Powheg unit tests so far.
\subsubsection{Compare generated emission with Sudakov form factor}
This is a nontrivial test of the generation algorithm and should be
independent of the used upper bounding function (as long as all
singularities are included).
It runs for an extensive amount of time generating a file [[sudakov.dat]] containing
a histogram for the Sudakov factor in bins of the radiation's transverse momentum $p_T^2$.
So far, it is only designed to work for lepton collisions without beam spectra and cuts.
In its current state however, it fills the histogram with either $1$ or [[NaN]] as the
[[p_hard]] received in [[term_instance_evaluate_interaction]] is identically zero.
<<POWHEG matching: powheg matching: TBP>>=
procedure :: test_sudakov => powheg_test_sudakov
<<POWHEG matching: sub interfaces>>=
module subroutine powheg_test_sudakov (powheg)
class(powheg_matching_t), intent(inout) :: powheg
end subroutine powheg_test_sudakov
<<POWHEG matching: procedures>>=
module subroutine powheg_test_sudakov (powheg)
class(powheg_matching_t), intent(inout) :: powheg
integer :: n_calls1, n_calls2
integer, parameter :: n_bins = 20
- real(default) :: sqme_real_x_jacobian, sqme_born
+ real(default) :: sqme_real_x_jac, sqme_born
type(vector4_t), dimension(:), allocatable :: p_born
real(default), dimension(3) :: random
real(default) :: xi, y
integer :: i_call, i_bin, alr, emitter, i_phs
real(default) :: alpha_s, kT2, weight
real(default) :: pt2_min, s, random_jacobian
real(default), dimension(n_bins) :: histo1, histo2, histo1sq, histo2sq
real(default), dimension(n_bins) :: tmp
integer :: i_strip, n_in_strip, n_strips
real(default), dimension(n_bins) :: average, average_sq, error
real(default), dimension(n_bins) :: &
sudakov_0, sudakov_p, sudakov_m, rel_error
integer :: u
p_born = powheg%event_deps%p_born_lab%get_momenta (1)
sqme_born = powheg%event_deps%sqme_born
s = powheg%event_deps%s_hat
pt2_min = powheg%settings%pt2_min
n_calls1 = 100000; n_calls2 = 1000000
histo1 = zero; histo2 = zero; histo1sq = zero; histo2sq = zero
n_strips = 10
call compute_integrals ()
call generate_emissions ()
call write_to_screen_and_file ()
contains
<<POWHEG matching: powheg test sudakov: procedures>>
end subroutine powheg_test_sudakov
@ %def powheg_test_sudakov
@ This determines the binning of the Sudakov histogram.
Linear and logarithmic binning are available.
<<POWHEG matching: powheg test sudakov: procedures>>=
pure function binning (i) result (pt2)
real(default) :: pt2
integer, intent(in) :: i
!pt2 = pt2_min + (s-pt2_min) * (i-1) / (n_bins-1)
pt2 = pt2_min * exp (log (s / pt2_min) * (i-1) / (n_bins-1))
end function
@ %def binning
@
<<POWHEG matching: powheg test sudakov: procedures>>=
subroutine compute_integrals ()
write (msg_buffer, "(A)") "POWHEG: test_sudakov: Computing integrals"
call msg_message ()
select type (pcm_work => powheg%process_instance%pcm_work)
class is (pcm_nlo_workspace_t)
associate (fks => powheg%phs_fks_generator)
do i_call = 1, n_calls1
do alr = 1, powheg%process_deps%n_alr
call powheg%rng%generate (random)
select type (pcm => powheg%process_instance%pcm)
type is (pcm_nlo_t)
emitter = pcm%region_data%get_emitter (alr)
i_phs = powheg%process_deps%alr_to_i_phs(alr)
end select
!!! The sudakov test works only with lepton collisions without beam spectra
!!! so we can identify the cms and lab momenta.
powheg%event_deps%p_real_lab = powheg%event_deps%p_real_cms
call powheg%copy_momenta (i_phs)
call fks%get_radiation_variables (i_phs, xi, y)
kT2 = powheg%sudakov(alr)%s%kt2(xi, y)
if (kT2 >= pt2_min .and. xi < one - tiny_07) then
alpha_s = get_alpha_s (powheg%qcd, kT2)
- sqme_real_x_jacobian = powheg%compute_sqme_real (alr, sqrt(kT2))
+ sqme_real_x_jac = powheg%compute_sqme_real (alr, sqrt(kT2))
random_jacobian = pcm_work%real_kinematics%jac_rand (emitter)
- weight = sqme_real_x_jacobian * random_jacobian / sqme_born
+ weight = sqme_real_x_jac * random_jacobian / sqme_born
do i_bin = 1, n_bins
if (kT2 > binning(i_bin)) then
histo1(i_bin) = histo1(i_bin) + weight
histo1sq(i_bin) = histo1sq(i_bin) + weight**2
end if
end do
end if
! Do not cycle since there is a Heaviside in the exponent
end do
call msg_show_progress (i_call, n_calls1)
end do
end associate
end select
average = histo1 / n_calls1
average_sq = histo1sq / n_calls1
error = sqrt ((average_sq - average**2) / n_calls1)
sudakov_0 = exp(-average)
sudakov_p = exp(-(average + error))
sudakov_m = exp(-(average - error))
rel_error = (sudakov_m - sudakov_p) / (2 * sudakov_0) * 100
end subroutine compute_integrals
@ %def compute_integrals
@
<<POWHEG matching: powheg test sudakov: procedures>>=
subroutine generate_emissions ()
write (msg_buffer, "(A)") "POWHEG: test_sudakov: Generating emissions"
call msg_message ()
do i_strip = 1, n_strips
tmp = 0
n_in_strip = n_calls2 / n_strips
do i_call = 1, n_in_strip
if (signal_is_pending ()) return
call powheg%generate_emission (pt2_generated = kT2)
do i_bin = 1, n_bins
if (kT2 > binning(i_bin)) then
tmp(i_bin) = tmp(i_bin) + 1
end if
end do
end do
tmp = one - (one * tmp) / n_in_strip
histo2 = histo2 + tmp
histo2sq = histo2sq + tmp**2
call msg_show_progress (i_strip, n_strips)
end do
average = histo2 / n_strips
average_sq = histo2sq / n_strips
error = sqrt ((average_sq - average**2) / n_strips)
end subroutine generate_emissions
@ %def generate_emissions
@
<<POWHEG matching: powheg test sudakov: procedures>>=
subroutine write_to_screen_and_file ()
u = free_unit ()
open (file='sudakov.dat', unit=u, action='write')
print *, 'exp(-Integrated R/B)-distribution: '
print *, 'pT2 sudakov_+ sudakov_0 sudakov_- rel_err[%]: '
do i_bin = 1, n_bins
print *, binning(i_bin), &
sudakov_p(i_bin), sudakov_0(i_bin), sudakov_m(i_bin), &
rel_error(i_bin)
write (u, "(6(" // FMT_16 // ",2X))") binning(i_bin), &
sudakov_p(i_bin), sudakov_0(i_bin), sudakov_m(i_bin), &
average(i_bin), error(i_bin)
end do
close (u)
print *, '*******************************'
print *, 'Noemission probability: '
do i_bin = 1, n_bins
print *, binning (i_bin), average (i_bin), error(i_bin)
end do
end subroutine write_to_screen_and_file
@ %def write_to_screen_and_file
@
Index: trunk/src/combinatorics/combinatorics.nw
===================================================================
--- trunk/src/combinatorics/combinatorics.nw (revision 8819)
+++ trunk/src/combinatorics/combinatorics.nw (revision 8820)
@@ -1,3949 +1,3949 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: combinatorics and such
\chapter{Combinatorics}
\includemodulegraph{combinatorics}
These modules implement standard algorithms (sorting, hashing, etc.)
that are not available in Fortran.
Fortran doesn't support generic programming, therefore the algorithms
are implemented only for specific data types.
\begin{description}
\item[bytes]
Derived types for bytes and words.
\item[hashes]
Types and tools for setting up hashtables.
\item[md5]
The MD5 algorithm for message digest.
\item[permutations]
Permuting an array of integers.
\item[sorting]
Sorting integer and real values.
\item[grids]
$d$-dimensional grids can be saved to disk and used for interpolation,
maximum finding, etc.
\end{description}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Bytes and such}
In a few instances we will need the notion of a byte (8-bit) and a word
(32 bit), even a 64-bit word. A block of 512 bit is also needed (for
MD5).
We rely on integers up to 64 bit being supported by the processor.
The main difference to standard integers is the interpretation as
unsigned integers.
<<[[bytes.f90]]>>=
<<File header>>
module bytes
use kinds, only: i8, i32, i64
<<Standard module head>>
<<Bytes: public>>
<<Bytes: types>>
<<Bytes: parameters>>
<<Bytes: interfaces>>
interface
<<Bytes: sub interfaces>>
end interface
end module bytes
@ %def bytes
@
<<[[bytes_sub.f90]]>>=
<<File header>>
submodule (bytes) bytes_s
use io_units
implicit none
contains
<<Bytes: procedures>>
end submodule bytes_s
@ %def bytes_s
@
\subsection{8-bit words: bytes}
This is essentially a wrapper around 8-bit integers. The wrapper
emphasises their special interpretation as a sequence of bits.
However, we interpret bytes as unsigned integers.
<<Bytes: public>>=
public :: byte_t
<<Bytes: types>>=
type :: byte_t
private
integer(i8) :: i
end type byte_t
@ %def byte
<<Bytes: public>>=
public :: byte_zero
<<Bytes: parameters>>=
type(byte_t), parameter :: byte_zero = byte_t (0_i8)
@ %def byte_zero
@ Set a byte from 8-bit integer:
<<Bytes: public>>=
public :: assignment(=)
<<Bytes: interfaces>>=
interface assignment(=)
module procedure set_byte_from_i8
end interface
@ %def =
@
<<Bytes: sub interfaces>>=
module subroutine set_byte_from_i8 (b, i)
type(byte_t), intent(out) :: b
integer(i8), intent(in) :: i
end subroutine set_byte_from_i8
<<Bytes: procedures>>=
module subroutine set_byte_from_i8 (b, i)
type(byte_t), intent(out) :: b
integer(i8), intent(in) :: i
b%i = i
end subroutine set_byte_from_i8
@ %def set_byte_from_i8
@ Write a byte in one of two formats: either as a hexadecimal number
(two digits, default) or as a decimal number (one to three digits).
The decimal version is nontrivial because bytes are unsigned integers.
Optionally append a newline.
<<Bytes: public>>=
public :: byte_write
<<Bytes: interfaces>>=
interface byte_write
module procedure byte_write_unit, byte_write_string
end interface
<<Bytes: sub interfaces>>=
module subroutine byte_write_unit (b, unit, decimal, newline)
type(byte_t), intent(in), optional :: b
integer, intent(in), optional :: unit
logical, intent(in), optional :: decimal, newline
end subroutine byte_write_unit
<<Bytes: procedures>>=
module subroutine byte_write_unit (b, unit, decimal, newline)
type(byte_t), intent(in), optional :: b
integer, intent(in), optional :: unit
logical, intent(in), optional :: decimal, newline
logical :: dc, nl
type(word32_t) :: w
integer :: u
u = given_output_unit (unit); if (u < 0) return
dc = .false.; if (present (decimal)) dc = decimal
nl = .false.; if (present (newline)) nl = newline
if (dc) then
w = b
write (u, '(I3)', advance='no') w%i
else
write (u, '(z2.2)', advance='no') b%i
end if
if (nl) write (u, *)
end subroutine byte_write_unit
@ %def byte_write_unit
@ The string version is hex-only
<<Bytes: sub interfaces>>=
module subroutine byte_write_string (b, s)
type(byte_t), intent(in) :: b
character(len=2), intent(inout) :: s
end subroutine byte_write_string
<<Bytes: procedures>>=
module subroutine byte_write_string (b, s)
type(byte_t), intent(in) :: b
character(len=2), intent(inout) :: s
write (s, '(z2.2)') b%i
end subroutine byte_write_string
@ %def byte_write_string
@
\subsection{32-bit words}
This is not exactly a 32-bit integer. A word is to be filled with
bytes, and it may be partially filled. The filling is done lowest-byte
first, highest-byte last. We count the bits, so [[fill]] should be
either 0, 8, 16, 24, or 32.
In printing words, we correspondingly
distinguish between printing zeros and printing blanks.
<<Bytes: public>>=
public :: word32_t
<<Bytes: types>>=
type :: word32_t
private
integer(i32) :: i
integer :: fill = 0
end type word32_t
@ %def word32
@ Assignment: the word is filled by inserting a 32-bit integer
<<Bytes: interfaces>>=
interface assignment(=)
module procedure word32_set_from_i32
module procedure word32_set_from_byte
end interface
@ %def =
@
<<Bytes: sub interfaces>>=
module subroutine word32_set_from_i32 (w, i)
type(word32_t), intent(out) :: w
integer(i32), intent(in) :: i
end subroutine word32_set_from_i32
<<Bytes: procedures>>=
module subroutine word32_set_from_i32 (w, i)
type(word32_t), intent(out) :: w
integer(i32), intent(in) :: i
w%i = i
w%fill = 32
end subroutine word32_set_from_i32
@ %def word32_set_from_i32
@ Reverse assignment to a 32-bit integer. We do not check the fill
status.
<<Bytes: interfaces>>=
interface assignment(=)
module procedure i32_from_word32
end interface
@ %def =
@
<<Bytes: sub interfaces>>=
module subroutine i32_from_word32 (i, w)
integer(i32), intent(out) :: i
type(word32_t), intent(in) :: w
end subroutine i32_from_word32
<<Bytes: procedures>>=
module subroutine i32_from_word32 (i, w)
integer(i32), intent(out) :: i
type(word32_t), intent(in) :: w
i = w%i
end subroutine i32_from_word32
@ %def i32_from_word32
@ Filling with a 8-bit integer is slightly tricky, because in this
interpretation integers are unsigned.
<<Bytes: sub interfaces>>=
module subroutine word32_set_from_byte (w, b)
type(word32_t), intent(out) :: w
type(byte_t), intent(in) :: b
end subroutine word32_set_from_byte
<<Bytes: procedures>>=
module subroutine word32_set_from_byte (w, b)
type(word32_t), intent(out) :: w
type(byte_t), intent(in) :: b
if (b%i >= 0_i8) then
w%i = b%i
else
w%i = 2_i32*(huge(0_i8)+1_i32) + b%i
end if
w%fill = 32
end subroutine word32_set_from_byte
@ %def word32_set_from_byte
@ Check the fill status
<<Bytes: public>>=
public :: word32_empty, word32_filled, word32_fill
<<Bytes: sub interfaces>>=
module function word32_empty (w)
type(word32_t), intent(in) :: w
logical :: word32_empty
end function word32_empty
module function word32_filled (w)
type(word32_t), intent(in) :: w
logical :: word32_filled
end function word32_filled
module function word32_fill (w)
type(word32_t), intent(in) :: w
integer :: word32_fill
end function word32_fill
<<Bytes: procedures>>=
module function word32_empty (w)
type(word32_t), intent(in) :: w
logical :: word32_empty
word32_empty = (w%fill == 0)
end function word32_empty
module function word32_filled (w)
type(word32_t), intent(in) :: w
logical :: word32_filled
word32_filled = (w%fill == 32)
end function word32_filled
module function word32_fill (w)
type(word32_t), intent(in) :: w
integer :: word32_fill
word32_fill = w%fill
end function word32_fill
@ %def word32_empty word32_filled word32_fill
@ Partial assignment: append a byte to a partially filled word.
(Note: no assignment if the word is filled, so check this before if
necessary.)
<<Bytes: public>>=
public :: word32_append_byte
<<Bytes: sub interfaces>>=
module subroutine word32_append_byte (w, b)
type(word32_t), intent(inout) :: w
type(byte_t), intent(in) :: b
end subroutine word32_append_byte
<<Bytes: procedures>>=
module subroutine word32_append_byte (w, b)
type(word32_t), intent(inout) :: w
type(byte_t), intent(in) :: b
type(word32_t) :: w1
if (.not. word32_filled (w)) then
w1 = b
call mvbits (w1%i, 0, 8, w%i, w%fill)
w%fill = w%fill + 8
end if
end subroutine word32_append_byte
@ %def word32_append_byte
@ Extract a byte from a word. The argument [[i]] is the position,
which may be 0, 1, 2, or 3.
For the final assignment, we set the highest bit separately.
Otherwise, we might trigger an overflow condition for a compiler with
strict checking turned on.
<<Bytes: public>>=
public :: byte_from_word32
<<Bytes: sub interfaces>>=
module function byte_from_word32 (w, i) result (b)
type(word32_t), intent(in) :: w
integer, intent(in) :: i
type(byte_t) :: b
end function byte_from_word32
<<Bytes: procedures>>=
module function byte_from_word32 (w, i) result (b)
type(word32_t), intent(in) :: w
integer, intent(in) :: i
type(byte_t) :: b
integer(i32) :: j
j = 0
if (i >= 0 .and. i*8 < w%fill) then
call mvbits (w%i, i*8, 8, j, 0)
end if
b%i = int (ibclr (j, 7), kind=i8)
if (btest (j, 7)) b%i = ibset (b%i, 7)
end function byte_from_word32
@ %def byte_from_word32
@ Write a word to file or STDOUT. We understand words as unsigned
integers, therefore we cannot use the built-in routine unchanged.
However, we can make use of the existence of 64-bit integers and their
output routine.
In hexadecimal format, the default version prints eight hex
characters, highest-first. The [[bytes]] version prints four bytes
(two-hex characters), lowest first, with spaces in-between. The
decimal bytes version is analogous. In the [[bytes]] version, missing
bytes are printed as whitespace.
<<Bytes: public>>=
public :: word32_write
<<Bytes: interfaces>>=
interface word32_write
module procedure word32_write_unit
end interface
<<Bytes: sub interfaces>>=
module subroutine word32_write_unit (w, unit, bytes, decimal, newline)
type(word32_t), intent(in) :: w
integer, intent(in), optional :: unit
logical, intent(in), optional :: bytes, decimal, newline
end subroutine word32_write_unit
<<Bytes: procedures>>=
module subroutine word32_write_unit (w, unit, bytes, decimal, newline)
type(word32_t), intent(in) :: w
integer, intent(in), optional :: unit
logical, intent(in), optional :: bytes, decimal, newline
logical :: dc, by, nl
type(word64_t) :: ww
integer :: i, u
u = given_output_unit (unit); if (u < 0) return
by = .false.; if (present (bytes)) by = bytes
dc = .false.; if (present (decimal)) dc = decimal
nl = .false.; if (present (newline)) nl = newline
if (by) then
do i = 0, 3
if (i>0) write (u, '(1x)', advance='no')
if (8*i < w%fill) then
call byte_write (byte_from_word32 (w, i), unit, decimal=decimal)
else if (dc) then
write (u, '(3x)', advance='no')
else
write (u, '(2x)', advance='no')
end if
end do
else if (dc) then
ww = w
write (u, '(I10)', advance='no') ww%i
else
select case (w%fill)
case ( 0)
case ( 8); write (6, '(1x,z8.2)', advance='no') ibits (w%i, 0, 8)
case (16); write (6, '(1x,z8.4)', advance='no') ibits (w%i, 0,16)
case (24); write (6, '(1x,z8.6)', advance='no') ibits (w%i, 0,24)
case (32); write (6, '(1x,z8.8)', advance='no') ibits (w%i, 0,32)
end select
end if
if (nl) write (u, *)
end subroutine word32_write_unit
@ %def word32_write_unit
@
\subsection{Operations on 32-bit words}
Define the usual logical operations, as well as addition (mod
$2^{32}$). We assume that all operands are completely filled.
<<Bytes: public>>=
public :: not, ior, ieor, iand, ishft, ishftc
<<Bytes: interfaces>>=
interface not
module procedure word_not
end interface
interface ior
module procedure word_or
end interface
interface ieor
module procedure word_eor
end interface
interface iand
module procedure word_and
end interface
interface ishft
module procedure word_shft
end interface
interface ishftc
module procedure word_shftc
end interface
@ %def not, ior, ieor, iand, ishftc
@
<<Bytes: sub interfaces>>=
module function word_not (w1) result (w2)
type(word32_t), intent(in) :: w1
type(word32_t) :: w2
end function word_not
module function word_or (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
end function word_or
module function word_eor (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
end function word_eor
module function word_and (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
end function word_and
module function word_shft (w1, s) result (w2)
type(word32_t), intent(in) :: w1
integer, intent(in) :: s
type(word32_t) :: w2
end function word_shft
module function word_shftc (w1, s) result (w2)
type(word32_t), intent(in) :: w1
integer, intent(in) :: s
type(word32_t) :: w2
end function word_shftc
<<Bytes: procedures>>=
module function word_not (w1) result (w2)
type(word32_t), intent(in) :: w1
type(word32_t) :: w2
w2 = not (w1%i)
end function word_not
module function word_or (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
w3 = ior (w1%i, w2%i)
end function word_or
module function word_eor (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
w3 = ieor (w1%i, w2%i)
end function word_eor
module function word_and (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
w3 = iand (w1%i, w2%i)
end function word_and
module function word_shft (w1, s) result (w2)
type(word32_t), intent(in) :: w1
integer, intent(in) :: s
type(word32_t) :: w2
w2 = ishft (w1%i, s)
end function word_shft
module function word_shftc (w1, s) result (w2)
type(word32_t), intent(in) :: w1
integer, intent(in) :: s
type(word32_t) :: w2
w2 = ishftc (w1%i, s, 32)
end function word_shftc
@ %def word_not word_or word_eor word_and word_shft word_shftc
@ Addition is defined mod $2^{32}$, i.e., without overflow checking.
This means that we have to work around a possible overflow check enforced by
the compiler.
<<Bytes: public>>=
public :: operator(+)
<<Bytes: interfaces>>=
interface operator(+)
module procedure word_add
module procedure word_add_i8
module procedure word_add_i32
end interface
@ %def +
@
<<Bytes: sub interfaces>>=
module function word_add (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
end function word_add
module function word_add_i8 (w1, i) result (w3)
type(word32_t), intent(in) :: w1
integer(i8), intent(in) :: i
type(word32_t) :: w3
end function word_add_i8
module function word_add_i32 (w1, i) result (w3)
type(word32_t), intent(in) :: w1
integer(i32), intent(in) :: i
type(word32_t) :: w3
end function word_add_i32
<<Bytes: procedures>>=
module function word_add (w1, w2) result (w3)
type(word32_t), intent(in) :: w1, w2
type(word32_t) :: w3
integer(i64) :: j
j = int (ibclr (w1%i, 31), i64) + int (ibclr (w2%i, 31), i64)
w3 = int (ibclr (j, 31), kind=i32)
if (btest (j, 31)) then
if (btest (w1%i, 31) .eqv. btest (w2%i, 31)) w3 = ibset (w3%i, 31)
else
if (btest (w1%i, 31) .neqv. btest (w2%i, 31)) w3 = ibset (w3%i, 31)
end if
end function word_add
module function word_add_i8 (w1, i) result (w3)
type(word32_t), intent(in) :: w1
integer(i8), intent(in) :: i
type(word32_t) :: w3
integer(i64) :: j
j = int (ibclr (w1%i, 31), i64) + int (ibclr (i, 7), i64)
if (btest (i, 7)) j = j + 128
w3 = int (ibclr (j, 31), kind=i32)
if (btest (j, 31) .neqv. btest (w1%i, 31)) w3 = ibset (w3%i, 31)
end function word_add_i8
module function word_add_i32 (w1, i) result (w3)
type(word32_t), intent(in) :: w1
integer(i32), intent(in) :: i
type(word32_t) :: w3
integer(i64) :: j
j = int (ibclr (w1%i, 31), i64) + int (ibclr (i, 31), i64)
w3 = int (ibclr (j, 31), kind=i32)
if (btest (j, 31)) then
if (btest (w1%i, 31) .eqv. btest (i, 31)) w3 = ibset (w3%i, 31)
else
if (btest (w1%i, 31) .neqv. btest (i, 31)) w3 = ibset (w3%i, 31)
end if
end function word_add_i32
@ %def word_add word_add_i32
@
\subsection{64-bit words}
These objects consist of two 32-bit words. They thus can hold integer
numbers larger than $2^{32}$ (to be exact, $2^{31}$ since FORTRAN
integers are signed). The order is low-word, high-word.
<<Bytes: public>>=
public :: word64_t
<<Bytes: types>>=
type :: word64_t
private
integer(i64) :: i
end type word64_t
@ %def word64
@ Set a 64 bit word:
<<Bytes: interfaces>>=
interface assignment(=)
module procedure word64_set_from_i64
module procedure word64_set_from_word32
end interface
@ %def =
@
<<Bytes: sub interfaces>>=
module subroutine word64_set_from_i64 (ww, i)
type(word64_t), intent(out) :: ww
integer(i64), intent(in) :: i
end subroutine word64_set_from_i64
<<Bytes: procedures>>=
module subroutine word64_set_from_i64 (ww, i)
type(word64_t), intent(out) :: ww
integer(i64), intent(in) :: i
ww%i = i
end subroutine word64_set_from_i64
@ %def word64_set_from_i64
@ Filling with a 32-bit word:
<<Bytes: sub interfaces>>=
module subroutine word64_set_from_word32 (ww, w)
type(word64_t), intent(out) :: ww
type(word32_t), intent(in) :: w
end subroutine word64_set_from_word32
<<Bytes: procedures>>=
module subroutine word64_set_from_word32 (ww, w)
type(word64_t), intent(out) :: ww
type(word32_t), intent(in) :: w
if (w%i >= 0_i32) then
ww%i = w%i
else
ww%i = 2_i64*(huge(0_i32)+1_i64) + w%i
end if
end subroutine word64_set_from_word32
@ %def word64_set_from_word32
@ Extract a byte from a word. The argument [[i]] is the position,
which may be between 0 and 7.
For the final assignment, we set the highest bit separately.
Otherwise, we might trigger an overflow condition for a compiler with
strict checking turned on.
<<Bytes: public>>=
public :: byte_from_word64, word32_from_word64
<<Bytes: sub interfaces>>=
module function byte_from_word64 (ww, i) result (b)
type(word64_t), intent(in) :: ww
integer, intent(in) :: i
type(byte_t) :: b
end function byte_from_word64
<<Bytes: procedures>>=
module function byte_from_word64 (ww, i) result (b)
type(word64_t), intent(in) :: ww
integer, intent(in) :: i
type(byte_t) :: b
integer(i64) :: j
j = 0
if (i >= 0 .and. i*8 < 64) then
call mvbits (ww%i, i*8, 8, j, 0)
end if
b%i = int (ibclr (j, 7), kind=i8)
if (btest (j, 7)) b%i = ibset (b%i, 7)
end function byte_from_word64
@ %def byte_from_word64
@ Extract a 32-bit word from a 64-bit word. The position is either 0
or 1.
<<Bytes: sub interfaces>>=
module function word32_from_word64 (ww, i) result (w)
type(word64_t), intent(in) :: ww
integer, intent(in) :: i
type(word32_t) :: w
end function word32_from_word64
<<Bytes: procedures>>=
module function word32_from_word64 (ww, i) result (w)
type(word64_t), intent(in) :: ww
integer, intent(in) :: i
type(word32_t) :: w
integer(i64) :: j
j = 0
select case (i)
case (0); call mvbits (ww%i, 0, 32, j, 0)
case (1); call mvbits (ww%i, 32, 32, j, 0)
end select
w = int (ibclr (j, 31), kind=i32)
if (btest (j, 31)) w = ibset (w%i, 31)
end function word32_from_word64
@ %def word32_from_word64
@ Print a 64-bit word. Decimal version works up to $2^{63}$.
The [[words]] version uses the 'word32' printout, separated by two
spaces. The low-word is printed first. The [[bytes]] version also
uses the 'word32' printout. This implies that the lowest byte is
first. The default version prints a hexadecimal
number without spaces, highest byte first.
<<Bytes: public>>=
public :: word64_write
<<Bytes: interfaces>>=
interface word64_write
module procedure word64_write_unit
end interface
<<Bytes: sub interfaces>>=
module subroutine word64_write_unit (ww, unit, words, bytes, decimal, newline)
type(word64_t), intent(in) :: ww
integer, intent(in), optional :: unit
logical, intent(in), optional :: words, bytes, decimal, newline
end subroutine word64_write_unit
<<Bytes: procedures>>=
module subroutine word64_write_unit (ww, unit, words, bytes, decimal, newline)
type(word64_t), intent(in) :: ww
integer, intent(in), optional :: unit
logical, intent(in), optional :: words, bytes, decimal, newline
logical :: wo, by, dc, nl
integer :: u
u = given_output_unit (unit); if (u < 0) return
wo = .false.; if (present (words)) wo = words
by = .false.; if (present (bytes)) by = bytes
dc = .false.; if (present (decimal)) dc = decimal
nl = .false.; if (present (newline)) nl = newline
if (wo .or. by) then
call word32_write_unit (word32_from_word64 (ww, 0), unit, by, dc)
write (u, '(2x)', advance='no')
call word32_write_unit (word32_from_word64 (ww, 1), unit, by, dc)
else if (dc) then
write (u, '(I19)', advance='no') ww%i
else
write (u, '(Z16)', advance='no') ww%i
end if
if (nl) write (u, *)
end subroutine word64_write_unit
@ %def word64_write_unit
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Hashtables}
Hash tables, like lists, are not part of Fortran and must be defined
on a per-case basis. In this section we define a module that contains
a hash function.
Furthermore, for reference there is a complete framework of hashtable
type definitions and access functions. This code is to be replicated
where hash tables are used, mutatis mutandis.
<<[[hashes.f90]]>>=
<<File header>>
module hashes
use kinds, only: i8, i32
<<Standard module head>>
<<Hashes: public>>
interface
<<Hashes: sub interfaces>>
end interface
end module hashes
@ %def hashes
@
<<[[hashes_sub.f90]]>>=
<<File header>>
submodule (hashes) hashes_s
use bytes
implicit none
contains
<<Hashes: procedures>>
end submodule hashes_s
@ %def hashes_s
@
\subsection{The hash function}
This is the one-at-a-time hash function by Bob Jenkins (from
Wikipedia), re-implemented in Fortran. The function works on an array
of bytes (8-bit integers), as could be produced by, e.g., the
[[transfer]] function, and returns a single 32-bit integer. For
determining the position in a hashtable, one can pick the lower bits
of the result as appropriate to the hashtable size (which should be a
power of 2). Note that we are working on signed integers, so the
interpretation of values differs from the C version. This should not
matter in practice, however.
<<Hashes: public>>=
public :: hash
<<Hashes: sub interfaces>>=
module function hash (key) result (hashval)
integer(i32) :: hashval
integer(i8), dimension(:), intent(in) :: key
end function hash
<<Hashes: procedures>>=
module function hash (key) result (hashval)
integer(i32) :: hashval
integer(i8), dimension(:), intent(in) :: key
type(word32_t) :: w
integer :: i
w = 0_i32
do i = 1, size (key)
w = w + key(i)
w = w + ishft (w, 10)
w = ieor (w, ishft (w, -6))
end do
w = w + ishft (w, 3)
w = ieor (w, ishft (w, -11))
w = w + ishft (w, 15)
hashval = w
end function hash
@ %def hash
@
\subsection{The hash table}
We define a generic hashtable type (that depends on the
[[hash_data_t]] type) together with associated methods.
This is a template:
<<Hashtables: types>>=
type :: hash_data_t
integer :: i
end type hash_data_t
@ %def hash_data_t
@ Associated methods:
<<Hashtables: procedures>>=
subroutine hash_data_final (data)
type(hash_data_t), intent(inout) :: data
end subroutine hash_data_final
subroutine hash_data_write (data, unit)
type(hash_data_t), intent(in) :: data
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, *) data%i
end subroutine hash_data_write
@ %def hash_data_final hash_data_write
@ Each hash entry stores the unmasked hash value, the key, and points to
actual data if present. Note that this could be an allocatable scalar
in principle, but making it a pointer avoids deep copy when expanding
the hashtable.
<<Hashtables: types>>=
type :: hash_entry_t
integer(i32) :: hashval = 0
integer(i8), dimension(:), allocatable :: key
type(hash_data_t), pointer :: data => null ()
end type hash_entry_t
@ %def hash_entry_t
@ The hashtable object holds the actual table, the number of filled
entries and the number of entries after which the size should be
doubled. The mask is equal to the table size minus one and thus
coincides with the upper bound of the table index, which starts at zero.
<<Hashtables: types>>=
type :: hashtable_t
integer :: n_entries = 0
real :: fill_ratio = 0
integer :: n_entries_max = 0
integer(i32) :: mask = 0
type(hash_entry_t), dimension(:), allocatable :: entry
end type hashtable_t
@ %def hashtable_t
@ Initializer: The size has to be a power of two, the fill ratio is a
real (machine-default!) number between 0 and 1.
<<Hashtables: procedures>>=
subroutine hashtable_init (hashtable, size, fill_ratio)
type(hashtable_t), intent(out) :: hashtable
integer, intent(in) :: size
real, intent(in) :: fill_ratio
hashtable%fill_ratio = fill_ratio
hashtable%n_entries_max = size * fill_ratio
hashtable%mask = size - 1
allocate (hashtable%entry (0:hashtable%mask))
end subroutine hashtable_init
@ %def hashtable_init
@ Finalizer: This calls a [[hash_data_final]] subroutine which must
exist.
<<Hashtables: procedures>>=
subroutine hashtable_final (hashtable)
type(hashtable_t), intent(inout) :: hashtable
integer :: i
do i = 0, hashtable%mask
if (associated (hashtable%entry(i)%data)) then
call hash_data_final (hashtable%entry(i)%data)
deallocate (hashtable%entry(i)%data)
end if
end do
deallocate (hashtable%entry)
end subroutine hashtable_final
@ %def hashtable_final
@ Output. Here, we refer to a [[hash_data_write]] subroutine.
<<Hashtables: procedures>>=
subroutine hashtable_write (hashtable, unit)
type(hashtable_t), intent(in) :: hashtable
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
do i = 0, hashtable%mask
if (associated (hashtable%entry(i)%data)) then
write (u, *) i, "(hash =", hashtable%entry(i)%hashval, ")", &
hashtable%entry(i)%key
call hash_data_write (hashtable%entry(i)%data, unit)
end if
end do
end subroutine hashtable_write
@ %def hashtable_write
@
\subsection{Hashtable insertion}
Insert a single entry with the hash value as trial place. If the
table is filled, first expand it.
<<Hashtables: procedures>>=
subroutine hashtable_insert (hashtable, key, data)
type(hashtable_t), intent(inout) :: hashtable
integer(i8), dimension(:), intent(in) :: key
type(hash_data_t), intent(in), target :: data
integer(i32) :: h
if (hashtable%n_entries >= hashtable%n_entries_max) &
call hashtable_expand (hashtable)
h = hash (key)
call hashtable_insert_rec (hashtable, h, h, key, data)
end subroutine hashtable_insert
@ %def hashtable_insert
@ We need this auxiliary routine for doubling the size of the
hashtable. We rely on the fact that default assignment copies
the data pointer, not the data themselves. The temporary array must
not be finalized; it is deallocated automatically together with its
allocatable components.
<<Hashtables: procedures>>=
subroutine hashtable_expand (hashtable)
type(hashtable_t), intent(inout) :: hashtable
type(hash_entry_t), dimension(:), allocatable :: table_tmp
integer :: i, s
allocate (table_tmp (0:hashtable%mask))
table_tmp = hashtable%entry
deallocate (hashtable%entry)
s = 2 * size (table_tmp)
hashtable%n_entries = 0
hashtable%n_entries_max = s * hashtable%fill_ratio
hashtable%mask = s - 1
allocate (hashtable%entry (0:hashtable%mask))
do i = 0, ubound (table_tmp, 1)
if (associated (table_tmp(i)%data)) then
call hashtable_insert_rec (hashtable, table_tmp(i)%hashval, &
table_tmp(i)%hashval, table_tmp(i)%key, table_tmp(i)%data)
end if
end do
end subroutine hashtable_expand
@ %def hashtable_expand
@ Insert a single entry at a trial place [[h]], reduced to the table
size. Collision resolution is done simply by choosing the next
element, recursively until the place is empty. For bookkeeping, we
preserve the original hash value. For a good hash function, there
should be no clustering.
Note that if the new key exactly matches an existing key, nothing is done.
<<Hashtables: procedures>>=
recursive subroutine hashtable_insert_rec (hashtable, h, hashval, key, data)
type(hashtable_t), intent(inout) :: hashtable
integer(i32), intent(in) :: h, hashval
integer(i8), dimension(:), intent(in) :: key
type(hash_data_t), intent(in), target :: data
integer(i32) :: i
i = iand (h, hashtable%mask)
if (associated (hashtable%entry(i)%data)) then
if (size (hashtable%entry(i)%key) /= size (key)) then
call hashtable_insert_rec (hashtable, h + 1, hashval, key, data)
else if (any (hashtable%entry(i)%key /= key)) then
call hashtable_insert_rec (hashtable, h + 1, hashval, key, data)
end if
else
hashtable%entry(i)%hashval = hashval
allocate (hashtable%entry(i)%key (size (key)))
hashtable%entry(i)%key = key
hashtable%entry(i)%data => data
hashtable%n_entries = hashtable%n_entries + 1
end if
end subroutine hashtable_insert_rec
@ %def hashtable_insert_rec
@
\subsection{Hashtable lookup}
The lookup function has to parallel the insert function. If the place
is filled, check if the key matches. Yes: return the pointer; no:
increment the hash value and check again.
<<Hashtables: procedures>>=
function hashtable_lookup (hashtable, key) result (ptr)
type(hash_data_t), pointer :: ptr
type(hashtable_t), intent(in) :: hashtable
integer(i8), dimension(:), intent(in) :: key
ptr => hashtable_lookup_rec (hashtable, hash (key), key)
end function hashtable_lookup
@ %def hashtable_get_data_ptr
<<Hashtables: procedures>>=
recursive function hashtable_lookup_rec (hashtable, h, key) result (ptr)
type(hash_data_t), pointer :: ptr
type(hashtable_t), intent(in) :: hashtable
integer(i32), intent(in) :: h
integer(i8), dimension(:), intent(in) :: key
integer(i32) :: i
i = iand (h, hashtable%mask)
if (associated (hashtable%entry(i)%data)) then
if (size (hashtable%entry(i)%key) == size (key)) then
if (all (hashtable%entry(i)%key == key)) then
ptr => hashtable%entry(i)%data
else
ptr => hashtable_lookup_rec (hashtable, h + 1, key)
end if
else
ptr => hashtable_lookup_rec (hashtable, h + 1, key)
end if
else
ptr => null ()
end if
end function hashtable_lookup_rec
@ %def hashtable_lookup_rec
<<Hashtables: public>>=
public :: hashtable_test
<<Hashtables: procedures>>=
subroutine hashtable_test ()
type(hash_data_t), pointer :: data
type(hashtable_t) :: hashtable
integer(i8) :: i
call hashtable_init (hashtable, 16, 0.25)
do i = 1, 10
allocate (data)
data%i = i*i
call hashtable_insert (hashtable, [i, i+i], data)
end do
call hashtable_insert (hashtable, [2_i8, 4_i8], data)
call hashtable_write (hashtable)
data => hashtable_lookup (hashtable, [5_i8, 10_i8])
if (associated (data)) then
print *, "lookup:", data%i
else
print *, "lookup: --"
end if
data => hashtable_lookup (hashtable, [6_i8, 12_i8])
if (associated (data)) then
print *, "lookup:", data%i
else
print *, "lookup: --"
end if
data => hashtable_lookup (hashtable, [4_i8, 9_i8])
if (associated (data)) then
print *, "lookup:", data%i
else
print *, "lookup: --"
end if
call hashtable_final (hashtable)
end subroutine hashtable_test
@ %def hashtable_test
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{MD5 Checksums}
Implementing MD5 checksums allows us
to check input/file integrity on the basis of a well-known standard.
The building blocks have been introduced in the [[bytes]] module.
<<[[md5.f90]]>>=
<<File header>>
module md5
use bytes
<<Standard module head>>
<<MD5: public>>
<<MD5: types>>
<<MD5: interfaces>>
interface
<<MD5: sub interfaces>>
end interface
end module md5
@ %def md5
@
<<[[md5_sub.f90]]>>=
<<File header>>
submodule (md5) md5_s
use kinds, only: i8, i32, i64
use system_defs, only: BUFFER_SIZE
use system_defs, only: LF, EOR, EOF
use io_units
use diagnostics
implicit none
<<MD5: variables>>
contains
<<MD5: procedures>>
end submodule md5_s
@ %def md5_s
@
\subsection{Blocks}
A block is a sequence of 16 words (64 bytes or 512 bits). We
anticipate that blocks will be linked, so include a pointer to the
next block. There is a fill status (word counter), as there is one
for each word. The fill status is equal to the number of bytes that
are in, so it may be between 0 and 64.
<<MD5: types>>=
type :: block_t
private
type(word32_t), dimension(0:15) :: w
type(block_t), pointer :: next => null ()
integer :: fill = 0
end type block_t
@ %def block
@ Check if a block is completely filled or empty:
<<MD5: procedures>>=
function block_is_empty (b)
type(block_t), intent(in) :: b
logical :: block_is_empty
block_is_empty = (b%fill == 0 .and. word32_empty (b%w(0)))
end function block_is_empty
function block_is_filled (b)
type(block_t), intent(in) :: b
logical :: block_is_filled
block_is_filled = (b%fill == 64)
end function block_is_filled
@ %def block_is_empty block_is_filled
@ Append a single byte to a block. Works only if the block is not yet
filled.
<<MD5: procedures>>=
subroutine block_append_byte (bl, by)
type(block_t), intent(inout) :: bl
type(byte_t), intent(in) :: by
if (.not. block_is_filled (bl)) then
call word32_append_byte (bl%w(bl%fill/4), by)
bl%fill = bl%fill + 1
end if
end subroutine block_append_byte
@ %def block_append_byte
@ The printing routine allows for printing as sequences of words or
bytes, decimal or hex.
<<MD5: interfaces>>=
interface block_write
module procedure block_write_unit
end interface
<<MD5: sub interfaces>>=
module subroutine block_write_unit (b, unit, bytes, decimal)
type(block_t), intent(in) :: b
integer, intent(in), optional :: unit
logical, intent(in), optional :: bytes, decimal
end subroutine block_write_unit
<<MD5: procedures>>=
module subroutine block_write_unit (b, unit, bytes, decimal)
type(block_t), intent(in) :: b
integer, intent(in), optional :: unit
logical, intent(in), optional :: bytes, decimal
logical :: by, dc
integer :: i, u
u = given_output_unit (unit); if (u < 0) return
by = .false.; if (present (bytes)) by = bytes
dc = .false.; if (present (decimal)) dc = decimal
do i = 0, b%fill/4 - 1
call newline_or_blank (u, i, by, dc)
call word32_write (b%w(i), unit, bytes, decimal)
end do
if (.not. block_is_filled (b)) then
i = b%fill/4
if (.not. word32_empty (b%w(i))) then
call newline_or_blank (u, i, by, dc)
call word32_write (b%w(i), unit, bytes, decimal)
end if
end if
write (u, *)
contains
subroutine newline_or_blank (u, i, bytes, decimal)
integer, intent(in) :: u, i
logical, intent(in) :: bytes, decimal
if (decimal) then
select case (i)
case (0)
case (2,4,6,8,10,12,14); write (u, *)
case default
write (u, '(2x)', advance='no')
end select
else if (bytes) then
select case (i)
case (0)
case (4,8,12); write (u, *)
case default
write (u, '(2x)', advance='no')
end select
else
if (i == 8) write (u, *)
end if
end subroutine newline_or_blank
end subroutine block_write_unit
@ %def block_write_unit
@
\subsection{Messages}
A message (within this module) is a linked list of blocks.
<<MD5: types>>=
type :: message_t
private
type(block_t), pointer :: first => null ()
type(block_t), pointer :: last => null ()
integer :: n_blocks = 0
end type message_t
@ %def message_t
@ Clear the message list
<<MD5: procedures>>=
subroutine message_clear (m)
type(message_t), intent(inout) :: m
type(block_t), pointer :: b
nullify (m%last)
do
b => m%first
if (.not.(associated (b))) exit
m%first => b%next
deallocate (b)
end do
m%n_blocks = 0
end subroutine message_clear
@ %def message_clear
@ Append an empty block to the message list
<<MD5: procedures>>=
subroutine message_append_new_block (m)
type(message_t), intent(inout) :: m
if (associated (m%last)) then
allocate (m%last%next)
m%last => m%last%next
m%n_blocks = m%n_blocks + 1
else
allocate (m%first)
m%last => m%first
m%n_blocks = 1
end if
end subroutine message_append_new_block
@ %def message_append_new_block
@ Initialize: clear and allocate the first (empty) block.
<<MD5: procedures>>=
subroutine message_init (m)
type(message_t), intent(inout) :: m
call message_clear (m)
call message_append_new_block (m)
end subroutine message_init
@ %def message_init
@ Append a single byte to a message. If necessary, allocate a new
block. If the message is empty, initialize it.
<<MD5: procedures>>=
subroutine message_append_byte (m, b)
type(message_t), intent(inout) :: m
type(byte_t), intent(in) :: b
if (.not. associated (m%last)) then
call message_init (m)
else if (block_is_filled (m%last)) then
call message_append_new_block (m)
end if
call block_append_byte (m%last, b)
end subroutine message_append_byte
@ %def message_append_byte
@ Append zero bytes until the current block is filled up to the required
position. If we are already beyond that, append a new block and fill
that one.
<<MD5: procedures>>=
subroutine message_pad_zero (m, i)
type(message_t), intent(inout) :: m
integer, intent(in) :: i
type(block_t), pointer :: b
integer :: j
if (associated (m%last)) then
b => m%last
if (b%fill > i) then
do j = b%fill + 1, 64 + i
call message_append_byte (m, byte_zero)
end do
else
do j = b%fill + 1, i
call message_append_byte (m, byte_zero)
end do
end if
end if
end subroutine message_pad_zero
@ %def message_pad_zero
@ This returns the number of bits within a message. We need a 64-bit
word for the result since it may be more than $2^{31}$. This is also
required by the MD5 standard.
<<MD5: procedures>>=
function message_bits (m) result (length)
type(message_t), intent(in) :: m
type(word64_t) :: length
type(block_t), pointer :: b
integer(i64) :: n_blocks_filled, n_bytes_extra
if (m%n_blocks > 0) then
b => m%last
if (block_is_filled (b)) then
n_blocks_filled = m%n_blocks
n_bytes_extra = 0
else
n_blocks_filled = m%n_blocks - 1
n_bytes_extra = b%fill
end if
length = n_blocks_filled * 512 + n_bytes_extra * 8
else
length = 0_i64
end if
end function message_bits
@ %def message_bits
@
\subsection{Message I/O}
Append the contents of a string to a message. We first cast the
character string into a 8-bit integer array and the append this byte
by byte.
<<MD5: procedures>>=
subroutine message_append_string (m, s)
type(message_t), intent(inout) :: m
character(len=*), intent(in) :: s
integer(i64) :: i, n_bytes
integer(i8), dimension(:), allocatable :: buffer
integer(i8), dimension(1) :: mold
type(byte_t) :: b
n_bytes = size (transfer (s, mold))
allocate (buffer (n_bytes))
buffer = transfer (s, mold)
do i = 1, size (buffer)
b = buffer(i)
call message_append_byte (m, b)
end do
deallocate (buffer)
end subroutine message_append_string
@ %def message_append_string
@ Append the contents of a 32-bit integer to a message. We first cast the
32-bit integer into a 8-bit integer array and the append this byte
by byte.
<<MD5: procedures>>=
subroutine message_append_i32 (m, x)
type(message_t), intent(inout) :: m
integer(i32), intent(in) :: x
integer(i8), dimension(4) :: buffer
type(byte_t) :: b
integer :: i
buffer = transfer (x, buffer, size(buffer))
do i = 1, size (buffer)
b = buffer(i)
call message_append_byte (m, b)
end do
end subroutine message_append_i32
@ %def message_append_i32
@ Append one line from file to a message. Include the newline character.
<<MD5: procedures>>=
subroutine message_append_from_unit (m, u, iostat)
type(message_t), intent(inout) :: m
integer, intent(in) :: u
integer, intent(out) :: iostat
character(len=BUFFER_SIZE) :: buffer
read (u, *, iostat=iostat) buffer
call message_append_string (m, trim (buffer))
call message_append_string (m, LF)
end subroutine message_append_from_unit
@ %def message_append_from_unit
@ Fill a message from file. (Each line counts as a string.)
<<MD5: procedures>>=
subroutine message_read_from_file (m, f)
type(message_t), intent(inout) :: m
character(len=*), intent(in) :: f
integer :: u, iostat
u = free_unit ()
open (file=f, unit=u, action='read')
do
call message_append_from_unit (m, u, iostat=iostat)
if (iostat < 0) exit
end do
close (u)
end subroutine message_read_from_file
@ %def message_read_from_file
@ Write a message. After each block, insert an empty line.
<<MD5: interfaces>>=
interface message_write
module procedure message_write_unit
end interface
<<MD5: sub interfaces>>=
module subroutine message_write_unit (m, unit, bytes, decimal)
type(message_t), intent(in) :: m
integer, intent(in), optional :: unit
logical, intent(in), optional :: bytes, decimal
end subroutine message_write_unit
<<MD5: procedures>>=
module subroutine message_write_unit (m, unit, bytes, decimal)
type(message_t), intent(in) :: m
integer, intent(in), optional :: unit
logical, intent(in), optional :: bytes, decimal
type(block_t), pointer :: b
integer :: u
u = given_output_unit (unit); if (u < 0) return
b => m%first
if (associated (b)) then
do
call block_write_unit (b, unit, bytes, decimal)
b => b%next
if (.not. associated (b)) exit
write (u, *)
end do
end if
end subroutine message_write_unit
@ %def message_write_unit
@
\subsection{Auxiliary functions}
These four functions on three words are defined in the MD5 standard:
<<MD5: procedures>>=
function ff (x, y, z)
type(word32_t), intent(in) :: x, y, z
type(word32_t) :: ff
ff = ior (iand (x, y), iand (not (x), z))
end function ff
function fg (x, y, z)
type(word32_t), intent(in) :: x, y, z
type(word32_t) :: fg
fg = ior (iand (x, z), iand (y, not (z)))
end function fg
function fh (x, y, z)
type(word32_t), intent(in) :: x, y, z
type(word32_t) :: fh
fh = ieor (ieor (x, y), z)
end function fh
function fi (x, y, z)
type(word32_t), intent(in) :: x, y, z
type(word32_t) :: fi
fi = ieor (y, ior (x, not (z)))
end function fi
@ %def ff fg fh fi
@
\subsection{Auxiliary stuff}
This defines and initializes the table of transformation constants:
<<MD5: variables>>=
type(word32_t), dimension(64), save :: t
logical, save :: table_initialized = .false.
@ %def t table_initialized
<<MD5: procedures>>=
subroutine table_init
type(word64_t) :: ww
integer :: i
if (.not.table_initialized) then
do i = 1, 64
ww = int (4294967296d0 * abs (sin (i * 1d0)), kind=i64)
t(i) = word32_from_word64 (ww, 0)
end do
table_initialized = .true.
end if
end subroutine table_init
@ %def table_init
@ This encodes the message digest (4 words) into a 32-character
string.
<<MD5: procedures>>=
function digest_string (aa) result (s)
type(word32_t), dimension (0:3), intent(in) :: aa
character(len=32) :: s
integer :: i, j
do i = 0, 3
do j = 0, 3
call byte_write (byte_from_word32 (aa(i), j), s(i*8+j*2+1:i*8+j*2+2))
end do
end do
end function digest_string
@ %def digest_string
@
\subsection{MD5 algorithm}
Pad the message with a byte [[x80]] and then pad zeros up to a full
block minus two words; in these words, insert the message length
(before padding) as a 64-bit word, low-word first.
<<MD5: procedures>>=
subroutine message_pad (m)
type(message_t), intent(inout) :: m
type(word64_t) :: length
integer(i8), parameter :: ipad = -128 ! z'80'
type(byte_t) :: b
integer :: i
length = message_bits (m)
b = ipad
call message_append_byte (m, b)
call message_pad_zero (m, 56)
do i = 0, 7
call message_append_byte (m, byte_from_word64 (length, i))
end do
end subroutine message_pad
@ %def message_pad
@ Apply a series of transformations onto a state [[a,b,c,d]], where
the transform function uses each word of the message together with the
predefined words. Finally, encode the state as a 32-character string.
<<MD5: procedures>>=
subroutine message_digest (m, s)
type(message_t), intent(in) :: m
character(len=32), intent(out) :: s
integer(i32), parameter :: ia = 1732584193 ! z'67452301'
integer(i32), parameter :: ib = -271733879 ! z'efcdab89'
integer(i32), parameter :: ic = -1732584194 ! z'98badcfe'
integer(i32), parameter :: id = 271733878 ! z'10325476'
type(word32_t) :: a, b, c, d
type(word32_t) :: aa, bb, cc, dd
type(word32_t), dimension(0:15) :: x
type(block_t), pointer :: bl
call table_init
a = ia; b = ib; c = ic; d = id
bl => m%first
do
if (.not.associated (bl)) exit
x = bl%w
aa = a; bb = b; cc = c; dd = d
call transform (ff, a, b, c, d, 0, 7, 1)
call transform (ff, d, a, b, c, 1, 12, 2)
call transform (ff, c, d, a, b, 2, 17, 3)
call transform (ff, b, c, d, a, 3, 22, 4)
call transform (ff, a, b, c, d, 4, 7, 5)
call transform (ff, d, a, b, c, 5, 12, 6)
call transform (ff, c, d, a, b, 6, 17, 7)
call transform (ff, b, c, d, a, 7, 22, 8)
call transform (ff, a, b, c, d, 8, 7, 9)
call transform (ff, d, a, b, c, 9, 12, 10)
call transform (ff, c, d, a, b, 10, 17, 11)
call transform (ff, b, c, d, a, 11, 22, 12)
call transform (ff, a, b, c, d, 12, 7, 13)
call transform (ff, d, a, b, c, 13, 12, 14)
call transform (ff, c, d, a, b, 14, 17, 15)
call transform (ff, b, c, d, a, 15, 22, 16)
call transform (fg, a, b, c, d, 1, 5, 17)
call transform (fg, d, a, b, c, 6, 9, 18)
call transform (fg, c, d, a, b, 11, 14, 19)
call transform (fg, b, c, d, a, 0, 20, 20)
call transform (fg, a, b, c, d, 5, 5, 21)
call transform (fg, d, a, b, c, 10, 9, 22)
call transform (fg, c, d, a, b, 15, 14, 23)
call transform (fg, b, c, d, a, 4, 20, 24)
call transform (fg, a, b, c, d, 9, 5, 25)
call transform (fg, d, a, b, c, 14, 9, 26)
call transform (fg, c, d, a, b, 3, 14, 27)
call transform (fg, b, c, d, a, 8, 20, 28)
call transform (fg, a, b, c, d, 13, 5, 29)
call transform (fg, d, a, b, c, 2, 9, 30)
call transform (fg, c, d, a, b, 7, 14, 31)
call transform (fg, b, c, d, a, 12, 20, 32)
call transform (fh, a, b, c, d, 5, 4, 33)
call transform (fh, d, a, b, c, 8, 11, 34)
call transform (fh, c, d, a, b, 11, 16, 35)
call transform (fh, b, c, d, a, 14, 23, 36)
call transform (fh, a, b, c, d, 1, 4, 37)
call transform (fh, d, a, b, c, 4, 11, 38)
call transform (fh, c, d, a, b, 7, 16, 39)
call transform (fh, b, c, d, a, 10, 23, 40)
call transform (fh, a, b, c, d, 13, 4, 41)
call transform (fh, d, a, b, c, 0, 11, 42)
call transform (fh, c, d, a, b, 3, 16, 43)
call transform (fh, b, c, d, a, 6, 23, 44)
call transform (fh, a, b, c, d, 9, 4, 45)
call transform (fh, d, a, b, c, 12, 11, 46)
call transform (fh, c, d, a, b, 15, 16, 47)
call transform (fh, b, c, d, a, 2, 23, 48)
call transform (fi, a, b, c, d, 0, 6, 49)
call transform (fi, d, a, b, c, 7, 10, 50)
call transform (fi, c, d, a, b, 14, 15, 51)
call transform (fi, b, c, d, a, 5, 21, 52)
call transform (fi, a, b, c, d, 12, 6, 53)
call transform (fi, d, a, b, c, 3, 10, 54)
call transform (fi, c, d, a, b, 10, 15, 55)
call transform (fi, b, c, d, a, 1, 21, 56)
call transform (fi, a, b, c, d, 8, 6, 57)
call transform (fi, d, a, b, c, 15, 10, 58)
call transform (fi, c, d, a, b, 6, 15, 59)
call transform (fi, b, c, d, a, 13, 21, 60)
call transform (fi, a, b, c, d, 4, 6, 61)
call transform (fi, d, a, b, c, 11, 10, 62)
call transform (fi, c, d, a, b, 2, 15, 63)
call transform (fi, b, c, d, a, 9, 21, 64)
a = a + aa
b = b + bb
c = c + cc
d = d + dd
bl => bl%next
end do
s = digest_string ([a, b, c, d])
contains
<<MD5: Internal subroutine transform>>
end subroutine message_digest
@ %def message_digest
@ And this is the actual transformation that depends on one of the
previous functions, four words, and three integers. The implicit
arguments are [[x]], the word from the message to digest, and [[t]],
the entry in the predefined table.
<<MD5: Internal subroutine transform>>=
subroutine transform (f, a, b, c, d, k, s, i)
interface
function f (x, y, z)
import word32_t
type(word32_t), intent(in) :: x, y, z
type(word32_t) :: f
end function f
end interface
type(word32_t), intent(inout) :: a
type(word32_t), intent(in) :: b, c, d
integer, intent(in) :: k, s, i
a = b + ishftc (a + f(b, c, d) + x(k) + t(i), s)
end subroutine transform
@ %def transform
@
\subsection{User interface}
<<MD5: public>>=
public :: md5sum
<<MD5: interfaces>>=
interface md5sum
module procedure md5sum_from_string
module procedure md5sum_from_unit
end interface
@ %def md5sum
@ This function computes the MD5 sum of the input string and returns it
as a 32-character string
<<MD5: sub interfaces>>=
module function md5sum_from_string (s) result (digest)
character(len=*), intent(in) :: s
character(len=32) :: digest
end function md5sum_from_string
<<MD5: procedures>>=
module function md5sum_from_string (s) result (digest)
character(len=*), intent(in) :: s
character(len=32) :: digest
type(message_t) :: m
call message_append_string (m, s)
call message_pad (m)
call message_digest (m, digest)
call message_clear (m)
end function md5sum_from_string
@ %def md5sum_from_string
@ This funct. reads from unit u (an unformmated sequence of
integers) and computes the MD5 sum.
<<MD5: sub interfaces>>=
module function md5sum_from_unit (u) result (digest)
integer, intent(in) :: u
character(len=32) :: digest
end function md5sum_from_unit
<<MD5: procedures>>=
module function md5sum_from_unit (u) result (digest)
integer, intent(in) :: u
character(len=32) :: digest
type(message_t) :: m
character :: char
integer :: iostat
READ_CHARS: do
read (u, "(A)", advance="no", iostat=iostat) char
select case (iostat)
case (0)
call message_append_string (m, char)
case (EOR)
call message_append_string (m, LF)
case (EOF)
exit READ_CHARS
case default
call msg_fatal &
("Computing MD5 sum: I/O error while reading from scratch file")
end select
end do READ_CHARS
call message_pad (m)
call message_digest (m, digest)
call message_clear (m)
end function md5sum_from_unit
@ %def md5sum_from_unit
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[md5_ut.f90]]>>=
<<File header>>
module md5_ut
use unit_tests
use md5_uti
<<Standard module head>>
<<MD5: public test>>
contains
<<MD5: test driver>>
end module md5_ut
@ %def md5_ut
@
<<[[md5_uti.f90]]>>=
<<File header>>
module md5_uti
use diagnostics
use md5
<<Standard module head>>
<<MD5: test declarations>>
contains
<<MD5: tests>>
end module md5_uti
@ %def md5_ut
@ API: driver for the unit tests below.
<<MD5: public test>>=
public :: md5_test
<<MD5: test driver>>=
subroutine md5_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<MD5: execute tests>>
end subroutine md5_test
@ %def md5_test
@ This function checks the implementation by computing the checksum of
certain strings and comparing them with the known values.
<<MD5: execute tests>>=
call test (md5_1, "md5_1", &
"check MD5 sums", &
u, results)
<<MD5: test declarations>>=
public :: md5_1
<<MD5: tests>>=
subroutine md5_1 (u)
integer, intent(in) :: u
character(32) :: s
integer, parameter :: n = 7
integer :: i
character(80), dimension(n) :: teststring
data teststring(1) /""/
data teststring(2) /"a"/
data teststring(3) /"abc"/
data teststring(4) /"message digest"/
data teststring(5) /"abcdefghijklmnopqrstuvwxyz"/
data teststring(6) /"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"/
data teststring(7) /"12345678901234567890123456789012345678901234567890123456789012345678901234567890"/
character(32), dimension(n) :: result
data result(1) /"D41D8CD98F00B204E9800998ECF8427E"/
data result(2) /"0CC175B9C0F1B6A831C399E269772661"/
data result(3) /"900150983CD24FB0D6963F7D28E17F72"/
data result(4) /"F96B697D7CB7938D525A2F31AAF161D0"/
data result(5) /"C3FCD3D76192E4007DFB496CCA67E13B"/
data result(6) /"D174AB98D277D9F5A5611C2C9F419D9F"/
data result(7) /"57EDF4A22BE3C955AC49DA2E2107B67A"/
write (u, "(A)") "* Test output: MD5"
write (u, "(A)") "* Purpose: test MD5 sums"
write (u, "(A)")
do i = 1, n
write (u, "(A)") "MD5 test string = " // '"'// &
trim (teststring(i)) // '"'
s = md5sum (trim (teststring(i)))
write (u, "(A)") "MD5 check sum = " // trim (s)
write (u, "(A)") "Ref check sum = " // result(i)
if (s == result(i)) then
call msg_message ("=> ok", u)
else
call msg_message ("=> MD5 sum self-test failed", u)
end if
end do
call msg_message ("=============================================================================|", unit=u)
end subroutine md5_1
@ %def md5_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Permutations}
Permute arrays of integers (of specific kind).
<<[[permutations.f90]]>>=
<<File header>>
module permutations
use kinds, only: TC
<<Standard module head>>
<<Permutations: public>>
<<Permutations: types>>
<<Permutations: interfaces>>
interface
<<Permutations: sub interfaces>>
end interface
end module permutations
@ %def permutations
@
<<[[permutations_sub.f90]]>>=
<<File header>>
submodule (permutations) permutations_s
implicit none
<<Permutations: variables>>
contains
<<Permutations: procedures>>
end submodule permutations_s
@ %def permutations_s
@
\subsection{Permutations}
A permutation is an array of integers. Each integer between one and
[[size]] should occur exactly once.
<<Permutations: public>>=
public :: permutation_t
<<Permutations: types>>=
type :: permutation_t
private
integer, dimension(:), allocatable :: p
end type permutation_t
@ %def permutation
@
Initialize with the identity permutation.
<<Permutations: public>>=
public :: permutation_init
public :: permutation_final
<<Permutations: sub interfaces>>=
elemental module subroutine permutation_init (p, size)
type(permutation_t), intent(inout) :: p
integer, intent(in) :: size
end subroutine permutation_init
elemental module subroutine permutation_final (p)
type(permutation_t), intent(inout) :: p
end subroutine permutation_final
<<Permutations: procedures>>=
elemental module subroutine permutation_init (p, size)
type(permutation_t), intent(inout) :: p
integer, intent(in) :: size
integer :: i
allocate (p%p (size))
forall (i = 1:size)
p%p(i) = i
end forall
end subroutine permutation_init
elemental module subroutine permutation_final (p)
type(permutation_t), intent(inout) :: p
deallocate (p%p)
end subroutine permutation_final
@ %def permutation_init permutation_final
@ I/O:
<<Permutations: public>>=
public :: permutation_write
<<Permutations: sub interfaces>>=
module subroutine permutation_write (p, u)
type(permutation_t), intent (in) :: p
integer, intent(in) :: u
end subroutine permutation_write
<<Permutations: procedures>>=
module subroutine permutation_write (p, u)
type(permutation_t), intent (in) :: p
integer, intent(in) :: u
integer :: i
do i = 1, size (p%p)
if (size (p%p) < 10) then
write (u,"(1x,I1)", advance="no") p%p(i)
else
write (u,"(1x,I3)", advance="no") p%p(i)
end if
end do
write (u, *)
end subroutine permutation_write
@ %def permutation_write
@
Administration:
<<Permutations: public>>=
public :: permutation_size
<<Permutations: sub interfaces>>=
elemental module function permutation_size (perm) result (s)
type(permutation_t), intent(in) :: perm
integer :: s
end function permutation_size
<<Permutations: procedures>>=
elemental module function permutation_size (perm) result (s)
type(permutation_t), intent(in) :: perm
integer :: s
s = size (perm%p)
end function permutation_size
@ %def permutation_size
@ Extract an entry in a permutation.
<<Permutations: public>>=
public :: permute
<<Permutations: sub interfaces>>=
elemental module function permute (i, p) result (j)
integer, intent(in) :: i
type(permutation_t), intent(in) :: p
integer :: j
end function permute
<<Permutations: procedures>>=
elemental module function permute (i, p) result (j)
integer, intent(in) :: i
type(permutation_t), intent(in) :: p
integer :: j
if (i > 0 .and. i <= size (p%p)) then
j = p%p(i)
else
j = 0
end if
end function permute
@ %def permute
@
Check whether a permutation is valid: Each integer in the range occurs
exactly once.
<<Permutations: public>>=
public :: permutation_ok
<<Permutations: sub interfaces>>=
elemental module function permutation_ok (perm) result (ok)
type(permutation_t), intent(in) :: perm
logical :: ok
end function permutation_ok
<<Permutations: procedures>>=
elemental module function permutation_ok (perm) result (ok)
type(permutation_t), intent(in) :: perm
logical :: ok
integer :: i
logical, dimension(:), allocatable :: set
ok = .true.
allocate (set (size (perm%p)))
set = .false.
do i = 1, size (perm%p)
ok = (perm%p(i) > 0 .and. perm%p(i) <= size (perm%p))
if (.not.ok) return
set(perm%p(i)) = .true.
end do
ok = all (set)
end function permutation_ok
@ %def permutation_ok
@ Find the permutation that transforms the second array into the first
one. We assume that this is possible and unique and all bounds are
set correctly.
This cannot be elemental.
<<Permutations: public>>=
public :: permutation_find
<<Permutations: sub interfaces>>=
module subroutine permutation_find (perm, a1, a2)
type(permutation_t), intent(inout) :: perm
integer, dimension(:), intent(in) :: a1, a2
end subroutine permutation_find
<<Permutations: procedures>>=
module subroutine permutation_find (perm, a1, a2)
type(permutation_t), intent(inout) :: perm
integer, dimension(:), intent(in) :: a1, a2
integer :: i, j
if (allocated (perm%p)) deallocate (perm%p)
allocate (perm%p (size (a1)))
do i = 1, size (a1)
do j = 1, size (a2)
if (a1(i) == a2(j)) then
perm%p(i) = j
exit
end if
perm%p(i) = 0
end do
end do
end subroutine permutation_find
@ %def permutation_find
@
Find all permutations that transform an array of integers into
itself. The resulting permutation list is allocated with the correct
length and filled.
The first step is to count the number of different entries in
[[code]]. Next, we scan [[code]] again and assign a mask to each
different entry, true for all identical entries. Finally, we
recursively permute the identity for each possible mask.
The permutation is done as follows: A list of all permutations of the
initial one with respect to the current mask is generated, then the
permutations are generated in turn for each permutation in this list
with the next mask. The result is always stored back into the main
list, starting from the end of the current list.
<<Permutations: public>>=
public :: permutation_array_make
<<Permutations: sub interfaces>>=
module subroutine permutation_array_make (pa, code)
type(permutation_t), dimension(:), allocatable, intent(out) :: pa
integer, dimension(:), intent(in) :: code
end subroutine permutation_array_make
<<Permutations: procedures>>=
module subroutine permutation_array_make (pa, code)
type(permutation_t), dimension(:), allocatable, intent(out) :: pa
integer, dimension(:), intent(in) :: code
logical, dimension(size(code)) :: mask
logical, dimension(:,:), allocatable :: imask
integer, dimension(:), allocatable :: n_i
type(permutation_t) :: p_init
type(permutation_t), dimension(:), allocatable :: p_tmp
integer :: psize, i, j, k, n_different, n, nn_k
psize = size (code)
mask = .true.
n_different = 0
do i=1, psize
if (mask(i)) then
n_different = n_different + 1
mask = mask .and. (code /= code(i))
end if
end do
allocate (imask(psize, n_different), n_i(n_different))
mask = .true.
k = 0
do i=1, psize
if (mask(i)) then
k = k + 1
imask(:,k) = (code == code(i))
n_i(k) = factorial (count(imask(:,k)))
mask = mask .and. (code /= code(i))
end if
end do
n = product (n_i)
allocate (pa (n))
call permutation_init (p_init, psize)
pa(1) = p_init
nn_k = 1
do k = 1, n_different
allocate (p_tmp (n_i(k)))
do i = nn_k, 1, -1
call permutation_array_with_mask (p_tmp, imask(:,k), pa(i))
do j = n_i(k), 1, -1
pa((i-1)*n_i(k) + j) = p_tmp(j)
end do
end do
deallocate (p_tmp)
nn_k = nn_k * n_i(k)
end do
call permutation_final (p_init)
deallocate (imask, n_i)
end subroutine permutation_array_make
@ %def permutation_array_make
@ Make a list of permutations of the elements marked true in the
[[mask]] array. The final permutation list must be allocated with the
correct length ($n!$). The third argument is the initial
permutation to start with, which must have the same length as the
[[mask]] array (this is not checked).
<<Permutations: procedures>>=
subroutine permutation_array_with_mask (pa, mask, p_init)
type(permutation_t), dimension(:), intent(inout) :: pa
logical, dimension(:), intent(in) :: mask
type(permutation_t), intent(in) :: p_init
integer :: plen
integer :: i, ii, j, fac_i, k, x
integer, dimension(:), allocatable :: index
plen = size (pa)
allocate (index(count(mask)))
ii = 0
do i = 1, size (mask)
if (mask(i)) then
ii = ii + 1
index(ii) = i
end if
end do
pa = p_init
ii = 0
fac_i = 1
do i = 1, size (mask)
if (mask(i)) then
ii = ii + 1
fac_i = fac_i * ii
x = permute (i, p_init)
do j = 1, plen
k = ii - mod (((j-1)*fac_i)/plen, ii)
call insert (pa(j), x, k, ii, index)
end do
end if
end do
deallocate (index)
contains
subroutine insert (p, x, k, n, index)
type(permutation_t), intent(inout) :: p
integer, intent(in) :: x, k, n
integer, dimension(:), intent(in) :: index
integer :: i
do i = n, k+1, -1
p%p(index(i)) = p%p(index(i-1))
end do
p%p(index(k)) = x
end subroutine insert
end subroutine permutation_array_with_mask
@ %def permutation_array_with_mask
@ The factorial function is needed for pre-determining the number of
permutations that will be generated:
<<Permutations: public>>=
public :: factorial
<<Permutations: sub interfaces>>=
elemental module function factorial (n) result (f)
integer, intent(in) :: n
integer :: f
end function factorial
<<Permutations: procedures>>=
elemental module function factorial (n) result (f)
integer, intent(in) :: n
integer :: f
integer :: i
f = 1
do i=2, abs(n)
f = f*i
end do
end function factorial
@ %def factorial
@
\subsection{Operations on binary codes}
Binary codes are needed for phase-space trees. Since the permutation
function uses permutations, and no other special type is involved, we
put the functions here.
This is needed for phase space trees: permute bits in a tree binary
code. If no permutation is given, leave as is. (We may want to
access the permutation directly here if this is efficiency-critical.)
<<Permutations: public>>=
public :: tc_permute
<<Permutations: sub interfaces>>=
module function tc_permute (k, perm, mask_in) result (pk)
integer(TC), intent(in) :: k, mask_in
type(permutation_t), intent(in) :: perm
integer(TC) :: pk
end function tc_permute
<<Permutations: procedures>>=
module function tc_permute (k, perm, mask_in) result (pk)
integer(TC), intent(in) :: k, mask_in
type(permutation_t), intent(in) :: perm
integer(TC) :: pk
integer :: i
pk = iand (k, mask_in)
do i = 1, size (perm%p)
if (btest(k,i-1)) pk = ibset (pk, perm%p(i)-1)
end do
end function tc_permute
@ %def tc_permute
@
This routine returns the number of set bits in the tree code value
[[k]]. Hence, it is the number of externals connected to the current
line. If [[mask]] is present, the complement of the tree code is also
considered, and the smaller number is returned. This gives the true
distance from the external states, taking into account the initial
particles. The complement number is increased by one, since for a
scattering diagram the vertex with the sum of all final-state codes is
still one point apart from the initial particles.
<<Permutations: public>>=
public :: tc_decay_level
<<Permutations: interfaces>>=
interface tc_decay_level
module procedure decay_level_simple
module procedure decay_level_complement
end interface
@ %def decay_level
@
<<Permutations: sub interfaces>>=
module function decay_level_complement (k, mask) result (l)
integer(TC), intent(in) :: k, mask
integer :: l
end function decay_level_complement
module function decay_level_simple (k) result(l)
integer(TC), intent(in) :: k
integer :: l
end function decay_level_simple
<<Permutations: procedures>>=
module function decay_level_complement (k, mask) result (l)
integer(TC), intent(in) :: k, mask
integer :: l
l = min (decay_level_simple (k), &
& decay_level_simple (ieor (k, mask)) + 1)
end function decay_level_complement
module function decay_level_simple (k) result(l)
integer(TC), intent(in) :: k
integer :: l
integer :: i
l = 0
do i=0, bit_size(k)-1
if (btest(k,i)) l = l+1
end do
end function decay_level_simple
@ %def decay_level_simple decay_level_complement
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Sorting}
This small module provides functions for sorting integer or real
arrays.
<<[[sorting.f90]]>>=
<<File header>>
module sorting
<<Use kinds>>
<<Standard module head>>
<<Sorting: public>>
<<Sorting: interfaces>>
interface
<<Sorting: sub interfaces>>
end interface
end module sorting
@ %def sorting
@
<<[[sorting_sub.f90]]>>=
<<File header>>
submodule (sorting) sorting_s
use diagnostics
implicit none
contains
<<Sorting: procedures>>
end submodule sorting_s
@ %def sorting_s
@
\subsection{Implementation}
The [[sort]] function returns, for a given integer or real array, the
array sorted by increasing value. The current implementation is
\emph{mergesort}, which has $O(n\ln n)$ behavior in all cases, and is
stable for elements of equal value.
The [[sort_abs]] variant sorts by increasing absolute value, where for
identical absolute value, the positive number comes first.
<<Sorting: public>>=
public :: sort
public :: sort_abs
<<Sorting: interfaces>>=
interface sort
module procedure sort_int
module procedure sort_real
end interface
interface sort_abs
module procedure sort_int_abs
end interface
@ %def sort sort_abs
@ This variant of integer sort returns
@ The body is identical, just the interface differs.
<<Sorting: sub interfaces>>=
module function sort_int (val_in) result (val)
integer, dimension(:), intent(in) :: val_in
integer, dimension(size(val_in)) :: val
end function sort_int
module function sort_real (val_in) result (val)
real(default), dimension(:), intent(in) :: val_in
real(default), dimension(size(val_in)) :: val
end function sort_real
module function sort_int_abs (val_in) result (val)
integer, dimension(:), intent(in) :: val_in
integer, dimension(size(val_in)) :: val
end function sort_int_abs
<<Sorting: procedures>>=
module function sort_int (val_in) result (val)
integer, dimension(:), intent(in) :: val_in
integer, dimension(size(val_in)) :: val
<<Sorting: sort>>
end function sort_int
module function sort_real (val_in) result (val)
real(default), dimension(:), intent(in) :: val_in
real(default), dimension(size(val_in)) :: val
<<Sorting: sort>>
end function sort_real
module function sort_int_abs (val_in) result (val)
integer, dimension(:), intent(in) :: val_in
integer, dimension(size(val_in)) :: val
<<Sorting: sort abs>>
end function sort_int_abs
@ %def sort_int sort_real sort_int_abs
<<Sorting: sort>>=
val = val_in( order (val_in) )
<<Sorting: sort abs>>=
val = val_in( order_abs (val_in) )
@ The [[order]] function returns, for a given integer or real array, the
array of indices of the elements sorted by increasing value.
<<Sorting: public>>=
public :: order
public :: order_abs
<<Sorting: interfaces>>=
interface order
module procedure order_int
module procedure order_real
end interface
interface order_abs
module procedure order_int_abs
end interface
@ %def order order_abs
@
<<Sorting: sub interfaces>>=
module function order_int (val) result (idx)
integer, dimension(:), intent(in) :: val
integer, dimension(size(val)) :: idx
end function order_int
module function order_real (val) result (idx)
real(default), dimension(:), intent(in) :: val
integer, dimension(size(val)) :: idx
end function order_real
module function order_int_abs (val) result (idx)
integer, dimension(:), intent(in) :: val
integer, dimension(size(val)) :: idx
end function order_int_abs
<<Sorting: procedures>>=
module function order_int (val) result (idx)
integer, dimension(:), intent(in) :: val
integer, dimension(size(val)) :: idx
<<Sorting: order>>
end function order_int
module function order_real (val) result (idx)
real(default), dimension(:), intent(in) :: val
integer, dimension(size(val)) :: idx
<<Sorting: order>>
end function order_real
module function order_int_abs (val) result (idx)
integer, dimension(:), intent(in) :: val
integer, dimension(size(val)) :: idx
<<Sorting: order abs>>
end function order_int_abs
@ %def order_int order_real order_int_abs
@ We start by individual elements, merge them to pairs, merge those to
four-element subarrays, and so on. The last subarray can extend only
up to the original array bound, of course, and the second of the
subarrays to merge should contain at least one element.
<<Sorting: order>>=
<<Sorting: order1>>
call merge (idx(b1:e2), idx(b1:e1), idx(b2:e2), val)
<<Sorting: order2>>
@
<<Sorting: order abs>>=
<<Sorting: order1>>
call merge_abs (idx(b1:e2), idx(b1:e1), idx(b2:e2), val)
<<Sorting: order2>>
@
<<Sorting: order1>>=
integer :: n, i, s, b1, b2, e1, e2
n = size (idx)
do i = 1, n
idx(i) = i
end do
s = 1
do while (s < n)
do b1 = 1, n-s, 2*s
b2 = b1 + s
e1 = b2 - 1
e2 = min (e1 + s, n)
@
<<Sorting: order2>>=
end do
s = 2 * s
end do
@ The merging step does the actual sorting. We take two sorted array
sections and merge them to a sorted result array. We are working on
the indices, and comparing is done by taking the associated [[val]]
which is real or integer.
<<Sorting: interfaces>>=
interface merge
module procedure merge_int
module procedure merge_real
end interface
interface merge_abs
module procedure merge_int_abs
end interface
@ %def merge merge_abs
@
<<Sorting: sub interfaces>>=
module subroutine merge_int (res, src1, src2, val)
integer, dimension(:), intent(out) :: res
integer, dimension(:), intent(in) :: src1, src2
integer, dimension(:), intent(in) :: val
end subroutine merge_int
module subroutine merge_real (res, src1, src2, val)
integer, dimension(:), intent(out) :: res
integer, dimension(:), intent(in) :: src1, src2
real(default), dimension(:), intent(in) :: val
end subroutine merge_real
module subroutine merge_int_abs (res, src1, src2, val)
integer, dimension(:), intent(out) :: res
integer, dimension(:), intent(in) :: src1, src2
integer, dimension(:), intent(in) :: val
end subroutine merge_int_abs
<<Sorting: procedures>>=
module subroutine merge_int (res, src1, src2, val)
integer, dimension(:), intent(out) :: res
integer, dimension(:), intent(in) :: src1, src2
integer, dimension(:), intent(in) :: val
integer, dimension(size(res)) :: tmp
<<Sorting: merge>>
end subroutine merge_int
module subroutine merge_real (res, src1, src2, val)
integer, dimension(:), intent(out) :: res
integer, dimension(:), intent(in) :: src1, src2
real(default), dimension(:), intent(in) :: val
integer, dimension(size(res)) :: tmp
<<Sorting: merge>>
end subroutine merge_real
module subroutine merge_int_abs (res, src1, src2, val)
integer, dimension(:), intent(out) :: res
integer, dimension(:), intent(in) :: src1, src2
integer, dimension(:), intent(in) :: val
integer, dimension(size(res)) :: tmp
<<Sorting: merge abs>>
end subroutine merge_int_abs
@ %def merge_int merge_real merge_int_abs
<<Sorting: merge>>=
<<Sorting: merge1>>
if (val(src1(i1)) <= val(src2(i2))) then
<<Sorting: merge2>>
@ We keep the elements if the absolute values are strictly ordered.
If they are equal in magnitude, we keep them if the larger value
comes first, or if they are equal.
<<Sorting: merge abs>>=
<<Sorting: merge1>>
if (abs (val(src1(i1))) < abs (val(src2(i2))) .or. &
(abs (val(src1(i1))) == abs (val(src2(i2))) .and. &
val(src1(i1)) >= val(src2(i2)))) then
<<Sorting: merge2>>
@
<<Sorting: merge1>>=
integer :: i1, i2, i
i1 = 1
i2 = 1
do i = 1, size (tmp)
@
<<Sorting: merge2>>=
tmp(i) = src1(i1); i1 = i1 + 1
if (i1 > size (src1)) then
tmp(i+1:) = src2(i2:)
exit
end if
else
tmp(i) = src2(i2); i2 = i2 + 1
if (i2 > size (src2)) then
tmp(i+1:) = src1(i1:)
exit
end if
end if
end do
res = tmp
@
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sorting_ut.f90]]>>=
<<File header>>
module sorting_ut
use unit_tests
use sorting_uti
<<Standard module head>>
<<Sorting: public test>>
contains
<<Sorting: test driver>>
end module sorting_ut
@ %def sorting_ut
@
<<[[sorting_uti.f90]]>>=
<<File header>>
module sorting_uti
<<Use kinds>>
use sorting
<<Standard module head>>
<<Sorting: test declarations>>
contains
<<Sorting: tests>>
end module sorting_uti
@ %def sorting_ut
@ API: driver for the unit tests below.
<<Sorting: public test>>=
public :: sorting_test
<<Sorting: test driver>>=
subroutine sorting_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Sorting: execute tests>>
end subroutine sorting_test
@ %def sorting_test
@ This checks whether the sorting routine works correctly.
<<Sorting: execute tests>>=
call test (sorting_1, "sorting_1", &
"check sorting routines", &
u, results)
<<Sorting: test declarations>>=
public :: sorting_1
<<Sorting: tests>>=
subroutine sorting_1 (u)
integer, intent(in) :: u
integer, parameter :: NMAX = 10
real(default), dimension(NMAX) :: rval
integer, dimension(NMAX) :: ival
real, dimension(NMAX,NMAX) :: harvest_r
integer, dimension(NMAX,NMAX) :: harvest_i
integer, dimension(NMAX,NMAX) :: harvest_a
integer :: i, j
harvest_r(:, 1) = [0.9976, 0., 0., 0., 0., 0., 0., 0., 0., 0.]
harvest_r(:, 2) = [0.5668, 0.9659, 0., 0., 0., 0., 0., 0., 0., 0.]
harvest_r(:, 3) = [0.7479, 0.3674, 0.4806, 0., 0., 0., 0., 0., 0., &
0.]
harvest_r(:, 4) = [0.0738, 0.0054, 0.3471, 0.3422, 0., 0., 0., 0., &
0., 0.]
harvest_r(:, 5) = [0.2180, 0.1332, 0.9005, 0.3868, 0.4455, 0., 0., &
0., 0., 0.]
harvest_r(:, 6) = [0.6619, 0.0161, 0.6509, 0.6464, 0.3230, &
0.8557, 0., 0., 0., 0.]
harvest_r(:, 7) = [0.4013, 0.2069, 0.9685, 0.5984, 0.6730, &
0.4569, 0.3300, 0., 0., 0.]
harvest_r(:, 8) = [0.1004, 0.7555, 0.6057, 0.7190, 0.8973, &
0.6582, 0.1507, 0.6123, 0., 0.]
harvest_r(:, 9) = [0.9787, 0.9991, 0.2568, 0.5509, 0.6590, &
0.5540, 0.9778, 0.9019, 0.6579, 0.]
harvest_r(:,10) = [0.7289, 0.4025, 0.9286, 0.1478, 0.6745, &
0.7696, 0.3393, 0.1158, 0.6144, 0.8206]
harvest_i(:, 1) = [18, 0, 0, 0, 0, 0, 0, 0, 0, 0]
harvest_i(:, 2) = [14, 9, 0, 0, 0, 0, 0, 0, 0, 0]
harvest_i(:, 3) = [ 7, 8,11, 0, 0, 0, 0, 0, 0, 0]
harvest_i(:, 4) = [19,19,14,19, 0, 0, 0, 0, 0, 0]
harvest_i(:, 5) = [ 1,14,15,18,14, 0, 0, 0, 0, 0]
harvest_i(:, 6) = [16,11, 1, 9,11, 2, 0, 0, 0, 0]
harvest_i(:, 7) = [11,10,17, 6,13,13,10, 0, 0, 0]
harvest_i(:, 8) = [ 5, 1, 2,10, 7, 0,15,12, 0, 0]
harvest_i(:, 9) = [15,19, 2, 6,11, 0, 2, 4, 2, 0]
harvest_i(:,10) = [ 1, 4, 8, 4,11, 0, 8, 7,19,13]
harvest_a(:, 1) = [-6, 0, 0, 0, 0, 0, 0, 0, 0, 0]
harvest_a(:, 2) = [-8, -9, 0, 0, 0, 0, 0, 0, 0, 0]
harvest_a(:, 3) = [ 4, -3, 3, 0, 0, 0, 0, 0, 0, 0]
harvest_a(:, 4) = [-6, 6, 2, -2, 0, 0, 0, 0, 0, 0]
harvest_a(:, 5) = [ 1, -2, 0, -6, 8, 0, 0, 0, 0, 0]
harvest_a(:, 6) = [-2, -1, -8, -5, 8, -5, 0, 0, 0, 0]
harvest_a(:, 7) = [-9, 0, -6, 2, 5, 3, 2, 0, 0, 0]
harvest_a(:, 8) = [-5, -7, 6, 7, -3, 0, -7, 4, 0, 0]
harvest_a(:, 9) = [ 5, 0, -1, -7, 5, 2, 7, -3, 3, 0]
harvest_a(:,10) = [-9, 2, -6, 3, -9, 5, 5, 7, 5, -9]
write (u, "(A)") "* Test output: Sorting"
write (u, "(A)") "* Purpose: test sorting routines"
write (u, "(A)")
write (u, "(A)") "* Sorting real values:"
do i = 1, NMAX
write (u, "(A)")
rval(:i) = harvest_r(:i,i)
write (u, "(10(1x,F7.4))") rval(:i)
rval(:i) = sort (rval(:i))
write (u, "(10(1x,F7.4))") rval(:i)
do j = i, 2, -1
if (rval(j)-rval(j-1) < 0) &
write (u, "(A)") "*** Sorting failure. ***"
end do
end do
write (u, "(A)")
write (u, "(A)") "* Sorting integer values:"
do i = 1, NMAX
write (u, "(A)")
ival(:i) = harvest_i(:i,i)
write (u, "(10(1x,I2))") ival(:i)
ival(:i) = sort (ival(:i))
write (u, "(10(1x,I2))") ival(:i)
do j = i, 2, -1
if (ival(j)-ival(j-1) < 0) &
write (u, "(A)") "*** Sorting failure. ***"
end do
end do
write (u, "(A)")
write (u, "(A)") "* Sorting integer values by absolute value:"
do i = 1, NMAX
write (u, "(A)")
ival(:i) = harvest_a(:i,i)
write (u, "(10(1x,I2))") ival(:i)
ival(:i) = sort_abs (ival(:i))
write (u, "(10(1x,I2))") ival(:i)
do j = i, 2, -1
if (abs(ival(j))-abs(ival(j-1)) < 0 .or. &
(abs(ival(j))==abs(ival(j-1))) .and. ival(j)>ival(j-1)) &
write (u, "(A)") "*** Sorting failure. ***"
end do
end do
write (u, "(A)")
write (u, "(A)") "* Test output end: sorting_1"
end subroutine sorting_1
@ %def sorting_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Grids}
\emph{This is not really a combinatorics module but this directory is the
closest I could find. Maybe this will be moved to a seperate directory
or combined with related stuff.}
<<[[grids.f90]]>>=
<<File header>>
module grids
<<Use kinds>>
<<Use mpi f08>>
<<Standard module head>>
<<Grids: public>>
<<Grids: types>>
interface
<<Grids: sub interfaces>>
end interface
end module grids
@ %def grids
<<[[grids_sub.f90]]>>=
<<File header>>
submodule (grids) grids_s
use constants, only: zero, one, tiny_07
use io_units
- use format_defs, only: FMT_16
+ use format_defs, only: FMT_16, FMT_12
use diagnostics
<<Use mpi f08>>
implicit none
<<Grids: parameters>>
contains
<<Grids: procedures>>
end submodule grids_s
@ %def grids_s
@
@ Grids are used in many applications and a general implementation seems
useful. The relevant properties implemented so far are
\begin{itemize}
\item Segments of the hypercube are represented by an integer array
with size $d$ corresponding to the dimension.
\item There is a mapping from the indices to the location in the
continuous memory block of values.
\item Given a point in the hypercube, find the corresponding
segment and the value of the grid therein.
\item Update the grid sequentially to represent the maximum
of a function over the unit hypercube.
\item The grid can be saved to and recovered from disk.
\end{itemize}
The following might be implemented in the future
\begin{itemize}
\item Generate a random point in the hypercube by interpreting the
grid as probability distribution.
\emph{This would most likely be solved by using projections and the
[[selector_t]], which would make a move of this module higher up in
the dependency tree necessary.}
\item Update the grid sequentially to represent the \emph{minimum}
of a function over the unit hypercube.
\end{itemize}
<<Grids: public>>=
public :: grid_t
<<Grids: types>>=
type :: grid_t
private
real(default), dimension(:), allocatable :: values
integer, dimension(:), allocatable :: points
contains
<<Grids: grid: TBP>>
end type grid_t
@ %def grid_t
@
\subsection{Initializer and finalizer}
For initialization, we expect the number of points for each dimension
as an array or the the number of dimensions as a scalar whereby the
default number of points is used then for each dimension.
<<Grids: grid: TBP>>=
generic :: init => init_base, init_simple
procedure :: init_base => grid_init_base
procedure :: init_simple => grid_init_simple
<<Grids: sub interfaces>>=
pure module subroutine grid_init_base (grid, points)
class(grid_t), intent(inout) :: grid
integer, dimension(:), intent(in) :: points
end subroutine grid_init_base
<<Grids: procedures>>=
pure module subroutine grid_init_base (grid, points)
class(grid_t), intent(inout) :: grid
integer, dimension(:), intent(in) :: points
allocate (grid%points (size (points)))
allocate (grid%values (product (points)))
grid%points = points
grid%values = zero
end subroutine grid_init_base
@ %def grid_init_base
@
<<Grids: sub interfaces>>=
pure module subroutine grid_init_simple (grid, dimensions)
class(grid_t), intent(inout) :: grid
integer, intent(in) :: dimensions
end subroutine grid_init_simple
<<Grids: procedures>>=
pure module subroutine grid_init_simple (grid, dimensions)
class(grid_t), intent(inout) :: grid
integer, intent(in) :: dimensions
allocate (grid%points (dimensions))
allocate (grid%values (DEFAULT_POINTS_PER_DIMENSION ** dimensions))
grid%points = DEFAULT_POINTS_PER_DIMENSION
grid%values = zero
end subroutine grid_init_simple
@ %def grid_init_simple
@ Manual assignment (tests)
<<Grids: grid: TBP>>=
procedure :: set_values => grid_set_values
<<Grids: sub interfaces>>=
module subroutine grid_set_values (grid, values)
class(grid_t), intent(inout) :: grid
real(default), dimension(:), intent(in) :: values
end subroutine grid_set_values
<<Grids: procedures>>=
module subroutine grid_set_values (grid, values)
class(grid_t), intent(inout) :: grid
real(default), dimension(:), intent(in) :: values
grid%values = values
end subroutine grid_set_values
@ %def grid_set_values
@ A reasonable default
<<Grids: parameters>>=
integer, parameter :: DEFAULT_POINTS_PER_DIMENSION = 100
@ %def DEFAULT_POINTS_PER_DIMENSION
@ Calling this is not mandatory, when an instance of [[grid_t]] goes out
of scope as it will be done by Fortran automatically.
<<Grids: grid: TBP>>=
procedure :: final => grid_final
<<Grids: sub interfaces>>=
pure module subroutine grid_final (grid)
class(grid_t), intent(inout) :: grid
end subroutine grid_final
<<Grids: procedures>>=
pure module subroutine grid_final (grid)
class(grid_t), intent(inout) :: grid
if (allocated (grid%values)) then
deallocate (grid%values)
end if
if (allocated (grid%points)) then
deallocate (grid%points)
end if
end subroutine grid_final
@ %def grid_final
@
\subsection{Segment finding and memory mapping}
The [[indices]] array is expected to go from 1 to $d$ whereby the
entries for the different $\text{dim}$s are from 1 to
$n_\text{points}(\text{dim})$.
@ We get the value of the grid either from given [[indices]] or from a
point [[x]] in the hypercube. In the latter case, we have to find the
segment first.
<<Grids: grid: TBP>>=
generic :: get_value => get_value_from_x, get_value_from_indices
procedure :: get_value_from_x => grid_get_value_from_x
procedure :: get_value_from_indices => grid_get_value_from_indices
<<Grids: sub interfaces>>=
module function grid_get_value_from_indices (grid, indices)
real(default) :: grid_get_value_from_indices
class(grid_t), intent(in) :: grid
integer, dimension(:), intent(in) :: indices
end function grid_get_value_from_indices
<<Grids: procedures>>=
module function grid_get_value_from_indices (grid, indices)
real(default) :: grid_get_value_from_indices
class(grid_t), intent(in) :: grid
integer, dimension(:), intent(in) :: indices
grid_get_value_from_indices = grid%values(grid%get_index(indices))
end function grid_get_value_from_indices
@ %def grid_get_value_from_indices
@
<<Grids: sub interfaces>>=
module function grid_get_value_from_x (grid, x)
real(default) :: grid_get_value_from_x
class(grid_t), intent(in) :: grid
real(default), dimension(:), intent(in) :: x
end function grid_get_value_from_x
<<Grids: procedures>>=
module function grid_get_value_from_x (grid, x)
real(default) :: grid_get_value_from_x
class(grid_t), intent(in) :: grid
real(default), dimension(:), intent(in) :: x
grid_get_value_from_x = grid_get_value_from_indices &
(grid, grid_get_segment (grid, x))
end function grid_get_value_from_x
@ %def grid_get_value_from_x
@ The segment is the part of the grid that contains the point [[x]] and
is identified by a tupel of [[indices]]. This is just a brute force
search, for fine grids one could also implement a binary search for
$\mathcal{O}(\log{N})$ behavior instead of $\mathcal{O}({N})$.
<<Grids: grid: TBP>>=
procedure :: get_segment => grid_get_segment
<<Grids: sub interfaces>>=
module function grid_get_segment (grid, x, unit) result (segment)
class(grid_t), intent(in) :: grid
real(default), dimension(:), intent(in) :: x
integer, intent(in), optional :: unit
integer, dimension(1:size (x)) :: segment
end function grid_get_segment
<<Grids: procedures>>=
module function grid_get_segment (grid, x, unit) result (segment)
class(grid_t), intent(in) :: grid
real(default), dimension(:), intent(in) :: x
integer, intent(in), optional :: unit
integer, dimension(1:size (x)) :: segment
integer :: dim, i
real(default) :: segment_width
segment = 0
do dim = 1, size (grid%points)
segment_width = one / grid%points (dim)
SEARCH: do i = 1, grid%points (dim)
if (x (dim) <= i * segment_width + tiny_07) then
segment (dim) = i
exit SEARCH
end if
end do SEARCH
if (segment (dim) == 0) then
do i = 1, size(x)
write (msg_buffer, "(A," // DEFAULT_OUTPUT_PRECISION // ")") &
"x[i] = ", x(i)
call msg_message ()
end do
call msg_error ("grid_get_segment: Did not find x in [0,1]^d", &
unit=unit)
end if
end do
end function grid_get_segment
@ %def grid_get_segment
@ This is a simple storage mapping function but more sophisticated ideas
like hashing could be implemented.
\begin{align}
\text{index} = &\text{indices}(1) + \notag\\
&\text{indices}(2) * \text{size}(1) + \notag\\
&\text{indices}(3) * \text{size}(1) * \text{size}(2) +
\dots
\end{align}
<<Grids: grid: TBP>>=
procedure :: get_index => grid_get_index
<<Grids: sub interfaces>>=
pure module function grid_get_index (grid, indices) result (grid_index)
integer :: grid_index
class(grid_t), intent(in) :: grid
integer, dimension(:), intent(in) :: indices
end function grid_get_index
<<Grids: procedures>>=
pure module function grid_get_index (grid, indices) result (grid_index)
integer :: grid_index
class(grid_t), intent(in) :: grid
integer, dimension(:), intent(in) :: indices
integer :: dim_innerloop, dim_outerloop, multiplier
grid_index = 1
do dim_outerloop = 1, size(indices)
multiplier = 1
do dim_innerloop = 1, dim_outerloop - 1
multiplier = multiplier * grid%points (dim_innerloop)
end do
grid_index = grid_index + (indices(dim_outerloop) - 1) * multiplier
end do
end function grid_get_index
@ %def grid_get_index
@
\subsection{Grid manipulations}
Given a point in the hypercube [[x]] and its value [[y]], we update
the grids, such that the stepwise function $f$ defined by the grid is
$f(x_i)\geq y_i\;\forall \{x_i, y_i\}$.
<<Grids: grid: TBP>>=
procedure :: update_maxima => grid_update_maxima
<<Grids: sub interfaces>>=
module subroutine grid_update_maxima (grid, x, y)
class(grid_t), intent(inout) :: grid
real(default), dimension(:), intent(in) :: x
real(default), intent(in) :: y
end subroutine grid_update_maxima
<<Grids: procedures>>=
module subroutine grid_update_maxima (grid, x, y)
class(grid_t), intent(inout) :: grid
real(default), dimension(:), intent(in) :: x
real(default), intent(in) :: y
integer, dimension(1:size(x)) :: indices
indices = grid%get_segment (x)
if (grid%get_value (indices) < y) then
grid%values (grid%get_index (indices)) = y
end if
end subroutine grid_update_maxima
@ %def grid_update_maxima
@ More general cases have to be thought through when they are needed.
\emph{This is inefficient and non-general}.
<<Grids: grid: TBP>>=
procedure :: get_maximum_in_3d => grid_get_maximum_in_3d
<<Grids: sub interfaces>>=
module function grid_get_maximum_in_3d (grid, projected_index) result (maximum)
real(default) :: maximum
class(grid_t), intent(in) :: grid
integer, intent(in) :: projected_index
end function grid_get_maximum_in_3d
<<Grids: procedures>>=
module function grid_get_maximum_in_3d (grid, projected_index) result (maximum)
real(default) :: maximum
class(grid_t), intent(in) :: grid
integer, intent(in) :: projected_index
real(default) :: val
integer :: i, j
maximum = zero
do i = 1, grid%points(1)
do j = 1, grid%points(2)
val = grid%get_value ([i, j, projected_index])
if (val > maximum) then
maximum = val
end if
end do
end do
end function grid_get_maximum_in_3d
@ %def grid_get_maximum_in_3d
@
<<Grids: grid: TBP>>=
procedure :: is_non_zero_everywhere => grid_is_non_zero_everywhere
<<Grids: sub interfaces>>=
pure module function grid_is_non_zero_everywhere (grid) result (yorn)
logical :: yorn
class(grid_t), intent(in) :: grid
end function grid_is_non_zero_everywhere
<<Grids: procedures>>=
pure module function grid_is_non_zero_everywhere (grid) result (yorn)
logical :: yorn
class(grid_t), intent(in) :: grid
yorn = all (abs (grid%values) > zero)
end function grid_is_non_zero_everywhere
@ %def grid_is_non_zero_everywhere
@ Returns true if any value of the grid is non-zero.
We need this to determine whether the grid has been filled during integration.
<<Grids: grid: TBP>>=
procedure :: has_non_zero_entries => grid_has_non_zero_entries
<<Grids: sub interfaces>>=
pure module function grid_has_non_zero_entries (grid) result (non_zero)
logical :: non_zero
class(grid_t), intent(in) :: grid
end function grid_has_non_zero_entries
<<Grids: procedures>>=
pure module function grid_has_non_zero_entries (grid) result (non_zero)
logical :: non_zero
class(grid_t), intent(in) :: grid
non_zero = any (abs (grid%values) > zero)
end function grid_has_non_zero_entries
@ %def grid_has_non_zero_entries
@ MPI: We allow for several grids in a parallelized run to be combined with [[MPI_reduce]].
The operator has to be specified. We do not check on any specifications.
<<MPI: Grids: grid: TBP>>=
procedure :: mpi_reduce => grid_mpi_reduce
<<MPI: Grids: sub interfaces>>=
module subroutine grid_mpi_reduce (grid, operator)
class(grid_t), intent(inout) :: grid
type(MPI_op), intent(in) :: operator
end subroutine grid_mpi_reduce
<<MPI: Grids: procedures>>=
module subroutine grid_mpi_reduce (grid, operator)
class(grid_t), intent(inout) :: grid
type(MPI_op), intent(in) :: operator
real(default), dimension(size (grid%values)) :: root_values
integer :: rank
call MPI_Comm_rank (MPI_COMM_WORLD, rank)
call MPI_Reduce (grid%values, root_values, size (grid%values),&
& MPI_DOUBLE_PRECISION, operator, 0, MPI_COMM_WORLD)
if (rank == 0) then
grid%values = root_values
end if
end subroutine grid_mpi_reduce
@ %def grid_mpi_reduce
\subsection{Input and Output to screen and disk}
<<Grids: grid: TBP>>=
procedure :: write => grid_write
<<Grids: sub interfaces>>=
module subroutine grid_write (grid, unit)
class(grid_t), intent(in) :: grid
integer, intent(in), optional :: unit
end subroutine grid_write
<<Grids: procedures>>=
module subroutine grid_write (grid, unit)
class(grid_t), intent(in) :: grid
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(1X,A)") "Grid"
write (u, "(2X,A,2X)", advance='no') "Number of points per dimension:"
if (allocated (grid%points)) then
do i = 1, size (grid%points)
write (u, "(I12,1X)", advance='no') &
grid%points (i)
end do
end if
write (u, *)
write (u, "(2X,A)") "Values of the grid:"
if (allocated (grid%values)) then
do i = 1, size (grid%values)
write (u, "(" // DEFAULT_OUTPUT_PRECISION // ",1X)") &
grid%values (i)
end do
end if
call grid%compute_and_write_mean_and_max (u)
end subroutine grid_write
@ %def grid_write
@
<<Grids: grid: TBP>>=
procedure :: compute_and_write_mean_and_max => &
grid_compute_and_write_mean_and_max
<<Grids: sub interfaces>>=
module subroutine grid_compute_and_write_mean_and_max (grid, unit)
class(grid_t), intent(in) :: grid
integer, intent(in), optional :: unit
end subroutine grid_compute_and_write_mean_and_max
<<Grids: procedures>>=
module subroutine grid_compute_and_write_mean_and_max (grid, unit)
class(grid_t), intent(in) :: grid
integer, intent(in), optional :: unit
integer :: u, i, n_values
real(default) :: mean, val, maximum
u = given_output_unit (unit); if (u < 0) return
mean = zero
maximum = zero
if (allocated (grid%values)) then
n_values = size (grid%values)
do i = 1, n_values
val = grid%values (i)
mean = mean + val / n_values
if (val > maximum) then
maximum = val
end if
end do
- write (msg_buffer, "(A," // DEFAULT_OUTPUT_PRECISION // ")") &
+ write (msg_buffer, "(A," // FMT_12 // ")") &
"Grid: Mean value of the grid: ", mean
call msg_message ()
- write (msg_buffer, "(A," // DEFAULT_OUTPUT_PRECISION // ")") &
+ write (msg_buffer, "(A," // FMT_12 // ")") &
"Grid: Max value of the grid: ", maximum
call msg_message ()
if (maximum > zero) then
- write (msg_buffer, "(A," // DEFAULT_OUTPUT_PRECISION // ")") &
+ write (msg_buffer, "(A," // FMT_12 // ")") &
"Grid: Mean/Max value of the grid: ", mean / maximum
call msg_message ()
end if
else
call msg_warning ("Grid: Grid is not allocated!")
end if
end subroutine grid_compute_and_write_mean_and_max
@ %def grid_compute_and_write_mean_and_max
@
<<Grids: grid: TBP>>=
procedure :: save_to_file => grid_save_to_file
<<Grids: sub interfaces>>=
module subroutine grid_save_to_file (grid, file)
class(grid_t), intent(in) :: grid
character(len=*), intent(in) :: file
end subroutine grid_save_to_file
<<Grids: procedures>>=
module subroutine grid_save_to_file (grid, file)
class(grid_t), intent(in) :: grid
character(len=*), intent(in) :: file
integer :: iostat, u, i
u = free_unit ()
open (file=file, unit=u, action='write')
if (allocated (grid%points)) then
write (u, "(I12)") size (grid%points)
do i = 1, size (grid%points)
write (u, "(I12,1X)", advance='no', iostat=iostat) &
grid%points (i)
end do
end if
write (u, *)
if (allocated (grid%values)) then
do i = 1, size (grid%values)
write (u, "(" // DEFAULT_OUTPUT_PRECISION // ",1X)", &
advance='no', iostat=iostat) grid%values (i)
end do
end if
if (iostat /= 0) then
call msg_warning &
('grid_save_to_file: Could not save grid to file')
end if
close (u)
end subroutine grid_save_to_file
@ %def grid_save_to_file
@
<<Grids: parameters>>=
character(len=*), parameter :: DEFAULT_OUTPUT_PRECISION = FMT_16
@ %def DEFAULT_OUTPUT_PRECISION
@
<<Grids: public>>=
public :: verify_points_for_grid
<<Grids: sub interfaces>>=
module function verify_points_for_grid (file, points) result (valid)
logical :: valid
character(len=*), intent(in) :: file
integer, dimension(:), intent(in) :: points
end function verify_points_for_grid
<<Grids: procedures>>=
module function verify_points_for_grid (file, points) result (valid)
logical :: valid
character(len=*), intent(in) :: file
integer, dimension(:), intent(in) :: points
integer, dimension(:), allocatable :: points_from_file
integer :: u
call load_points_from_file (file, u, points_from_file)
close (u)
if (allocated (points_from_file)) then
valid = all (points == points_from_file)
else
valid = .false.
end if
end function verify_points_for_grid
@ %def verify_points_for_grid
@ Returns the [[unit]] that has opened the input [[file]] and read the
first two lines. The caller has to close it. Furthermore, we return
[[points]] containing the number of points in each dimension.
<<Grids: procedures>>=
subroutine load_points_from_file (file, unit, points)
character(len=*), intent(in) :: file
integer, intent(out) :: unit
integer, dimension(:), allocatable :: points
integer :: iostat, n_dimensions, i_dim
unit = free_unit ()
open (file=file, unit=unit, action='read', iostat=iostat)
if (iostat /= 0) return
read (unit, "(I12)", iostat=iostat) n_dimensions
if (iostat /= 0) return
allocate (points (n_dimensions))
do i_dim = 1, size (points)
read (unit, "(I12,1X)", advance='no', iostat=iostat) &
points (i_dim)
end do
if (iostat /= 0) return
read (unit, *)
if (iostat /= 0) return
end subroutine load_points_from_file
@ %def procedure
@
<<Grids: grid: TBP>>=
procedure :: load_from_file => grid_load_from_file
<<Grids: sub interfaces>>=
module subroutine grid_load_from_file (grid, file)
class(grid_t), intent(out) :: grid
character(len=*), intent(in) :: file
end subroutine grid_load_from_file
<<Grids: procedures>>=
module subroutine grid_load_from_file (grid, file)
class(grid_t), intent(out) :: grid
character(len=*), intent(in) :: file
integer :: iostat, u, i
integer, dimension(:), allocatable :: points
call load_points_from_file (file, u, points)
if (.not. allocated (points)) return
call grid%init (points)
do i = 1, size (grid%values)
read (u, "(" // DEFAULT_OUTPUT_PRECISION // ",1X)", advance='no', iostat=iostat) &
grid%values (i)
end do
if (iostat /= 0) then
call msg_warning ('grid_load_from_file: Could not load grid from file')
end if
close (u)
end subroutine grid_load_from_file
@ %def grid_load_from_file
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[grids_ut.f90]]>>=
<<File header>>
module grids_ut
use unit_tests
use grids_uti
<<Standard module head>>
<<Grids: public test>>
contains
<<Grids: test driver>>
end module grids_ut
@ %def grids_ut
@
<<[[grids_uti.f90]]>>=
<<File header>>
module grids_uti
<<Use kinds>>
use constants, only: zero, one, two, three, four, tiny_07
use file_utils, only: delete_file
use numeric_utils
use grids
<<Standard module head>>
<<Grids: test declarations>>
contains
<<Grids: tests>>
end module grids_uti
@ %def grids_ut
@ API: driver for the unit tests below.
<<Grids: public test>>=
public :: grids_test
<<Grids: test driver>>=
subroutine grids_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Grids: execute tests>>
end subroutine grids_test
@ %def grids_test
@
\subsubsection{Test Index Function}
<<Grids: execute tests>>=
call test(grids_1, "grids_1", &
"Test Index Function", u, results)
<<Grids: test declarations>>=
public :: grids_1
<<Grids: tests>>=
subroutine grids_1 (u)
integer, intent(in) :: u
type(grid_t) :: grid
write (u, "(A)") "* Test output: grids_1"
write (u, "(A)") "* Purpose: Test Index Function"
write (u, "(A)")
call grid%init ([3])
call grid%write(u)
call assert (u, grid%get_index([1]) == 1, "grid%get_index(1) == 1")
call assert (u, grid%get_index([2]) == 2, "grid%get_index(2) == 2")
call assert (u, grid%get_index([3]) == 3, "grid%get_index(3) == 3")
call grid%final ()
call grid%init ([3,3])
call grid%write(u)
call assert (u, grid%get_index([1,1]) == 1, "grid%get_index(1,1) == 1")
call assert (u, grid%get_index([2,1]) == 2, "grid%get_index(2,1) == 2")
call assert (u, grid%get_index([3,1]) == 3, "grid%get_index(3,1) == 3")
call assert (u, grid%get_index([1,2]) == 4, "grid%get_index(1,2) == 4")
call assert (u, grid%get_index([2,2]) == 5, "grid%get_index(2,2) == 5")
call assert (u, grid%get_index([3,2]) == 6, "grid%get_index(3,2) == 6")
call assert (u, grid%get_index([1,3]) == 7, "grid%get_index(1,3) == 7")
call assert (u, grid%get_index([2,3]) == 8, "grid%get_index(2,3) == 8")
call assert (u, grid%get_index([3,3]) == 9, "grid%get_index(3,3) == 9")
call grid%final ()
call grid%init ([3,3,2])
call grid%write(u)
call assert (u, grid%get_index([1,1,1]) == 1, "grid%get_index(1,1,1) == 1")
call assert (u, grid%get_index([2,1,2]) == 2+9, "grid%get_index(2,1,2) == 2+9")
call assert (u, grid%get_index([3,3,1]) == 9, "grid%get_index(3,3,1) == 3")
call assert (u, grid%get_index([3,1,2]) == 3+9, "grid%get_index(3,1,2) == 4+9")
call assert (u, grid%get_index([2,2,1]) == 5, "grid%get_index(2,2,1) == 5")
call assert (u, grid%get_index([3,2,2]) == 6+9, "grid%get_index(3,2,2) == 6+9")
call assert (u, grid%get_index([1,3,1]) == 7, "grid%get_index(1,3,1) == 7")
call assert (u, grid%get_index([2,3,2]) == 8+9, "grid%get_index(2,3,2) == 8+9")
call assert (u, grid%get_index([3,3,2]) == 9+9, "grid%get_index(3,3,2) == 9+9")
call grid%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: grids_1"
end subroutine grids_1
@ %def grids_1
@
\subsubsection{Saving and Loading}
<<Grids: execute tests>>=
call test(grids_2, "grids_2", &
"Saving and Loading", u, results)
<<Grids: test declarations>>=
public :: grids_2
<<Grids: tests>>=
subroutine grids_2 (u)
integer, intent(in) :: u
type(grid_t) :: grid
write (u, "(A)") "* Test output: grids_2"
write (u, "(A)") "* Purpose: Saving and Loading"
write (u, "(A)")
call grid%init ([3])
call grid%set_values ([one, two, three])
call grid%save_to_file ('grids_2_test')
call grid%final ()
call assert (u, verify_points_for_grid('grids_2_test', [3]), &
"verify_points_for_grid")
call grid%load_from_file ('grids_2_test')
call grid%write (u)
call assert (u, nearly_equal (grid%get_value([1]), one), "grid%get_value(1) == 1")
call assert (u, nearly_equal (grid%get_value([2]), two), "grid%get_value(2) == 2")
call assert (u, nearly_equal (grid%get_value([3]), three), "grid%get_value(3) == 3")
call grid%final ()
call grid%init ([3,3])
call grid%set_values ([one, two, three, four, zero, zero, zero, zero, zero])
call grid%save_to_file ('grids_2_test')
call grid%final ()
call assert (u, verify_points_for_grid('grids_2_test', [3,3]), &
"verify_points_for_grid")
call grid%load_from_file ('grids_2_test')
call grid%write (u)
call assert (u, nearly_equal (grid%get_value([1,1]), one), "grid%get_value(1,1) == 1")
call assert (u, nearly_equal (grid%get_value([2,1]), two), "grid%get_value(2,1) == 2")
call assert (u, nearly_equal (grid%get_value([3,1]), three), "grid%get_value(3,1) == 3")
call assert (u, nearly_equal (grid%get_value([1,2]), four), "grid%get_value(1,2) == 4")
call delete_file ('grids_2_test')
call grid%load_from_file ('grids_2_test')
call assert (u, .not. verify_points_for_grid('grids_2_test', [3,3]), &
"verify_points_for_grid")
call grid%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: grids_2"
end subroutine grids_2
@ %def grids_2
@
\subsubsection{Get Segments}
<<Grids: execute tests>>=
call test(grids_3, "grids_3", &
"Get Segments", u, results)
<<Grids: test declarations>>=
public :: grids_3
<<Grids: tests>>=
subroutine grids_3 (u)
integer, intent(in) :: u
type(grid_t) :: grid
integer, dimension(2) :: fail
write (u, "(A)") "* Test output: grids_3"
write (u, "(A)") "* Purpose: Get Segments"
write (u, "(A)")
call grid%init ([3])
call assert (u, all(grid%get_segment([0.00_default]) == [1]), &
"all(grid%get_segment([0.00_default]) == [1])")
call assert (u, all(grid%get_segment([0.32_default]) == [1]), &
"all(grid%get_segment([0.32_default]) == [1])")
call assert (u, all(grid%get_segment([0.52_default]) == [2]), &
"all(grid%get_segment([0.52_default]) == [2])")
call assert (u, all(grid%get_segment([1.00_default]) == [3]), &
"all(grid%get_segment([1.00_default]) == [3])")
call grid%final ()
call grid%init ([3,3])
call assert (u, all(grid%get_segment([0.00_default,0.00_default]) == [1,1]), &
"all(grid%get_segment([0.00_default,0.00_default]) == [1,1])")
call assert (u, all(grid%get_segment([0.32_default,0.32_default]) == [1,1]), &
"all(grid%get_segment([0.32_default,0.32_default]) == [1,1])")
call assert (u, all(grid%get_segment([0.52_default,0.52_default]) == [2,2]), &
"all(grid%get_segment([0.52_default,0.52_default]) == [2,2])")
call assert (u, all(grid%get_segment([1.00_default,1.00_default]) == [3,3]), &
"all(grid%get_segment([1.00_default,1.00_default]) == [3,3])")
write (u, "(A)") "* A double error is expected"
fail = grid%get_segment([1.10_default,1.10_default], u)
call grid%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: grids_3"
end subroutine grids_3
@ %def grids_3
@
\subsubsection{Update Maxima}
<<Grids: execute tests>>=
call test(grids_4, "grids_4", &
"Update Maxima", u, results)
<<Grids: test declarations>>=
public :: grids_4
<<Grids: tests>>=
subroutine grids_4 (u)
integer, intent(in) :: u
type(grid_t) :: grid
write (u, "(A)") "* Test output: grids_4"
write (u, "(A)") "* Purpose: Update Maxima"
write (u, "(A)")
call grid%init ([4,4])
call grid%update_maxima ([0.1_default, 0.0_default], 0.3_default)
call grid%update_maxima ([0.9_default, 0.95_default], 1.7_default)
call grid%write (u)
call assert_equal (u, grid%get_value([1,1]), 0.3_default, &
"grid%get_value([1,1]")
call assert_equal (u, grid%get_value([2,2]), 0.0_default, &
"grid%get_value([2,2]")
call assert_equal (u, grid%get_value([4,4]), 1.7_default, &
"grid%get_value([4,4]")
write (u, "(A)")
write (u, "(A)") "* Test output end: grids_4"
end subroutine grids_4
@ %def grids_4
@
\subsubsection{Finding and checking}
<<Grids: execute tests>>=
call test(grids_5, "grids_5", &
"Finding and checking", u, results)
<<Grids: test declarations>>=
public :: grids_5
<<Grids: tests>>=
subroutine grids_5 (u)
integer, intent(in) :: u
type(grid_t) :: grid
real(default) :: first, second
write (u, "(A)") "* Test output: grids_5"
write (u, "(A)") "* Purpose: Finding and checking"
write (u, "(A)")
call grid%init ([2,2,2])
first = one / two - tiny_07
second = two / two - tiny_07
call grid%update_maxima ([0.1_default, 0.0_default, first], 0.3_default)
call grid%update_maxima ([0.9_default, 0.95_default, second], 1.7_default)
call grid%write (u)
call assert (u, .not. grid%is_non_zero_everywhere (), &
".not. grid%is_non_zero_everywhere (")
call assert_equal (u, grid%get_maximum_in_3d (1), 0.3_default, &
"grid%get_maximum_in_3d (1)")
call assert_equal (u, grid%get_maximum_in_3d (2), 1.7_default, &
"grid%get_maximum_in_3d (2)")
call grid%update_maxima ([0.9_default, 0.95_default, first], 1.8_default)
call grid%update_maxima ([0.1_default, 0.95_default, first], 1.5_default)
call grid%update_maxima ([0.9_default, 0.15_default, first], 1.5_default)
call grid%update_maxima ([0.1_default, 0.0_default, second], 0.2_default)
call grid%update_maxima ([0.1_default, 0.9_default, second], 0.2_default)
call grid%update_maxima ([0.9_default, 0.0_default, second], 0.2_default)
call grid%write (u)
call assert (u, grid%is_non_zero_everywhere (), &
"grid%is_non_zero_everywhere (")
call assert_equal (u, grid%get_maximum_in_3d (1), 1.8_default, &
"grid%get_maximum_in_3d (1)")
call assert_equal (u, grid%get_maximum_in_3d (2), 1.7_default, &
"grid%get_maximum_in_3d (2)")
write (u, "(A)")
write (u, "(A)") "* Test output end: grids_5"
end subroutine grids_5
@ %def grids_5
@ One could think of multiple implementations of a generic type.
<<[[solver.f90]]>>=
<<File header>>
module solver
<<Use kinds>>
use constants, only: tiny_10
<<Standard module head>>
<<Solver: public>>
<<Solver: parameters>>
<<Solver: types>>
<<Solver: interfaces>>
interface
<<Solver: sub interfaces>>
end interface
end module solver
@ %def solver
@
<<[[solver_sub.f90]]>>=
<<File header>>
submodule (solver) solver_s
use numeric_utils
use diagnostics
implicit none
contains
<<Solver: procedures>>
end submodule solver_s
@ %def solver_s
@
<<Solver: public>>=
public :: solver_function_t
<<Solver: types>>=
type, abstract :: solver_function_t
contains
procedure(solver_function_evaluate), deferred :: evaluate
end type solver_function_t
@ %def solver_function_t
@
<<Solver: interfaces>>=
abstract interface
function solver_function_evaluate (solver_f, x) result (f)
import
complex(default) :: f
class(solver_function_t), intent(in) :: solver_f
real(default), intent(in) :: x
end function
end interface
@ %def solver_function_evaluate
@
<<Solver: public>>=
public :: solve_secant
<<Solver: sub interfaces>>=
module function solve_secant &
(func, lower_start, upper_start, success, precision) result (x0)
class(solver_function_t), intent(in) :: func
real(default) :: x0
real(default), intent(in) :: lower_start, upper_start
real(default), intent(in), optional :: precision
logical, intent(out) :: success
end function solve_secant
<<Solver: procedures>>=
module function solve_secant &
(func, lower_start, upper_start, success, precision) result (x0)
class(solver_function_t), intent(in) :: func
real(default) :: x0
real(default), intent(in) :: lower_start, upper_start
real(default), intent(in), optional :: precision
logical, intent(out) :: success
real(default) :: desired, x_curr, x_next, f_curr, f_next, x_new
integer :: n_iter
desired = DEFAULT_PRECISION; if (present(precision)) desired = precision
x_curr = lower_start
x_next = upper_start
n_iter = 0
success = .false.
SEARCH: do
n_iter = n_iter + 1
f_curr = real( func%evaluate (x_curr) )
f_next = real( func%evaluate (x_next) )
<<Exit if close to zero and handle exceptions>>
x_new = x_next - (x_next - x_curr) / (f_next - f_curr) * f_next
x_curr = x_next
x_next = x_new
end do SEARCH
if (x0 < lower_start .or. x0 > upper_start) then
call msg_warning ("solve: The root of the function is not in boundaries")
return
end if
success = .true.
end function solve_secant
@ %def solve_secant
<<Exit if close to zero and handle exceptions>>=
if (abs (f_next) < desired) then
x0 = x_next
exit
end if
if (n_iter > MAX_TRIES) then
call msg_warning ("solve: Couldn't find root of function")
return
end if
if (vanishes (f_next - f_curr)) then
x_next = x_next + (x_next - x_curr) / 10
cycle
end if
@
@ Implements the bisection root-finding method to find a root of [[func]]
between [[lower_start]] and [[upper_start]] with tolerance [[precision]].
<<Solver: public>>=
public :: solve_interval
<<Solver: sub interfaces>>=
module function solve_interval &
(func, lower_start, upper_start, success, precision) result (x0)
class(solver_function_t), intent(in) :: func
real(default) :: x0
real(default), intent(in) :: lower_start, upper_start
real(default), intent(in), optional :: precision
logical, intent(out) :: success
end function solve_interval
<<Solver: procedures>>=
module function solve_interval &
(func, lower_start, upper_start, success, precision) result (x0)
class(solver_function_t), intent(in) :: func
real(default) :: x0
real(default), intent(in) :: lower_start, upper_start
real(default), intent(in), optional :: precision
logical, intent(out) :: success
real(default) :: desired
real(default) :: x_low, x_high, x_half
real(default) :: f_low, f_high, f_half
integer :: n_iter
success = .false.
desired = DEFAULT_PRECISION; if (present(precision)) desired = precision
x0 = lower_start
x_low = lower_start
x_high = upper_start
f_low = real( func%evaluate (x_low) )
f_high = real( func%evaluate (x_high) )
if (f_low * f_high > 0) return
if (x_low > x_high) then
call display_solver_status()
call msg_fatal ("Interval solver: Upper bound must be &
&greater than lower bound")
end if
n_iter = 0
do n_iter = 1, MAX_TRIES
x_half = (x_high + x_low)/2
f_half = real( func%evaluate (x_half) )
if (abs (f_half) <= desired) then
x0 = x_half
exit
end if
if (f_low * f_half > 0._default) then
x_low = x_half
f_low = f_half
else
x_high = x_half
f_high = f_half
end if
end do
if (x0 < lower_start .or. x0 > upper_start) then
call msg_warning ("Interval solver: The root of the function&
& is out of boundaries")
return
end if
success = .true.
contains
subroutine display_solver_status ()
print *, '================='
print *, 'Status of interval solver: '
print *, 'initial values: ', lower_start, upper_start
print *, 'iteration: ', n_iter
print *, 'x_low: ', x_low, 'f_low: ', f_low
print *, 'x_high: ', x_high, 'f_high: ', f_high
print *, 'x_half: ', x_half, 'f_half: ', f_half
end subroutine display_solver_status
end function solve_interval
@ %def solve_interval
@
<<Solver: public>>=
public :: solve_qgaus
<<Solver: sub interfaces>>=
module function solve_qgaus (integrand, grid) result (integral)
class(solver_function_t), intent(in) :: integrand
complex(default) :: integral
real(default), dimension(:), intent(in) :: grid
end function solve_qgaus
<<Solver: procedures>>=
module function solve_qgaus (integrand, grid) result (integral)
class(solver_function_t), intent(in) :: integrand
complex(default) :: integral
real(default), dimension(:), intent(in) :: grid
integer :: i, j
real(default) :: xm, xr
real(default), dimension(5) :: dx, &
w = (/ 0.2955242247_default, 0.2692667193_default, &
0.2190863625_default, 0.1494513491_default, 0.0666713443_default /), &
x = (/ 0.1488743389_default, 0.4333953941_default, 0.6794095682_default, &
0.8650633666_default, 0.9739065285_default /)
integral = 0.0_default
if ( size(grid) < 2 ) then
call msg_warning ("solve_qgaus: size of integration grid smaller than 2.")
return
end if
do i=1, size(grid)-1
xm = 0.5_default * ( grid(i+1) + grid(i) )
xr = 0.5_default * ( grid(i+1) - grid(i) )
do j=1, 5
dx(j) = xr * x(j)
integral = integral + xr * w(j) * &
( integrand%evaluate (xm+dx(j)) + integrand%evaluate (xm-dx(j)) )
end do
end do
end function solve_qgaus
@ %def solve_qgaus
@
<<Solver: parameters>>=
real(default), parameter, public :: DEFAULT_PRECISION = tiny_10
@ %def name
@
<<Solver: parameters>>=
integer, parameter :: MAX_TRIES = 10000
@ %def MAX_TRIES
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[solver_ut.f90]]>>=
<<File header>>
module solver_ut
use unit_tests
use solver_uti
<<Standard module head>>
<<Solver: public test>>
contains
<<Solver: test driver>>
end module solver_ut
@ %def solver_ut
@
<<[[solver_uti.f90]]>>=
<<File header>>
module solver_uti
<<Use kinds>>
use constants, only: zero, one, two
use numeric_utils
use solver
<<Standard module head>>
<<Solver: test declarations>>
<<Solver: test types>>
contains
<<Solver: tests>>
<<Solver: test auxiliary>>
end module solver_uti
@ %def solver_ut
@ API: driver for the unit tests below.
<<Solver: public test>>=
public :: solver_test
<<Solver: test driver>>=
subroutine solver_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Solver: execute tests>>
end subroutine solver_test
@ %def solver_test
@
\subsubsection{Test functions}
<<Solver: test types>>=
type, extends (solver_function_t) :: test_function_1_t
contains
procedure :: evaluate => test_func_1
end type test_function_1_t
@ %def test_function_1_t
@
<<Solver: test types>>=
type, extends (solver_function_t) :: test_function_2_t
contains
procedure :: evaluate => test_func_2
end type test_function_2_t
@ %def test_function_2_t
@
<<Solver: test types>>=
type, extends (solver_function_t) :: test_function_3_t
contains
procedure :: evaluate => test_func_3
end type test_function_3_t
@ %def test_function_3_t
@
<<Solver: test types>>=
type, extends (solver_function_t) :: test_function_4_t
contains
procedure :: evaluate => test_func_4
end type test_function_4_t
@ %def test_function_4_t
@
<<Solver: test auxiliary>>=
function test_func_1 (solver_f, x) result (f)
complex(default) :: f
class(test_function_1_t), intent(in) :: solver_f
real(default), intent(in) :: x
f = x
end function test_func_1
function test_func_2 (solver_f, x) result (f)
complex(default) :: f
class(test_function_2_t), intent(in) :: solver_f
real(default), intent(in) :: x
f = x ** 2
end function test_func_2
function test_func_3 (solver_f, x) result (f)
complex(default) :: f
class(test_function_3_t), intent(in) :: solver_f
real(default), intent(in) :: x
f = x ** 3
end function test_func_3
function test_func_4 (solver_f, x) result (f)
complex(default) :: f
class(test_function_4_t), intent(in) :: solver_f
real(default), intent(in) :: x
real(default) :: s, cutoff
s = 100.0_default
cutoff = 1.01_default
if (x < cutoff) then
f = - (log (s) * log (log (s) / log(cutoff**2)) - log (s / cutoff**2)) - &
log (one/two)
else
f = - (log (s) * log (log (s) / log(x**2)) - log (s / x**2)) - &
log (one/two)
end if
end function test_func_4
@ %def test_func_1
@
\subsubsection{Solve trivial functions}
<<Solver: execute tests>>=
call test(solver_1, "solver_1", &
"Solve trivial functions", u, results)
<<Solver: test declarations>>=
public :: solver_1
<<Solver: tests>>=
subroutine solver_1 (u)
integer, intent(in) :: u
real(default) :: zero_position
logical :: success
type(test_function_1_t) :: test_func_1
type(test_function_2_t) :: test_func_2
type(test_function_3_t) :: test_func_3
type(test_function_4_t) :: test_func_4
write (u, "(A)") "* Test output: solver_1"
write (u, "(A)") "* Purpose: Solve trivial functions"
write (u, "(A)")
zero_position = solve_interval (test_func_1, -one, one, success)
call assert (u, success, "success")
call assert_equal (u, zero_position, zero, "test_func_1: zero_position")
zero_position = solve_interval (test_func_4, two, 10.0_default, success)
call assert (u, success, "success")
call assert_equal (u, zero_position, &
3.5216674011865940283397224_default, &
"test_func_4: zero_position", rel_smallness=1000*DEFAULT_PRECISION)
write (u, "(A)")
write (u, "(A)") "* Test output end: solver_1"
end subroutine solver_1
@ %def solver_1
@
Index: trunk/src/physics/physics.nw
===================================================================
--- trunk/src/physics/physics.nw (revision 8819)
+++ trunk/src/physics/physics.nw (revision 8820)
@@ -1,8420 +1,8511 @@
% -*- 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]]>>=
<<File header>>
module physics_defs
<<Use kinds>>
<<Use strings>>
use constants, only: one, two, three
<<Standard module head>>
<<Physics defs: public parameters>>
<<Physics defs: public>>
<<Physics defs: interfaces>>
interface
<<Physics defs: sub interfaces>>
end interface
end module physics_defs
@ %def physics_defs
@
<<[[physics_defs_sub.f90]]>>=
<<File header>>
submodule (physics_defs) physics_defs_s
implicit none
contains
<<Physics defs: procedures>>
end submodule physics_defs_s
@ %def physics_defs_s
@
\subsection{Units}
Conversion from energy units to cross-section units.
<<Physics defs: public parameters>>=
real(default), parameter, public :: &
conv = 0.38937966e12_default
@
Conversion from millimeter to nanoseconds for lifetimes.
<<Physics defs: public parameters>>=
real(default), parameter, public :: &
ns_per_mm = 1.e6_default / 299792458._default
@
Rescaling factor.
<<Physics defs: public parameters>>=
real(default), parameter, public :: &
pb_per_fb = 1.e-3_default
@
String for the default energy and cross-section units.
<<Physics defs: public parameters>>=
character(*), parameter, public :: &
energy_unit = "GeV"
character(*), parameter, public :: &
cross_section_unit = "fb"
@
\subsection{SM and QCD constants}
<<Physics defs: public parameters>>=
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.
<<Physics defs: public parameters>>=
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:
<<Physics defs: public parameters>>=
integer, parameter, public :: UNDEFINED = 0
@ %def UNDEFINED
@ SM fermions:
<<Physics defs: public parameters>>=
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:
<<Physics defs: public parameters>>=
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:
<<Physics defs: public parameters>>=
integer, parameter, public :: PION = 111
integer, parameter, public :: PIPLUS = 211
integer, parameter, public :: PIMINUS = - PIPLUS
@ %def PION PIPLUS PIMINUS
@ Di-Quarks:
<<Physics defs: public parameters>>=
integer, parameter, public :: UD0 = 2101
integer, parameter, public :: UD1 = 2103
integer, parameter, public :: UU1 = 2203
@ %def UD0 UD1 UU1
@ Mesons:
<<Physics defs: public parameters>>=
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:
<<Physics defs: public parameters>>=
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:
<<Physics defs: public parameters>>=
integer, parameter, public :: SIGMAPLUS = 3222
integer, parameter, public :: SIGMA0 = 3212
integer, parameter, public :: SIGMAMINUS = 3112
@ %def SIGMAPLUS SIGMA0 SIGMAMINUS
@ Charmed baryons:
<<Physics defs: public parameters>>=
integer, parameter, public :: SIGMACPLUSPLUS = 4222
integer, parameter, public :: SIGMACPLUS = 4212
integer, parameter, public :: SIGMAC0 = 4112
@ %def SIGMACPLUSPLUS SIGMACPLUS SIGMAC0
@ Bottom baryons:
<<Physics defs: public parameters>>=
integer, parameter, public :: SIGMAB0 = 5212
integer, parameter, public :: SIGMABPLUS = 5222
@ %def SIGMAB0 SIGMABPLUS
@ 81-100 are reserved for internal codes. Hadron and beam remnants:
<<Physics defs: public parameters>>=
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:
<<Physics defs: public parameters>>=
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.
<<Physics defs: public parameters>>=
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.
<<Physics defs: public parameters>>=
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.
<<Physics defs: public parameters>>=
integer, parameter, public :: n_beams_rescaled = 2
@ %def n_beams_rescaled
@
Orders of the electron PDFs.
<<Physics defs: public parameters>>=
integer, parameter, public :: EPDF_LL = 0
integer, parameter, public :: EPDF_NLL = 1
@ %def EPDF_LL EPDF_NLL
@
<<Physics defs: public>>=
public :: component_status
<<Physics defs: interfaces>>=
interface component_status
module procedure component_status_of_string
module procedure component_status_to_string
end interface
<<Physics defs: sub interfaces>>=
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
<<Physics defs: procedures>>=
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
@
<<Physics defs: public>>=
public :: is_nlo_component
<<Physics defs: sub interfaces>>=
elemental module function is_nlo_component (comp) result (is_nlo)
logical :: is_nlo
integer, intent(in) :: comp
end function is_nlo_component
<<Physics defs: procedures>>=
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
@
<<Physics defs: public>>=
public :: is_subtraction_component
<<Physics defs: sub interfaces>>=
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
<<Physics defs: procedures>>=
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
<<Physics defs: public parameters>>=
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
@
@
<<Physics defs: public>>=
public :: thr_leg
<<Physics defs: sub interfaces>>=
module function thr_leg (emitter) result (leg)
integer :: leg
integer, intent(in) :: emitter
end function thr_leg
<<Physics defs: procedures>>=
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]]>>=
<<File header>>
module c_particles
use, intrinsic :: iso_c_binding !NODEP!
<<Standard module head>>
<<C Particles: public>>
<<C Particles: types>>
interface
<<C Particles: sub interfaces>>
end interface
end module c_particles
@ %def c_particles
@
<<[[c_particles_sub.f90]]>>=
<<File header>>
submodule (c_particles) c_particles_s
use io_units
use format_defs, only: FMT_14, FMT_19
implicit none
contains
<<C Particles: procedures>>
end submodule c_particles_s
@ %def c_particles_s
@
<<C Particles: public>>=
public :: c_prt_t
<<C Particles: types>>=
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]].
<<C Particles: public>>=
public :: c_prt_write
<<C Particles: sub interfaces>>=
module subroutine c_prt_write (prt, unit)
type(c_prt_t), intent(in) :: prt
integer, intent(in), optional :: unit
end subroutine c_prt_write
<<C Particles: procedures>>=
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]]>>=
<<File header>>
module lorentz
<<Use kinds with double>>
use constants, only: zero, one
use c_particles
<<Standard module head>>
<<Lorentz: public>>
<<Lorentz: public operators>>
<<Lorentz: public functions>>
<<Lorentz: types>>
<<Lorentz: parameters>>
<<Lorentz: interfaces>>
interface
<<Lorentz: sub interfaces>>
end interface
end module lorentz
@ %def lorentz
@
<<[[lorentz_sub.f90]]>>=
<<File header>>
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
<<Lorentz: procedures>>
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.
<<Lorentz: public>>=
public :: vector3_t
<<Lorentz: types>>=
type :: vector3_t
real(default), dimension(3) :: p
end type vector3_t
@ %def vector3_t
@ Output a vector
<<Lorentz: public>>=
public :: vector3_write
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: public>>=
public :: vector3_null
<<Lorentz: parameters>>=
type(vector3_t), parameter :: vector3_null = &
vector3_t ([ zero, zero, zero ])
@ %def vector3_null
@ Canonical three-vector:
<<Lorentz: public>>=
public :: vector3_canonical
<<Lorentz: sub interfaces>>=
elemental module function vector3_canonical (k) result (p)
type(vector3_t) :: p
integer, intent(in) :: k
end function vector3_canonical
<<Lorentz: procedures>>=
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.
<<Lorentz: public>>=
public :: vector3_moving
<<Lorentz: interfaces>>=
interface vector3_moving
module procedure vector3_moving_canonical
module procedure vector3_moving_generic
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: public operators>>=
public :: operator(==), operator(/=)
<<Lorentz: interfaces>>=
interface operator(==)
module procedure vector3_eq
end interface
interface operator(/=)
module procedure vector3_neq
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: public operators>>=
public :: operator(+), operator(-)
<<Lorentz: interfaces>>=
interface operator(+)
module procedure add_vector3
end interface
interface operator(-)
module procedure sub_vector3
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: public operators>>=
public :: operator(*), operator(/)
<<Lorentz: interfaces>>=
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
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: interfaces>>=
interface operator(*)
module procedure prod_vector3
end interface
<<Lorentz: sub interfaces>>=
elemental module function prod_vector3 (p, q) result (s)
real(default) :: s
type(vector3_t), intent(in) :: p,q
end function prod_vector3
<<Lorentz: procedures>>=
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 *
<<Lorentz: public functions>>=
public :: cross_product
<<Lorentz: interfaces>>=
interface cross_product
module procedure vector3_cross_product
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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]].
<<Lorentz: public operators>>=
public :: operator(**)
<<Lorentz: interfaces>>=
interface operator(**)
module procedure power_vector3
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: interfaces>>=
interface operator(-)
module procedure negate_vector3
end interface
<<Lorentz: sub interfaces>>=
elemental module function negate_vector3 (p) result (q)
type(vector3_t) :: q
type(vector3_t), intent(in) :: p
end function negate_vector3
<<Lorentz: procedures>>=
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:
<<Lorentz: public functions>>=
public :: sum
<<Lorentz: interfaces>>=
interface sum
module procedure sum_vector3
end interface
@ %def sum
@
<<Lorentz: public>>=
public :: vector3_set_component
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: sub interfaces>>=
pure module function sum_vector3 (p) result (q)
type(vector3_t) :: q
type(vector3_t), dimension(:), intent(in) :: p
end function sum_vector3
<<Lorentz: procedures>>=
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:
<<Lorentz: public>>=
public :: vector3_get_component
@ %def component
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public>>=
public :: vector3_get_components
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: direction
<<Lorentz: interfaces>>=
interface direction
module procedure vector3_get_direction
end interface
<<Lorentz: sub interfaces>>=
elemental module function vector3_get_direction (p) result (q)
type(vector3_t) :: q
type(vector3_t), intent(in) :: p
end function vector3_get_direction
<<Lorentz: procedures>>=
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.
<<Lorentz: public>>=
public :: vector4_t
<<Lorentz: types>>=
type :: vector4_t
real(default), dimension(0:3) :: p = &
[zero, zero, zero, zero]
contains
<<Lorentz: vector4: TBP>>
end type vector4_t
@ %def vector4_t
@ Output a vector
<<Lorentz: public>>=
public :: vector4_write
<<Lorentz: vector4: TBP>>=
procedure :: write => vector4_write
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: public>>=
public :: vector4_write_raw
public :: vector4_read_raw
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: public>>=
public :: vector4_null
<<Lorentz: parameters>>=
type(vector4_t), parameter :: vector4_null = &
vector4_t ([ zero, zero, zero, zero ])
@ %def vector4_null
@ Canonical four-vector:
<<Lorentz: public>>=
public :: vector4_canonical
<<Lorentz: sub interfaces>>=
elemental module function vector4_canonical (k) result (p)
type(vector4_t) :: p
integer, intent(in) :: k
end function vector4_canonical
<<Lorentz: procedures>>=
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:
<<Lorentz: public>>=
public :: vector4_at_rest
<<Lorentz: sub interfaces>>=
elemental module function vector4_at_rest (m) result (p)
type(vector4_t) :: p
real(default), intent(in) :: m
end function vector4_at_rest
<<Lorentz: procedures>>=
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)
<<Lorentz: public>>=
public :: vector4_moving
<<Lorentz: interfaces>>=
interface vector4_moving
module procedure vector4_moving_canonical
module procedure vector4_moving_generic
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: interfaces>>=
interface operator(==)
module procedure vector4_eq
end interface
interface operator(/=)
module procedure vector4_neq
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: interfaces>>=
interface operator(+)
module procedure add_vector4
end interface
interface operator(-)
module procedure sub_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: interfaces>>=
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
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: interfaces>>=
interface operator(*)
module procedure prod_vector4
end interface
interface operator(**)
module procedure power_vector4
end interface
<<Lorentz: sub interfaces>>=
elemental module function prod_vector4 (p, q) result (s)
real(default) :: s
type(vector4_t), intent(in) :: p,q
end function prod_vector4
<<Lorentz: procedures>>=
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]].
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: interfaces>>=
interface operator(-)
module procedure negate_vector4
end interface
<<Lorentz: sub interfaces>>=
elemental module function negate_vector4 (p) result (q)
type(vector4_t) :: q
type(vector4_t), intent(in) :: p
end function negate_vector4
<<Lorentz: procedures>>=
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:
<<Lorentz: interfaces>>=
interface sum
module procedure sum_vector4, sum_vector4_mask
end interface
@ %def sum
@
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: public>>=
public :: vector4_set_component
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: public>>=
public :: vector4_get_component
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public>>=
public :: vector4_get_components
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: public functions>>=
public :: space_part
<<Lorentz: interfaces>>=
interface space_part
module procedure vector4_get_space_part
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: interfaces>>=
interface direction
module procedure vector4_get_direction
end interface
<<Lorentz: sub interfaces>>=
elemental module function vector4_get_direction (p) result (q)
type(vector3_t) :: q
type(vector4_t), intent(in) :: p
end function vector4_get_direction
<<Lorentz: procedures>>=
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
<<Lorentz: public>>=
public :: vector4_invert_direction
<<Lorentz: sub interfaces>>=
elemental module subroutine vector4_invert_direction (p)
type(vector4_t), intent(inout) :: p
end subroutine vector4_invert_direction
<<Lorentz: procedures>>=
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.
<<Lorentz: public>>=
public :: assignment (=)
<<Lorentz: interfaces>>=
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
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: vector4
<<Lorentz: sub interfaces>>=
pure module function vector4 (a) result (p)
type(vector4_t) :: p
real(default), intent(in), dimension(4) :: a
end function vector4
<<Lorentz: procedures>>=
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
@
<<Lorentz: vector4: TBP>>=
procedure :: to_pythia6 => vector4_to_pythia6
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: interfaces>>=
interface assignment (=)
module procedure vector4_from_c_prt, c_prt_from_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public>>=
public :: vector4_to_c_prt
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: azimuthal_angle
<<Lorentz: interfaces>>=
interface azimuthal_angle
module procedure vector3_azimuthal_angle
module procedure vector4_azimuthal_angle
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: public functions>>=
public :: azimuthal_angle_deg
<<Lorentz: interfaces>>=
interface azimuthal_angle_deg
module procedure vector3_azimuthal_angle_deg
module procedure vector4_azimuthal_angle_deg
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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$.
<<Lorentz: public functions>>=
public :: azimuthal_distance
<<Lorentz: interfaces>>=
interface azimuthal_distance
module procedure vector3_azimuthal_distance
module procedure vector4_azimuthal_distance
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: public functions>>=
public :: azimuthal_distance_deg
<<Lorentz: interfaces>>=
interface azimuthal_distance_deg
module procedure vector3_azimuthal_distance_deg
module procedure vector4_azimuthal_distance_deg
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: polar_angle
<<Lorentz: interfaces>>=
interface polar_angle
module procedure polar_angle_vector3
module procedure polar_angle_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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$.
<<Lorentz: public functions>>=
public :: polar_angle_ct
<<Lorentz: interfaces>>=
interface polar_angle_ct
module procedure polar_angle_ct_vector3
module procedure polar_angle_ct_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: polar_angle_deg
<<Lorentz: interfaces>>=
interface polar_angle_deg
module procedure polar_angle_deg_vector3
module procedure polar_angle_deg_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: enclosed_angle
<<Lorentz: interfaces>>=
interface enclosed_angle
module procedure enclosed_angle_vector3
module procedure enclosed_angle_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: enclosed_angle_ct
<<Lorentz: interfaces>>=
interface enclosed_angle_ct
module procedure enclosed_angle_ct_vector3
module procedure enclosed_angle_ct_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: enclosed_angle_deg
<<Lorentz: interfaces>>=
interface enclosed_angle_deg
module procedure enclosed_angle_deg_vector3
module procedure enclosed_angle_deg_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: enclosed_angle_rest_frame
public :: enclosed_angle_ct_rest_frame
public :: enclosed_angle_deg_rest_frame
<<Lorentz: interfaces>>=
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
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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)
<<Lorentz: public functions>>=
public :: transverse_part
<<Lorentz: interfaces>>=
interface transverse_part
module procedure transverse_part_vector4_beam_axis
module procedure transverse_part_vector4_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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]].
<<Lorentz: public functions>>=
public :: longitudinal_part
<<Lorentz: interfaces>>=
interface longitudinal_part
module procedure longitudinal_part_vector4
end interface
<<Lorentz: sub interfaces>>=
elemental module function longitudinal_part_vector4 (p) result (pL)
real(default) :: pL
type(vector4_t), intent(in) :: p
end function longitudinal_part_vector4
<<Lorentz: procedures>>=
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
<<Lorentz: public functions>>=
public :: space_part_norm
<<Lorentz: interfaces>>=
interface space_part_norm
module procedure space_part_norm_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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)
<<Lorentz: public functions>>=
public :: energy
<<Lorentz: interfaces>>=
interface energy
module procedure energy_vector4
module procedure energy_vector3
module procedure energy_real
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: invariant_mass
<<Lorentz: interfaces>>=
interface invariant_mass
module procedure invariant_mass_vector4
end interface
<<Lorentz: sub interfaces>>=
elemental module function invariant_mass_vector4 (p) result (m)
real(default) :: m
type(vector4_t), intent(in) :: p
end function invariant_mass_vector4
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: invariant_mass_squared
<<Lorentz: interfaces>>=
interface invariant_mass_squared
module procedure invariant_mass_squared_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: transverse_mass
<<Lorentz: interfaces>>=
interface transverse_mass
module procedure transverse_mass_vector4
end interface
<<Lorentz: sub interfaces>>=
elemental module function transverse_mass_vector4 (p) result (m)
real(default) :: m
type(vector4_t), intent(in) :: p
end function transverse_mass_vector4
<<Lorentz: procedures>>=
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$)
<<Lorentz: public functions>>=
public :: rapidity
<<Lorentz: interfaces>>=
interface rapidity
module procedure rapidity_vector4
end interface
<<Lorentz: sub interfaces>>=
elemental module function rapidity_vector4 (p) result (y)
real(default) :: y
type(vector4_t), intent(in) :: p
end function rapidity_vector4
<<Lorentz: procedures>>=
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$)
<<Lorentz: public functions>>=
public :: pseudorapidity
<<Lorentz: interfaces>>=
interface pseudorapidity
module procedure pseudorapidity_vector4
end interface
<<Lorentz: sub interfaces>>=
elemental module function pseudorapidity_vector4 (p) result (eta)
real(default) :: eta
type(vector4_t), intent(in) :: p
end function pseudorapidity_vector4
<<Lorentz: procedures>>=
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$)
<<Lorentz: public functions>>=
public :: rapidity_distance
<<Lorentz: interfaces>>=
interface rapidity_distance
module procedure rapidity_distance_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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$)
<<Lorentz: public functions>>=
public :: pseudorapidity_distance
<<Lorentz: interfaces>>=
interface pseudorapidity_distance
module procedure pseudorapidity_distance_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: public functions>>=
public :: eta_phi_distance
<<Lorentz: interfaces>>=
interface eta_phi_distance
module procedure eta_phi_distance_vector4
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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}
<<Lorentz: public>>=
public :: lorentz_transformation_t
<<Lorentz: types>>=
type :: lorentz_transformation_t
private
real(default), dimension(0:3, 0:3) :: L
contains
<<Lorentz: lorentz transformation: TBP>>
end type lorentz_transformation_t
@ %def lorentz_transformation_t
@ Output:
<<Lorentz: public>>=
public :: lorentz_transformation_write
<<Lorentz: lorentz transformation: TBP>>=
procedure :: write => lorentz_transformation_write
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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:
<<Lorentz: public>>=
public :: lorentz_transformation_get_components
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: inverse
<<Lorentz: interfaces>>=
interface inverse
module procedure lorentz_transformation_inverse
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: parameters>>=
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:
<<Lorentz: public>>=
public :: identity
<<Lorentz: parameters>>=
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
<<Lorentz: public>>=
public :: space_reflection
<<Lorentz: parameters>>=
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.
<<Lorentz: public functions>>=
public :: create_orthogonal
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public functions>>=
public :: create_unit_vector
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public functions>>=
public :: normalize
<<Lorentz: sub interfaces>>=
module function normalize(p) result (p_norm)
type(vector3_t) :: p_norm
type(vector3_t), intent(in) :: p
end function normalize
<<Lorentz: procedures>>=
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]].
<<Lorentz: public>>=
public :: compute_resonance_mass
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: get_resonance_momentum
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: create_two_particle_decay
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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*}
<<Lorentz: public>>=
public :: create_three_particle_decay
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: evaluate_one_to_two_splitting_special
<<Lorentz: interfaces>>=
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
@
<<Lorentz: public>>=
public :: generate_on_shell_decay
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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}
<<Lorentz: public functions>>=
public :: boost
<<Lorentz: interfaces>>=
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)$.
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: rotation
<<Lorentz: interfaces>>=
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.
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: rotation_to_2nd
<<Lorentz: interfaces>>=
interface rotation_to_2nd
module procedure rotation_to_2nd_generic
module procedure rotation_to_2nd_canonical
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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$.
<<Lorentz: procedures>>=
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$.
<<Lorentz: public functions>>=
public :: transformation
<<Lorentz: interfaces>>=
interface transformation
module procedure transformation_rec_generic
module procedure transformation_rec_canonical
end interface
@ %def transformation
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: interfaces>>=
interface operator(*)
module procedure prod_LT_vector4
module procedure prod_LT_LT
module procedure prod_vector4_LT
end interface
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: LT_compose_r3_r2_b3
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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}
<<Lorentz: public functions>>=
public :: LT_compose_r2_r3_b3
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
<<Lorentz: public functions>>=
public :: axis_from_p_r3_r2_b3, axis_from_p_b3
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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$.
<<Lorentz: public functions>>=
public :: lambda
<<Lorentz: sub interfaces>>=
elemental module function lambda (m1sq, m2sq, m3sq)
real(default) :: lambda
real(default), intent(in) :: m1sq, m2sq, m3sq
end function lambda
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: colliding_momenta
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public functions>>=
public :: pacify
<<Lorentz: interfaces>>=
interface pacify
module procedure pacify_vector3
module procedure pacify_vector4
module procedure pacify_LT
end interface pacify
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: vector_set_reshuffle
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: vector_set_is_cms
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: vector_set_is_lab
<<Lorentz: sub interfaces>>=
module function vector_set_is_lab (p, n_in) result (is_lab)
logical :: is_lab
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: n_in
end function vector_set_is_lab
<<Lorentz: procedures>>=
module function vector_set_is_lab (p, n_in) result (is_lab)
logical :: is_lab
type(vector4_t), intent(in), dimension(:) :: p
integer, intent(in) :: n_in
is_lab = .not. vector_set_is_cms (p, n_in)
end function vector_set_is_lab
@ %def vector_set_is_lab
@
<<Lorentz: public>>=
public :: vector4_write_set
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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
@
<<Lorentz: public>>=
public :: vector4_check_momentum_conservation
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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.
<<Lorentz: public>>=
public :: spinor_product
<<Lorentz: sub interfaces>>=
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
<<Lorentz: procedures>>=
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)
!!! <ij>
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
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\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]]>>=
<<File header>>
module phs_points
<<Use kinds>>
use lorentz, only: vector4_t
use lorentz, only: lorentz_transformation_t
use lorentz, only: sum
<<Standard module head>>
<<PHS points: public>>
<<PHS points: types>>
<<PHS points: interfaces>>
interface
<<PHS points: sub interfaces>>
end interface
end module phs_points
@ %def phs_points
@
<<[[phs_points_sub.f90]]>>=
<<File header>>
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
<<PHS points: procedures>>
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.
<<PHS points: public>>=
public :: phs_point_t
<<PHS points: types>>=
type :: phs_point_t
private
type(vector4_t), dimension(:), allocatable :: p
contains
<<PHS points: phs point: TBP>>
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.
<<PHS points: phs point: TBP>>=
procedure :: write => phs_point_write
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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
<<PHS points: public>>=
public :: assignment(=)
<<PHS points: interfaces>>=
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
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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).
<<PHS points: public>>=
public :: size
<<PHS points: interfaces>>=
interface size
module procedure phs_point_size
end interface size
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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.
<<PHS points: public>>=
public :: operator(==)
<<PHS points: interfaces>>=
interface operator(==)
module procedure phs_point_eq
end interface operator(==)
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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
<<PHS points: phs point: TBP>>=
procedure :: get => phs_point_get
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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.
<<PHS points: phs point: TBP>>=
procedure :: select => phs_point_select
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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
<<PHS points: phs point: TBP>>=
procedure :: get_msq => phs_point_get_msq
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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.
<<PHS points: public>>=
public :: operator(*)
<<PHS points: interfaces>>=
interface operator(*)
module procedure prod_LT_phs_point
end interface operator(*)
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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.
<<PHS points: public>>=
public :: sum
<<PHS points: interfaces>>=
interface sum
module procedure phs_point_sum
module procedure phs_point_sum_iarray
end interface sum
<<PHS points: sub interfaces>>=
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
<<PHS points: procedures>>=
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
p = sum (phs_point%p, mask)
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.
<<PHS points: phs point: TBP>>=
procedure :: get_x => phs_point_get_x
<<PHS points: sub interfaces>>=
- pure module function phs_point_get_x (phs_point, E_beam) result (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
<<PHS points: procedures>>=
- pure module function phs_point_get_x (phs_point, E_beam) result (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]]>>=
<<File header>>
module phs_points_ut
use unit_tests
use phs_points_uti
<<Standard module head>>
<<PHS points: public test>>
contains
<<PHS points: test driver>>
end module phs_points_ut
@ %def phs_points_ut
@
<<[[phs_points_uti.f90]]>>=
<<File header>>
module phs_points_uti
<<Use kinds>>
use phs_points
<<Standard module head>>
<<PHS points: test declarations>>
contains
<<PHS points: tests>>
end module phs_points_uti
@ %def phs_points_ut
@ API: driver for the unit tests below.
<<PHS points: public test>>=
public :: phs_points_test
<<PHS points: test driver>>=
subroutine phs_points_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<PHS points: execute tests>>
end subroutine phs_points_test
@ %def phs_points_test
@
\subsubsection{Splitting functions}
<<PHS points: execute tests>>=
call test (phs_points_1, "phs_points_1", &
"Dummy test", &
u, results)
<<PHS points: test declarations>>=
public :: phs_points_1
<<PHS points: tests>>=
subroutine phs_points_1 (u)
integer, intent(in) :: u
write (u, "(A)") "* Test output: phs_points_1"
write (u, "(A)") "* Purpose: none yet"
write (u, "(A)")
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]]>>=
<<File header>>
module sm_physics
<<Use kinds with double>>
use constants
use physics_defs
use lorentz
<<Standard module head>>
<<SM physics: public>>
<<SM physics: parameters>>
interface
<<SM physics: sub interfaces>>
end interface
end module sm_physics
@ %def sm_physics
@
<<[[sm_physics_sub.f90]]>>=
<<File header>>
submodule (sm_physics) sm_physics_s
use io_units
use numeric_utils
use diagnostics
use permutations, only: factorial
implicit none
contains
<<SM physics: procedures>>
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*}
<<SM physics: public>>=
public :: zeta2, zeta3, zeta4, zeta5
<<SM physics: parameters>>=
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 =
+ \gamma_E =
\end{equation*}
<<SM physics: public>>=
public :: eulerc
<<SM physics: parameters>>=
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.
<<SM physics: public>>=
public :: beta0, beta1, beta2
public :: coeff_b0, coeff_b1, coeff_b2, coeffqed_b0, coeffqed_b1
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: running_as, running_as_lam, running_alpha, running_alpha_num
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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.
+<<SM physics: public>>=
+ public :: lambda_qcd
+<<SM physics: sub interfaces>>=
+ 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
+<<SM physics: procedures>>=
+ 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}
<<SM physics: parameters>>=
real(default), parameter, public :: gamma_q = three/two * CF, &
k_q = (7.0_default/two - pi**2/6.0_default) * CF
@ %def gamma_q
@
<<SM physics: public>>=
public :: gamma_g, k_g
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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}$.
<<SM physics: public>>=
public :: Li2
<<SM physics: sub interfaces>>=
elemental module function Li2 (x)
real(default), intent(in) :: x
real(default) :: Li2
end function Li2
<<SM physics: procedures>>=
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
@
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: psic
public :: psir
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: psim
public :: psimr
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: cnielsen
public :: nielsen
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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, &
+ 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)$.
<<SM physics: public>>=
public :: polylog
<<SM physics: sub interfaces>>=
module function polylog (n, x) result (plog)
integer, intent(in) :: n
real(default), intent(in) :: x
real(default) :: plog
end function polylog
<<SM physics: procedures>>=
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)$.
<<SM physics: public>>=
public :: dilog
<<SM physics: sub interfaces>>=
module function dilog (x) result (dlog)
real(default), intent(in) :: x
real(default) :: dlog
end function dilog
<<SM physics: procedures>>=
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)$.
<<SM physics: public>>=
public :: trilog
<<SM physics: sub interfaces>>=
module function trilog (x) result (tlog)
real(default), intent(in) :: x
real(default) :: tlog
end function trilog
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: faux
<<SM physics: sub interfaces>>=
elemental module function faux (x) result (y)
real(default), intent(in) :: x
complex(default) :: y
end function faux
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: fonehalf
<<SM physics: sub interfaces>>=
elemental module function fonehalf (x) result (y)
real(default), intent(in) :: x
complex(default) :: y
end function fonehalf
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: fonehalf_pseudo
<<SM physics: sub interfaces>>=
module function fonehalf_pseudo (x) result (y)
real(default), intent(in) :: x
complex(default) :: y
end function fonehalf_pseudo
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: fone
<<SM physics: sub interfaces>>=
elemental module function fone (x) result (y)
real(default), intent(in) :: x
complex(default) :: y
end function fone
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: gaux
<<SM physics: sub interfaces>>=
elemental module function gaux (x) result (y)
real(default), intent(in) :: x
complex(default) :: y
end function gaux
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: tri_i1
<<SM physics: sub interfaces>>=
elemental module function tri_i1 (a,b) result (y)
real(default), intent(in) :: a,b
complex(default) :: y
end function tri_i1
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: tri_i2
<<SM physics: sub interfaces>>=
elemental module function tri_i2 (a,b) result (y)
real(default), intent(in) :: a,b
complex(default) :: y
end function tri_i2
<<SM physics: procedures>>=
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$.
<<SM physics: public>>=
public :: run_b0
<<SM physics: sub interfaces>>=
elemental module function run_b0 (nf) result (bnull)
integer, intent(in) :: nf
real(default) :: bnull
end function run_b0
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: run_b1
<<SM physics: sub interfaces>>=
elemental module function run_b1 (nf) result (bone)
integer, intent(in) :: nf
real(default) :: bone
end function run_b1
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: run_aa
<<SM physics: sub interfaces>>=
elemental module function run_aa (nf) result (aaa)
integer, intent(in) :: nf
real(default) :: aaa
end function run_aa
<<SM physics: procedures>>=
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
@
<<SM physics: pubic functions>>=
public :: run_bb
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: ff_dipole
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: fi_dipole
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: if_dipole
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: ii_dipole
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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}$:
<<SM physics: public>>=
public :: delta
<<SM physics: sub interfaces>>=
elemental module function delta (x,eps) result (z)
real(default), intent(in) :: x, eps
real(default) :: z
end function delta
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: plus_distr
<<SM physics: sub interfaces>>=
elemental module function plus_distr (x,eps) result (plusd)
real(default), intent(in) :: x, eps
real(default) :: plusd
end function plus_distr
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: pqq
<<SM physics: sub interfaces>>=
elemental module function pqq (x,eps) result (pqqx)
real(default), intent(in) :: x, eps
real(default) :: pqqx
end function pqq
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: pgq
<<SM physics: sub interfaces>>=
elemental module function pgq (x) result (pgqx)
real(default), intent(in) :: x
real(default) :: pgqx
end function pgq
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: pqg
<<SM physics: sub interfaces>>=
elemental module function pqg (x) result (pqgx)
real(default), intent(in) :: x
real(default) :: pqgx
end function pqg
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: pgg
<<SM physics: sub interfaces>>=
elemental module function pgg (x, nf, eps) result (pggx)
real(default), intent(in) :: x, nf, eps
real(default) :: pggx
end function pgg
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: pqq_reg
<<SM physics: sub interfaces>>=
elemental module function pqq_reg (x) result (pqqregx)
real(default), intent(in) :: x
real(default) :: pqqregx
end function pqq_reg
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: pgg_reg
<<SM physics: sub interfaces>>=
elemental module function pgg_reg (x) result (pggregx)
real(default), intent(in) :: x
real(default) :: pggregx
end function pgg_reg
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: kbarqg
<<SM physics: sub interfaces>>=
module function kbarqg (x) result (kbarqgx)
real(default), intent(in) :: x
real(default) :: kbarqgx
end function kbarqg
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: kbargq
<<SM physics: sub interfaces>>=
module function kbargq (x) result (kbargqx)
real(default), intent(in) :: x
real(default) :: kbargqx
end function kbargq
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: kbarqq
<<SM physics: sub interfaces>>=
module function kbarqq (x,eps) result (kbarqqx)
real(default), intent(in) :: x, eps
real(default) :: kbarqqx
end function kbarqq
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: kbargg
<<SM physics: sub interfaces>>=
module function kbargg (x,eps,nf) result (kbarggx)
real(default), intent(in) :: x, eps, nf
real(default) :: kbarggx
end function kbargg
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: ktildeqq
<<SM physics: sub interfaces>>=
module function ktildeqq (x,eps) result (ktildeqqx)
real(default), intent(in) :: x, eps
real(default) :: ktildeqqx
end function ktildeqq
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: ktildeqg
<<SM physics: sub interfaces>>=
module function ktildeqg (x,eps) result (ktildeqgx)
real(default), intent(in) :: x, eps
real(default) :: ktildeqgx
end function ktildeqg
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: ktildegq
<<SM physics: sub interfaces>>=
module function ktildegq (x,eps) result (ktildegqx)
real(default), intent(in) :: x, eps
real(default) :: ktildegqx
end function ktildegq
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: ktildegg
<<SM physics: sub interfaces>>=
module function ktildegg (x,eps) result (ktildeggx)
real(default), intent(in) :: x, eps
real(default) :: ktildeggx
end function ktildegg
<<SM physics: procedures>>=
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$.
<<SM physics: public>>=
public :: insert_q
<<SM physics: sub interfaces>>=
pure module function insert_q () result (i_q)
real(default), dimension(0:2) :: i_q
end function insert_q
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: insert_g
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: k_q_al, k_g_al
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: plus_distr_al
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: kbarqg_al
<<SM physics: sub interfaces>>=
module function kbarqg_al (x,alpha,eps) result (kbarqgx)
real(default), intent(in) :: x, alpha, eps
real(default) :: kbarqgx
end function kbarqg_al
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: kbargq_al
<<SM physics: sub interfaces>>=
module function kbargq_al (x,alpha,eps) result (kbargqx)
real(default), intent(in) :: x, alpha, eps
real(default) :: kbargqx
end function kbargq_al
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: kbarqq_al
<<SM physics: sub interfaces>>=
module function kbarqq_al (x,alpha,eps) result (kbarqqx)
real(default), intent(in) :: x, alpha, eps
real(default) :: kbarqqx
end function kbarqq_al
<<SM physics: procedures>>=
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
<<SM physics: public>>=
public :: kbargg_al
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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}
<<SM physics: public>>=
public :: ktildeqq_al
<<SM physics: sub interfaces>>=
module function ktildeqq_al (x,alpha,eps) result (ktildeqqx)
real(default), intent(in) :: x, eps, alpha
real(default) :: ktildeqqx
end function ktildeqq_al
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: log_plus_distr
<<SM physics: sub interfaces>>=
module function log_plus_distr (x,eps) result (lpd)
real(default), intent(in) :: x, eps
real(default) :: lpd, eps2
end function log_plus_distr
<<SM physics: procedures>>=
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)_+$.
<<SM physics: public>>=
public :: log2_plus_distr
<<SM physics: sub interfaces>>=
module function log2_plus_distr (x,eps) result (lpd)
real(default), intent(in) :: x, eps
real(default) :: lpd
end function log2_plus_distr
<<SM physics: procedures>>=
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}$.
<<SM physics: public>>=
public :: log2_plus_distr_al
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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:
<<SM physics: public>>=
public :: p_qqg
public :: p_gqq
public :: p_ggg
@ $q\to q g$
<<SM physics: sub interfaces>>=
elemental module function p_qqg (z) result (P)
real(default), intent(in) :: z
real(default) :: P
end function p_qqg
<<SM physics: procedures>>=
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}$
<<SM physics: sub interfaces>>=
elemental module function p_gqq (z) result (P)
real(default), intent(in) :: z
real(default) :: P
end function p_gqq
<<SM physics: procedures>>=
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$
<<SM physics: sub interfaces>>=
elemental module function p_ggg (z) result (P)
real(default), intent(in) :: z
real(default) :: P
end function p_ggg
<<SM physics: procedures>>=
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:
<<SM physics: public>>=
public :: integral_over_p_qqg
public :: integral_over_p_gqq
public :: integral_over_p_ggg
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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:
<<SM physics: public>>=
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$):
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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)$:
<<SM physics: public>>=
public :: pqqm
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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
+@ %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*}
@
<<SM physics: public>>=
public :: top_width_sm_lo
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: g_mu_from_alpha
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: alpha_from_g_mu
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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]].
<<SM physics: public>>=
public :: top_width_sm_qcd_nlo_massless_b
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: f0
<<SM physics: sub interfaces>>=
elemental module function f0 (w2) result (f)
real(default) :: f
real(default), intent(in) :: w2
end function f0
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: f1
<<SM physics: sub interfaces>>=
elemental module function f1 (w2) result (f)
real(default) :: f
real(default), intent(in) :: w2
end function f1
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: top_width_sm_qcd_nlo_jk
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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.
<<SM physics: public>>=
public :: top_width_sm_qcd_nlo_ce
<<SM physics: sub interfaces>>=
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
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: ff0
<<SM physics: sub interfaces>>=
elemental module function ff0 (eps2, w2) result (f)
real(default) :: f
real(default), intent(in) :: eps2, w2
end function ff0
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: ff_f0
<<SM physics: sub interfaces>>=
elemental module function ff_f0 (eps2, w2) result (f)
real(default) :: f
real(default), intent(in) :: eps2, w2
end function ff_f0
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: ff_lambda
<<SM physics: sub interfaces>>=
elemental module function ff_lambda (eps2, w2) result (l)
real(default) :: l
real(default), intent(in) :: eps2, w2
end function ff_lambda
<<SM physics: procedures>>=
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
@
<<SM physics: public>>=
public :: ff1
<<SM physics: sub interfaces>>=
elemental module function ff1 (eps2, w2) result (f)
real(default) :: f
real(default), intent(in) :: eps2, w2
end function ff1
<<SM physics: procedures>>=
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]]>>=
<<File header>>
module sm_physics_ut
use unit_tests
use sm_physics_uti
<<Standard module head>>
<<SM physics: public test>>
contains
<<SM physics: test driver>>
end module sm_physics_ut
@ %def sm_physics_ut
@
<<[[sm_physics_uti.f90]]>>=
<<File header>>
module sm_physics_uti
<<Use kinds>>
use numeric_utils
use format_defs, only: FMT_15
use constants
use sm_physics
<<Standard module head>>
<<SM physics: test declarations>>
contains
<<SM physics: tests>>
end module sm_physics_uti
@ %def sm_physics_ut
@ API: driver for the unit tests below.
<<SM physics: public test>>=
public :: sm_physics_test
<<SM physics: test driver>>=
subroutine sm_physics_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SM physics: execute tests>>
end subroutine sm_physics_test
@ %def sm_physics_test
@
\subsubsection{Splitting functions}
<<SM physics: execute tests>>=
call test (sm_physics_1, "sm_physics_1", &
"Splitting functions", &
u, results)
<<SM physics: test declarations>>=
public :: sm_physics_1
<<SM physics: tests>>=
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}
<<SM physics: execute tests>>=
call test(sm_physics_2, "sm_physics_2", &
"Top width", u, results)
<<SM physics: test declarations>>=
public :: sm_physics_2
<<SM physics: tests>>=
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}
<<SM physics: execute tests>>=
call test (sm_physics_3, "sm_physics_3", &
"Special functions", &
u, results)
<<SM physics: test declarations>>=
public :: sm_physics_3
<<SM physics: tests>>=
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)")
+ 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]]>>=
<<File header>>
module sm_qcd
<<Use kinds>>
use physics_defs
<<Standard module head>>
<<SM qcd: public>>
<<SM qcd: types>>
<<SM qcd: interfaces>>
interface
<<SM qcd: sub interfaces>>
end interface
end module sm_qcd
@ %def sm_qcd
@
<<[[sm_qcd_sub.f90]]>>=
<<File header>>
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
<<SM qcd: procedures>>
end submodule sm_qcd_s
@ %def sm_qcd_s
@
\subsection{Coupling: Abstract Data Type}
This is the abstract version of the QCD coupling implementation.
<<SM qcd: public>>=
public :: alpha_qcd_t
<<SM qcd: types>>=
type, abstract :: alpha_qcd_t
contains
<<SM qcd: alpha qcd: TBP>>
end type alpha_qcd_t
@ %def alpha_qcd_t
@ There must be an output routine.
<<SM qcd: alpha qcd: TBP>>=
procedure (alpha_qcd_write), deferred :: write
<<SM qcd: interfaces>>=
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.
<<SM qcd: alpha qcd: TBP>>=
procedure (alpha_qcd_get), deferred :: get
<<SM qcd: interfaces>>=
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$.
<<SM qcd: public>>=
public :: alpha_qcd_fixed_t
<<SM qcd: types>>=
type, extends (alpha_qcd_t) :: alpha_qcd_fixed_t
real(default) :: val = ALPHA_QCD_MZ_REF
contains
<<SM qcd: alpha qcd fixed: TBP>>
end type alpha_qcd_fixed_t
@ %def alpha_qcd_fixed_t
@ Output.
<<SM qcd: alpha qcd fixed: TBP>>=
procedure :: write => alpha_qcd_fixed_write
<<SM qcd: sub interfaces>>=
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
<<SM qcd: procedures>>=
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.
<<SM qcd: alpha qcd fixed: TBP>>=
procedure :: get => alpha_qcd_fixed_get
<<SM qcd: sub interfaces>>=
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
<<SM qcd: procedures>>=
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.
<<SM qcd: public>>=
public :: alpha_qcd_from_scale_t
<<SM qcd: types>>=
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
<<SM qcd: alpha qcd from scale: TBP>>
end type alpha_qcd_from_scale_t
@ %def alpha_qcd_from_scale_t
@ Output.
<<SM qcd: alpha qcd from scale: TBP>>=
procedure :: write => alpha_qcd_from_scale_write
<<SM qcd: sub interfaces>>=
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
<<SM qcd: procedures>>=
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.
<<SM qcd: alpha qcd from scale: TBP>>=
procedure :: get => alpha_qcd_from_scale_get
<<SM qcd: sub interfaces>>=
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
<<SM qcd: procedures>>=
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.
<<SM qcd: public>>=
public :: alpha_qcd_from_lambda_t
<<SM qcd: types>>=
type, extends (alpha_qcd_t) :: alpha_qcd_from_lambda_t
real(default) :: lambda = LAMBDA_QCD_REF
integer :: order = 0
integer :: nf = 5
contains
<<SM qcd: alpha qcd from lambda: TBP>>
end type alpha_qcd_from_lambda_t
@ %def alpha_qcd_from_lambda_t
@ Output.
<<SM qcd: alpha qcd from lambda: TBP>>=
procedure :: write => alpha_qcd_from_lambda_write
<<SM qcd: sub interfaces>>=
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
<<SM qcd: procedures>>=
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.
<<SM qcd: alpha qcd from lambda: TBP>>=
procedure :: get => alpha_qcd_from_lambda_get
<<SM qcd: sub interfaces>>=
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
<<SM qcd: procedures>>=
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).
<<SM qcd: public>>=
public :: qcd_t
<<SM qcd: types>>=
type :: qcd_t
class(alpha_qcd_t), allocatable :: alpha
character(32) :: md5sum = ""
integer :: n_f = -1
contains
<<SM qcd: qcd: TBP>>
end type qcd_t
@ %def qcd_t
@ Output. We first print the polymorphic [[alpha]] which contains a headline,
then any extra components.
<<SM qcd: qcd: TBP>>=
procedure :: write => qcd_write
<<SM qcd: sub interfaces>>=
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
<<SM qcd: procedures>>=
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.
<<SM qcd: qcd: TBP>>=
procedure :: compute_alphas_md5sum => qcd_compute_alphas_md5sum
<<SM qcd: sub interfaces>>=
module subroutine qcd_compute_alphas_md5sum (qcd)
class(qcd_t), intent(inout) :: qcd
integer :: unit
end subroutine qcd_compute_alphas_md5sum
<<SM qcd: procedures>>=
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.
<<SM qcd: qcd: TBP>>=
procedure :: get_md5sum => qcd_get_md5sum
<<SM qcd: sub interfaces>>=
module function qcd_get_md5sum (qcd) result (md5sum)
character(32) :: md5sum
class(qcd_t), intent(inout) :: qcd
end function qcd_get_md5sum
<<SM qcd: procedures>>=
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]]>>=
<<File header>>
module sm_qcd_ut
use unit_tests
use sm_qcd_uti
<<Standard module head>>
<<SM qcd: public test>>
contains
<<SM qcd: test driver>>
end module sm_qcd_ut
@ %def sm_qcd_ut
@
<<[[sm_qcd_uti.f90]]>>=
<<File header>>
module sm_qcd_uti
<<Use kinds>>
use physics_defs, only: MZ_REF
use sm_qcd
<<Standard module head>>
<<SM qcd: test declarations>>
contains
<<SM qcd: tests>>
end module sm_qcd_uti
@ %def sm_qcd_ut
@ API: driver for the unit tests below.
<<SM qcd: public test>>=
public :: sm_qcd_test
<<SM qcd: test driver>>=
subroutine sm_qcd_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SM qcd: execute tests>>
end subroutine sm_qcd_test
@ %def sm_qcd_test
@
\subsubsection{QCD Coupling}
We check two different implementations of the abstract QCD coupling.
<<SM qcd: execute tests>>=
call test (sm_qcd_1, "sm_qcd_1", &
"running alpha_s", &
u, results)
<<SM qcd: test declarations>>=
public :: sm_qcd_1
<<SM qcd: tests>>=
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]]>>=
<<File header>>
module sm_qed
<<Use kinds>>
use physics_defs
<<Standard module head>>
<<SM qed: public>>
<<SM qed: types>>
<<SM qed: interfaces>>
interface
<<SM qed: sub interfaces>>
end interface
end module sm_qed
@ %def sm_qed
@
<<[[sm_qed_sub.f90]]>>=
<<File header>>
submodule (sm_qed) sm_qed_s
use io_units
use format_defs, only: FMT_12
use md5
use sm_physics
implicit none
contains
<<SM qed: procedures>>
end submodule sm_qed_s
@ %def sm_qed_s
@
\subsection{Coupling: Abstract Data Type}
This is the abstract version of the QCD coupling implementation.
<<SM qed: public>>=
public :: alpha_qed_t
<<SM qed: types>>=
type, abstract :: alpha_qed_t
contains
<<SM qed: alpha qed: TBP>>
end type alpha_qed_t
@ %def alpha_qed_t
@ There must be an output routine.
<<SM qed: alpha qed: TBP>>=
procedure (alpha_qed_write), deferred :: write
<<SM qed: interfaces>>=
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.
<<SM qed: alpha qed: TBP>>=
procedure (alpha_qed_get), deferred :: get
<<SM qed: interfaces>>=
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.
<<SM qed: public>>=
public :: alpha_qed_fixed_t
<<SM qed: types>>=
type, extends (alpha_qed_t) :: alpha_qed_fixed_t
real(default) :: val = ALPHA_QED_ME_REF
contains
<<SM qed: alpha qed fixed: TBP>>
end type alpha_qed_fixed_t
@ %def alpha_qed_fixed_t
@ Output.
<<SM qed: alpha qed fixed: TBP>>=
procedure :: write => alpha_qed_fixed_write
<<SM qed: sub interfaces>>=
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
<<SM qed: procedures>>=
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.
<<SM qed: alpha qed fixed: TBP>>=
procedure :: get => alpha_qed_fixed_get
<<SM qed: sub interfaces>>=
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
<<SM qed: procedures>>=
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.
<<SM qed: public>>=
public :: alpha_qed_from_scale_t
<<SM qed: types>>=
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
<<SM qed: alpha qed from scale: TBP>>
end type alpha_qed_from_scale_t
@ %def alpha_qed_from_scale_t
@ Output.
<<SM qed: alpha qed from scale: TBP>>=
procedure :: write => alpha_qed_from_scale_write
<<SM qed: sub interfaces>>=
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
<<SM qed: procedures>>=
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.
<<SM qed: alpha qed from scale: TBP>>=
procedure :: get => alpha_qed_from_scale_get
<<SM qed: sub interfaces>>=
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
<<SM qed: procedures>>=
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$
+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.
<<SM qed: public>>=
public :: qed_t
<<SM qed: types>>=
type :: qed_t
class(alpha_qed_t), allocatable :: alpha
character(32) :: md5sum = ""
integer :: n_f = -1
integer :: n_lep = -1
contains
<<SM qed: qed: TBP>>
end type qed_t
@ %def qed_t
Output. We first print the polymorphic [[alpha]] which contains a headline,
then any extra components.
<<SM qed: qed: TBP>>=
procedure :: write => qed_write
<<SM qed: sub interfaces>>=
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
<<SM qed: procedures>>=
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.
<<SM qed: qed: TBP>>=
procedure :: compute_alpha_md5sum => qed_compute_alpha_md5sum
<<SM qed: sub interfaces>>=
module subroutine qed_compute_alpha_md5sum (qed)
class(qed_t), intent(inout) :: qed
integer :: unit
end subroutine qed_compute_alpha_md5sum
<<SM qed: procedures>>=
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.
<<SM qed: qed: TBP>>=
procedure :: get_md5sum => qed_get_md5sum
<<SM qed: sub interfaces>>=
module function qed_get_md5sum (qed) result (md5sum)
character(32) :: md5sum
class(qed_t), intent(inout) :: qed
end function qed_get_md5sum
<<SM qed: procedures>>=
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]]>>=
<<File header>>
module sm_qed_ut
use unit_tests
use sm_qed_uti
<<Standard module head>>
<<SM qed: public test>>
contains
<<SM qed: test driver>>
end module sm_qed_ut
@ %def sm_qed_ut
@
<<[[sm_qed_uti.f90]]>>=
<<File header>>
module sm_qed_uti
<<Use kinds>>
use physics_defs, only: ME_REF
use sm_qed
<<Standard module head>>
<<SM qed: test declarations>>
contains
<<SM qed: tests>>
end module sm_qed_uti
@ %def sm_qed_ut
@ API: driver for the unit tests below.
<<SM qed: public test>>=
public :: sm_qed_test
<<SM qed: test driver>>=
subroutine sm_qed_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SM qed: execute tests>>
end subroutine sm_qed_test
@ %def sm_qed_test
@
\subsubsection{QED Coupling}
We check two different implementations of the abstract QED coupling.
<<SM qed: execute tests>>=
call test (sm_qed_1, "sm_qed_1", &
- "running alpha_s", &
+ "running alpha", &
u, results)
<<SM qed: test declarations>>=
public :: sm_qed_1
<<SM qed: tests>>=
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]]>>=
<<File header>>
module shower_algorithms
<<Use kinds>>
<<Standard module head>>
<<Shower algorithms: public>>
<<Shower algorithms: interfaces>>
interface
<<Shower algorithms: sub interfaces>>
end interface
end module shower_algorithms
@ %def shower_algorithms
<<[[shower_algorithms_sub.f90]]>>=
<<File header>>
submodule (shower_algorithms) shower_algorithms_s
use diagnostics
use constants
implicit none
contains
<<Shower algorithms: procedures>>
<<Shower algorithms: tests>>
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.
<<Shower algorithms: sub interfaces>>=
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
<<Shower algorithms: procedures>>=
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
@
<<Shower algorithms: procedures>>=
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
@
<<Shower algorithms: interfaces>>=
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.)
<<XXX Shower algorithms: public>>=
public :: shower_algorithms_test
<<XXX Shower algorithms: tests>>=
subroutine shower_algorithms_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Shower algorithms: execute tests>>
end subroutine shower_algorithms_test
@ %def shower_algorithms_test
@
\subsubsection{Splitting functions}
<<XXX shower algorithms: execute tests>>=
call test (shower_algorithms_1, "shower_algorithms_1", &
"veto technique", &
u, results)
<<XXX shower algorithms: tests>>=
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/beams/beams.nw
===================================================================
--- trunk/src/beams/beams.nw (revision 8819)
+++ trunk/src/beams/beams.nw (revision 8820)
@@ -1,28230 +1,28248 @@
%% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: beams and beam structure
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Beams}
\includemodulegraph{beams}
These modules implement beam configuration and beam structure, the
latter in abstract terms.
\begin{description}
\item[beam\_structures]
The [[beam_structure_t]] type is a messenger type that communicates
the user settings to the \whizard\ core.
\item[beams]
Beam configuration.
\item[sf\_aux]
Tools for handling structure functions and splitting
\item[sf\_mappings]
Mapping functions, useful for structure function implementation
\item[sf\_base]
The abstract structure-function interaction and structure-function
chain types.
\end{description}
These are the implementation modules, the concrete counterparts of
[[sf_base]]:
\begin{description}
\item[sf\_isr]
ISR structure function (photon radiation inclusive and resummed in
collinear and IR regions).
\item[sf\_epa]
Effective Photon Approximation.
\item[sf\_ewa]
Effective $W$ (and $Z$) approximation.
\item[sf\_escan]
Energy spectrum that emulates a uniform energy scan.
\item[sf\_gaussian]
Gaussian beam spread
\item[sf\_beam\_events]
Beam-event generator that reads its input from an external file.
\item[sf\_circe1]
CIRCE1 beam spectra for electrons and photons.
\item[sf\_circe2]
CIRCE2 beam spectra for electrons and photons.
\item[hoppet\_interface]
Support for $b$-quark matching, addon to PDF modules.
\item[sf\_pdf\_builtin]
Direct support for selected hadron PDFs.
\item[sf\_lhapdf]
LHAPDF library support.
\end{description}
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Beam structure}
This module stores the beam structure definition as it is declared in
the SINDARIN script. The structure definition is not analyzed, just
recorded for later use.
We do not capture any numerical parameters, just names of particles and
structure functions.
<<[[beam_structures.f90]]>>=
<<File header>>
module beam_structures
<<Use kinds>>
<<Use strings>>
use lorentz
use polarizations
<<Standard module head>>
<<Beam structures: public>>
<<Beam structures: types>>
<<Beam structures: interfaces>>
interface
<<Beam structures: sub interfaces>>
end interface
end module beam_structures
@ %def beam_structures
@
<<[[beam_structures_sub.f90]]>>=
<<File header>>
submodule (beam_structures) beam_structures_s
use io_units
use format_defs, only: FMT_19
use diagnostics
implicit none
contains
<<Beam structures: procedures>>
end submodule beam_structures_s
@ %def beam_structures_s
@
\subsection{Beam structure elements}
An entry in a beam-structure record consists of a string
that denotes a type of structure function.
<<Beam structures: types>>=
type :: beam_structure_entry_t
logical :: is_valid = .false.
type(string_t) :: name
contains
<<Beam structures: beam structure entry: TBP>>
end type beam_structure_entry_t
@ %def beam_structure_entry_t
@ Output.
<<Beam structures: beam structure entry: TBP>>=
procedure :: to_string => beam_structure_entry_to_string
<<Beam structures: sub interfaces>>=
module function beam_structure_entry_to_string (object) result (string)
class(beam_structure_entry_t), intent(in) :: object
type(string_t) :: string
end function beam_structure_entry_to_string
<<Beam structures: procedures>>=
module function beam_structure_entry_to_string (object) result (string)
class(beam_structure_entry_t), intent(in) :: object
type(string_t) :: string
if (object%is_valid) then
string = object%name
else
string = "none"
end if
end function beam_structure_entry_to_string
@ %def beam_structure_entry_to_string
@
A record in the beam-structure sequence denotes either a
structure-function entry, a pair of such entries, or a pair spectrum.
<<Beam structures: types>>=
type :: beam_structure_record_t
type(beam_structure_entry_t), dimension(:), allocatable :: entry
end type beam_structure_record_t
@ %def beam_structure_record_t
@
\subsection{Beam structure type}
The beam-structure object contains the beam particle(s) as simple strings.
The sequence of records indicates the structure functions by name. No
numerical parameters are stored.
<<Beam structures: public>>=
public :: beam_structure_t
<<Beam structures: types>>=
type :: beam_structure_t
private
integer :: n_beam = 0
type(string_t), dimension(:), allocatable :: prt
type(beam_structure_record_t), dimension(:), allocatable :: record
type(smatrix_t), dimension(:), allocatable :: smatrix
real(default), dimension(:), allocatable :: pol_f
real(default), dimension(:), allocatable :: p
real(default), dimension(:), allocatable :: theta
real(default), dimension(:), allocatable :: phi
contains
<<Beam structures: beam structure: TBP>>
end type beam_structure_t
@ %def beam_structure_t
@ The finalizer deletes all contents explicitly, so we can continue
with an empty beam record. (It is not needed for deallocation.) We
have distinct finalizers for the independent parts of the beam structure.
<<Beam structures: beam structure: TBP>>=
procedure :: final_sf => beam_structure_final_sf
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_final_sf (object)
class(beam_structure_t), intent(inout) :: object
end subroutine beam_structure_final_sf
<<Beam structures: procedures>>=
module subroutine beam_structure_final_sf (object)
class(beam_structure_t), intent(inout) :: object
if (allocated (object%prt)) deallocate (object%prt)
if (allocated (object%record)) deallocate (object%record)
object%n_beam = 0
end subroutine beam_structure_final_sf
@ %def beam_structure_final_sf
@ Output. The actual information fits in a single line, therefore we can
provide a [[to_string]] method. The [[show]] method also lists the
current values of relevant global variables.
<<Beam structures: beam structure: TBP>>=
procedure :: write => beam_structure_write
- procedure :: to_string => beam_structure_to_string
+ procedure :: to_string => beam_structure_to_string
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_write (object, unit)
class(beam_structure_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine beam_structure_write
module function beam_structure_to_string (object, sf_only) result (string)
class(beam_structure_t), intent(in) :: object
logical, intent(in), optional :: sf_only
type(string_t) :: string
end function beam_structure_to_string
<<Beam structures: procedures>>=
module subroutine beam_structure_write (object, unit)
class(beam_structure_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A,A)") "Beam structure: ", char (object%to_string ())
if (allocated (object%smatrix)) then
do i = 1, size (object%smatrix)
write (u, "(3x,A,I0,A)") "polarization (beam ", i, "):"
call object%smatrix(i)%write (u, indent=2)
end do
end if
if (allocated (object%pol_f)) then
write (u, "(3x,A,F10.7,:,',',F10.7)") "polarization degree =", &
object%pol_f
end if
if (allocated (object%p)) then
write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
")") "momentum =", object%p
end if
if (allocated (object%theta)) then
write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
")") "angle th =", object%theta
end if
if (allocated (object%phi)) then
write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
")") "angle ph =", object%phi
end if
end subroutine beam_structure_write
module function beam_structure_to_string (object, sf_only) result (string)
class(beam_structure_t), intent(in) :: object
logical, intent(in), optional :: sf_only
type(string_t) :: string
integer :: i, j
logical :: with_beams
with_beams = .true.; if (present (sf_only)) with_beams = .not. sf_only
select case (object%n_beam)
case (1)
if (with_beams) then
string = object%prt(1)
else
string = ""
end if
case (2)
if (with_beams) then
string = object%prt(1) // ", " // object%prt(2)
else
string = ""
end if
if (allocated (object%record)) then
if (size (object%record) > 0) then
if (with_beams) string = string // " => "
do i = 1, size (object%record)
if (i > 1) string = string // " => "
do j = 1, size (object%record(i)%entry)
if (j > 1) string = string // ", "
string = string // object%record(i)%entry(j)%to_string ()
end do
end do
end if
end if
case default
string = "[any particles]"
end select
end function beam_structure_to_string
@ %def beam_structure_write beam_structure_to_string
@ Initializer: dimension the beam structure record. Each array
element denotes the number of entries for a record within the
beam-structure sequence. The number of entries is either one or two,
while the number of records is unlimited.
<<Beam structures: beam structure: TBP>>=
procedure :: init_sf => beam_structure_init_sf
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_init_sf (beam_structure, prt, dim_array)
class(beam_structure_t), intent(inout) :: beam_structure
type(string_t), dimension(:), intent(in) :: prt
integer, dimension(:), intent(in), optional :: dim_array
end subroutine beam_structure_init_sf
<<Beam structures: procedures>>=
module subroutine beam_structure_init_sf (beam_structure, prt, dim_array)
class(beam_structure_t), intent(inout) :: beam_structure
type(string_t), dimension(:), intent(in) :: prt
integer, dimension(:), intent(in), optional :: dim_array
integer :: i
call beam_structure%final_sf ()
beam_structure%n_beam = size (prt)
allocate (beam_structure%prt (size (prt)))
beam_structure%prt = prt
if (present (dim_array)) then
allocate (beam_structure%record (size (dim_array)))
do i = 1, size (dim_array)
allocate (beam_structure%record(i)%entry (dim_array(i)))
end do
else
allocate (beam_structure%record (0))
end if
end subroutine beam_structure_init_sf
@ %def beam_structure_init_sf
@ Set an entry, specified by record number and entry number.
<<Beam structures: beam structure: TBP>>=
procedure :: set_sf => beam_structure_set_sf
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_set_sf (beam_structure, i, j, name)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i, j
type(string_t), intent(in) :: name
end subroutine beam_structure_set_sf
<<Beam structures: procedures>>=
module subroutine beam_structure_set_sf (beam_structure, i, j, name)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i, j
type(string_t), intent(in) :: name
associate (entry => beam_structure%record(i)%entry(j))
entry%name = name
entry%is_valid = .true.
end associate
end subroutine beam_structure_set_sf
@ %def beam_structure_set_sf
@ Expand the beam-structure object. (i) For a pair spectrum, keep the
entry. (ii) For a single-particle structure function written as a
single entry, replace this by a record with two entries.
(ii) For a record with two nontrivial entries, separate this into two
records with one trivial entry each.
To achieve this, we need a function that tells us whether an entry is
a spectrum or a structure function. It returns 0 for a trivial entry,
1 for a single-particle structure function, and 2 for a two-particle
spectrum.
<<Beam structures: interfaces>>=
abstract interface
function strfun_mode_fun (name) result (n)
import
type(string_t), intent(in) :: name
integer :: n
end function strfun_mode_fun
end interface
@ %def is_spectrum_t
@ Algorithm: (1) Mark entries as invalid where necessary. (2) Count
the number of entries that we will need. (3) Expand and copy
entries to a new record array. (4) Replace the old array by the new one.
<<Beam structures: beam structure: TBP>>=
procedure :: expand => beam_structure_expand
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_expand (beam_structure, strfun_mode)
class(beam_structure_t), intent(inout) :: beam_structure
procedure(strfun_mode_fun) :: strfun_mode
end subroutine beam_structure_expand
<<Beam structures: procedures>>=
module subroutine beam_structure_expand (beam_structure, strfun_mode)
class(beam_structure_t), intent(inout) :: beam_structure
procedure(strfun_mode_fun) :: strfun_mode
type(beam_structure_record_t), dimension(:), allocatable :: new
integer :: n_record, i, j
if (.not. allocated (beam_structure%record)) return
do i = 1, size (beam_structure%record)
associate (entry => beam_structure%record(i)%entry)
do j = 1, size (entry)
select case (strfun_mode (entry(j)%name))
case (0); entry(j)%is_valid = .false.
end select
end do
end associate
end do
n_record = 0
do i = 1, size (beam_structure%record)
associate (entry => beam_structure%record(i)%entry)
select case (size (entry))
case (1)
if (entry(1)%is_valid) then
select case (strfun_mode (entry(1)%name))
case (1); n_record = n_record + 2
case (2); n_record = n_record + 1
end select
end if
case (2)
do j = 1, 2
if (entry(j)%is_valid) then
select case (strfun_mode (entry(j)%name))
case (1); n_record = n_record + 1
case (2)
call beam_structure%write ()
call msg_fatal ("Pair spectrum used as &
&single-particle structure function")
end select
end if
end do
end select
end associate
end do
allocate (new (n_record))
n_record = 0
do i = 1, size (beam_structure%record)
associate (entry => beam_structure%record(i)%entry)
select case (size (entry))
case (1)
if (entry(1)%is_valid) then
select case (strfun_mode (entry(1)%name))
case (1)
n_record = n_record + 1
allocate (new(n_record)%entry (2))
new(n_record)%entry(1) = entry(1)
n_record = n_record + 1
allocate (new(n_record)%entry (2))
new(n_record)%entry(2) = entry(1)
case (2)
n_record = n_record + 1
allocate (new(n_record)%entry (1))
new(n_record)%entry(1) = entry(1)
end select
end if
case (2)
do j = 1, 2
if (entry(j)%is_valid) then
n_record = n_record + 1
allocate (new(n_record)%entry (2))
new(n_record)%entry(j) = entry(j)
end if
end do
end select
end associate
end do
call move_alloc (from = new, to = beam_structure%record)
end subroutine beam_structure_expand
@ %def beam_structure_expand
@
\subsection{Polarization}
To record polarization, we provide an allocatable array of [[smatrix]]
objects, sparse matrices. The polarization structure is independent of the
structure-function setup, they are combined only when an actual beam object is
constructed.
<<Beam structures: beam structure: TBP>>=
procedure :: final_pol => beam_structure_final_pol
procedure :: init_pol => beam_structure_init_pol
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_final_pol (beam_structure)
class(beam_structure_t), intent(inout) :: beam_structure
end subroutine beam_structure_final_pol
module subroutine beam_structure_init_pol (beam_structure, n)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: n
end subroutine beam_structure_init_pol
<<Beam structures: procedures>>=
module subroutine beam_structure_final_pol (beam_structure)
class(beam_structure_t), intent(inout) :: beam_structure
if (allocated (beam_structure%smatrix)) deallocate (beam_structure%smatrix)
if (allocated (beam_structure%pol_f)) deallocate (beam_structure%pol_f)
end subroutine beam_structure_final_pol
module subroutine beam_structure_init_pol (beam_structure, n)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: n
if (allocated (beam_structure%smatrix)) deallocate (beam_structure%smatrix)
allocate (beam_structure%smatrix (n))
if (.not. allocated (beam_structure%pol_f)) &
allocate (beam_structure%pol_f (n), source = 1._default)
end subroutine beam_structure_init_pol
@ %def beam_structure_final_pol
@ %def beam_structure_init_pol
@ Check if polarized beams are used.
<<Beam structures: beam structure: TBP>>=
procedure :: has_polarized_beams => beam_structure_has_polarized_beams
<<Beam structures: sub interfaces>>=
elemental module function beam_structure_has_polarized_beams &
(beam_structure) result (pol)
logical :: pol
class(beam_structure_t), intent(in) :: beam_structure
end function beam_structure_has_polarized_beams
<<Beam structures: procedures>>=
elemental module function beam_structure_has_polarized_beams &
(beam_structure) result (pol)
logical :: pol
class(beam_structure_t), intent(in) :: beam_structure
if (allocated (beam_structure%pol_f)) then
pol = any (beam_structure%pol_f /= 0)
else
pol = .false.
end if
end function beam_structure_has_polarized_beams
@ %def beam_structure_has_polarized_beams
@ Directly copy the spin density matrices.
<<Beam structures: beam structure: TBP>>=
procedure :: set_smatrix => beam_structure_set_smatrix
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_set_smatrix (beam_structure, i, smatrix)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i
type(smatrix_t), intent(in) :: smatrix
end subroutine beam_structure_set_smatrix
<<Beam structures: procedures>>=
module subroutine beam_structure_set_smatrix (beam_structure, i, smatrix)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i
type(smatrix_t), intent(in) :: smatrix
beam_structure%smatrix(i) = smatrix
end subroutine beam_structure_set_smatrix
@ %def beam_structure_set_smatrix
@ Initialize one of the spin density matrices manually.
<<Beam structures: beam structure: TBP>>=
procedure :: init_smatrix => beam_structure_init_smatrix
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_init_smatrix (beam_structure, i, n_entry)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i
integer, intent(in) :: n_entry
end subroutine beam_structure_init_smatrix
<<Beam structures: procedures>>=
module subroutine beam_structure_init_smatrix (beam_structure, i, n_entry)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i
integer, intent(in) :: n_entry
call beam_structure%smatrix(i)%init (2, n_entry)
end subroutine beam_structure_init_smatrix
@ %def beam_structure_init_smatrix
@ Set a polarization entry.
<<Beam structures: beam structure: TBP>>=
procedure :: set_sentry => beam_structure_set_sentry
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_set_sentry &
(beam_structure, i, i_entry, index, value)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i
integer, intent(in) :: i_entry
integer, dimension(:), intent(in) :: index
complex(default), intent(in) :: value
end subroutine beam_structure_set_sentry
<<Beam structures: procedures>>=
module subroutine beam_structure_set_sentry &
(beam_structure, i, i_entry, index, value)
class(beam_structure_t), intent(inout) :: beam_structure
integer, intent(in) :: i
integer, intent(in) :: i_entry
integer, dimension(:), intent(in) :: index
complex(default), intent(in) :: value
call beam_structure%smatrix(i)%set_entry (i_entry, index, value)
end subroutine beam_structure_set_sentry
@ %def beam_structure_set_sentry
@ Set the array of polarization fractions.
<<Beam structures: beam structure: TBP>>=
procedure :: set_pol_f => beam_structure_set_pol_f
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_set_pol_f (beam_structure, f)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: f
end subroutine beam_structure_set_pol_f
<<Beam structures: procedures>>=
module subroutine beam_structure_set_pol_f (beam_structure, f)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: f
if (allocated (beam_structure%pol_f)) deallocate (beam_structure%pol_f)
allocate (beam_structure%pol_f (size (f)), source = f)
end subroutine beam_structure_set_pol_f
@ %def beam_structure_set_pol_f
@
\subsection{Beam momenta}
By default, beam momenta are deduced from the [[sqrts]] value or from
the mass of the decaying particle, assuming a c.m.\ setup. Here we
set them explicitly.
<<Beam structures: beam structure: TBP>>=
procedure :: final_mom => beam_structure_final_mom
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_final_mom (beam_structure)
class(beam_structure_t), intent(inout) :: beam_structure
end subroutine beam_structure_final_mom
<<Beam structures: procedures>>=
module subroutine beam_structure_final_mom (beam_structure)
class(beam_structure_t), intent(inout) :: beam_structure
if (allocated (beam_structure%p)) deallocate (beam_structure%p)
if (allocated (beam_structure%theta)) deallocate (beam_structure%theta)
if (allocated (beam_structure%phi)) deallocate (beam_structure%phi)
end subroutine beam_structure_final_mom
@ %def beam_structure_final_mom
<<Beam structures: beam structure: TBP>>=
procedure :: set_momentum => beam_structure_set_momentum
procedure :: set_theta => beam_structure_set_theta
procedure :: set_phi => beam_structure_set_phi
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_set_momentum (beam_structure, p)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: p
end subroutine beam_structure_set_momentum
module subroutine beam_structure_set_theta (beam_structure, theta)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: theta
end subroutine beam_structure_set_theta
module subroutine beam_structure_set_phi (beam_structure, phi)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: phi
end subroutine beam_structure_set_phi
<<Beam structures: procedures>>=
module subroutine beam_structure_set_momentum (beam_structure, p)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: p
if (allocated (beam_structure%p)) deallocate (beam_structure%p)
allocate (beam_structure%p (size (p)), source = p)
end subroutine beam_structure_set_momentum
module subroutine beam_structure_set_theta (beam_structure, theta)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: theta
if (allocated (beam_structure%theta)) deallocate (beam_structure%theta)
allocate (beam_structure%theta (size (theta)), source = theta)
end subroutine beam_structure_set_theta
module subroutine beam_structure_set_phi (beam_structure, phi)
class(beam_structure_t), intent(inout) :: beam_structure
real(default), dimension(:), intent(in) :: phi
if (allocated (beam_structure%phi)) deallocate (beam_structure%phi)
allocate (beam_structure%phi (size (phi)), source = phi)
end subroutine beam_structure_set_phi
@ %def beam_structure_set_momentum
@ %def beam_structure_set_theta
@ %def beam_structure_set_phi
@
\subsection{Get contents}
Look at the incoming particles. We may also have the case that beam
particles are not specified, but polarization.
<<Beam structures: beam structure: TBP>>=
procedure :: is_set => beam_structure_is_set
procedure :: get_n_beam => beam_structure_get_n_beam
procedure :: get_prt => beam_structure_get_prt
<<Beam structures: sub interfaces>>=
module function beam_structure_is_set (beam_structure) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
logical :: flag
end function beam_structure_is_set
module function beam_structure_get_n_beam (beam_structure) result (n)
class(beam_structure_t), intent(in) :: beam_structure
integer :: n
end function beam_structure_get_n_beam
module function beam_structure_get_prt (beam_structure) result (prt)
class(beam_structure_t), intent(in) :: beam_structure
type(string_t), dimension(:), allocatable :: prt
end function beam_structure_get_prt
<<Beam structures: procedures>>=
module function beam_structure_is_set (beam_structure) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
logical :: flag
flag = beam_structure%n_beam > 0 .or. beam_structure%asymmetric ()
end function beam_structure_is_set
module function beam_structure_get_n_beam (beam_structure) result (n)
class(beam_structure_t), intent(in) :: beam_structure
integer :: n
n = beam_structure%n_beam
end function beam_structure_get_n_beam
module function beam_structure_get_prt (beam_structure) result (prt)
class(beam_structure_t), intent(in) :: beam_structure
type(string_t), dimension(:), allocatable :: prt
allocate (prt (size (beam_structure%prt)))
prt = beam_structure%prt
end function beam_structure_get_prt
@ %def beam_structure_is_set
@ %def beam_structure_get_n_beam
@ %def beam_structure_get_prt
@
Return the number of records.
<<Beam structures: beam structure: TBP>>=
procedure :: get_n_record => beam_structure_get_n_record
<<Beam structures: sub interfaces>>=
module function beam_structure_get_n_record (beam_structure) result (n)
class(beam_structure_t), intent(in) :: beam_structure
integer :: n
end function beam_structure_get_n_record
<<Beam structures: procedures>>=
module function beam_structure_get_n_record (beam_structure) result (n)
class(beam_structure_t), intent(in) :: beam_structure
integer :: n
if (allocated (beam_structure%record)) then
n = size (beam_structure%record)
else
n = 0
end if
end function beam_structure_get_n_record
@ %def beam_structure_get_n_record
@ Return an array consisting of the beam indices affected by the valid
entries within a record. After expansion, there should be exactly one
valid entry per record.
<<Beam structures: beam structure: TBP>>=
procedure :: get_i_entry => beam_structure_get_i_entry
<<Beam structures: sub interfaces>>=
module function beam_structure_get_i_entry &
(beam_structure, i) result (i_entry)
class(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: i
integer, dimension(:), allocatable :: i_entry
end function beam_structure_get_i_entry
<<Beam structures: procedures>>=
module function beam_structure_get_i_entry &
(beam_structure, i) result (i_entry)
class(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: i
integer, dimension(:), allocatable :: i_entry
associate (record => beam_structure%record(i))
select case (size (record%entry))
case (1)
if (record%entry(1)%is_valid) then
allocate (i_entry (2), source = [1, 2])
else
allocate (i_entry (0))
end if
case (2)
if (all (record%entry%is_valid)) then
allocate (i_entry (2), source = [1, 2])
else if (record%entry(1)%is_valid) then
allocate (i_entry (1), source = [1])
else if (record%entry(2)%is_valid) then
allocate (i_entry (1), source = [2])
else
allocate (i_entry (0))
end if
end select
end associate
end function beam_structure_get_i_entry
@ %def beam_structure_get_i_entry
@ Return the name of the first valid entry within a record. After
expansion, there should be exactly one valid entry per record.
<<Beam structures: beam structure: TBP>>=
procedure :: get_name => beam_structure_get_name
<<Beam structures: sub interfaces>>=
module function beam_structure_get_name (beam_structure, i) result (name)
type(string_t) :: name
class(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: i
end function beam_structure_get_name
<<Beam structures: procedures>>=
module function beam_structure_get_name (beam_structure, i) result (name)
type(string_t) :: name
class(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: i
associate (record => beam_structure%record(i))
if (record%entry(1)%is_valid) then
name = record%entry(1)%name
else if (size (record%entry) == 2) then
name = record%entry(2)%name
end if
end associate
end function beam_structure_get_name
@ %def beam_structure_get_name
@
<<Beam structures: beam structure: TBP>>=
procedure :: has_pdf => beam_structure_has_pdf
<<Beam structures: sub interfaces>>=
module function beam_structure_has_pdf (beam_structure) result (has_pdf)
logical :: has_pdf
class(beam_structure_t), intent(in) :: beam_structure
end function beam_structure_has_pdf
<<Beam structures: procedures>>=
module function beam_structure_has_pdf (beam_structure) result (has_pdf)
logical :: has_pdf
class(beam_structure_t), intent(in) :: beam_structure
integer :: i
type(string_t) :: name
has_pdf = .false.
do i = 1, beam_structure%get_n_record ()
name = beam_structure%get_name (i)
has_pdf = has_pdf .or. name == var_str ("pdf_builtin") .or. name == var_str ("lhapdf")
end do
end function beam_structure_has_pdf
@ %def beam_structure_has_pdf
@ Return true if the beam structure contains a particular structure
function identifier (such as [[lhapdf]], [[isr]], etc.)
<<Beam structures: beam structure: TBP>>=
procedure :: contains => beam_structure_contains
<<Beam structures: sub interfaces>>=
module function beam_structure_contains (beam_structure, name) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
character(*), intent(in) :: name
logical :: flag
end function beam_structure_contains
<<Beam structures: procedures>>=
module function beam_structure_contains (beam_structure, name) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
character(*), intent(in) :: name
logical :: flag
integer :: i, j
flag = .false.
if (allocated (beam_structure%record)) then
do i = 1, size (beam_structure%record)
do j = 1, size (beam_structure%record(i)%entry)
flag = beam_structure%record(i)%entry(j)%name == name
if (flag) return
end do
end do
end if
end function beam_structure_contains
@ %def beam_structure_contains
@ Return polarization data.
<<Beam structures: beam structure: TBP>>=
procedure :: polarized => beam_structure_polarized
procedure :: get_smatrix => beam_structure_get_smatrix
procedure :: get_pol_f => beam_structure_get_pol_f
procedure :: asymmetric => beam_structure_asymmetric
<<Beam structures: sub interfaces>>=
module function beam_structure_polarized (beam_structure) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
logical :: flag
end function beam_structure_polarized
module function beam_structure_get_smatrix (beam_structure) result (smatrix)
class(beam_structure_t), intent(in) :: beam_structure
type(smatrix_t), dimension(:), allocatable :: smatrix
end function beam_structure_get_smatrix
module function beam_structure_get_pol_f (beam_structure) result (pol_f)
class(beam_structure_t), intent(in) :: beam_structure
real(default), dimension(:), allocatable :: pol_f
end function beam_structure_get_pol_f
module function beam_structure_asymmetric (beam_structure) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
logical :: flag
end function beam_structure_asymmetric
<<Beam structures: procedures>>=
module function beam_structure_polarized (beam_structure) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
logical :: flag
flag = allocated (beam_structure%smatrix)
end function beam_structure_polarized
module function beam_structure_get_smatrix (beam_structure) result (smatrix)
class(beam_structure_t), intent(in) :: beam_structure
type(smatrix_t), dimension(:), allocatable :: smatrix
allocate (smatrix (size (beam_structure%smatrix)), &
source = beam_structure%smatrix)
end function beam_structure_get_smatrix
module function beam_structure_get_pol_f (beam_structure) result (pol_f)
class(beam_structure_t), intent(in) :: beam_structure
real(default), dimension(:), allocatable :: pol_f
allocate (pol_f (size (beam_structure%pol_f)), &
source = beam_structure%pol_f)
end function beam_structure_get_pol_f
module function beam_structure_asymmetric (beam_structure) result (flag)
class(beam_structure_t), intent(in) :: beam_structure
logical :: flag
flag = allocated (beam_structure%p) &
.or. allocated (beam_structure%theta) &
.or. allocated (beam_structure%phi)
end function beam_structure_asymmetric
@ %def beam_structure_polarized
@ %def beam_structure_get_smatrix
@ %def beam_structure_get_pol_f
@ %def beam_structure_asymmetric
@ Return the beam momenta (the space part, i.e., three-momenta). This
is meaningful only if momenta and, optionally, angles have been set.
<<Beam structures: beam structure: TBP>>=
procedure :: get_momenta => beam_structure_get_momenta
<<Beam structures: sub interfaces>>=
module function beam_structure_get_momenta (beam_structure) result (p)
class(beam_structure_t), intent(in) :: beam_structure
type(vector3_t), dimension(:), allocatable :: p
end function beam_structure_get_momenta
<<Beam structures: procedures>>=
module function beam_structure_get_momenta (beam_structure) result (p)
class(beam_structure_t), intent(in) :: beam_structure
type(vector3_t), dimension(:), allocatable :: p
real(default), dimension(:), allocatable :: theta, phi
integer :: n, i
if (allocated (beam_structure%p)) then
n = size (beam_structure%p)
if (allocated (beam_structure%theta)) then
if (size (beam_structure%theta) == n) then
allocate (theta (n), source = beam_structure%theta)
else
call msg_fatal ("Beam structure: mismatch in momentum vs. &
&angle theta specification")
end if
else
allocate (theta (n), source = 0._default)
end if
if (allocated (beam_structure%phi)) then
if (size (beam_structure%phi) == n) then
allocate (phi (n), source = beam_structure%phi)
else
call msg_fatal ("Beam structure: mismatch in momentum vs. &
&angle phi specification")
end if
else
allocate (phi (n), source = 0._default)
end if
allocate (p (n))
do i = 1, n
p(i) = beam_structure%p(i) * vector3_moving ([ &
sin (theta(i)) * cos (phi(i)), &
sin (theta(i)) * sin (phi(i)), &
cos (theta(i))])
end do
if (n == 2) p(2) = - p(2)
else
call msg_fatal ("Beam structure: angle theta/phi specified but &
&momentum/a p undefined")
end if
end function beam_structure_get_momenta
@ %def beam_structure_get_momenta
@ Check for a complete beam structure. The [[applies]] flag tells if
the beam structure should actually be used for a process with the
given [[n_in]] number of incoming particles.
It set if the beam structure matches the process as either decay or
scattering. It is unset if beam structure references a scattering
setup but the process is a decay. It is also unset if the beam
structure itself is empty.
If the beam structure cannot be used, terminate with fatal error.
<<Beam structures: beam structure: TBP>>=
procedure :: check_against_n_in => beam_structure_check_against_n_in
<<Beam structures: sub interfaces>>=
module subroutine beam_structure_check_against_n_in &
(beam_structure, n_in, applies)
class(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: n_in
logical, intent(out) :: applies
end subroutine beam_structure_check_against_n_in
<<Beam structures: procedures>>=
module subroutine beam_structure_check_against_n_in &
(beam_structure, n_in, applies)
class(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: n_in
logical, intent(out) :: applies
if (beam_structure%is_set ()) then
if (n_in == beam_structure%get_n_beam ()) then
applies = .true.
else if (beam_structure%get_n_beam () == 0) then
call msg_fatal &
("Asymmetric beams: missing beam particle specification")
applies = .false.
else
call msg_fatal &
("Mismatch of process and beam setup (scattering/decay)")
applies = .false.
end if
else
applies = .false.
end if
end subroutine beam_structure_check_against_n_in
@ %def beam_structure_check_against_n_in
@
\subsection{Unit Tests}
Test module, followed by the corresponding implementation module.
<<[[beam_structures_ut.f90]]>>=
<<File header>>
module beam_structures_ut
use unit_tests
use beam_structures_uti
<<Standard module head>>
<<Beam structures: public test>>
contains
<<Beam structures: test driver>>
end module beam_structures_ut
@ %def beam_structures_ut
@
<<[[beam_structures_uti.f90]]>>=
<<File header>>
module beam_structures_uti
<<Use kinds>>
<<Use strings>>
use beam_structures
<<Standard module head>>
<<Beam structures: test declarations>>
contains
<<Beam structures: tests>>
<<Beam structures: test auxiliary>>
end module beam_structures_uti
@ %def beam_structures_ut
@ API: driver for the unit tests below.
<<Beam structures: public test>>=
public :: beam_structures_test
<<Beam structures: test driver>>=
subroutine beam_structures_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Beam structures: execute tests>>
end subroutine beam_structures_test
@ %def beam_structures_tests
@
\subsubsection{Empty structure}
<<Beam structures: execute tests>>=
call test (beam_structures_1, "beam_structures_1", &
"empty beam structure record", &
u, results)
<<Beam structures: test declarations>>=
public :: beam_structures_1
<<Beam structures: tests>>=
subroutine beam_structures_1 (u)
integer, intent(in) :: u
type(beam_structure_t) :: beam_structure
write (u, "(A)") "* Test output: beam_structures_1"
write (u, "(A)") "* Purpose: display empty beam structure record"
write (u, "(A)")
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_structures_1"
end subroutine beam_structures_1
@ %def beam_structures_1
@
\subsubsection{Nontrivial configurations}
<<Beam structures: execute tests>>=
call test (beam_structures_2, "beam_structures_2", &
"beam structure records", &
u, results)
<<Beam structures: test declarations>>=
public :: beam_structures_2
<<Beam structures: tests>>=
subroutine beam_structures_2 (u)
integer, intent(in) :: u
type(beam_structure_t) :: beam_structure
integer, dimension(0) :: empty_array
type(string_t) :: s
write (u, "(A)") "* Test output: beam_structures_2"
write (u, "(A)") "* Purpose: setup beam structure records"
write (u, "(A)")
s = "s"
call beam_structure%init_sf ([s], empty_array)
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%init_sf ([s, s], [1])
call beam_structure%set_sf (1, 1, var_str ("a"))
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%init_sf ([s, s], [2])
call beam_structure%set_sf (1, 1, var_str ("a"))
call beam_structure%set_sf (1, 2, var_str ("b"))
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%init_sf ([s, s], [2, 1])
call beam_structure%set_sf (1, 1, var_str ("a"))
call beam_structure%set_sf (1, 2, var_str ("b"))
call beam_structure%set_sf (2, 1, var_str ("c"))
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_structures_2"
end subroutine beam_structures_2
@ %def beam_structures_2
@
\subsubsection{Expansion}
Provide a function that tells, for the dummy structure function names
used here, whether they are considered a two-particle spectrum or a
single-particle structure function:
<<Beam structures: test auxiliary>>=
function test_strfun_mode (name) result (n)
type(string_t), intent(in) :: name
integer :: n
select case (char (name))
case ("a"); n = 2
case ("b"); n = 1
case default; n = 0
end select
end function test_strfun_mode
@ %def test_ist_pair_spectrum
@
<<Beam structures: execute tests>>=
call test (beam_structures_3, "beam_structures_3", &
"beam structure expansion", &
u, results)
<<Beam structures: test declarations>>=
public :: beam_structures_3
<<Beam structures: tests>>=
subroutine beam_structures_3 (u)
integer, intent(in) :: u
type(beam_structure_t) :: beam_structure
type(string_t) :: s
write (u, "(A)") "* Test output: beam_structures_3"
write (u, "(A)") "* Purpose: expand beam structure records"
write (u, "(A)")
s = "s"
write (u, "(A)") "* Pair spectrum (keep as-is)"
write (u, "(A)")
call beam_structure%init_sf ([s, s], [1])
call beam_structure%set_sf (1, 1, var_str ("a"))
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%expand (test_strfun_mode)
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Structure function pair (expand)"
write (u, "(A)")
call beam_structure%init_sf ([s, s], [2])
call beam_structure%set_sf (1, 1, var_str ("b"))
call beam_structure%set_sf (1, 2, var_str ("b"))
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%expand (test_strfun_mode)
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Structure function (separate and expand)"
write (u, "(A)")
call beam_structure%init_sf ([s, s], [1])
call beam_structure%set_sf (1, 1, var_str ("b"))
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%expand (test_strfun_mode)
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Combination"
write (u, "(A)")
call beam_structure%init_sf ([s, s], [1, 1])
call beam_structure%set_sf (1, 1, var_str ("a"))
call beam_structure%set_sf (2, 1, var_str ("b"))
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%expand (test_strfun_mode)
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_structures_3"
end subroutine beam_structures_3
@ %def beam_structures_3
@
\subsubsection{Public methods}
Check the methods that can be called to get the beam-structure
contents.
<<Beam structures: execute tests>>=
call test (beam_structures_4, "beam_structures_4", &
"beam structure contents", &
u, results)
<<Beam structures: test declarations>>=
public :: beam_structures_4
<<Beam structures: tests>>=
subroutine beam_structures_4 (u)
integer, intent(in) :: u
type(beam_structure_t) :: beam_structure
type(string_t) :: s
type(string_t), dimension(2) :: prt
integer :: i
write (u, "(A)") "* Test output: beam_structures_4"
write (u, "(A)") "* Purpose: check the API"
write (u, "(A)")
s = "s"
write (u, "(A)") "* Structure-function combination"
write (u, "(A)")
call beam_structure%init_sf ([s, s], [1, 2, 2])
call beam_structure%set_sf (1, 1, var_str ("a"))
call beam_structure%set_sf (2, 1, var_str ("b"))
call beam_structure%set_sf (3, 2, var_str ("c"))
call beam_structure%write (u)
write (u, *)
write (u, "(1x,A,I0)") "n_beam = ", beam_structure%get_n_beam ()
prt = beam_structure%get_prt ()
write (u, "(1x,A,2(1x,A))") "prt =", char (prt(1)), char (prt(2))
write (u, *)
write (u, "(1x,A,I0)") "n_record = ", beam_structure%get_n_record ()
do i = 1, 3
write (u, "(A)")
write (u, "(1x,A,I0,A,A)") "name(", i, ") = ", &
char (beam_structure%get_name (i))
write (u, "(1x,A,I0,A,2(1x,I0))") "i_entry(", i, ") =", &
beam_structure%get_i_entry (i)
end do
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_structures_4"
end subroutine beam_structures_4
@ %def beam_structures_4
@
\subsubsection{Polarization}
The polarization properties are independent from the structure-function setup.
<<Beam structures: execute tests>>=
call test (beam_structures_5, "beam_structures_5", &
"polarization", &
u, results)
<<Beam structures: test declarations>>=
public :: beam_structures_5
<<Beam structures: tests>>=
subroutine beam_structures_5 (u)
integer, intent(in) :: u
type(beam_structure_t) :: beam_structure
integer, dimension(0) :: empty_array
type(string_t) :: s
write (u, "(A)") "* Test output: beam_structures_5"
write (u, "(A)") "* Purpose: setup polarization in beam structure records"
write (u, "(A)")
s = "s"
call beam_structure%init_sf ([s], empty_array)
call beam_structure%init_pol (1)
call beam_structure%init_smatrix (1, 1)
call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
call beam_structure%set_pol_f ([0.5_default])
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%final_sf ()
call beam_structure%final_pol ()
call beam_structure%init_sf ([s, s], [1])
call beam_structure%set_sf (1, 1, var_str ("a"))
call beam_structure%init_pol (2)
call beam_structure%init_smatrix (1, 2)
call beam_structure%set_sentry (1, 1, [-1,1], (0.5_default,-0.5_default))
call beam_structure%set_sentry (1, 2, [ 1,1], (1._default, 0._default))
call beam_structure%init_smatrix (2, 0)
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_structures_5"
end subroutine beam_structures_5
@ %def beam_structures_5
@
\subsubsection{Momenta}
The momenta are independent from the structure-function setup.
<<Beam structures: execute tests>>=
call test (beam_structures_6, "beam_structures_6", &
"momenta", &
u, results)
<<Beam structures: test declarations>>=
public :: beam_structures_6
<<Beam structures: tests>>=
subroutine beam_structures_6 (u)
integer, intent(in) :: u
type(beam_structure_t) :: beam_structure
integer, dimension(0) :: empty_array
type(string_t) :: s
write (u, "(A)") "* Test output: beam_structures_6"
write (u, "(A)") "* Purpose: setup momenta in beam structure records"
write (u, "(A)")
s = "s"
call beam_structure%init_sf ([s], empty_array)
call beam_structure%set_momentum ([500._default])
call beam_structure%write (u)
write (u, "(A)")
call beam_structure%final_sf ()
call beam_structure%final_mom ()
call beam_structure%init_sf ([s, s], [1])
call beam_structure%set_momentum ([500._default, 700._default])
call beam_structure%set_theta ([0._default, 0.1_default])
call beam_structure%set_phi ([0._default, 1.51_default])
call beam_structure%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_structures_6"
end subroutine beam_structures_6
@ %def beam_structures_6
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Beams for collisions and decays}
<<[[beams.f90]]>>=
<<File header>>
module beams
<<Use kinds>>
<<Use strings>>
use lorentz
use model_data
use flavors
use quantum_numbers
use state_matrices
use interactions
use polarizations
use beam_structures
<<Standard module head>>
<<Beams: public>>
<<Beams: types>>
<<Beams: interfaces>>
interface
<<Beams: sub interfaces>>
end interface
end module beams
@ %def beams
@
<<[[beams_sub.f90]]>>=
<<File header>>
submodule (beams) beams_s
use io_units
use format_defs, only: FMT_19
use numeric_utils
use diagnostics
use md5
implicit none
contains
<<Beams: procedures>>
end submodule beams_s
@ %def beams_s
@
\subsection{Beam data}
The beam data type contains beam data for one or two beams, depending
on whether we are dealing with beam collisions or particle decay. In
addition, it holds the c.m.\ energy [[sqrts]], the Lorentz
transformation [[L]] that transforms the c.m.\ system into the lab
system, and the pair of c.m.\ momenta.
<<Beams: public>>=
public :: beam_data_t
<<Beams: types>>=
type :: beam_data_t
logical :: initialized = .false.
integer :: n = 0
type(flavor_t), dimension(:), allocatable :: flv
real(default), dimension(:), allocatable :: mass
type(pmatrix_t), dimension(:), allocatable :: pmatrix
logical :: lab_is_cm = .true.
type(vector4_t), dimension(:), allocatable :: p_cm
type(vector4_t), dimension(:), allocatable :: p
type(lorentz_transformation_t), allocatable :: L_cm_to_lab
real(default) :: sqrts = 0
character(32) :: md5sum = ""
contains
<<Beams: beam data: TBP>>
end type beam_data_t
@ %def beam_data_t
@ Generic initializer. This is called by the specific initializers
below. Initialize either for decay or for collision.
<<Beams: procedures>>=
subroutine beam_data_init (beam_data, n)
type(beam_data_t), intent(out) :: beam_data
integer, intent(in) :: n
beam_data%n = n
allocate (beam_data%flv (n))
allocate (beam_data%mass (n))
allocate (beam_data%pmatrix (n))
allocate (beam_data%p_cm (n))
allocate (beam_data%p (n))
beam_data%initialized = .true.
end subroutine beam_data_init
@ %def beam_data_init
@ Finalizer: needed for the polarization components of the beams.
<<Beams: beam data: TBP>>=
procedure :: final => beam_data_final
<<Beams: sub interfaces>>=
module subroutine beam_data_final (beam_data)
class(beam_data_t), intent(inout) :: beam_data
end subroutine beam_data_final
<<Beams: procedures>>=
module subroutine beam_data_final (beam_data)
class(beam_data_t), intent(inout) :: beam_data
beam_data%initialized = .false.
end subroutine beam_data_final
@ %def beam_data_final
@ The verbose (default) version is for debugging. The short version
is for screen output in the UI.
<<Beams: beam data: TBP>>=
procedure :: write => beam_data_write
<<Beams: sub interfaces>>=
module subroutine beam_data_write (beam_data, unit, verbose, write_md5sum)
class(beam_data_t), intent(in) :: beam_data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose, write_md5sum
end subroutine beam_data_write
<<Beams: procedures>>=
module subroutine beam_data_write (beam_data, unit, verbose, write_md5sum)
class(beam_data_t), intent(in) :: beam_data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose, write_md5sum
integer :: prt_name_len
logical :: verb, write_md5
integer :: u
u = given_output_unit (unit); if (u < 0) return
verb = .false.; if (present (verbose)) verb = verbose
write_md5 = verb; if (present (write_md5sum)) write_md5 = write_md5sum
if (.not. beam_data%initialized) then
write (u, "(1x,A)") "Beam data: [undefined]"
return
end if
prt_name_len = maxval (len (beam_data%flv%get_name ()))
select case (beam_data%n)
case (1)
write (u, "(1x,A)") "Beam data (decay):"
if (verb) then
call write_prt (1)
call beam_data%pmatrix(1)%write (u)
write (u, *) "R.f. momentum:"
call vector4_write (beam_data%p_cm(1), u)
write (u, *) "Lab momentum:"
call vector4_write (beam_data%p(1), u)
else
call write_prt (1)
end if
case (2)
write (u, "(1x,A)") "Beam data (collision):"
if (verb) then
call write_prt (1)
call beam_data%pmatrix(1)%write (u)
call write_prt (2)
call beam_data%pmatrix(2)%write (u)
call write_sqrts
write (u, *) "C.m. momenta:"
call vector4_write (beam_data%p_cm(1), u)
call vector4_write (beam_data%p_cm(2), u)
write (u, *) "Lab momenta:"
call vector4_write (beam_data%p(1), u)
call vector4_write (beam_data%p(2), u)
else
call write_prt (1)
call write_prt (2)
call write_sqrts
end if
end select
if (allocated (beam_data%L_cm_to_lab)) then
if (verb) then
call lorentz_transformation_write (beam_data%L_cm_to_lab, u)
else
write (u, "(1x,A)") "Beam structure: lab and c.m. frame differ"
end if
end if
if (write_md5) then
write (u, *) "MD5 sum: ", beam_data%md5sum
end if
contains
subroutine write_sqrts
character(80) :: sqrts_str
write (sqrts_str, "(" // FMT_19 // ")") beam_data%sqrts
write (u, "(3x,A)") "sqrts = " // trim (adjustl (sqrts_str)) // " GeV"
end subroutine write_sqrts
subroutine write_prt (i)
integer, intent(in) :: i
character(80) :: name_str, mass_str
write (name_str, "(A)") char (beam_data%flv(i)%get_name ())
write (mass_str, "(ES13.7)") beam_data%mass(i)
write (u, "(3x,A)", advance="no") &
name_str(:prt_name_len) // " (mass = " &
// trim (adjustl (mass_str)) // " GeV)"
if (beam_data%pmatrix(i)%is_polarized ()) then
write (u, "(2x,A)") "polarized"
else
write (u, *)
end if
end subroutine write_prt
end subroutine beam_data_write
@ %def beam_data_write
@ Return initialization status:
<<Beams: beam data: TBP>>=
procedure :: are_valid => beam_data_are_valid
<<Beams: sub interfaces>>=
module function beam_data_are_valid (beam_data) result (flag)
class(beam_data_t), intent(in) :: beam_data
logical :: flag
end function beam_data_are_valid
<<Beams: procedures>>=
module function beam_data_are_valid (beam_data) result (flag)
class(beam_data_t), intent(in) :: beam_data
logical :: flag
flag = beam_data%initialized
end function beam_data_are_valid
@ %def beam_data_are_valid
@ Check whether beam data agree with the current values of relevant
parameters.
<<Beams: beam data: TBP>>=
procedure :: check_scattering => beam_data_check_scattering
<<Beams: sub interfaces>>=
module subroutine beam_data_check_scattering (beam_data, sqrts)
class(beam_data_t), intent(in) :: beam_data
real(default), intent(in), optional :: sqrts
end subroutine beam_data_check_scattering
<<Beams: procedures>>=
module subroutine beam_data_check_scattering (beam_data, sqrts)
class(beam_data_t), intent(in) :: beam_data
real(default), intent(in), optional :: sqrts
if (beam_data_are_valid (beam_data)) then
if (present (sqrts)) then
if (.not. nearly_equal (sqrts, beam_data%sqrts)) then
call msg_error ("Current setting of sqrts is inconsistent " &
// "with beam setup (ignored).")
end if
end if
else
call msg_bug ("Beam setup: invalid beam data")
end if
end subroutine beam_data_check_scattering
@ %def beam_data_check_scattering
@ Return the number of beams (1 for decays, 2 for collisions).
<<Beams: beam data: TBP>>=
procedure :: get_n_in => beam_data_get_n_in
<<Beams: sub interfaces>>=
module function beam_data_get_n_in (beam_data) result (n_in)
class(beam_data_t), intent(in) :: beam_data
integer :: n_in
end function beam_data_get_n_in
<<Beams: procedures>>=
module function beam_data_get_n_in (beam_data) result (n_in)
class(beam_data_t), intent(in) :: beam_data
integer :: n_in
n_in = beam_data%n
end function beam_data_get_n_in
@ %def beam_data_get_n_in
@ Return the beam flavor
<<Beams: beam data: TBP>>=
procedure :: get_flavor => beam_data_get_flavor
<<Beams: sub interfaces>>=
module function beam_data_get_flavor (beam_data) result (flv)
class(beam_data_t), intent(in) :: beam_data
type(flavor_t), dimension(:), allocatable :: flv
end function beam_data_get_flavor
<<Beams: procedures>>=
module function beam_data_get_flavor (beam_data) result (flv)
class(beam_data_t), intent(in) :: beam_data
type(flavor_t), dimension(:), allocatable :: flv
allocate (flv (beam_data%n))
flv = beam_data%flv
end function beam_data_get_flavor
@ %def beam_data_get_flavor
@ Return the beam energies
<<Beams: beam data: TBP>>=
procedure :: get_energy => beam_data_get_energy
<<Beams: sub interfaces>>=
module function beam_data_get_energy (beam_data) result (e)
class(beam_data_t), intent(in) :: beam_data
real(default), dimension(:), allocatable :: e
end function beam_data_get_energy
<<Beams: procedures>>=
module function beam_data_get_energy (beam_data) result (e)
class(beam_data_t), intent(in) :: beam_data
real(default), dimension(:), allocatable :: e
integer :: i
allocate (e (beam_data%n))
if (beam_data%initialized) then
do i = 1, beam_data%n
e(i) = energy (beam_data%p(i))
end do
else
e = 0
end if
end function beam_data_get_energy
@ %def beam_data_get_energy
@ Return the c.m.\ energy.
<<Beams: beam data: TBP>>=
procedure :: get_sqrts => beam_data_get_sqrts
<<Beams: sub interfaces>>=
module function beam_data_get_sqrts (beam_data) result (sqrts)
class(beam_data_t), intent(in) :: beam_data
real(default) :: sqrts
end function beam_data_get_sqrts
<<Beams: procedures>>=
module function beam_data_get_sqrts (beam_data) result (sqrts)
class(beam_data_t), intent(in) :: beam_data
real(default) :: sqrts
sqrts = beam_data%sqrts
end function beam_data_get_sqrts
@ %def beam_data_get_sqrts
@ Return the polarization in case it is just two degrees
<<Beams: beam data: TBP>>=
procedure :: get_polarization => beam_data_get_polarization
<<Beams: sub interfaces>>=
module function beam_data_get_polarization (beam_data) result (pol)
class(beam_data_t), intent(in) :: beam_data
real(default), dimension(beam_data%n) :: pol
end function beam_data_get_polarization
<<Beams: procedures>>=
module function beam_data_get_polarization (beam_data) result (pol)
class(beam_data_t), intent(in) :: beam_data
real(default), dimension(beam_data%n) :: pol
pol = beam_data%pmatrix%get_simple_pol ()
end function beam_data_get_polarization
@ %def beam_data_get_polarization
@
<<Beams: beam data: TBP>>=
procedure :: get_helicity_state_matrix => beam_data_get_helicity_state_matrix
<<Beams: sub interfaces>>=
module function beam_data_get_helicity_state_matrix &
(beam_data) result (state_hel)
type(state_matrix_t) :: state_hel
class(beam_data_t), intent(in) :: beam_data
end function beam_data_get_helicity_state_matrix
<<Beams: procedures>>=
module function beam_data_get_helicity_state_matrix &
(beam_data) result (state_hel)
type(state_matrix_t) :: state_hel
class(beam_data_t), intent(in) :: beam_data
type(polarization_t), dimension(:), allocatable :: pol
integer :: i
allocate (pol (beam_data%n))
do i = 1, beam_data%n
call pol(i)%init_pmatrix (beam_data%pmatrix(i))
end do
call combine_polarization_states (pol, state_hel)
end function beam_data_get_helicity_state_matrix
@ %def beam_data_get_helicity_state_matrix
@
<<Beams: beam data: TBP>>=
procedure :: is_initialized => beam_data_is_initialized
<<Beams: sub interfaces>>=
module function beam_data_is_initialized (beam_data) result (initialized)
logical :: initialized
class(beam_data_t), intent(in) :: beam_data
end function beam_data_is_initialized
<<Beams: procedures>>=
module function beam_data_is_initialized (beam_data) result (initialized)
logical :: initialized
class(beam_data_t), intent(in) :: beam_data
initialized = any (beam_data%pmatrix%exists ())
end function beam_data_is_initialized
@ %def beam_data_is_initialized
@ Return a MD5 checksum for beam data. If no checksum is present
(because beams have not been initialized), compute the checksum of the
sqrts value.
<<Beams: beam data: TBP>>=
procedure :: get_md5sum => beam_data_get_md5sum
<<Beams: sub interfaces>>=
module function beam_data_get_md5sum &
(beam_data, sqrts) result (md5sum_beams)
class(beam_data_t), intent(in) :: beam_data
real(default), intent(in) :: sqrts
character(32) :: md5sum_beams
end function beam_data_get_md5sum
<<Beams: procedures>>=
module function beam_data_get_md5sum &
(beam_data, sqrts) result (md5sum_beams)
class(beam_data_t), intent(in) :: beam_data
real(default), intent(in) :: sqrts
character(32) :: md5sum_beams
character(80) :: buffer
if (beam_data%md5sum /= "") then
md5sum_beams = beam_data%md5sum
else
write (buffer, *) sqrts
md5sum_beams = md5sum (buffer)
end if
end function beam_data_get_md5sum
@ %def beam_data_get_md5sum
@
\subsection{Initializers: beam structure}
Initialize the beam data object from a beam structure object, given energy and
model.
<<Beams: beam data: TBP>>=
procedure :: init_structure => beam_data_init_structure
<<Beams: sub interfaces>>=
module subroutine beam_data_init_structure &
(beam_data, structure, sqrts, model, decay_rest_frame)
class(beam_data_t), intent(out) :: beam_data
type(beam_structure_t), intent(in) :: structure
real(default), intent(in) :: sqrts
class(model_data_t), intent(in), target :: model
logical, intent(in), optional :: decay_rest_frame
end subroutine beam_data_init_structure
<<Beams: procedures>>=
module subroutine beam_data_init_structure &
(beam_data, structure, sqrts, model, decay_rest_frame)
class(beam_data_t), intent(out) :: beam_data
type(beam_structure_t), intent(in) :: structure
integer :: n_beam
real(default), intent(in) :: sqrts
class(model_data_t), intent(in), target :: model
logical, intent(in), optional :: decay_rest_frame
type(flavor_t), dimension(:), allocatable :: flv
n_beam = structure%get_n_beam ()
allocate (flv (n_beam))
call flv%init (structure%get_prt (), model)
if (structure%asymmetric ()) then
if (structure%polarized ()) then
call beam_data%init_momenta (structure%get_momenta (), flv, &
structure%get_smatrix (), structure%get_pol_f ())
else
call beam_data%init_momenta (structure%get_momenta (), flv)
end if
else
select case (n_beam)
case (1)
if (structure%polarized ()) then
call beam_data%init_decay (flv, &
structure%get_smatrix (), structure%get_pol_f (), &
rest_frame = decay_rest_frame)
else
call beam_data%init_decay (flv, &
rest_frame = decay_rest_frame)
end if
case (2)
if (structure%polarized ()) then
call beam_data%init_sqrts (sqrts, flv, &
structure%get_smatrix (), structure%get_pol_f ())
else
call beam_data%init_sqrts (sqrts, flv)
end if
case default
call msg_bug ("Beam data: invalid beam structure object")
end select
end if
end subroutine beam_data_init_structure
@ %def beam_data_init_structure
@
\subsection{Initializers: collisions}
This is the simplest one: just the two flavors, c.m.\ energy,
polarization. Color is inferred from flavor. Beam momenta and c.m.\
momenta coincide.
<<Beams: beam data: TBP>>=
procedure :: init_sqrts => beam_data_init_sqrts
<<Beams: sub interfaces>>=
module subroutine beam_data_init_sqrts &
(beam_data, sqrts, flv, smatrix, pol_f)
class(beam_data_t), intent(out) :: beam_data
real(default), intent(in) :: sqrts
type(flavor_t), dimension(:), intent(in) :: flv
type(smatrix_t), dimension(:), intent(in), optional :: smatrix
real(default), dimension(:), intent(in), optional :: pol_f
end subroutine beam_data_init_sqrts
<<Beams: procedures>>=
module subroutine beam_data_init_sqrts &
(beam_data, sqrts, flv, smatrix, pol_f)
class(beam_data_t), intent(out) :: beam_data
real(default), intent(in) :: sqrts
type(flavor_t), dimension(:), intent(in) :: flv
type(smatrix_t), dimension(:), intent(in), optional :: smatrix
real(default), dimension(:), intent(in), optional :: pol_f
real(default), dimension(size(flv)) :: E, p
call beam_data_init (beam_data, size (flv))
beam_data%sqrts = sqrts
beam_data%lab_is_cm = .true.
select case (beam_data%n)
case (1)
E = sqrts; p = 0
beam_data%p_cm = vector4_moving (E, p, 3)
beam_data%p = beam_data%p_cm
case (2)
beam_data%p_cm = colliding_momenta (sqrts, flv%get_mass ())
beam_data%p = colliding_momenta (sqrts, flv%get_mass ())
end select
call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
end subroutine beam_data_init_sqrts
@ %def beam_data_init_sqrts
@ This version sets beam momenta directly, assuming that they are
asymmetric, i.e., lab frame and c.m.\ frame do not coincide.
Polarization info is deferred to a common initializer.
The Lorentz transformation that we compute here is not actually used
in the calculation; instead, it will be recomputed for each event in
the subroutine [[phs_set_incoming_momenta]]. We compute it here for
the nominal beam setup nevertheless, so we can print it and, in
particular, include it in the MD5 sum.
<<Beams: beam data: TBP>>=
procedure :: init_momenta => beam_data_init_momenta
<<Beams: sub interfaces>>=
module subroutine beam_data_init_momenta &
(beam_data, p3, flv, smatrix, pol_f)
class(beam_data_t), intent(out) :: beam_data
type(vector3_t), dimension(:), intent(in) :: p3
type(flavor_t), dimension(:), intent(in) :: flv
type(smatrix_t), dimension(:), intent(in), optional :: smatrix
real(default), dimension(:), intent(in), optional :: pol_f
end subroutine beam_data_init_momenta
<<Beams: procedures>>=
module subroutine beam_data_init_momenta &
(beam_data, p3, flv, smatrix, pol_f)
class(beam_data_t), intent(out) :: beam_data
type(vector3_t), dimension(:), intent(in) :: p3
type(flavor_t), dimension(:), intent(in) :: flv
type(smatrix_t), dimension(:), intent(in), optional :: smatrix
real(default), dimension(:), intent(in), optional :: pol_f
type(vector4_t) :: p0
type(vector4_t), dimension(:), allocatable :: p, p_cm_rot
real(default), dimension(size(p3)) :: e
real(default), dimension(size(flv)) :: m
type(lorentz_transformation_t) :: L_boost, L_rot
call beam_data_init (beam_data, size (flv))
m = flv%get_mass ()
e = sqrt (p3 ** 2 + m ** 2)
allocate (p (beam_data%n))
p = vector4_moving (e, p3)
p0 = sum (p)
beam_data%p = p
beam_data%lab_is_cm = .false.
beam_data%sqrts = p0 ** 1
L_boost = boost (p0, beam_data%sqrts)
allocate (p_cm_rot (beam_data%n))
p_cm_rot = inverse (L_boost) * p
allocate (beam_data%L_cm_to_lab)
select case (beam_data%n)
case (1)
beam_data%L_cm_to_lab = L_boost
beam_data%p_cm = vector4_at_rest (beam_data%sqrts)
case (2)
L_rot = rotation_to_2nd (3, space_part (p_cm_rot(1)))
beam_data%L_cm_to_lab = L_boost * L_rot
beam_data%p_cm = &
colliding_momenta (beam_data%sqrts, flv%get_mass ())
end select
call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
end subroutine beam_data_init_momenta
@ %def beam_data_init_momenta
@
Final steps:
If requested, rotate the beams in the lab frame, and set
the beam-data components.
<<Beams: procedures>>=
subroutine beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
type(beam_data_t), intent(inout) :: beam_data
type(flavor_t), dimension(:), intent(in) :: flv
type(smatrix_t), dimension(:), intent(in), optional :: smatrix
real(default), dimension(:), intent(in), optional :: pol_f
integer :: i
do i = 1, beam_data%n
beam_data%flv(i) = flv(i)
beam_data%mass(i) = flv(i)%get_mass ()
if (present (smatrix)) then
if (size (smatrix) /= beam_data%n) &
call msg_fatal ("Beam data: &
&polarization density array has wrong dimension")
beam_data%pmatrix(i) = smatrix(i)
if (present (pol_f)) then
if (size (pol_f) /= size (smatrix)) &
call msg_fatal ("Beam data: &
&polarization fraction array has wrong dimension")
call beam_data%pmatrix(i)%normalize (flv(i), pol_f(i))
else
call beam_data%pmatrix(i)%normalize (flv(i), 1._default)
end if
else
call beam_data%pmatrix(i)%init (2, 0)
call beam_data%pmatrix(i)%normalize (flv(i), 0._default)
end if
end do
call beam_data%compute_md5sum ()
end subroutine beam_data_finish_initialization
@ %def beam_data_finish_initialization
@
The MD5 sum is stored within the beam-data record, so it can be
checked for integrity in subsequent runs.
<<Beams: beam data: TBP>>=
procedure :: compute_md5sum => beam_data_compute_md5sum
<<Beams: sub interfaces>>=
module subroutine beam_data_compute_md5sum (beam_data)
class(beam_data_t), intent(inout) :: beam_data
integer :: unit
end subroutine beam_data_compute_md5sum
<<Beams: procedures>>=
module subroutine beam_data_compute_md5sum (beam_data)
class(beam_data_t), intent(inout) :: beam_data
integer :: unit
unit = free_unit ()
open (unit = unit, status = "scratch", action = "readwrite")
call beam_data%write (unit, write_md5sum = .false., &
verbose = .true.)
rewind (unit)
beam_data%md5sum = md5sum (unit)
close (unit)
end subroutine beam_data_compute_md5sum
@ %def beam_data_compute_md5sum
@
\subsection{Initializers: decays}
This is the simplest one: decay in rest frame. We need just flavor
and polarization. Color is inferred from flavor. Beam momentum and
c.m.\ momentum coincide.
<<Beams: beam data: TBP>>=
procedure :: init_decay => beam_data_init_decay
<<Beams: sub interfaces>>=
module subroutine beam_data_init_decay &
(beam_data, flv, smatrix, pol_f, rest_frame)
class(beam_data_t), intent(out) :: beam_data
type(flavor_t), dimension(1), intent(in) :: flv
type(smatrix_t), dimension(1), intent(in), optional :: smatrix
real(default), dimension(:), intent(in), optional :: pol_f
logical, intent(in), optional :: rest_frame
end subroutine beam_data_init_decay
<<Beams: procedures>>=
module subroutine beam_data_init_decay &
(beam_data, flv, smatrix, pol_f, rest_frame)
class(beam_data_t), intent(out) :: beam_data
type(flavor_t), dimension(1), intent(in) :: flv
type(smatrix_t), dimension(1), intent(in), optional :: smatrix
real(default), dimension(:), intent(in), optional :: pol_f
logical, intent(in), optional :: rest_frame
real(default), dimension(1) :: m
m = flv%get_mass ()
if (present (smatrix)) then
call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
else
call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
end if
if (present (rest_frame)) beam_data%lab_is_cm = rest_frame
end subroutine beam_data_init_decay
@ %def beam_data_init_decay
@
\subsection{The beams type}
Beam objects are interaction objects that contain the actual beam
data including polarization and density matrix. For collisions, the
beam object actually contains two beams.
<<Beams: public>>=
public :: beam_t
<<Beams: types>>=
type :: beam_t
private
type(interaction_t) :: int
end type beam_t
@ %def beam_t
@ The constructor contains code that converts beam data into the
(entangled) particle-pair quantum state. First, we set the number of
particles and polarization mask. (The polarization mask is handed
over to all later interactions, so if helicity is diagonal or absent, this fact
is used when constructing the hard-interaction events.) Then, we
construct the entangled state that combines helicity, flavor and color
of the two particles (where flavor and color are unique, while several
helicity states are possible). Then, we transfer this state together
with the associated values from the spin density matrix into the
[[interaction_t]] object.
Calling the [[add_state]] method of the interaction object, we keep
the entries of the helicity density matrix without adding them up.
This ensures that for unpolarized states, we do not normalize but end
up with an $1/N$ entry, where $N$ is the initial-state multiplicity.
<<Beams: public>>=
public :: beam_init
<<Beams: sub interfaces>>=
module subroutine beam_init (beam, beam_data)
type(beam_t), intent(out) :: beam
type(beam_data_t), intent(in), target :: beam_data
end subroutine beam_init
<<Beams: procedures>>=
module subroutine beam_init (beam, beam_data)
type(beam_t), intent(out) :: beam
type(beam_data_t), intent(in), target :: beam_data
logical, dimension(beam_data%n) :: polarized, diagonal
type(quantum_numbers_mask_t), dimension(beam_data%n) :: mask, mask_d
type(state_matrix_t), target :: state_hel, state_fc, state_tmp
type(state_iterator_t) :: it_hel, it_tmp
type(quantum_numbers_t), dimension(:), allocatable :: qn
complex(default) :: value
real(default), parameter :: tolerance = 100 * epsilon (1._default)
polarized = beam_data%pmatrix%is_polarized ()
diagonal = beam_data%pmatrix%is_diagonal ()
mask = quantum_numbers_mask (.false., .false., &
mask_h = .not. polarized, &
mask_hd = diagonal)
mask_d = quantum_numbers_mask (.false., .false., .false., &
mask_hd = polarized .and. diagonal)
call beam%int%basic_init &
(0, 0, beam_data%n, mask = mask, store_values = .true.)
state_hel = beam_data%get_helicity_state_matrix ()
allocate (qn (beam_data%n))
call qn%init (beam_data%flv, color_from_flavor (beam_data%flv, 1))
call state_fc%init ()
call state_fc%add_state (qn)
call merge_state_matrices (state_hel, state_fc, state_tmp)
call it_hel%init (state_hel)
call it_tmp%init (state_tmp)
do while (it_hel%is_valid ())
qn = it_tmp%get_quantum_numbers ()
value = it_hel%get_matrix_element ()
if (any (qn%are_redundant (mask_d))) then
! skip off-diagonal elements for diagonal polarization
else if (abs (value) <= tolerance) then
! skip zero entries
else
call beam%int%add_state (qn, value = value)
end if
call it_hel%advance ()
call it_tmp%advance ()
end do
call beam%int%freeze ()
call beam%int%set_momenta (beam_data%p, outgoing = .true.)
call state_hel%final ()
call state_fc%final ()
call state_tmp%final ()
end subroutine beam_init
@ %def beam_init
@ Finalizer:
<<Beams: public>>=
public :: beam_final
<<Beams: sub interfaces>>=
module subroutine beam_final (beam)
type(beam_t), intent(inout) :: beam
end subroutine beam_final
<<Beams: procedures>>=
module subroutine beam_final (beam)
type(beam_t), intent(inout) :: beam
call beam%int%final ()
end subroutine beam_final
@ %def beam_final
@ I/O:
<<Beams: public>>=
public :: beam_write
<<Beams: sub interfaces>>=
module subroutine beam_write &
(beam, unit, verbose, show_momentum_sum, show_mass, col_verbose)
type(beam_t), intent(in) :: beam
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
logical, intent(in), optional :: col_verbose
end subroutine beam_write
<<Beams: procedures>>=
module subroutine beam_write &
(beam, unit, verbose, show_momentum_sum, show_mass, col_verbose)
type(beam_t), intent(in) :: beam
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
logical, intent(in), optional :: col_verbose
integer :: u
u = given_output_unit (unit); if (u < 0) return
select case (beam%int%get_n_out ())
case (1); write (u, *) "Decaying particle:"
case (2); write (u, *) "Colliding beams:"
end select
call beam%int%basic_write &
(unit, verbose = verbose, show_momentum_sum = &
show_momentum_sum, show_mass = show_mass, &
col_verbose = col_verbose)
end subroutine beam_write
@ %def beam_write
@ Defined assignment: deep copy
<<Beams: public>>=
public :: assignment(=)
<<Beams: interfaces>>=
interface assignment(=)
module procedure beam_assign
end interface
<<Beams: sub interfaces>>=
module subroutine beam_assign (beam_out, beam_in)
type(beam_t), intent(out) :: beam_out
type(beam_t), intent(in) :: beam_in
end subroutine beam_assign
<<Beams: procedures>>=
module subroutine beam_assign (beam_out, beam_in)
type(beam_t), intent(out) :: beam_out
type(beam_t), intent(in) :: beam_in
beam_out%int = beam_in%int
end subroutine beam_assign
@ %def beam_assign
@
\subsection{Inherited procedures}
<<Beams: public>>=
public :: interaction_set_source_link_beam
<<Beams: sub interfaces>>=
module subroutine interaction_set_source_link_beam (int, i, beam1, i1)
type(interaction_t), intent(inout) :: int
type(beam_t), intent(in), target :: beam1
integer, intent(in) :: i, i1
end subroutine interaction_set_source_link_beam
<<Beams: procedures>>=
module subroutine interaction_set_source_link_beam (int, i, beam1, i1)
type(interaction_t), intent(inout) :: int
type(beam_t), intent(in), target :: beam1
integer, intent(in) :: i, i1
call int%set_source_link (i, beam1%int, i1)
end subroutine interaction_set_source_link_beam
@ %def interaction_set_source_link_beam
@
\subsection{Accessing contents}
Return the interaction component -- as a pointer, to avoid any copying.
<<Beams: public>>=
public :: beam_get_int_ptr
<<Beams: sub interfaces>>=
module function beam_get_int_ptr (beam) result (int)
type(interaction_t), pointer :: int
type(beam_t), intent(in), target :: beam
end function beam_get_int_ptr
<<Beams: procedures>>=
module function beam_get_int_ptr (beam) result (int)
type(interaction_t), pointer :: int
type(beam_t), intent(in), target :: beam
int => beam%int
end function beam_get_int_ptr
@ %def beam_get_int_ptr
@ Set beam momenta directly. (Used for cascade decays.)
<<Beams: public>>=
public :: beam_set_momenta
<<Beams: sub interfaces>>=
module subroutine beam_set_momenta (beam, p)
type(beam_t), intent(inout) :: beam
type(vector4_t), dimension(:), intent(in) :: p
end subroutine beam_set_momenta
<<Beams: procedures>>=
module subroutine beam_set_momenta (beam, p)
type(beam_t), intent(inout) :: beam
type(vector4_t), dimension(:), intent(in) :: p
call beam%int%set_momenta (p)
end subroutine beam_set_momenta
@ %def beam_set_momenta
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[beams_ut.f90]]>>=
<<File header>>
module beams_ut
use unit_tests
use beams_uti
<<Standard module head>>
<<Beams: public test>>
contains
<<Beams: test driver>>
end module beams_ut
@ %def beams_ut
@
<<[[beams_uti.f90]]>>=
<<File header>>
module beams_uti
<<Use kinds>>
use lorentz
use flavors
use interactions, only: reset_interaction_counter
use polarizations, only: smatrix_t
use model_data
use beam_structures
use beams
<<Standard module head>>
<<Beams: test declarations>>
contains
<<Beams: tests>>
end module beams_uti
@ %def beams_ut
@ API: driver for the unit tests below.
<<Beams: public test>>=
public :: beams_test
<<Beams: test driver>>=
subroutine beams_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Beams: execute tests>>
end subroutine beams_test
@ %def beams_test
@ Test the basic beam setup.
<<Beams: execute tests>>=
call test (beam_1, "beam_1", &
"check basic beam setup", &
u, results)
<<Beams: test declarations>>=
public :: beam_1
<<Beams: tests>>=
subroutine beam_1 (u)
integer, intent(in) :: u
type(beam_data_t), target :: beam_data
type(beam_t) :: beam
real(default) :: sqrts
type(flavor_t), dimension(2) :: flv
type(smatrix_t), dimension(2) :: smatrix
real(default), dimension(2) :: pol_f
type(model_data_t), target :: model
write (u, "(A)") "* Test output: beam_1"
write (u, "(A)") "* Purpose: test basic beam setup"
write (u, "(A)")
write (u, "(A)") "* Reading model file"
write (u, "(A)")
call reset_interaction_counter ()
call model%init_sm_test ()
write (u, "(A)") "* Unpolarized scattering, massless fermions"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([1,-1], model)
call beam_data%init_sqrts (sqrts, flv)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Unpolarized scattering, massless bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([22,22], model)
call beam_data%init_sqrts (sqrts, flv)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Unpolarized scattering, massive bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([24,-24], model)
call beam_data%init_sqrts (sqrts, flv)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Polarized scattering, massless fermions"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([1,-1], model)
call smatrix(1)%init (2, 1)
call smatrix(1)%set_entry (1, [1,1], (1._default, 0._default))
pol_f(1) = 0.5_default
call smatrix(2)%init (2, 3)
call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
call smatrix(2)%set_entry (2, [-1,-1], (1._default, 0._default))
call smatrix(2)%set_entry (3, [-1,1], (1._default, 0._default))
pol_f(2) = 1._default
call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Semi-polarized scattering, massless bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([22,22], model)
call smatrix(1)%init (2, 0)
pol_f(1) = 0._default
call smatrix(2)%init (2, 1)
call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
pol_f(2) = 1._default
call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Semi-polarized scattering, massive bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([24,-24], model)
call smatrix(1)%init (2, 0)
pol_f(1) = 0._default
call smatrix(2)%init (2, 1)
call smatrix(2)%set_entry (1, [0,0], (1._default, 0._default))
pol_f(2) = 1._default
call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Unpolarized decay, massive boson"
write (u, "(A)")
call reset_interaction_counter ()
call flv(1)%init (23, model)
call beam_data%init_decay (flv(1:1))
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
write (u, "(A)")
write (u, "(A)") "* Polarized decay, massive boson"
write (u, "(A)")
call reset_interaction_counter ()
call flv(1)%init (23, model)
call smatrix(1)%init (2, 1)
call smatrix(1)%set_entry (1, [0,0], (1._default, 0._default))
pol_f(1) = 0.4_default
call beam_data%init_decay (flv(1:1), smatrix(1:1), pol_f(1:1))
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call beam_final (beam)
call beam_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_1"
end subroutine beam_1
@ %def beam_1
@ Test advanced beam setup.
<<Beams: execute tests>>=
call test (beam_2, "beam_2", &
"beam initialization", &
u, results)
<<Beams: test declarations>>=
public :: beam_2
<<Beams: tests>>=
subroutine beam_2 (u)
integer, intent(in) :: u
type(beam_data_t), target :: beam_data
type(beam_t) :: beam
real(default) :: sqrts
type(flavor_t), dimension(2) :: flv
integer, dimension(0) :: no_records
type(beam_structure_t) :: beam_structure
type(model_data_t), target :: model
write (u, "(A)") "* Test output: beam_2"
write (u, "(A)") "* Purpose: transfer beam polarization using &
&beam structure"
write (u, "(A)")
write (u, "(A)") "* Reading model file"
write (u, "(A)")
call model%init_sm_test ()
write (u, "(A)") "* Unpolarized scattering, massless fermions"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([1,-1], model)
call beam_structure%init_sf (flv%get_name (), no_records)
call beam_structure%final_pol ()
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Unpolarized scattering, massless bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([22,22], model)
call beam_structure%init_sf (flv%get_name (), no_records)
call beam_structure%final_pol ()
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Unpolarized scattering, massive bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([24,-24], model)
call beam_structure%init_sf (flv%get_name (), no_records)
call beam_structure%final_pol ()
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Polarized scattering, massless fermions"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([1,-1], model)
call beam_structure%init_sf (flv%get_name (), no_records)
call beam_structure%init_pol (2)
call beam_structure%init_smatrix (1, 1)
call beam_structure%set_sentry (1, 1, [1,1], (1._default, 0._default))
call beam_structure%init_smatrix (2, 3)
call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))
call beam_structure%set_sentry (2, 2, [-1,-1], (1._default, 0._default))
call beam_structure%set_sentry (2, 3, [-1,1], (1._default, 0._default))
call beam_structure%set_pol_f ([0.5_default, 1._default])
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, *)
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
call beam_structure%final_pol ()
call beam_structure%final_sf ()
write (u, "(A)")
write (u, "(A)") "* Semi-polarized scattering, massless bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([22,22], model)
call beam_structure%init_sf (flv%get_name (), no_records)
call beam_structure%init_pol (2)
call beam_structure%init_smatrix (1, 0)
call beam_structure%init_smatrix (2, 1)
call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))
call beam_structure%set_pol_f ([0._default, 1._default])
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Semi-polarized scattering, massive bosons"
write (u, "(A)")
call reset_interaction_counter ()
sqrts = 500
call flv%init ([24,-24], model)
call beam_structure%init_sf (flv%get_name (), no_records)
call beam_structure%init_pol (2)
call beam_structure%init_smatrix (1, 0)
call beam_structure%init_smatrix (2, 1)
call beam_structure%set_sentry (2, 1, [0,0], (1._default, 0._default))
call beam_structure%write (u)
write (u, "(A)")
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
write (u, "(A)")
write (u, "(A)") "* Unpolarized decay, massive boson"
write (u, "(A)")
call reset_interaction_counter ()
call flv(1)%init (23, model)
call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
call beam_structure%final_pol ()
call beam_structure%write (u)
write (u, "(A)")
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
write (u, "(A)")
write (u, "(A)") "* Polarized decay, massive boson"
write (u, "(A)")
call reset_interaction_counter ()
call flv(1)%init (23, model)
call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
call beam_structure%init_pol (1)
call beam_structure%init_smatrix (1, 1)
call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
call beam_structure%set_pol_f ([0.4_default])
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, sqrts, model)
call beam_data%write (u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call beam_final (beam)
call beam_data%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_2"
end subroutine beam_2
@ %def beam_2
@ Test advanced beam setup, completely arbitrary momenta.
<<Beams: execute tests>>=
call test (beam_3, "beam_3", &
"generic beam momenta", &
u, results)
<<Beams: test declarations>>=
public :: beam_3
<<Beams: tests>>=
subroutine beam_3 (u)
integer, intent(in) :: u
type(beam_data_t), target :: beam_data
type(beam_t) :: beam
type(flavor_t), dimension(2) :: flv
integer, dimension(0) :: no_records
type(model_data_t), target :: model
type(beam_structure_t) :: beam_structure
type(vector3_t), dimension(2) :: p3
type(vector4_t), dimension(2) :: p
write (u, "(A)") "* Test output: beam_3"
write (u, "(A)") "* Purpose: set up beams with generic momenta"
write (u, "(A)")
write (u, "(A)") "* Reading model file"
write (u, "(A)")
call reset_interaction_counter ()
call model%init_sm_test ()
write (u, "(A)") "* 1: Scattering process"
write (u, "(A)")
call flv%init ([2212,2212], model)
p3(1) = vector3_moving ([5._default, 0._default, 10._default])
p3(2) = -vector3_moving ([1._default, 1._default, -10._default])
call beam_structure%init_sf (flv%get_name (), no_records)
call beam_structure%set_momentum (p3 ** 1)
call beam_structure%set_theta (polar_angle (p3))
call beam_structure%set_phi (azimuthal_angle (p3))
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, 0._default, model)
call pacify (beam_data%l_cm_to_lab, 1e-20_default)
call beam_data%compute_md5sum ()
call beam_data%write (u, verbose = .true.)
write (u, *)
write (u, "(1x,A)") "Beam momenta reconstructed from LT:"
p = beam_data%L_cm_to_lab * beam_data%p_cm
call pacify (p, 1e-12_default)
call vector4_write (p(1), u)
call vector4_write (p(2), u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
call beam_final (beam)
call beam_data%final ()
call beam_structure%final_sf ()
call beam_structure%final_mom ()
write (u, "(A)")
write (u, "(A)") "* 2: Decay"
write (u, "(A)")
call flv(1)%init (23, model)
p3(1) = vector3_moving ([10._default, 5._default, 50._default])
call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
call beam_structure%set_momentum ([p3(1) ** 1])
call beam_structure%set_theta ([polar_angle (p3(1))])
call beam_structure%set_phi ([azimuthal_angle (p3(1))])
call beam_structure%write (u)
write (u, *)
call beam_data%init_structure (beam_structure, 0._default, model)
call beam_data%write (u, verbose = .true.)
write (u, "(A)")
write (u, "(1x,A)") "Beam momentum reconstructed from LT:"
p(1) = beam_data%L_cm_to_lab * beam_data%p_cm(1)
call pacify (p(1), 1e-12_default)
call vector4_write (p(1), u)
write (u, "(A)")
call beam_init (beam, beam_data)
call beam_write (beam, u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call beam_final (beam)
call beam_data%final ()
call beam_structure%final_sf ()
call beam_structure%final_mom ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: beam_3"
end subroutine beam_3
@ %def beam_3
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Tools}
This module contains auxiliary procedures that can be accessed by the
structure function code.
<<[[sf_aux.f90]]>>=
<<File header>>
module sf_aux
<<Use kinds>>
use constants, only: twopi
use lorentz
<<Standard module head>>
<<SF aux: public>>
<<SF aux: parameters>>
<<SF aux: types>>
interface
<<SF aux: sub interfaces>>
end interface
end module sf_aux
@ %def sf_aux
@
<<[[sf_aux_sub.f90]]>>=
<<File header>>
submodule (sf_aux) sf_aux_s
use io_units
use numeric_utils
implicit none
contains
<<SF aux: procedures>>
end submodule sf_aux_s
@ %def sf_aux_s
@
\subsection{Momentum splitting}
Let us consider first an incoming parton with momentum $k$ and
invariant mass squared $s=k^2$ that splits into two partons with
momenta $q,p$ and invariant masses $t=q^2$ and $u=p^2$. (This is an
abuse of the Mandelstam notation. $t$ is actually the momentum
transfer, assuming that $p$ is radiated and $q$ initiates the hard
process.) The energy is split among the partons such that if $E=k^0$,
we have $q^0 = xE$ and $p^0=\bar x E$, where $\bar x\equiv 1-x$.
We define the angle $\theta$ as the polar angle of $p$ w.r.t.\ the
momentum axis of the incoming momentum $k$. Ignoring azimuthal angle,
we can write the four-momenta in the basis $(E,p_T,p_L)$ as
\begin{equation}
k =
\begin{pmatrix}
E \\ 0 \\ p
\end{pmatrix},
\qquad
p =
\begin{pmatrix}
\bar x E \\ \bar x\bar p\sin\theta \\ \bar x\bar p\cos\theta
\end{pmatrix},
\qquad
q =
\begin{pmatrix}
x E \\ -\bar x\bar p\sin\theta \\ p - \bar x\bar p\cos\theta
\end{pmatrix},
\end{equation}
where the first two mass-shell conditions are
\begin{equation}
p^2 = E^2 - s,
\qquad
\bar p^2 = E^2 - \frac{u}{\bar x^2}.
\end{equation}
The second condition implies that, for positive $u$, $\bar x^2 >
u/E^2$, or equivalently
\begin{equation}
x < 1 - \sqrt{u} / E.
\end{equation}
We are interested in the third mass-shell conditions: $s$ and $u$ are
fixed, so we need $t$ as a function of $\cos\theta$:
\begin{equation}
t = -2\bar x \left(E^2 - p\bar p\cos\theta\right) + s + u.
\end{equation}
Solving for $\cos\theta$, we get
\begin{equation}
\cos\theta = \frac{2\bar x E^2 + t - s - u}{2\bar x p\bar p}.
\end{equation}
We can compute $\sin\theta$ numerically as
$\sin^2\theta=1-\cos^2\theta$, but it is important to reexpress this
in view of numerical stability. To this end, we first determine the
bounds for $t$. The cosine must be between $-1$ and $1$, so the
bounds are
\begin{align}
t_0 &= -2\bar x\left(E^2 + p\bar p\right) + s + u,
\\
t_1 &= -2\bar x\left(E^2 - p\bar p\right) + s + u.
\end{align}
Computing $\sin^2\theta$ from $\cos\theta$ above, we observe that the
numerator is a quadratic polynomial in $t$ which has the zeros $t_0$
and $t_1$, while the common denominator is given by $(2\bar x p\bar
p)^2$. Hence, we can write
\begin{equation}
\sin^2\theta = -\frac{(t - t_0)(t - t_1)}{(2\bar x p\bar p)^2}
\qquad\text{and}\qquad
\cos\theta = \frac{(t-t_0) + (t-t_1)}{4\bar x p\bar p},
\end{equation}
which is free of large cancellations near $t=t_0$ or $t=t_1$.
If all is massless, i.e., $s=u=0$, this simplifies to
\begin{align}
t_0 &= -4\bar x E^2,
&
t_1 &= 0,
\\
\sin^2\theta &= -\frac{t}{\bar x E^2}
\left(1 + \frac{t}{4\bar x E^2}\right),
&
\cos\theta &= 1 + \frac{t}{2\bar x E^2}.
\end{align}
Here is the implementation. First, we define a container for the
kinematical integration limits and some further data.
Note: contents are public only for easy access in unit test.
<<SF aux: public>>=
public :: splitting_data_t
<<SF aux: types>>=
type :: splitting_data_t
! private
logical :: collinear = .false.
real(default) :: x0 = 0
real(default) :: x1
real(default) :: t0
real(default) :: t1
real(default) :: phi0 = 0
real(default) :: phi1 = twopi
real(default) :: E, p, s, u, m2
real(default) :: x, xb, pb
real(default) :: t = 0
real(default) :: phi = 0
contains
<<SF aux: splitting data: TBP>>
end type splitting_data_t
@ %def splitting_data_t
@ I/O for debugging:
<<SF aux: splitting data: TBP>>=
procedure :: write => splitting_data_write
<<SF aux: sub interfaces>>=
module subroutine splitting_data_write (d, unit)
class(splitting_data_t), intent(in) :: d
integer, intent(in), optional :: unit
end subroutine splitting_data_write
<<SF aux: procedures>>=
module subroutine splitting_data_write (d, unit)
class(splitting_data_t), intent(in) :: d
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(A)") "Splitting data:"
write (u, "(2x,A,L1)") "collinear = ", d%collinear
1 format (2x,A,1x,ES15.8)
write (u, 1) "x0 =", d%x0
write (u, 1) "x =", d%x
write (u, 1) "xb =", d%xb
write (u, 1) "x1 =", d%x1
write (u, 1) "t0 =", d%t0
write (u, 1) "t =", d%t
write (u, 1) "t1 =", d%t1
write (u, 1) "phi0 =", d%phi0
write (u, 1) "phi =", d%phi
write (u, 1) "phi1 =", d%phi1
write (u, 1) "E =", d%E
write (u, 1) "p =", d%p
write (u, 1) "pb =", d%pb
write (u, 1) "s =", d%s
write (u, 1) "u =", d%u
write (u, 1) "m2 =", d%m2
end subroutine splitting_data_write
@ %def splitting_data_write
@
\subsection{Constant data}
This is the initializer for the data. The input consists of the
incoming momentum, its invariant mass squared, and the invariant mass
squared of the radiated particle. $m2$ is the \emph{physical} mass
squared of the outgoing particle. The $t$ bounds depend on the chosen $x$
value and cannot be determined yet.
<<SF aux: splitting data: TBP>>=
procedure :: init => splitting_data_init
<<SF aux: sub interfaces>>=
module subroutine splitting_data_init (d, k, mk2, mr2, mo2, collinear)
class(splitting_data_t), intent(out) :: d
type(vector4_t), intent(in) :: k
real(default), intent(in) :: mk2, mr2, mo2
logical, intent(in), optional :: collinear
end subroutine splitting_data_init
<<SF aux: procedures>>=
module subroutine splitting_data_init (d, k, mk2, mr2, mo2, collinear)
class(splitting_data_t), intent(out) :: d
type(vector4_t), intent(in) :: k
real(default), intent(in) :: mk2, mr2, mo2
logical, intent(in), optional :: collinear
if (present (collinear)) d%collinear = collinear
d%E = energy (k)
d%x1 = 1 - sqrt (max (mr2, 0._default)) / d%E
d%p = sqrt (d%E**2 - mk2)
d%s = mk2
d%u = mr2
d%m2 = mo2
end subroutine splitting_data_init
@ %def splitting_data_init
@ Retrieve the $x$ bounds, if needed for $x$ sampling. Generating an
$x$ value is done by the caller, since this is the part that depends
on the nature of the structure function.
<<SF aux: splitting data: TBP>>=
procedure :: get_x_bounds => splitting_get_x_bounds
<<SF aux: sub interfaces>>=
module function splitting_get_x_bounds (d) result (x)
class(splitting_data_t), intent(in) :: d
real(default), dimension(2) :: x
end function splitting_get_x_bounds
<<SF aux: procedures>>=
module function splitting_get_x_bounds (d) result (x)
class(splitting_data_t), intent(in) :: d
real(default), dimension(2) :: x
x = [ d%x0, d%x1 ]
end function splitting_get_x_bounds
@ %def splitting_get_x_bounds
@ Now set the momentum fraction and compute $t_0$ and $t_1$.
[The calculation of $t_1$ is subject to numerical problems. The exact
formula is ($s=m_i^2$, $u=m_r^2$)
\begin{equation}
t_1 = -2\bar x E^2 + m_i^2 + m_r^2
+ 2\bar x \sqrt{E^2-m_i^2}\,\sqrt{E^2 - m_r^2/\bar x^2}.
\end{equation}
The structure-function paradigm is useful only if $E\gg m_i,m_r$. In
a Taylor expansion for large $E$, the leading term cancels. The
expansion of the square roots (to subleading order) yields
\begin{equation}
t_1 = xm_i^2 - \frac{x}{\bar x}m_r^2.
\end{equation}
There are two cases of interest: $m_i=m_o$ and $m_r=0$,
\begin{equation}
t_1 = xm_o^2
\end{equation}
and $m_i=m_r$ and $m_o=0$,
\begin{equation}
t_1 = -\frac{x^2}{\bar x}m_i^2.
\end{equation}
In both cases, $t_1\leq m_o^2$.]
That said, it turns out that taking the $t_1$ evaluation at face value
leads to less problems than the approximation. We express the angles
in terms of $t-t_0$ and $t-t_1$. Numerical noise in $t_1$ can then be
tolerated.
<<SF aux: splitting data: TBP>>=
procedure :: set_t_bounds => splitting_set_t_bounds
<<SF aux: sub interfaces>>=
elemental module subroutine splitting_set_t_bounds (d, x, xb)
class(splitting_data_t), intent(inout) :: d
real(default), intent(in), optional :: x, xb
end subroutine splitting_set_t_bounds
<<SF aux: procedures>>=
elemental module subroutine splitting_set_t_bounds (d, x, xb)
class(splitting_data_t), intent(inout) :: d
real(default), intent(in), optional :: x, xb
real(default) :: tp, tm
if (present (x)) d%x = x
if (present (xb)) d%xb = xb
if (vanishes (d%u)) then
d%pb = d%E
else
if (.not. vanishes (d%xb)) then
d%pb = sqrt (max (d%E**2 - d%u / d%xb**2, 0._default))
else
d%pb = 0
end if
end if
tp = -2 * d%xb * d%E**2 + d%s + d%u
tm = -2 * d%xb * d%p * d%pb
d%t0 = tp + tm
d%t1 = tp - tm
d%t = d%t1
end subroutine splitting_set_t_bounds
@ %def splitting_set_t_bounds
@
\subsection{Sampling recoil}
Compute a value for the momentum transfer $t$, using a random number
$r$. We assume a logarithmic distribution for $t-m^2$, corresponding
to the propagator $1/(t-m^2)$ with the physical mass $m$ for the
outgoing particle. Optionally, we can narrow the kinematical bounds.
If all three masses in the splitting vanish, the upper limit for $t$
is zero. In that case, the $t$ value is set to zero and the splitting
will be collinear.
<<SF aux: splitting data: TBP>>=
procedure :: sample_t => splitting_sample_t
<<SF aux: sub interfaces>>=
module subroutine splitting_sample_t (d, r, t0, t1)
class(splitting_data_t), intent(inout) :: d
real(default), intent(in) :: r
real(default), intent(in), optional :: t0, t1
end subroutine splitting_sample_t
<<SF aux: procedures>>=
module subroutine splitting_sample_t (d, r, t0, t1)
class(splitting_data_t), intent(inout) :: d
real(default), intent(in) :: r
real(default), intent(in), optional :: t0, t1
real(default) :: tt0, tt1, tt0m, tt1m
if (d%collinear) then
d%t = d%t1
else
tt0 = d%t0; if (present (t0)) tt0 = max (t0, tt0)
tt1 = d%t1; if (present (t1)) tt1 = min (t1, tt1)
tt0m = tt0 - d%m2
tt1m = tt1 - d%m2
if (tt0m < 0 .and. tt1m < 0 .and. abs(tt0m) > &
epsilon(tt0m) .and. abs(tt1m) > epsilon(tt0m)) then
d%t = d%m2 + tt0m * exp (r * log (tt1m / tt0m))
else
d%t = tt1
end if
end if
end subroutine splitting_sample_t
@ %def splitting_sample_t
@ The inverse operation: Given $t$, we recover the value of $r$ that
would have produced this value.
<<SF aux: splitting data: TBP>>=
procedure :: inverse_t => splitting_inverse_t
<<SF aux: sub interfaces>>=
module subroutine splitting_inverse_t (d, r, t0, t1)
class(splitting_data_t), intent(in) :: d
real(default), intent(out) :: r
real(default), intent(in), optional :: t0, t1
end subroutine splitting_inverse_t
<<SF aux: procedures>>=
module subroutine splitting_inverse_t (d, r, t0, t1)
class(splitting_data_t), intent(in) :: d
real(default), intent(out) :: r
real(default), intent(in), optional :: t0, t1
real(default) :: tt0, tt1, tt0m, tt1m
if (d%collinear) then
r = 0
else
tt0 = d%t0; if (present (t0)) tt0 = max (t0, tt0)
tt1 = d%t1; if (present (t1)) tt1 = min (t1, tt1)
tt0m = tt0 - d%m2
tt1m = tt1 - d%m2
if (tt0m < 0 .and. tt1m < 0) then
r = log ((d%t - d%m2) / tt0m) / log (tt1m / tt0m)
else
r = 0
end if
end if
end subroutine splitting_inverse_t
@ %def splitting_inverse_t
@ This is trivial, but provided for convenience:
<<SF aux: splitting data: TBP>>=
procedure :: sample_phi => splitting_sample_phi
<<SF aux: sub interfaces>>=
module subroutine splitting_sample_phi (d, r)
class(splitting_data_t), intent(inout) :: d
real(default), intent(in) :: r
end subroutine splitting_sample_phi
<<SF aux: procedures>>=
module subroutine splitting_sample_phi (d, r)
class(splitting_data_t), intent(inout) :: d
real(default), intent(in) :: r
if (d%collinear) then
d%phi = 0
else
d%phi = (1-r) * d%phi0 + r * d%phi1
end if
end subroutine splitting_sample_phi
@ %def splitting_sample_phi
@ Inverse:
<<SF aux: splitting data: TBP>>=
procedure :: inverse_phi => splitting_inverse_phi
<<SF aux: sub interfaces>>=
module subroutine splitting_inverse_phi (d, r)
class(splitting_data_t), intent(in) :: d
real(default), intent(out) :: r
end subroutine splitting_inverse_phi
<<SF aux: procedures>>=
module subroutine splitting_inverse_phi (d, r)
class(splitting_data_t), intent(in) :: d
real(default), intent(out) :: r
if (d%collinear) then
r = 0
else
r = (d%phi - d%phi0) / (d%phi1 - d%phi0)
end if
end subroutine splitting_inverse_phi
@ %def splitting_inverse_phi
@
\subsection{Splitting}
In this function, we actually perform the splitting. The incoming momentum
$k$ is split into (if no recoil) $q_1=(1-x)k$ and $q_2=xk$.
Apart from the splitting data, we need the incoming momentum $k$, the momentum
transfer $t$, and the azimuthal angle $\phi$. The momentum fraction $x$ is
already known here.
Alternatively, we can split without recoil. The azimuthal angle is
irrelevant, and the momentum transfer is always equal to the upper
limit $t_1$, so the polar angle is zero. Obviously, if there are
nonzero masses it is not possible to keep both energy-momentum
conservation and at the same time all particles on shell. We choose
for dropping the on-shell condition here.
<<SF aux: splitting data: TBP>>=
procedure :: split_momentum => splitting_split_momentum
<<SF aux: sub interfaces>>=
module function splitting_split_momentum (d, k) result (q)
class(splitting_data_t), intent(in) :: d
type(vector4_t), dimension(2) :: q
type(vector4_t), intent(in) :: k
end function splitting_split_momentum
<<SF aux: procedures>>=
module function splitting_split_momentum (d, k) result (q)
class(splitting_data_t), intent(in) :: d
type(vector4_t), dimension(2) :: q
type(vector4_t), intent(in) :: k
real(default) :: st2, ct2, st, ct, cp, sp
type(lorentz_transformation_t) :: rot
real(default) :: tt0, tt1, den
type(vector3_t) :: kk, q1, q2
if (d%collinear) then
if (vanishes (d%s) .and. vanishes(d%u)) then
q(1) = d%xb * k
q(2) = d%x * k
else
kk = space_part (k)
q1 = d%xb * (d%pb / d%p) * kk
q2 = kk - q1
q(1) = vector4_moving (d%xb * d%E, q1)
q(2) = vector4_moving (d%x * d%E, q2)
end if
else
den = 2 * d%xb * d%p * d%pb
tt0 = max (d%t - d%t0, 0._default)
tt1 = min (d%t - d%t1, 0._default)
if (den**2 <= epsilon(den)) then
st2 = 0
else
st2 = - (tt0 * tt1) / den ** 2
end if
if (st2 > 1) then
st2 = 1
end if
ct2 = 1 - st2
st = sqrt (max (st2, 0._default))
ct = sqrt (max (ct2, 0._default))
if ((d%t - d%t0 + d%t - d%t1) < 0) then
ct = - ct
end if
sp = sin (d%phi)
cp = cos (d%phi)
rot = rotation_to_2nd (3, space_part (k))
q1 = vector3_moving (d%xb * d%pb * [st * cp, st * sp, ct])
q2 = vector3_moving (d%p, 3) - q1
q(1) = rot * vector4_moving (d%xb * d%E, q1)
q(2) = rot * vector4_moving (d%x * d%E, q2)
end if
end function splitting_split_momentum
@ %def splitting_split_momentum
@
Momenta generated by splitting will in general be off-shell. They are
on-shell only if they are collinear and massless. This subroutine
puts them on shell by brute force, violating either momentum or energy
conservation. The direction of three-momentum is always retained.
If the energy is below mass shell, we return a zero momentum.
<<SF aux: parameters>>=
integer, parameter, public :: KEEP_ENERGY = 0, KEEP_MOMENTUM = 1
@ %def KEEP_ENERGY KEEP_MOMENTUM
<<SF aux: public>>=
public :: on_shell
<<SF aux: sub interfaces>>=
elemental module subroutine on_shell (p, m2, keep)
type(vector4_t), intent(inout) :: p
real(default), intent(in) :: m2
integer, intent(in) :: keep
end subroutine on_shell
<<SF aux: procedures>>=
elemental module subroutine on_shell (p, m2, keep)
type(vector4_t), intent(inout) :: p
real(default), intent(in) :: m2
integer, intent(in) :: keep
real(default) :: E, E2, pn
select case (keep)
case (KEEP_ENERGY)
E = energy (p)
E2 = E ** 2
if (E2 >= m2) then
pn = sqrt (E2 - m2)
p = vector4_moving (E, pn * direction (space_part (p)))
else
p = vector4_null
end if
case (KEEP_MOMENTUM)
E = sqrt (space_part (p) ** 2 + m2)
p = vector4_moving (E, space_part (p))
end select
end subroutine on_shell
@ %def on_shell
@
\subsection{Recovering the splitting}
This is the inverse problem. We have on-shell momenta and want to
deduce the splitting parameters $x$, $t$, and $\phi$.
Update 2018-08-22: As a true inverse to [[splitting_split_momentum]], we now use
not just a single momentum [[q2]] as before, but the momentum pair [[q1]], [[q2]]
for recovering $x$ and $\bar x$ separately. If $x$ happens to be
close to $1$, we would completely lose the tiny $\bar x$ value,
otherwise, and thus get a meaningless result.
<<SF aux: splitting data: TBP>>=
procedure :: recover => splitting_recover
<<SF aux: sub interfaces>>=
module subroutine splitting_recover (d, k, q, keep)
class(splitting_data_t), intent(inout) :: d
type(vector4_t), intent(in) :: k
type(vector4_t), dimension(2), intent(in) :: q
integer, intent(in) :: keep
end subroutine splitting_recover
<<SF aux: procedures>>=
module subroutine splitting_recover (d, k, q, keep)
class(splitting_data_t), intent(inout) :: d
type(vector4_t), intent(in) :: k
type(vector4_t), dimension(2), intent(in) :: q
integer, intent(in) :: keep
type(lorentz_transformation_t) :: rot
type(vector4_t) :: k0
type(vector4_t), dimension(2) :: q0
real(default) :: p1, p2, p3, pt2, pp2, pl
real(default) :: aux, den, norm
real(default) :: st2, ct2, ct
rot = inverse (rotation_to_2nd (3, space_part (k)))
q0 = rot * q
p1 = vector4_get_component (q0(2), 1)
p2 = vector4_get_component (q0(2), 2)
p3 = vector4_get_component (q0(2), 3)
pt2 = p1 ** 2 + p2 ** 2
pp2 = p1 ** 2 + p2 ** 2 + p3 ** 2
pl = abs (p3)
k0 = vector4_moving (d%E, d%p, 3)
select case (keep)
case (KEEP_ENERGY)
d%x = energy (q0(2)) / d%E
d%xb = energy (q0(1)) / d%E
call d%set_t_bounds ()
if (.not. d%collinear) then
aux = (d%xb * d%pb) ** 2 * pp2 - d%p ** 2 * pt2
den = d%p ** 2 - (d%xb * d%pb) ** 2
if (aux >= 0 .and. den > 0) then
norm = (d%p * pl + sqrt (aux)) / den
else
norm = 1
end if
end if
case (KEEP_MOMENTUM)
d%xb = sqrt (space_part (q0(1)) ** 2 + d%u) / d%E
d%x = 1 - d%xb
call d%set_t_bounds ()
norm = 1
end select
if (d%collinear) then
d%t = d%t1
d%phi = 0
else
if ((d%xb * d%pb * norm)**2 < epsilon(d%xb)) then
st2 = 1
else
st2 = pt2 / (d%xb * d%pb * norm ) ** 2
end if
if (st2 > 1) then
st2 = 1
end if
ct2 = 1 - st2
ct = sqrt (max (ct2, 0._default))
if (.not. vanishes (1 + ct)) then
d%t = d%t1 - 2 * d%xb * d%p * d%pb * st2 / (1 + ct)
else
d%t = d%t0
end if
if (.not. vanishes (p1) .or. .not. vanishes (p2)) then
d%phi = atan2 (-p2, -p1)
else
d%phi = 0
end if
end if
end subroutine splitting_recover
@ %def splitting_recover
@
\subsection{Extract data}
<<SF aux: splitting data: TBP>>=
procedure :: get_x => splitting_get_x
procedure :: get_xb => splitting_get_xb
<<SF aux: sub interfaces>>=
module function splitting_get_x (sd) result (x)
class(splitting_data_t), intent(in) :: sd
real(default) :: x
end function splitting_get_x
module function splitting_get_xb (sd) result (xb)
class(splitting_data_t), intent(in) :: sd
real(default) :: xb
end function splitting_get_xb
<<SF aux: procedures>>=
module function splitting_get_x (sd) result (x)
class(splitting_data_t), intent(in) :: sd
real(default) :: x
x = sd%x
end function splitting_get_x
module function splitting_get_xb (sd) result (xb)
class(splitting_data_t), intent(in) :: sd
real(default) :: xb
xb = sd%xb
end function splitting_get_xb
@ %def splitting_get_x
@ %def splitting_get_xb
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_aux_ut.f90]]>>=
<<File header>>
module sf_aux_ut
use unit_tests
use sf_aux_uti
<<Standard module head>>
<<SF aux: public test>>
contains
<<SF aux: test driver>>
end module sf_aux_ut
@ %def sf_aux_ut
@
<<[[sf_aux_uti.f90]]>>=
<<File header>>
module sf_aux_uti
<<Use kinds>>
use numeric_utils, only: pacify
use lorentz
use sf_aux
<<Standard module head>>
<<SF aux: test declarations>>
contains
<<SF aux: tests>>
end module sf_aux_uti
@ %def sf_aux_ut
@ API: driver for the unit tests below.
<<SF aux: public test>>=
public :: sf_aux_test
<<SF aux: test driver>>=
subroutine sf_aux_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF aux: execute tests>>
end subroutine sf_aux_test
@ %def sf_aux_test
@
\subsubsection{Momentum splitting: massless radiation}
Compute momentum splitting for generic kinematics. It turns out that
for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
lower bounds (this can be directly seen from the logarithmic
distribution in the function [[sample_t]] for $r \equiv x = 1 - x =
0.5$), we arrive at an exact number $t=-0.15$ for the given
input values.
<<SF aux: execute tests>>=
call test (sf_aux_1, "sf_aux_1", &
"massless radiation", &
u, results)
<<SF aux: test declarations>>=
public :: sf_aux_1
<<SF aux: tests>>=
subroutine sf_aux_1 (u)
integer, intent(in) :: u
type(splitting_data_t) :: sd
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q, q0
real(default) :: E, mk, mp, mq
real(default) :: x, r1, r2, r1o, r2o
real(default) :: k2, q0_2, q1_2, q2_2
write (u, "(A)") "* Test output: sf_aux_1"
write (u, "(A)") "* Purpose: compute momentum splitting"
write (u, "(A)") " (massless radiated particle)"
write (u, "(A)")
E = 1
mk = 0.3_default
mp = 0
mq = mk
k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
k2 = k ** 2; call pacify (k2, 1e-10_default)
x = 0.6_default
r1 = 0.5_default
r2 = 0.125_default
write (u, "(A)") "* (1) Non-collinear setup"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%sample_t (r1)
call sd%sample_phi (r2)
call sd%write (u)
q = sd%split_momentum (k)
q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: s"
write (u, "(2(1x,F11.8))") sd%s, k2
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") sd%t, q2_2
write (u, "(A)") "Compare: u"
write (u, "(2(1x,F11.8))") sd%u, q1_2
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)
write (u, "(A)")
write (u, "(A)") "Extract: x, 1-x"
write (u, "(2(1x,F11.8))") sd%get_x (), sd%get_xb ()
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep energy)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q0_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%recover (k, q0, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
call sd%inverse_t (r1o)
write (u, "(A)") "Compare: r1"
write (u, "(2(1x,F11.8))") r1, r1o
call sd%inverse_phi (r2o)
write (u, "(A)") "Compare: r2"
write (u, "(2(1x,F11.8))") r2, r2o
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep momentum)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q0_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%recover (k, q0, KEEP_MOMENTUM)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
call sd%inverse_t (r1o)
write (u, "(A)") "Compare: r1"
write (u, "(2(1x,F11.8))") r1, r1o
call sd%inverse_phi (r2o)
write (u, "(A)") "Compare: r2"
write (u, "(2(1x,F11.8))") r2, r2o
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* (2) Collinear setup"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, 1 - x)
call sd%write (u)
q = sd%split_momentum (k)
q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: s"
write (u, "(2(1x,F11.8))") sd%s, k2
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") sd%t, q2_2
write (u, "(A)") "Compare: u"
write (u, "(2(1x,F11.8))") sd%u, q1_2
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep energy)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q0_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%recover (k, q0, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep momentum)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q0_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%recover (k, q0, KEEP_MOMENTUM)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_aux_1"
end subroutine sf_aux_1
@ %def sf_aux_1
@
\subsubsection{Momentum splitting: massless parton}
Compute momentum splitting for generic kinematics. It turns out that
for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
lower bounds, we arrive at an exact number $t=-0.36$ for the given
input values.
<<SF aux: execute tests>>=
call test (sf_aux_2, "sf_aux_2", &
"massless parton", &
u, results)
<<SF aux: test declarations>>=
public :: sf_aux_2
<<SF aux: tests>>=
subroutine sf_aux_2 (u)
integer, intent(in) :: u
type(splitting_data_t) :: sd
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q, q0
real(default) :: E, mk, mp, mq
real(default) :: x, r1, r2, r1o, r2o
real(default) :: k2, q02_2, q1_2, q2_2
write (u, "(A)") "* Test output: sf_aux_2"
write (u, "(A)") "* Purpose: compute momentum splitting"
write (u, "(A)") " (massless outgoing particle)"
write (u, "(A)")
E = 1
mk = 0.3_default
mp = mk
mq = 0
k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
k2 = k ** 2; call pacify (k2, 1e-10_default)
x = 0.6_default
r1 = 0.5_default
r2 = 0.125_default
write (u, "(A)") "* (1) Non-collinear setup"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%sample_t (r1)
call sd%sample_phi (r2)
call sd%write (u)
q = sd%split_momentum (k)
q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: s"
write (u, "(2(1x,F11.8))") sd%s, k2
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") sd%t, q2_2
write (u, "(A)") "Compare: u"
write (u, "(2(1x,F11.8))") sd%u, q1_2
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep energy)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
call sd%inverse_t (r1o)
write (u, "(A)") "Compare: r1"
write (u, "(2(1x,F11.8))") r1, r1o
call sd%inverse_phi (r2o)
write (u, "(A)") "Compare: r2"
write (u, "(2(1x,F11.8))") r2, r2o
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep momentum)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_MOMENTUM)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
call sd%inverse_t (r1o)
write (u, "(A)") "Compare: r1"
write (u, "(2(1x,F11.8))") r1, r1o
call sd%inverse_phi (r2o)
write (u, "(A)") "Compare: r2"
write (u, "(2(1x,F11.8))") r2, r2o
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* (2) Collinear setup"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, 1 - x)
call sd%write (u)
q = sd%split_momentum (k)
q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: s"
write (u, "(2(1x,F11.8))") sd%s, k2
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") sd%t, q2_2
write (u, "(A)") "Compare: u"
write (u, "(2(1x,F11.8))") sd%u, q1_2
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep energy)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep momentum)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_MOMENTUM)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_aux_2"
end subroutine sf_aux_2
@ %def sf_aux_2
@
\subsubsection{Momentum splitting: all massless}
Compute momentum splitting for massless kinematics. In the non-collinear
case, we need a lower cutoff for $|t|$, otherwise a logarithmic distribution
is not possible.
<<SF aux: execute tests>>=
call test (sf_aux_3, "sf_aux_3", &
"massless parton", &
u, results)
<<SF aux: test declarations>>=
public :: sf_aux_3
<<SF aux: tests>>=
subroutine sf_aux_3 (u)
integer, intent(in) :: u
type(splitting_data_t) :: sd
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q, q0
real(default) :: E, mk, mp, mq, qmin, qmax
real(default) :: x, r1, r2, r1o, r2o
real(default) :: k2, q02_2, q1_2, q2_2
write (u, "(A)") "* Test output: sf_aux_3"
write (u, "(A)") "* Purpose: compute momentum splitting"
write (u, "(A)") " (all massless, q cuts)"
write (u, "(A)")
E = 1
mk = 0
mp = 0
mq = 0
qmin = 1e-2_default
qmax = 1e0_default
k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
k2 = k ** 2; call pacify (k2, 1e-10_default)
x = 0.6_default
r1 = 0.5_default
r2 = 0.125_default
write (u, "(A)") "* (1) Non-collinear setup"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%sample_t (r1, t1 = - qmin ** 2, t0 = - qmax **2)
call sd%sample_phi (r2)
call sd%write (u)
q = sd%split_momentum (k)
q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: s"
write (u, "(2(1x,F11.8))") sd%s, k2
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") sd%t, q2_2
write (u, "(A)") "Compare: u"
write (u, "(2(1x,F11.8))") sd%u, q1_2
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep energy)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
call sd%inverse_t (r1o, t1 = - qmin ** 2, t0 = - qmax **2)
write (u, "(A)") "Compare: r1"
write (u, "(2(1x,F11.8))") r1, r1o
call sd%inverse_phi (r2o)
write (u, "(A)") "Compare: r2"
write (u, "(2(1x,F11.8))") r2, r2o
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep momentum)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_MOMENTUM)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
call sd%inverse_t (r1o, t1 = - qmin ** 2, t0 = - qmax **2)
write (u, "(A)") "Compare: r1"
write (u, "(2(1x,F11.8))") r1, r1o
call sd%inverse_phi (r2o)
write (u, "(A)") "Compare: r2"
write (u, "(2(1x,F11.8))") r2, r2o
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* (2) Collinear setup"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, 1 - x)
call sd%write (u)
q = sd%split_momentum (k)
q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: s"
write (u, "(2(1x,F11.8))") sd%s, k2
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") sd%t, q2_2
write (u, "(A)") "Compare: u"
write (u, "(2(1x,F11.8))") sd%u, q1_2
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep energy)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Project on-shell (keep momentum)"
q0 = q
call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q0), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q0(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q0(2), u)
write (u, "(A)")
write (u, "(A)") "Compare: mo^2"
q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
write (u, "(2(1x,F11.8))") sd%m2, q02_2
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momentum"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2)
call sd%set_t_bounds (x, 1 - x)
call sd%recover (k, q0, KEEP_MOMENTUM)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: t"
write (u, "(2(1x,F11.8))") q2_2, sd%t
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_aux_3"
end subroutine sf_aux_3
@ %def sf_aux_3
@
\subsubsection{Endpoint stability}
Compute momentum splitting for collinear kinematics close to both
endpoints. In particular, check both directions $x\to$ momenta and
momenta $\to x$.
For purely massless collinear splitting, the [[KEEP_XXX]] flag is
irrelevant. We choose [[KEEP_ENERGY]] here.
<<SF aux: execute tests>>=
call test (sf_aux_4, "sf_aux_4", &
"endpoint numerics", &
u, results)
<<SF aux: test declarations>>=
public :: sf_aux_4
<<SF aux: tests>>=
subroutine sf_aux_4 (u)
integer, intent(in) :: u
type(splitting_data_t) :: sd
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E, mk, mp, mq, qmin, qmax
real(default) :: x, xb
write (u, "(A)") "* Test output: sf_aux_4"
write (u, "(A)") "* Purpose: compute massless collinear splitting near endpoint"
E = 1
mk = 0
mp = 0
mq = 0
qmin = 1e-2_default
qmax = 1e0_default
k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
x = 0.1_default
xb = 1 - x
write (u, "(A)")
write (u, "(A)") "* (1) Collinear setup, moderate kinematics"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, xb)
call sd%write (u)
q = sd%split_momentum (k)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momenta"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, xb)
call sd%recover (k, q, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") xb, sd%xb
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* (2) Close to x=0"
write (u, "(A)")
x = 1e-9_default
xb = 1 - x
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, xb)
call sd%write (u)
q = sd%split_momentum (k)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momenta"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, xb)
call sd%recover (k, q, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") xb, sd%xb
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* (3) Close to x=1"
write (u, "(A)")
xb = 1e-9_default
x = 1 - xb
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, xb)
call sd%write (u)
q = sd%split_momentum (k)
write (u, "(A)")
write (u, "(A)") "Incoming momentum k ="
call vector4_write (k, u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum sum p + q ="
call vector4_write (sum (q), u)
write (u, "(A)")
write (u, "(A)") "Radiated momentum p ="
call vector4_write (q(1), u)
write (u, "(A)")
write (u, "(A)") "Outgoing momentum q ="
call vector4_write (q(2), u)
write (u, "(A)")
write (u, "(A)") "* Recover parameters from outgoing momenta"
write (u, "(A)")
call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
call sd%set_t_bounds (x, xb)
call sd%recover (k, q, KEEP_ENERGY)
write (u, "(A)") "Compare: x"
write (u, "(2(1x,F11.8))") x, sd%x
write (u, "(A)") "Compare: 1-x"
write (u, "(2(1x,F11.8))") xb, sd%xb
write (u, "(A)")
call sd%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_aux_4"
end subroutine sf_aux_4
@ %def sf_aux_4
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Mappings for structure functions}
In this module, we provide a wrapper for useful mappings of the unit
(hyper-)square that we can apply to a set of structure functions.
In some cases it is useful, or even mandatory, to map the MC input
parameters nontrivially onto a set of structure functions for the two
beams. In all cases considered here, instead of $x_1,x_2,\ldots$ as
parameters for the beams, we generate one parameter that is equal, or
related to, the product $x_1x_2\cdots$ (so it directly corresponds to
$\sqrt{s}$). The other parameters describe the distribution of energy
(loss) between beams and radiations.
<<[[sf_mappings.f90]]>>=
<<File header>>
module sf_mappings
<<Use kinds>>
use kinds, only: double
<<Standard module head>>
<<SF mappings: public>>
<<SF mappings: parameters>>
<<SF mappings: types>>
<<SF mappings: interfaces>>
interface
<<SF mappings: sub interfaces>>
end interface
contains
<<SF mappings: main procedures>>
end module sf_mappings
@ %def sf_mappings
@
<<[[sf_mappings_sub.f90]]>>=
<<File header>>
submodule (sf_mappings) sf_mappings_s
use io_units
use constants, only: pi, zero, one
use numeric_utils
use diagnostics
implicit none
contains
<<SF mappings: procedures>>
end submodule sf_mappings_s
@ %def sf_mappings_s
@
\subsection{Base type}
First, we define an abstract base type for the mapping. In all cases
we need to store the indices of the parameters on which the mapping
applies. Additional parameters can be stored in the extensions of
this type.
<<SF mappings: public>>=
public :: sf_mapping_t
<<SF mappings: types>>=
type, abstract :: sf_mapping_t
integer, dimension(:), allocatable :: i
contains
<<SF mappings: sf mapping: TBP>>
end type sf_mapping_t
@ %def sf_mapping_t
@ The output routine is deferred:
<<SF mappings: sf mapping: TBP>>=
procedure (sf_mapping_write), deferred :: write
<<SF mappings: interfaces>>=
abstract interface
subroutine sf_mapping_write (object, unit)
import
class(sf_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_mapping_write
end interface
@ %def sf_mapping_write
@ Initializer for the base type. The array of parameter indices is
allocated but initialized to zero.
<<SF mappings: sf mapping: TBP>>=
procedure :: base_init => sf_mapping_base_init
<<SF mappings: sub interfaces>>=
module subroutine sf_mapping_base_init (mapping, n_par)
class(sf_mapping_t), intent(out) :: mapping
integer, intent(in) :: n_par
end subroutine sf_mapping_base_init
<<SF mappings: procedures>>=
module subroutine sf_mapping_base_init (mapping, n_par)
class(sf_mapping_t), intent(out) :: mapping
integer, intent(in) :: n_par
allocate (mapping%i (n_par))
mapping%i = 0
end subroutine sf_mapping_base_init
@ %def sf_mapping_base_init
@ Set an index value.
<<SF mappings: sf mapping: TBP>>=
procedure :: set_index => sf_mapping_set_index
<<SF mappings: sub interfaces>>=
module subroutine sf_mapping_set_index (mapping, j, i)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
end subroutine sf_mapping_set_index
<<SF mappings: procedures>>=
module subroutine sf_mapping_set_index (mapping, j, i)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
mapping%i(j) = i
end subroutine sf_mapping_set_index
@ %def sf_mapping_set_index
@ Retrieve an index value.
<<SF mappings: sf mapping: TBP>>=
procedure :: get_index => sf_mapping_get_index
<<SF mappings: sub interfaces>>=
module function sf_mapping_get_index (mapping, j) result (i)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j
integer :: i
end function sf_mapping_get_index
<<SF mappings: procedures>>=
module function sf_mapping_get_index (mapping, j) result (i)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j
integer :: i
i = mapping%i(j)
end function sf_mapping_get_index
@ %def sf_mapping_get_index
@ Return the dimensionality, i.e., the number of parameters.
<<SF mappings: sf mapping: TBP>>=
procedure :: get_n_dim => sf_mapping_get_n_dim
<<SF mappings: sub interfaces>>=
module function sf_mapping_get_n_dim (mapping) result (n)
class(sf_mapping_t), intent(in) :: mapping
integer :: n
end function sf_mapping_get_n_dim
<<SF mappings: procedures>>=
module function sf_mapping_get_n_dim (mapping) result (n)
class(sf_mapping_t), intent(in) :: mapping
integer :: n
n = size (mapping%i)
end function sf_mapping_get_n_dim
@ %def sf_mapping_get_n_dim
@ Computation: the values [[p]] are the input parameters, the values
[[r]] are the output parameters. The values [[rb]] are defined as
$\bar r = 1 - r$, but provided explicitly. They allow us to avoid
numerical problems near $r=1$.
The extra parameter [[x_free]]
indicates that the total energy has already been renormalized by this
factor. We have to take such a factor into account in a resonance or
on-shell mapping.
The Jacobian is [[f]]. We modify only
the two parameters indicated by the indices [[i]].
<<SF mappings: sf mapping: TBP>>=
procedure (sf_mapping_compute), deferred :: compute
<<SF mappings: interfaces>>=
abstract interface
subroutine sf_mapping_compute (mapping, r, rb, f, p, pb, x_free)
import
class(sf_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_mapping_compute
end interface
@ %def sf_mapping_compute
@ The inverse mapping. Use [[r]] and/or [[rb]] to reconstruct [[p]]
and also compute [[f]].
<<SF mappings: sf mapping: TBP>>=
procedure (sf_mapping_inverse), deferred :: inverse
<<SF mappings: interfaces>>=
abstract interface
subroutine sf_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
import
class(sf_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_mapping_inverse
end interface
@ %def sf_mapping_inverse
@
\subsection{Methods for self-tests}
This is a shorthand for: inject parameters, compute the mapping,
display results, compute the inverse, display again. We provide an
output format for the parameters and, optionally, a different output
format for the Jacobians.
<<SF mappings: sf mapping: TBP>>=
procedure :: check => sf_mapping_check
<<SF mappings: sub interfaces>>=
module subroutine sf_mapping_check (mapping, u, p_in, pb_in, fmt_p, fmt_f)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: u
real(default), dimension(:), intent(in) :: p_in, pb_in
character(*), intent(in) :: fmt_p
character(*), intent(in), optional :: fmt_f
end subroutine sf_mapping_check
<<SF mappings: procedures>>=
module subroutine sf_mapping_check (mapping, u, p_in, pb_in, fmt_p, fmt_f)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: u
real(default), dimension(:), intent(in) :: p_in, pb_in
character(*), intent(in) :: fmt_p
character(*), intent(in), optional :: fmt_f
real(default), dimension(size(p_in)) :: p, pb, r, rb
real(default) :: f, tolerance
tolerance = 1.5E-17_default
p = p_in
pb= pb_in
call mapping%compute (r, rb, f, p, pb)
call pacify (p, tolerance)
call pacify (pb, tolerance)
call pacify (r, tolerance)
call pacify (rb, tolerance)
write (u, "(3x,A,9(1x," // fmt_p // "))") "p =", p
write (u, "(3x,A,9(1x," // fmt_p // "))") "pb=", pb
write (u, "(3x,A,9(1x," // fmt_p // "))") "r =", r
write (u, "(3x,A,9(1x," // fmt_p // "))") "rb=", rb
if (present (fmt_f)) then
write (u, "(3x,A,9(1x," // fmt_f // "))") "f =", f
else
write (u, "(3x,A,9(1x," // fmt_p // "))") "f =", f
end if
write (u, *)
call mapping%inverse (r, rb, f, p, pb)
call pacify (p, tolerance)
call pacify (pb, tolerance)
call pacify (r, tolerance)
call pacify (rb, tolerance)
write (u, "(3x,A,9(1x," // fmt_p // "))") "p =", p
write (u, "(3x,A,9(1x," // fmt_p // "))") "pb=", pb
write (u, "(3x,A,9(1x," // fmt_p // "))") "r =", r
write (u, "(3x,A,9(1x," // fmt_p // "))") "rb=", rb
if (present (fmt_f)) then
write (u, "(3x,A,9(1x," // fmt_f // "))") "f =", f
else
write (u, "(3x,A,9(1x," // fmt_p // "))") "f =", f
end if
write (u, *)
write (u, "(3x,A,9(1x," // fmt_p // "))") "*r=", product (r)
end subroutine sf_mapping_check
@ %def sf_mapping_check
@ This is a consistency check for the self-tests: the integral over the unit
square should be unity. We estimate this by a simple binning and adding up
the values; this should be sufficient for a self-test.
The argument is the requested number of sampling points. We take the square
root for binning in both dimensions, so the precise number might be
different.
<<SF mappings: sf mapping: TBP>>=
procedure :: integral => sf_mapping_integral
<<SF mappings: sub interfaces>>=
module function sf_mapping_integral (mapping, n_calls) result (integral)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: n_calls
real(default) :: integral
end function sf_mapping_integral
<<SF mappings: procedures>>=
module function sf_mapping_integral (mapping, n_calls) result (integral)
class(sf_mapping_t), intent(inout) :: mapping
integer, intent(in) :: n_calls
real(default) :: integral
integer :: n_dim, n_bin, k
real(default), dimension(:), allocatable :: p, pb, r, rb
integer, dimension(:), allocatable :: ii
real(default) :: dx, f, s
n_dim = mapping%get_n_dim ()
allocate (p (n_dim))
allocate (pb(n_dim))
allocate (r (n_dim))
allocate (rb(n_dim))
allocate (ii(n_dim))
n_bin = nint (real (n_calls, default) ** (1._default / n_dim))
dx = 1._default / n_bin
s = 0
ii = 1
SAMPLE: do
do k = 1, n_dim
p(k) = ii(k) * dx - dx/2
pb(k) = (n_bin - ii(k)) * dx + dx/2
end do
call mapping%compute (r, rb, f, p, pb)
s = s + f
INCR: do k = 1, n_dim
ii(k) = ii(k) + 1
if (ii(k) <= n_bin) then
exit INCR
else if (k < n_dim) then
ii(k) = 1
else
exit SAMPLE
end if
end do INCR
end do SAMPLE
integral = s / real (n_bin, default) ** n_dim
end function sf_mapping_integral
@ %def sf_mapping_integral
@
\subsection{Implementation: standard mapping}
This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
while $p_2$ is related to the ratio.
<<SF mappings: public>>=
public :: sf_s_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_s_mapping_t
logical :: power_set = .false.
real(default) :: power = 1
contains
<<SF mappings: sf standard mapping: TBP>>
end type sf_s_mapping_t
@ %def sf_s_mapping_t
@ Output.
<<SF mappings: sf standard mapping: TBP>>=
procedure :: write => sf_s_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_s_mapping_write (object, unit)
class(sf_s_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_s_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_s_mapping_write (object, unit)
class(sf_s_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
write (u, "(A,F7.5,A)") ": standard (", object%power, ")"
end subroutine sf_s_mapping_write
@ %def sf_s_mapping_write
@ Initialize: index pair and power parameter.
<<SF mappings: sf standard mapping: TBP>>=
procedure :: init => sf_s_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_s_mapping_init (mapping, power)
class(sf_s_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: power
end subroutine sf_s_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_s_mapping_init (mapping, power)
class(sf_s_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: power
call mapping%base_init (2)
if (present (power)) then
mapping%power_set = .true.
mapping%power = power
end if
end subroutine sf_s_mapping_init
@ %def sf_s_mapping_init
@ Apply mapping.
<<SF mappings: sf standard mapping: TBP>>=
procedure :: compute => sf_s_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_s_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_s_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_s_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_s_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_s_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: r2
integer :: j
if (mapping%power_set) then
call map_unit_square (r2, f, p(mapping%i), mapping%power)
else
call map_unit_square (r2, f, p(mapping%i))
end if
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2(j)
rb(mapping%i(j)) = 1 - r2(j)
end do
end subroutine sf_s_mapping_compute
@ %def sf_s_mapping_compute
@ Apply inverse.
<<SF mappings: sf standard mapping: TBP>>=
procedure :: inverse => sf_s_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_s_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_s_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_s_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_s_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_s_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: p2
integer :: j
if (mapping%power_set) then
call map_unit_square_inverse (r(mapping%i), f, p2, mapping%power)
else
call map_unit_square_inverse (r(mapping%i), f, p2)
end if
p = r
pb= rb
do j = 1, 2
p (mapping%i(j)) = p2(j)
pb(mapping%i(j)) = 1 - p2(j)
end do
end subroutine sf_s_mapping_inverse
@ %def sf_s_mapping_inverse
@
\subsection{Implementation: resonance pair mapping}
This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
while $p_2$ is related to the ratio, then it maps $p_1$ to itself
according to a Breit-Wigner shape, i.e., a flat prior distribution in $p_1$
results in a Breit-Wigner distribution. Mass and width of the BW are
rescaled by the energy, thus dimensionless fractions.
<<SF mappings: public>>=
public :: sf_res_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_res_mapping_t
real(default) :: m = 0
real(default) :: w = 0
contains
<<SF mappings: sf resonance mapping: TBP>>
end type sf_res_mapping_t
@ %def sf_res_mapping_t
@ Output.
<<SF mappings: sf resonance mapping: TBP>>=
procedure :: write => sf_res_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_write (object, unit)
class(sf_res_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_res_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_write (object, unit)
class(sf_res_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
write (u, "(A,F7.5,', ',F7.5,A)") ": resonance (", object%m, object%w, ")"
end subroutine sf_res_mapping_write
@ %def sf_res_mapping_write
@ Initialize: index pair and dimensionless mass and width parameters.
<<SF mappings: sf resonance mapping: TBP>>=
procedure :: init => sf_res_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_init (mapping, m, w)
class(sf_res_mapping_t), intent(out) :: mapping
real(default), intent(in) :: m, w
end subroutine sf_res_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_init (mapping, m, w)
class(sf_res_mapping_t), intent(out) :: mapping
real(default), intent(in) :: m, w
call mapping%base_init (2)
mapping%m = m
mapping%w = w
end subroutine sf_res_mapping_init
@ %def sf_res_mapping_init
@ Apply mapping.
<<SF mappings: sf resonance mapping: TBP>>=
procedure :: compute => sf_res_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_res_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: r2, p2
real(default) :: fbw, f2, p1m
integer :: j
p2 = p(mapping%i)
call map_breit_wigner &
(p1m, fbw, p2(1), mapping%m, mapping%w, x_free)
call map_unit_square (r2, f2, [p1m, p2(2)])
f = fbw * f2
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2(j)
rb(mapping%i(j)) = 1 - r2(j)
end do
end subroutine sf_res_mapping_compute
@ %def sf_res_mapping_compute
@ Apply inverse.
<<SF mappings: sf resonance mapping: TBP>>=
procedure :: inverse => sf_res_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_res_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: p2
real(default) :: fbw, f2, p1m
call map_unit_square_inverse (r(mapping%i), f2, p2)
call map_breit_wigner_inverse &
(p2(1), fbw, p1m, mapping%m, mapping%w, x_free)
p = r
pb= rb
p (mapping%i(1)) = p1m
pb(mapping%i(1)) = 1 - p1m
p (mapping%i(2)) = p2(2)
pb(mapping%i(2)) = 1 - p2(2)
f = fbw * f2
end subroutine sf_res_mapping_inverse
@ %def sf_res_mapping_inverse
@
\subsection{Implementation: resonance single mapping}
While simpler, this is needed for structure-function setups only in
exceptional cases.
This maps the unit interval ($r_1$) to itself
according to a Breit-Wigner shape, i.e., a flat prior distribution in $r_1$
results in a Breit-Wigner distribution. Mass and width of the BW are
rescaled by the energy, thus dimensionless fractions.
<<SF mappings: public>>=
public :: sf_res_mapping_single_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_res_mapping_single_t
real(default) :: m = 0
real(default) :: w = 0
contains
<<SF mappings: sf resonance single mapping: TBP>>
end type sf_res_mapping_single_t
@ %def sf_res_mapping_single_t
@ Output.
<<SF mappings: sf resonance single mapping: TBP>>=
procedure :: write => sf_res_mapping_single_write
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_single_write (object, unit)
class(sf_res_mapping_single_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_res_mapping_single_write
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_single_write (object, unit)
class(sf_res_mapping_single_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,')')", advance="no") object%i
end if
write (u, "(A,F7.5,', ',F7.5,A)") ": resonance (", object%m, object%w, ")"
end subroutine sf_res_mapping_single_write
@ %def sf_res_mapping_single_write
@ Initialize: single index (!) and dimensionless mass and width parameters.
<<SF mappings: sf resonance single mapping: TBP>>=
procedure :: init => sf_res_mapping_single_init
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_single_init (mapping, m, w)
class(sf_res_mapping_single_t), intent(out) :: mapping
real(default), intent(in) :: m, w
end subroutine sf_res_mapping_single_init
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_single_init (mapping, m, w)
class(sf_res_mapping_single_t), intent(out) :: mapping
real(default), intent(in) :: m, w
call mapping%base_init (1)
mapping%m = m
mapping%w = w
end subroutine sf_res_mapping_single_init
@ %def sf_res_mapping_single_init
@ Apply mapping.
<<SF mappings: sf resonance single mapping: TBP>>=
procedure :: compute => sf_res_mapping_single_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_single_compute &
(mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_res_mapping_single_compute
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_single_compute &
(mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(1) :: r2, p2
real(default) :: fbw
integer :: j
p2 = p(mapping%i)
call map_breit_wigner &
(r2(1), fbw, p2(1), mapping%m, mapping%w, x_free)
f = fbw
r = p
rb= pb
r (mapping%i(1)) = r2(1)
rb(mapping%i(1)) = 1 - r2(1)
end subroutine sf_res_mapping_single_compute
@ %def sf_res_mapping_single_compute
@ Apply inverse.
<<SF mappings: sf resonance single mapping: TBP>>=
procedure :: inverse => sf_res_mapping_single_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_res_mapping_single_inverse &
(mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_res_mapping_single_inverse
<<SF mappings: procedures>>=
module subroutine sf_res_mapping_single_inverse &
(mapping, r, rb, f, p, pb, x_free)
class(sf_res_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(1) :: p2
real(default) :: fbw
call map_breit_wigner_inverse &
(r(mapping%i(1)), fbw, p2(1), mapping%m, mapping%w, x_free)
p = r
pb= rb
p (mapping%i(1)) = p2(1)
pb(mapping%i(1)) = 1 - p2(1)
f = fbw
end subroutine sf_res_mapping_single_inverse
@ %def sf_res_mapping_single_inverse
@
\subsection{Implementation: on-shell mapping}
This is a degenerate version of the unit-square mapping where the
product $r_1r_2$ is constant. This product is given by the rescaled
squared mass. We introduce an artificial first parameter $p_1$ to
keep the counting, but nothing depends on it. The second parameter is
the same $p_2$ as for the standard unit-square mapping for $\alpha=1$,
it parameterizes the ratio of $r_1$ and $r_2$.
<<SF mappings: public>>=
public :: sf_os_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_os_mapping_t
real(default) :: m = 0
real(default) :: lm2 = 0
contains
<<SF mappings: sf on-shell mapping: TBP>>
end type sf_os_mapping_t
@ %def sf_os_mapping_t
@ Output.
<<SF mappings: sf on-shell mapping: TBP>>=
procedure :: write => sf_os_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_write (object, unit)
class(sf_os_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_os_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_write (object, unit)
class(sf_os_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
write (u, "(A,F7.5,A)") ": on-shell (", object%m, ")"
end subroutine sf_os_mapping_write
@ %def sf_os_mapping_write
@ Initialize: index pair and dimensionless mass parameter.
<<SF mappings: sf on-shell mapping: TBP>>=
procedure :: init => sf_os_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_init (mapping, m)
class(sf_os_mapping_t), intent(out) :: mapping
real(default), intent(in) :: m
end subroutine sf_os_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_init (mapping, m)
class(sf_os_mapping_t), intent(out) :: mapping
real(default), intent(in) :: m
call mapping%base_init (2)
mapping%m = m
mapping%lm2 = abs (2 * log (mapping%m))
end subroutine sf_os_mapping_init
@ %def sf_os_mapping_init
@ Apply mapping. The [[x_free]] parameter rescales the total energy,
which must be accounted for in the enclosed mapping.
<<SF mappings: sf on-shell mapping: TBP>>=
procedure :: compute => sf_os_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_os_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: r2, p2
integer :: j
p2 = p(mapping%i)
call map_on_shell (r2, f, p2, mapping%lm2, x_free)
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2(j)
rb(mapping%i(j)) = 1 - r2(j)
end do
end subroutine sf_os_mapping_compute
@ %def sf_os_mapping_compute
@ Apply inverse. The irrelevant parameter $p_1$ is always set zero.
<<SF mappings: sf on-shell mapping: TBP>>=
procedure :: inverse => sf_os_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_os_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: p2, r2
r2 = r(mapping%i)
call map_on_shell_inverse (r2, f, p2, mapping%lm2, x_free)
p = r
pb= rb
p (mapping%i(1)) = p2(1)
pb(mapping%i(1)) = 1 - p2(1)
p (mapping%i(2)) = p2(2)
pb(mapping%i(2)) = 1 - p2(2)
end subroutine sf_os_mapping_inverse
@ %def sf_os_mapping_inverse
@
\subsection{Implementation: on-shell single mapping}
This is a degenerate version of the unit-interval mapping where the
result $r$ is constant. The value is given by the rescaled squared
mass. The input parameter $p_1$ is actually ignored, nothing depends
on it.
<<SF mappings: public>>=
public :: sf_os_mapping_single_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_os_mapping_single_t
real(default) :: m = 0
real(default) :: lm2 = 0
contains
<<SF mappings: sf on-shell mapping single: TBP>>
end type sf_os_mapping_single_t
@ %def sf_os_mapping_single_t
@ Output.
<<SF mappings: sf on-shell mapping single: TBP>>=
procedure :: write => sf_os_mapping_single_write
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_single_write (object, unit)
class(sf_os_mapping_single_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_os_mapping_single_write
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_single_write (object, unit)
class(sf_os_mapping_single_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,')')", advance="no") object%i
end if
write (u, "(A,F7.5,A)") ": on-shell (", object%m, ")"
end subroutine sf_os_mapping_single_write
@ %def sf_os_mapping_single_write
@ Initialize: index pair and dimensionless mass parameter.
<<SF mappings: sf on-shell mapping single: TBP>>=
procedure :: init => sf_os_mapping_single_init
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_single_init (mapping, m)
class(sf_os_mapping_single_t), intent(out) :: mapping
real(default), intent(in) :: m
end subroutine sf_os_mapping_single_init
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_single_init (mapping, m)
class(sf_os_mapping_single_t), intent(out) :: mapping
real(default), intent(in) :: m
call mapping%base_init (1)
mapping%m = m
mapping%lm2 = abs (2 * log (mapping%m))
end subroutine sf_os_mapping_single_init
@ %def sf_os_mapping_single_init
@ Apply mapping. The [[x_free]] parameter rescales the total energy,
which must be accounted for in the enclosed mapping.
<<SF mappings: sf on-shell mapping single: TBP>>=
procedure :: compute => sf_os_mapping_single_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_single_compute &
(mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_os_mapping_single_compute
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_single_compute &
(mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(1) :: r2, p2
integer :: j
p2 = p(mapping%i)
call map_on_shell_single (r2, f, p2, mapping%lm2, x_free)
r = p
rb= pb
r (mapping%i(1)) = r2(1)
rb(mapping%i(1)) = 1 - r2(1)
end subroutine sf_os_mapping_single_compute
@ %def sf_os_mapping_single_compute
@ Apply inverse. The irrelevant parameter $p_1$ is always set zero.
<<SF mappings: sf on-shell mapping single: TBP>>=
procedure :: inverse => sf_os_mapping_single_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_os_mapping_single_inverse &
(mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_os_mapping_single_inverse
<<SF mappings: procedures>>=
module subroutine sf_os_mapping_single_inverse &
(mapping, r, rb, f, p, pb, x_free)
class(sf_os_mapping_single_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(1) :: p2, r2
r2 = r(mapping%i)
call map_on_shell_single_inverse (r2, f, p2, mapping%lm2, x_free)
p = r
pb= rb
p (mapping%i(1)) = p2(1)
pb(mapping%i(1)) = 1 - p2(1)
end subroutine sf_os_mapping_single_inverse
@ %def sf_os_mapping_single_inverse
@
\subsection{Implementation: endpoint mapping}
This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
while $p_2$ is related to the ratio. Furthermore, we enhance the
region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
$p_2=0,1$. The enhancement is such that any power-like singularity is
caught. This is useful for beamstrahlung spectra.
In addition, we allow for a delta-function singularity in $r_1$ and/or
$r_2$. The singularity is smeared to an interval of width
$\epsilon$. If nonzero, we distinguish the kinematical momentum
fractions $r_i$ from effective values $x_i$, which should go into the
structure-function evaluation. A bin of width $\epsilon$ in $r$ is
mapped to $x=1$ exactly, while the interval $(0,1-\epsilon)$ is mapped
to $(0,1)$ in $x$. The Jacobian reflects this distinction, and the
logical [[in_peak]] allows for an unambiguous distinction.
The delta-peak fraction is used only for the integration self-test.
<<SF mappings: public>>=
public :: sf_ep_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_ep_mapping_t
real(default) :: a = 1
contains
<<SF mappings: sf endpoint mapping: TBP>>
end type sf_ep_mapping_t
@ %def sf_ep_mapping_t
@ Output.
<<SF mappings: sf endpoint mapping: TBP>>=
procedure :: write => sf_ep_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_ep_mapping_write (object, unit)
class(sf_ep_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_ep_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_ep_mapping_write (object, unit)
class(sf_ep_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
write (u, "(A,ES12.5,A)") ": endpoint (a =", object%a, ")"
end subroutine sf_ep_mapping_write
@ %def sf_ep_mapping_write
@ Initialize: no extra parameters.
<<SF mappings: sf endpoint mapping: TBP>>=
procedure :: init => sf_ep_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_ep_mapping_init (mapping, a)
class(sf_ep_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: a
end subroutine sf_ep_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_ep_mapping_init (mapping, a)
class(sf_ep_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: a
call mapping%base_init (2)
if (present (a)) mapping%a = a
end subroutine sf_ep_mapping_init
@ %def sf_ep_mapping_init
@ Apply mapping.
<<SF mappings: sf endpoint mapping: TBP>>=
procedure :: compute => sf_ep_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_ep_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ep_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ep_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_ep_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ep_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, r2
real(default) :: f1, f2
integer :: j
call map_endpoint_1 (px(1), f1, p(mapping%i(1)), mapping%a)
call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
call map_unit_square (r2, f, px)
f = f * f1 * f2
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2(j)
rb(mapping%i(j)) = 1 - r2(j)
end do
end subroutine sf_ep_mapping_compute
@ %def sf_ep_mapping_compute
@ Apply inverse.
<<SF mappings: sf endpoint mapping: TBP>>=
procedure :: inverse => sf_ep_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_ep_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ep_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ep_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_ep_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ep_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: r2, px, p2
real(default) :: f1, f2
integer :: j
do j = 1, 2
r2(j) = r(mapping%i(j))
end do
call map_unit_square_inverse (r2, f, px)
call map_endpoint_inverse_1 (px(1), f1, p2(1), mapping%a)
call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
f = f * f1 * f2
p = r
pb= rb
do j = 1, 2
p (mapping%i(j)) = p2(j)
pb(mapping%i(j)) = 1 - p2(j)
end do
end subroutine sf_ep_mapping_inverse
@ %def sf_ep_mapping_inverse
@
\subsection{Implementation: endpoint mapping with resonance}
Like the endpoint mapping for $p_2$, but replace the endpoint mapping
by a Breit-Wigner mapping for $p_1$. This covers resonance production
in the presence of beamstrahlung.
If the flag [[resonance]] is unset, we skip the resonance mapping, so
the parameter $p_1$ remains equal to $r_1r_2$, as in the standard
s-channel mapping.
<<SF mappings: public>>=
public :: sf_epr_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_epr_mapping_t
real(default) :: a = 1
real(default) :: m = 0
real(default) :: w = 0
logical :: resonance = .true.
contains
<<SF mappings: sf endpoint/res mapping: TBP>>
end type sf_epr_mapping_t
@ %def sf_epr_mapping_t
@ Output.
<<SF mappings: sf endpoint/res mapping: TBP>>=
procedure :: write => sf_epr_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_epr_mapping_write (object, unit)
class(sf_epr_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_epr_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_epr_mapping_write (object, unit)
class(sf_epr_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
if (object%resonance) then
write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)") ": ep/res (a = ", object%a, &
" | ", object%m, object%w, ")"
else
write (u, "(A,F7.5,A)") ": ep/nores (a = ", object%a, ")"
end if
end subroutine sf_epr_mapping_write
@ %def sf_epr_mapping_write
@ Initialize: if mass and width are not given, we initialize a
non-resonant version of the mapping.
<<SF mappings: sf endpoint/res mapping: TBP>>=
procedure :: init => sf_epr_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_epr_mapping_init (mapping, a, m, w)
class(sf_epr_mapping_t), intent(out) :: mapping
real(default), intent(in) :: a
real(default), intent(in), optional :: m, w
end subroutine sf_epr_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_epr_mapping_init (mapping, a, m, w)
class(sf_epr_mapping_t), intent(out) :: mapping
real(default), intent(in) :: a
real(default), intent(in), optional :: m, w
call mapping%base_init (2)
mapping%a = a
if (present (m) .and. present (w)) then
mapping%m = m
mapping%w = w
else
mapping%resonance = .false.
end if
end subroutine sf_epr_mapping_init
@ %def sf_epr_mapping_init
@ Apply mapping.
<<SF mappings: sf endpoint/res mapping: TBP>>=
procedure :: compute => sf_epr_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_epr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_epr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_epr_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_epr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_epr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, r2
real(default) :: f1, f2
integer :: j
if (mapping%resonance) then
call map_breit_wigner &
(px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
else
px(1) = p(mapping%i(1))
f1 = 1
end if
call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
call map_unit_square (r2, f, px)
f = f * f1 * f2
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2(j)
rb(mapping%i(j)) = 1 - r2(j)
end do
end subroutine sf_epr_mapping_compute
@ %def sf_epr_mapping_compute
@ Apply inverse.
<<SF mappings: sf endpoint/res mapping: TBP>>=
procedure :: inverse => sf_epr_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_epr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_epr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_epr_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_epr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_epr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, p2
real(default) :: f1, f2
integer :: j
call map_unit_square_inverse (r(mapping%i), f, px)
if (mapping%resonance) then
call map_breit_wigner_inverse &
(px(1), f1, p2(1), mapping%m, mapping%w, x_free)
else
p2(1) = px(1)
f1 = 1
end if
call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
f = f * f1 * f2
p = r
pb= rb
do j = 1, 2
p (mapping%i(j)) = p2(j)
pb(mapping%i(j)) = 1 - p2(j)
end do
end subroutine sf_epr_mapping_inverse
@ %def sf_epr_mapping_inverse
@
\subsection{Implementation: endpoint mapping for on-shell particle}
Analogous to the resonance mapping, but the $p_1$ input is ignored
altogether. This covers on-shell particle production
in the presence of beamstrahlung.
<<SF mappings: public>>=
public :: sf_epo_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_epo_mapping_t
real(default) :: a = 1
real(default) :: m = 0
real(default) :: lm2 = 0
contains
<<SF mappings: sf endpoint/os mapping: TBP>>
end type sf_epo_mapping_t
@ %def sf_epo_mapping_t
@ Output.
<<SF mappings: sf endpoint/os mapping: TBP>>=
procedure :: write => sf_epo_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_epo_mapping_write (object, unit)
class(sf_epo_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_epo_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_epo_mapping_write (object, unit)
class(sf_epo_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
write (u, "(A,F7.5,A,F7.5,A)") ": ep/on-shell (a = ", object%a, &
" | ", object%m, ")"
end subroutine sf_epo_mapping_write
@ %def sf_epo_mapping_write
@ Initialize: no extra parameters.
<<SF mappings: sf endpoint/os mapping: TBP>>=
procedure :: init => sf_epo_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_epo_mapping_init (mapping, a, m)
class(sf_epo_mapping_t), intent(out) :: mapping
real(default), intent(in) :: a, m
end subroutine sf_epo_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_epo_mapping_init (mapping, a, m)
class(sf_epo_mapping_t), intent(out) :: mapping
real(default), intent(in) :: a, m
call mapping%base_init (2)
mapping%a = a
mapping%m = m
mapping%lm2 = abs (2 * log (mapping%m))
end subroutine sf_epo_mapping_init
@ %def sf_epo_mapping_init
@ Apply mapping.
<<SF mappings: sf endpoint/os mapping: TBP>>=
procedure :: compute => sf_epo_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_epo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_epo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_epo_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_epo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_epo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, r2
real(default) :: f2
integer :: j
px(1) = 0
call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
call map_on_shell (r2, f, px, mapping%lm2)
f = f * f2
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2(j)
rb(mapping%i(j)) = 1 - r2(j)
end do
end subroutine sf_epo_mapping_compute
@ %def sf_epo_mapping_compute
@ Apply inverse.
<<SF mappings: sf endpoint/os mapping: TBP>>=
procedure :: inverse => sf_epo_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_epo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_epo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_epo_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_epo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_epo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, p2
real(default) :: f2
integer :: j
call map_on_shell_inverse (r(mapping%i), f, px, mapping%lm2)
p2(1) = 0
call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
f = f * f2
p = r
pb= rb
do j = 1, 2
p (mapping%i(j)) = p2(j)
pb(mapping%i(j)) = 1 - p2(j)
end do
end subroutine sf_epo_mapping_inverse
@ %def sf_epo_mapping_inverse
@
\subsection{Implementation: ISR endpoint mapping}
Similar to the endpoint mapping above: This maps the unit square
($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
related to the ratio. Furthermore, we enhance the region at $r_1=1$
and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.
The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
flattened. This would be easy in one dimension, but becomes
nontrivial in two dimensions.
<<SF mappings: public>>=
public :: sf_ip_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_ip_mapping_t
real(default) :: eps = 0
contains
<<SF mappings: sf power mapping: TBP>>
end type sf_ip_mapping_t
@ %def sf_ip_mapping_t
@ Output.
<<SF mappings: sf power mapping: TBP>>=
procedure :: write => sf_ip_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_ip_mapping_write (object, unit)
class(sf_ip_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_ip_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_ip_mapping_write (object, unit)
class(sf_ip_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
write (u, "(A,ES12.5,A)") ": isr (eps =", object%eps, ")"
end subroutine sf_ip_mapping_write
@ %def sf_ip_mapping_write
@ Initialize: no extra parameters.
<<SF mappings: sf power mapping: TBP>>=
procedure :: init => sf_ip_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_ip_mapping_init (mapping, eps)
class(sf_ip_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: eps
end subroutine sf_ip_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_ip_mapping_init (mapping, eps)
class(sf_ip_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: eps
call mapping%base_init (2)
if (present (eps)) mapping%eps = eps
if (mapping%eps <= 0) &
call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
end subroutine sf_ip_mapping_init
@ %def sf_ip_mapping_init
@ Apply mapping.
<<SF mappings: sf power mapping: TBP>>=
procedure :: compute => sf_ip_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_ip_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ip_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ip_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_ip_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ip_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, pxb, r2, r2b
real(default) :: f1, f2, xb, y, yb
integer :: j
call map_power_1 (xb, f1, pb(mapping%i(1)), 2 * mapping%eps)
call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
px(1) = 1 - xb
pxb(1) = xb
px(2) = y
pxb(2) = yb
call map_unit_square_prec (r2, r2b, f, px, pxb)
f = f * f1 * f2
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2 (j)
rb(mapping%i(j)) = r2b(j)
end do
end subroutine sf_ip_mapping_compute
@ %def sf_ip_mapping_compute
@ Apply inverse.
<<SF mappings: sf power mapping: TBP>>=
procedure :: inverse => sf_ip_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_ip_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ip_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ip_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_ip_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ip_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
real(default) :: f1, f2, xb, y, yb
integer :: j
do j = 1, 2
r2 (j) = r (mapping%i(j))
r2b(j) = rb(mapping%i(j))
end do
call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
xb = pxb(1)
if (px(1) > 0) then
y = px(2)
yb = pxb(2)
else
y = 0.5_default
yb = 0.5_default
end if
call map_power_inverse_1 (xb, f1, p2b(1), 2 * mapping%eps)
call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
p2 = 1 - p2b
f = f * f1 * f2
p = r
pb= rb
do j = 1, 2
p (mapping%i(j)) = p2(j)
pb(mapping%i(j)) = p2b(j)
end do
end subroutine sf_ip_mapping_inverse
@ %def sf_ip_mapping_inverse
@
\subsection{Implementation: ISR endpoint mapping, resonant}
Similar to the endpoint mapping above: This maps the unit square
($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
related to the ratio. Furthermore, we enhance the region at $r_1=1$
and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.
The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
flattened. This would be easy in one dimension, but becomes
nontrivial in two dimensions.
The resonance can be turned off by the flag [[resonance]].
<<SF mappings: public>>=
public :: sf_ipr_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_ipr_mapping_t
real(default) :: eps = 0
real(default) :: m = 0
real(default) :: w = 0
logical :: resonance = .true.
contains
<<SF mappings: sf power/res mapping: TBP>>
end type sf_ipr_mapping_t
@ %def sf_ipr_mapping_t
@ Output.
<<SF mappings: sf power/res mapping: TBP>>=
procedure :: write => sf_ipr_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_ipr_mapping_write (object, unit)
class(sf_ipr_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_ipr_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_ipr_mapping_write (object, unit)
class(sf_ipr_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
if (object%resonance) then
write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)") ": isr/res (eps = ", &
object%eps, " | ", object%m, object%w, ")"
else
write (u, "(A,F7.5,A)") ": isr/res (eps = ", object%eps, ")"
end if
end subroutine sf_ipr_mapping_write
@ %def sf_ipr_mapping_write
@ Initialize:
<<SF mappings: sf power/res mapping: TBP>>=
procedure :: init => sf_ipr_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_ipr_mapping_init (mapping, eps, m, w)
class(sf_ipr_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: eps, m, w
end subroutine sf_ipr_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_ipr_mapping_init (mapping, eps, m, w)
class(sf_ipr_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: eps, m, w
call mapping%base_init (2)
if (present (eps)) mapping%eps = eps
if (mapping%eps <= 0) &
call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
if (present (m) .and. present (w)) then
mapping%m = m
mapping%w = w
else
mapping%resonance = .false.
end if
end subroutine sf_ipr_mapping_init
@ %def sf_ipr_mapping_init
@ Apply mapping.
<<SF mappings: sf power/res mapping: TBP>>=
procedure :: compute => sf_ipr_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_ipr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ipr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ipr_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_ipr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ipr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, pxb, r2, r2b
real(default) :: f1, f2, y, yb
integer :: j
if (mapping%resonance) then
call map_breit_wigner &
(px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
else
px(1) = p(mapping%i(1))
f1 = 1
end if
call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
pxb(1) = 1 - px(1)
px(2) = y
pxb(2) = yb
call map_unit_square_prec (r2, r2b, f, px, pxb)
f = f * f1 * f2
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2 (j)
rb(mapping%i(j)) = r2b(j)
end do
end subroutine sf_ipr_mapping_compute
@ %def sf_ipr_mapping_compute
@ Apply inverse.
<<SF mappings: sf power/res mapping: TBP>>=
procedure :: inverse => sf_ipr_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_ipr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ipr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ipr_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_ipr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ipr_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
real(default) :: f1, f2, y, yb
integer :: j
do j = 1, 2
r2 (j) = r (mapping%i(j))
r2b(j) = rb(mapping%i(j))
end do
call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
if (px(1) > 0) then
y = px(2)
yb = pxb(2)
else
y = 0.5_default
yb = 0.5_default
end if
if (mapping%resonance) then
call map_breit_wigner_inverse &
(px(1), f1, p2(1), mapping%m, mapping%w, x_free)
else
p2(1) = px(1)
f1 = 1
end if
call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
p2b(1) = 1 - p2(1)
p2 (2) = 1 - p2b(2)
f = f * f1 * f2
p = r
pb= rb
do j = 1, 2
p (mapping%i(j)) = p2(j)
pb(mapping%i(j)) = p2b(j)
end do
end subroutine sf_ipr_mapping_inverse
@ %def sf_ipr_mapping_inverse
@
\subsection{Implementation: ISR on-shell mapping}
Similar to the endpoint mapping above: This maps the unit square
($r_1,r_2$) such that $p_1$ is ignored while the product $r_1r_2$ is
constant. $p_2$ is related to the ratio. Furthermore, we enhance the
region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
$p_2=0,1$.
The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
flattened. This would be easy in one dimension, but becomes
nontrivial in two dimensions.
<<SF mappings: public>>=
public :: sf_ipo_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_ipo_mapping_t
real(default) :: eps = 0
real(default) :: m = 0
contains
<<SF mappings: sf power/os mapping: TBP>>
end type sf_ipo_mapping_t
@ %def sf_ipo_mapping_t
@ Output.
<<SF mappings: sf power/os mapping: TBP>>=
procedure :: write => sf_ipo_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_ipo_mapping_write (object, unit)
class(sf_ipo_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_ipo_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_ipo_mapping_write (object, unit)
class(sf_ipo_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,',',I0,')')", advance="no") object%i
end if
write (u, "(A,F7.5,A,F7.5,A)") ": isr/os (eps = ", object%eps, &
" | ", object%m, ")"
end subroutine sf_ipo_mapping_write
@ %def sf_ipo_mapping_write
@ Initialize: no extra parameters.
<<SF mappings: sf power/os mapping: TBP>>=
procedure :: init => sf_ipo_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_ipo_mapping_init (mapping, eps, m)
class(sf_ipo_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: eps, m
end subroutine sf_ipo_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_ipo_mapping_init (mapping, eps, m)
class(sf_ipo_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: eps, m
call mapping%base_init (2)
if (present (eps)) mapping%eps = eps
if (mapping%eps <= 0) &
call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
mapping%m = m
end subroutine sf_ipo_mapping_init
@ %def sf_ipo_mapping_init
@ Apply mapping.
<<SF mappings: sf power/os mapping: TBP>>=
procedure :: compute => sf_ipo_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_ipo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ipo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ipo_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_ipo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ipo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: px, pxb, r2, r2b
real(default) :: f1, f2, y, yb
integer :: j
call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
px(1) = mapping%m ** 2
if (present (x_free)) px(1) = px(1) / x_free
pxb(1) = 1 - px(1)
px(2) = y
pxb(2) = yb
call map_unit_square_prec (r2, r2b, f1, px, pxb)
f = f1 * f2
r = p
rb= pb
do j = 1, 2
r (mapping%i(j)) = r2 (j)
rb(mapping%i(j)) = r2b(j)
end do
end subroutine sf_ipo_mapping_compute
@ %def sf_ipo_mapping_compute
@ Apply inverse.
<<SF mappings: sf power/os mapping: TBP>>=
procedure :: inverse => sf_ipo_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_ipo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ipo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ipo_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_ipo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ipo_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
real(default) :: f1, f2, y, yb
integer :: j
do j = 1, 2
r2 (j) = r (mapping%i(j))
r2b(j) = rb(mapping%i(j))
end do
call map_unit_square_inverse_prec (r2, r2b, f1, px, pxb)
y = px(2)
yb = pxb(2)
call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
p2(1) = 0
p2b(1)= 1
p2(2) = 1 - p2b(2)
f = f1 * f2
p = r
pb= rb
do j = 1, 2
p (mapping%i(j)) = p2(j)
pb(mapping%i(j)) = p2b(j)
end do
end subroutine sf_ipo_mapping_inverse
@ %def sf_ipo_mapping_inverse
@
\subsection{Implementation: Endpoint + ISR power mapping}
This is a combination of endpoint (i.e., beamstrahlung) and ISR power
mapping. The first two parameters apply to the beamstrahlung
spectrum, the last two to the ISR function for the first and second
beam, respectively.
<<SF mappings: public>>=
public :: sf_ei_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_ei_mapping_t
type(sf_ep_mapping_t) :: ep
type(sf_ip_mapping_t) :: ip
contains
<<SF mappings: sf ep-ip mapping: TBP>>
end type sf_ei_mapping_t
@ %def sf_ei_mapping_t
@ Output.
<<SF mappings: sf ep-ip mapping: TBP>>=
procedure :: write => sf_ei_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_ei_mapping_write (object, unit)
class(sf_ei_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_ei_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_ei_mapping_write (object, unit)
class(sf_ei_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
end if
write (u, "(A,ES12.5,A,ES12.5,A)") ": ep/isr (a =", object%ep%a, &
", eps =", object%ip%eps, ")"
end subroutine sf_ei_mapping_write
@ %def sf_ei_mapping_write
@ Initialize: no extra parameters.
<<SF mappings: sf ep-ip mapping: TBP>>=
procedure :: init => sf_ei_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_ei_mapping_init (mapping, a, eps)
class(sf_ei_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: a, eps
end subroutine sf_ei_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_ei_mapping_init (mapping, a, eps)
class(sf_ei_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: a, eps
call mapping%base_init (4)
call mapping%ep%init (a)
call mapping%ip%init (eps)
end subroutine sf_ei_mapping_init
@ %def sf_ei_mapping_init
@ Set an index value. We should communicate the appropriate indices to the
enclosed sub-mappings, therefore override the method.
<<SF mappings: sf ep-ip mapping: TBP>>=
procedure :: set_index => sf_ei_mapping_set_index
<<SF mappings: sub interfaces>>=
module subroutine sf_ei_mapping_set_index (mapping, j, i)
class(sf_ei_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
end subroutine sf_ei_mapping_set_index
<<SF mappings: procedures>>=
module subroutine sf_ei_mapping_set_index (mapping, j, i)
class(sf_ei_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
mapping%i(j) = i
select case (j)
case (1:2); call mapping%ep%set_index (j, i)
case (3:4); call mapping%ip%set_index (j-2, i)
end select
end subroutine sf_ei_mapping_set_index
@ %def sf_mapping_set_index
@ Apply mapping. Now, the beamstrahlung and ISR mappings are
independent of each other. The parameter subsets that are actually
used should not overlap. The Jacobians are multiplied.
<<SF mappings: sf ep-ip mapping: TBP>>=
procedure :: compute => sf_ei_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_ei_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ei_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ei_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_ei_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_ei_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(size(p)) :: q, qb
real(default) :: f1, f2
call mapping%ep%compute (q, qb, f1, p, pb, x_free)
call mapping%ip%compute (r, rb, f2, q, qb, x_free)
f = f1 * f2
end subroutine sf_ei_mapping_compute
@ %def sf_ei_mapping_compute
@ Apply inverse.
<<SF mappings: sf ep-ip mapping: TBP>>=
procedure :: inverse => sf_ei_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_ei_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ei_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_ei_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_ei_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_ei_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(size(p)) :: q, qb
real(default) :: f1, f2
call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
call mapping%ep%inverse (q, qb, f1, p, pb, x_free)
f = f1 * f2
end subroutine sf_ei_mapping_inverse
@ %def sf_ei_mapping_inverse
@
\subsection{Implementation: Endpoint + ISR + resonance}
This is a combination of endpoint (i.e., beamstrahlung) and ISR power
mapping, adapted for an s-channel resonance. The first two internal
parameters apply to the beamstrahlung spectrum, the last two to the
ISR function for the first and second beam, respectively. The first
and third parameters are the result of an overall resonance mapping,
so on the outside, the first parameter is the total momentum fraction,
the third one describes the distribution between beamstrahlung and ISR.
<<SF mappings: public>>=
public :: sf_eir_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_eir_mapping_t
type(sf_res_mapping_t) :: res
type(sf_epr_mapping_t) :: ep
type(sf_ipr_mapping_t) :: ip
contains
<<SF mappings: sf ep-ip-res mapping: TBP>>
end type sf_eir_mapping_t
@ %def sf_eir_mapping_t
@ Output.
<<SF mappings: sf ep-ip-res mapping: TBP>>=
procedure :: write => sf_eir_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_eir_mapping_write (object, unit)
class(sf_eir_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_eir_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_eir_mapping_write (object, unit)
class(sf_eir_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
end if
write (u, "(A,F7.5,A,F7.5,A,F7.5,', ',F7.5,A)") &
": ep/isr/res (a =", object%ep%a, &
", eps =", object%ip%eps, " | ", object%res%m, object%res%w, ")"
end subroutine sf_eir_mapping_write
@ %def sf_eir_mapping_write
@ Initialize: no extra parameters.
<<SF mappings: sf ep-ip-res mapping: TBP>>=
procedure :: init => sf_eir_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_eir_mapping_init (mapping, a, eps, m, w)
class(sf_eir_mapping_t), intent(out) :: mapping
real(default), intent(in) :: a, eps, m, w
end subroutine sf_eir_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_eir_mapping_init (mapping, a, eps, m, w)
class(sf_eir_mapping_t), intent(out) :: mapping
real(default), intent(in) :: a, eps, m, w
call mapping%base_init (4)
call mapping%res%init (m, w)
call mapping%ep%init (a)
call mapping%ip%init (eps)
end subroutine sf_eir_mapping_init
@ %def sf_eir_mapping_init
@ Set an index value. We should communicate the appropriate indices to the
enclosed sub-mappings, therefore override the method.
<<SF mappings: sf ep-ip-res mapping: TBP>>=
procedure :: set_index => sf_eir_mapping_set_index
<<SF mappings: sub interfaces>>=
module subroutine sf_eir_mapping_set_index (mapping, j, i)
class(sf_eir_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
end subroutine sf_eir_mapping_set_index
<<SF mappings: procedures>>=
module subroutine sf_eir_mapping_set_index (mapping, j, i)
class(sf_eir_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
mapping%i(j) = i
select case (j)
case (1); call mapping%res%set_index (1, i)
case (3); call mapping%res%set_index (2, i)
end select
select case (j)
case (1:2); call mapping%ep%set_index (j, i)
case (3:4); call mapping%ip%set_index (j-2, i)
end select
end subroutine sf_eir_mapping_set_index
@ %def sf_mapping_set_index
@ Apply mapping. Now, the beamstrahlung and ISR mappings are
independent of each other. The parameter subsets that are actually
used should not overlap. The Jacobians are multiplied.
<<SF mappings: sf ep-ip-res mapping: TBP>>=
procedure :: compute => sf_eir_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_eir_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_eir_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_eir_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_eir_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_eir_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(size(p)) :: px, pxb, q, qb
real(default) :: f0, f1, f2
call mapping%res%compute (px, pxb, f0, p, pb, x_free)
call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
call mapping%ip%compute (r, rb, f2, q, qb, x_free)
f = f0 * f1 * f2
end subroutine sf_eir_mapping_compute
@ %def sf_eir_mapping_compute
@ Apply inverse.
<<SF mappings: sf ep-ip-res mapping: TBP>>=
procedure :: inverse => sf_eir_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_eir_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_eir_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_eir_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_eir_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_eir_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(size(p)) :: px, pxb, q, qb
real(default) :: f0, f1, f2
call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
call mapping%res%inverse (px, pxb, f0, p, pb, x_free)
f = f0 * f1 * f2
end subroutine sf_eir_mapping_inverse
@ %def sf_eir_mapping_inverse
@
\subsection{Implementation: Endpoint + ISR power mapping, on-shell}
This is a combination of endpoint (i.e., beamstrahlung) and ISR power
mapping. The first two parameters apply to the beamstrahlung
spectrum, the last two to the ISR function for the first and second
beam, respectively. On top of that, we map the first and third parameter
such that the product is constant. From the outside, the first
parameter is irrelevant while the third parameter describes the
distribution of energy (loss) among beamstrahlung and ISR.
<<SF mappings: public>>=
public :: sf_eio_mapping_t
<<SF mappings: types>>=
type, extends (sf_mapping_t) :: sf_eio_mapping_t
type(sf_os_mapping_t) :: os
type(sf_epr_mapping_t) :: ep
type(sf_ipr_mapping_t) :: ip
contains
<<SF mappings: sf ep-ip-os mapping: TBP>>
end type sf_eio_mapping_t
@ %def sf_eio_mapping_t
@ Output.
<<SF mappings: sf ep-ip-os mapping: TBP>>=
procedure :: write => sf_eio_mapping_write
<<SF mappings: sub interfaces>>=
module subroutine sf_eio_mapping_write (object, unit)
class(sf_eio_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_eio_mapping_write
<<SF mappings: procedures>>=
module subroutine sf_eio_mapping_write (object, unit)
class(sf_eio_mapping_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "map"
if (any (object%i /= 0)) then
write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
end if
write (u, "(A,F7.5,A,F7.5,A,F7.5,A)") ": ep/isr/os (a =", object%ep%a, &
", eps =", object%ip%eps, " | ", object%os%m, ")"
end subroutine sf_eio_mapping_write
@ %def sf_eio_mapping_write
@ Initialize: no extra parameters.
<<SF mappings: sf ep-ip-os mapping: TBP>>=
procedure :: init => sf_eio_mapping_init
<<SF mappings: sub interfaces>>=
module subroutine sf_eio_mapping_init (mapping, a, eps, m)
class(sf_eio_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: a, eps, m
end subroutine sf_eio_mapping_init
<<SF mappings: procedures>>=
module subroutine sf_eio_mapping_init (mapping, a, eps, m)
class(sf_eio_mapping_t), intent(out) :: mapping
real(default), intent(in), optional :: a, eps, m
call mapping%base_init (4)
call mapping%os%init (m)
call mapping%ep%init (a)
call mapping%ip%init (eps)
end subroutine sf_eio_mapping_init
@ %def sf_eio_mapping_init
@ Set an index value. We should communicate the appropriate indices to the
enclosed sub-mappings, therefore override the method.
<<SF mappings: sf ep-ip-os mapping: TBP>>=
procedure :: set_index => sf_eio_mapping_set_index
<<SF mappings: sub interfaces>>=
module subroutine sf_eio_mapping_set_index (mapping, j, i)
class(sf_eio_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
end subroutine sf_eio_mapping_set_index
<<SF mappings: procedures>>=
module subroutine sf_eio_mapping_set_index (mapping, j, i)
class(sf_eio_mapping_t), intent(inout) :: mapping
integer, intent(in) :: j, i
mapping%i(j) = i
select case (j)
case (1); call mapping%os%set_index (1, i)
case (3); call mapping%os%set_index (2, i)
end select
select case (j)
case (1:2); call mapping%ep%set_index (j, i)
case (3:4); call mapping%ip%set_index (j-2, i)
end select
end subroutine sf_eio_mapping_set_index
@ %def sf_mapping_set_index
@ Apply mapping. Now, the beamstrahlung and ISR mappings are
independent of each other. The parameter subsets that are actually
used should not overlap. The Jacobians are multiplied.
<<SF mappings: sf ep-ip-os mapping: TBP>>=
procedure :: compute => sf_eio_mapping_compute
<<SF mappings: sub interfaces>>=
module subroutine sf_eio_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_eio_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_eio_mapping_compute
<<SF mappings: procedures>>=
module subroutine sf_eio_mapping_compute (mapping, r, rb, f, p, pb, x_free)
class(sf_eio_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(size(p)) :: px, pxb, q, qb
real(default) :: f0, f1, f2
call mapping%os%compute (px, pxb, f0, p, pb, x_free)
call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
call mapping%ip%compute (r, rb, f2, q, qb, x_free)
f = f0 * f1 * f2
end subroutine sf_eio_mapping_compute
@ %def sf_eio_mapping_compute
@ Apply inverse.
<<SF mappings: sf ep-ip-os mapping: TBP>>=
procedure :: inverse => sf_eio_mapping_inverse
<<SF mappings: sub interfaces>>=
module subroutine sf_eio_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_eio_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
end subroutine sf_eio_mapping_inverse
<<SF mappings: procedures>>=
module subroutine sf_eio_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
class(sf_eio_mapping_t), intent(inout) :: mapping
real(default), dimension(:), intent(in) :: r, rb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: p, pb
real(default), intent(inout), optional :: x_free
real(default), dimension(size(p)) :: px, pxb, q, qb
real(default) :: f0, f1, f2
call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
call mapping%os%inverse (px, pxb, f0, p, pb, x_free)
f = f0 * f1 * f2
end subroutine sf_eio_mapping_inverse
@ %def sf_eio_mapping_inverse
@
\subsection{Basic formulas}
\subsubsection{Standard mapping of the unit square}
This mapping of the unit square is appropriate in particular for
structure functions which are concentrated at the lower end. Instead
of a rectangular grid, one set of grid lines corresponds to constant
parton c.m. energy. The other set is chosen such that the jacobian is
only mildly singular ($\ln x$ which is zero at $x=1$), corresponding
to an initial concentration of sampling points at the maximum energy.
If [[power]] is greater than one (the default), points are also
concentrated at the lower end.
The formula is ([[power]]=$\alpha$):
\begin{align}
r_1 &= (p_1 ^ {p_2})^\alpha \\
r_2 &= (p_1 ^ {1 - p_2})^\alpha\\
f &= \alpha^2 p_1 ^ {\alpha - 1} |\log p_1|
\end{align}
and for the default case $\alpha=1$:
\begin{align}
r_1 &= p_1 ^ {p_2} \\
r_2 &= p_1 ^ {1 - p_2} \\
f &= |\log p_1|
\end{align}
<<SF mappings: procedures>>=
subroutine map_unit_square (r, factor, p, power)
real(default), dimension(2), intent(out) :: r
real(default), intent(out) :: factor
real(default), dimension(2), intent(in) :: p
real(default), intent(in), optional :: power
real(default) :: xx, yy
factor = 1
xx = p(1)
yy = p(2)
if (present(power)) then
if (p(1) > 0 .and. power > 1) then
xx = p(1)**power
factor = factor * power * xx / p(1)
end if
end if
if (.not. vanishes (xx)) then
r(1) = xx ** yy
r(2) = xx / r(1)
factor = factor * abs (log (xx))
else
r = 0
end if
end subroutine map_unit_square
@ %def map_unit_square
@ This is the inverse mapping.
<<SF mappings: procedures>>=
subroutine map_unit_square_inverse (r, factor, p, power)
real(kind=default), dimension(2), intent(in) :: r
real(kind=default), intent(out) :: factor
real(kind=default), dimension(2), intent(out) :: p
real(kind=default), intent(in), optional :: power
real(kind=default) :: lg, xx, yy
factor = 1
xx = r(1) * r(2)
if (.not. vanishes (xx)) then
lg = log (xx)
if (.not. vanishes (lg)) then
yy = log (r(1)) / lg
else
yy = 0
end if
p(2) = yy
factor = factor * abs (lg)
if (present(power)) then
p(1) = xx**(1._default/power)
factor = factor * power * xx / p(1)
else
p(1) = xx
end if
else
p = 0
end if
end subroutine map_unit_square_inverse
@ %def map_unit_square_inverse
@
\subsubsection{Precise mapping of the unit square}
A more precise version (with unit power parameter). This version
should be numerically stable near $x=1$ and $y=0,1$. The formulas are again
\begin{equation}
r_1 = p_1^{p_2}, \qquad
r_2 = p_1^{\bar p_2}, \qquad
f = - \log p_1
\end{equation}
but we compute both $r_i$ and $\bar r_i$ simultaneously and make
direct use of both $p_i$ and $\bar p_i$ as appropriate.
<<SF mappings: procedures>>=
subroutine map_unit_square_prec (r, rb, factor, p, pb)
real(default), dimension(2), intent(out) :: r
real(default), dimension(2), intent(out) :: rb
real(default), intent(out) :: factor
real(default), dimension(2), intent(in) :: p
real(default), dimension(2), intent(in) :: pb
if (p(1) > 0.5_default) then
call compute_prec_xy_1 (r(1), rb(1), p(1), pb(1), p (2))
call compute_prec_xy_1 (r(2), rb(2), p(1), pb(1), pb(2))
factor = - log_prec (p(1), pb(1))
else if (.not. vanishes (p(1))) then
call compute_prec_xy_0 (r(1), rb(1), p(1), pb(1), p (2))
call compute_prec_xy_0 (r(2), rb(2), p(1), pb(1), pb(2))
factor = - log_prec (p(1), pb(1))
else
r = 0
rb = 1
factor = 0
end if
end subroutine map_unit_square_prec
@ %def map_unit_square_prec
@ This is the inverse mapping.
<<SF mappings: procedures>>=
subroutine map_unit_square_inverse_prec (r, rb, factor, p, pb)
real(default), dimension(2), intent(in) :: r
real(default), dimension(2), intent(in) :: rb
real(default), intent(out) :: factor
real(default), dimension(2), intent(out) :: p
real(default), dimension(2), intent(out) :: pb
call inverse_prec_x (r, rb, p(1), pb(1))
if (all (r > 0)) then
if (rb(1) < rb(2)) then
call inverse_prec_y (r, rb, p(2), pb(2))
else
call inverse_prec_y ([r(2),r(1)], [rb(2),rb(1)], pb(2), p(2))
end if
factor = - log_prec (p(1), pb(1))
else
p(1) = 0
pb(1) = 1
p(2) = 0.5_default
pb(2) = 0.5_default
factor = 0
end if
end subroutine map_unit_square_inverse_prec
@ %def map_unit_square_prec_inverse
@ This is an auxiliary function: evaluate the expression $\bar z = 1 -
x^y$ in a numerically stable way. Instabilities occur for $y=0$ and
$x=1$. The idea is to replace the bracket by the first terms of its
Taylor expansion around $x=1$ (read $\bar x\equiv 1 -x$)
\begin{equation}
1 - x^y = y\bar x\left(1 + \frac12(1-y)\bar x +
\frac16(2-y)(1-y)\bar x^2\right)
\end{equation}
whenever this is the better approximation. Actually, the relative
numerical error of the exact formula is about $\eta/(y\bar x)$ where
$\eta$ is given by [[epsilon(KIND)]] in Fortran. The relative error
of the approximation is better than the last included term divided by
$(y\bar x)$.
The first subroutine computes $z$ and $\bar z$ near $x=1$ where $\log
x$ should be expanded, the second one near $x=0$ where $\log x$ can be
kept.
<<SF mappings: procedures>>=
subroutine compute_prec_xy_1 (z, zb, x, xb, y)
real(default), intent(out) :: z, zb
real(default), intent(in) :: x, xb, y
real(default) :: a1, a2, a3
a1 = y * xb
a2 = a1 * (1 - y) * xb / 2
a3 = a2 * (2 - y) * xb / 3
if (abs (a3) < epsilon (a3)) then
zb = a1 + a2 + a3
z = 1 - zb
else
z = x ** y
zb = 1 - z
end if
end subroutine compute_prec_xy_1
subroutine compute_prec_xy_0 (z, zb, x, xb, y)
real(default), intent(out) :: z, zb
real(default), intent(in) :: x, xb, y
real(default) :: a1, a2, a3, lx
lx = -log (x)
a1 = y * lx
a2 = a1 * y * lx / 2
a3 = a2 * y * lx / 3
if (abs (a3) < epsilon (a3)) then
zb = a1 + a2 + a3
z = 1 - zb
else
z = x ** y
zb = 1 - z
end if
end subroutine compute_prec_xy_0
@ %def compute_prec_xy_1
@ %def compute_prec_xy_0
@ For the inverse calculation, we evaluate $x=r_1r_2$ in a stable way.
Since it is just a polynomial, the expansion near $x=1$ is
analytically exact, and we don't need to choose based on precision.
<<SF mappings: procedures>>=
subroutine inverse_prec_x (r, rb, x, xb)
real(default), dimension(2), intent(in) :: r, rb
real(default), intent(out) :: x, xb
real(default) :: a0, a1
a0 = rb(1) + rb(2)
a1 = rb(1) * rb(2)
if (a0 > 0.5_default) then
xb = a0 - a1
x = 1 - xb
else
x = r(1) * r(2)
xb = 1 - x
end if
end subroutine inverse_prec_x
@ %def inverse_prec_x
@ The inverse calculation for the relative momentum fraction
\begin{equation}
y = \frac{1}{1 + \frac{\log{r_2}}{\log{r_1}}}
\end{equation}
is slightly more complicated. We should take the precise form of the
logarithm, so we are safe near $r_i=1$. A series expansion is
required if $r_1\ll r_2$, since then $y$ becomes small. (We assume
$r_1<r_2$ here; for the opposite case, the arguments can be
exchanged.)
<<SF mappings: procedures>>=
subroutine inverse_prec_y (r, rb, y, yb)
real(default), dimension(2), intent(in) :: r, rb
real(default), intent(out) :: y, yb
real(default) :: log1, log2, a1, a2, a3
log1 = log_prec (r(1), rb(1))
log2 = log_prec (r(2), rb(2))
if (abs (log2**3) < epsilon (one)) then
if (abs(log1) < epsilon (one)) then
y = zero
else
y = one / (one + log2 / log1)
end if
if (abs(log2) < epsilon (one)) then
yb = zero
else
yb = one / (one + log1 / log2)
end if
return
end if
a1 = - rb(1) / log2
a2 = - rb(1) ** 2 * (one / log2**2 + one / (2 * log2))
a3 = - rb(1) ** 3 * (one / log2**3 + one / log2**2 + one/(3 * log2))
if (abs (a3) < epsilon (a3)) then
y = a1 + a2 + a3
yb = one - y
else
y = one / (one + log2 / log1)
yb = one / (one + log1 / log2)
end if
end subroutine inverse_prec_y
@ %def inverse_prec_y
@
\subsubsection{Mapping for on-shell s-channel}
The limiting case, if the product $r_1r_2$ is fixed for on-shell
production. The parameter $p_1$ is ignored. In the inverse mapping,
it is returned zero.
The parameter [[x_free]], if present, rescales the total energy. If
it is less than one, the rescaled mass parameter $m^2$ should be increased
accordingly.
Public for access in unit test.
<<SF mappings: public>>=
public :: map_on_shell
public :: map_on_shell_inverse
<<SF mappings: sub interfaces>>=
module subroutine map_on_shell (r, factor, p, lm2, x_free)
real(default), dimension(2), intent(out) :: r
real(default), intent(out) :: factor
real(default), dimension(2), intent(in) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
end subroutine map_on_shell
module subroutine map_on_shell_inverse (r, factor, p, lm2, x_free)
real(default), dimension(2), intent(in) :: r
real(default), intent(out) :: factor
real(default), dimension(2), intent(out) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
end subroutine map_on_shell_inverse
<<SF mappings: procedures>>=
module subroutine map_on_shell (r, factor, p, lm2, x_free)
real(default), dimension(2), intent(out) :: r
real(default), intent(out) :: factor
real(default), dimension(2), intent(in) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
real(default) :: lx
lx = lm2; if (present (x_free)) lx = lx + log (x_free)
r(1) = exp (- p(2) * lx)
r(2) = exp (- (1 - p(2)) * lx)
factor = lx
end subroutine map_on_shell
module subroutine map_on_shell_inverse (r, factor, p, lm2, x_free)
real(default), dimension(2), intent(in) :: r
real(default), intent(out) :: factor
real(default), dimension(2), intent(out) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
real(default) :: lx
lx = lm2; if (present (x_free)) lx = lx + log (x_free)
p(1) = 0
p(2) = abs (log (r(1))) / lx
factor = lx
end subroutine map_on_shell_inverse
@ %def map_on_shell
@ %def map_on_shell_inverse
@
\subsubsection{Mapping for on-shell s-channel, single parameter}
This is a pseudo-mapping which applies if there is actually just one
parameter [[p]]. The output parameter [[r]] is fixed for on-shell
production. The lone parameter $p_1$ is ignored. In the inverse mapping,
it is returned zero.
The parameter [[x_free]], if present, rescales the total energy. If
it is less than one, the rescaled mass parameter $m^2$ should be increased
accordingly.
Public for access in unit test.
<<SF mappings: public>>=
public :: map_on_shell_single
public :: map_on_shell_single_inverse
<<SF mappings: sub interfaces>>=
module subroutine map_on_shell_single (r, factor, p, lm2, x_free)
real(default), dimension(1), intent(out) :: r
real(default), intent(out) :: factor
real(default), dimension(1), intent(in) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
end subroutine map_on_shell_single
module subroutine map_on_shell_single_inverse (r, factor, p, lm2, x_free)
real(default), dimension(1), intent(in) :: r
real(default), intent(out) :: factor
real(default), dimension(1), intent(out) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
end subroutine map_on_shell_single_inverse
<<SF mappings: procedures>>=
module subroutine map_on_shell_single (r, factor, p, lm2, x_free)
real(default), dimension(1), intent(out) :: r
real(default), intent(out) :: factor
real(default), dimension(1), intent(in) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
real(default) :: lx
lx = lm2; if (present (x_free)) lx = lx + log (x_free)
r(1) = exp (- lx)
factor = 1
end subroutine map_on_shell_single
module subroutine map_on_shell_single_inverse (r, factor, p, lm2, x_free)
real(default), dimension(1), intent(in) :: r
real(default), intent(out) :: factor
real(default), dimension(1), intent(out) :: p
real(default), intent(in) :: lm2
real(default), intent(in), optional :: x_free
real(default) :: lx
lx = lm2; if (present (x_free)) lx = lx + log (x_free)
p(1) = 0
factor = 1
end subroutine map_on_shell_single_inverse
@ %def map_on_shell_single
@ %def map_on_shell_single_inverse
@
\subsubsection{Mapping for a Breit-Wigner resonance}
This is the standard Breit-Wigner mapping. We apply it to a single
variable, independently of or in addition to a unit-square mapping. We
assume here that the limits for the variable are 0 and 1, and that the
mass $m$ and width $w$ are rescaled appropriately, so they are
dimensionless and usually between 0 and 1.
If [[x_free]] is set, it rescales the total energy and thus mass and
width, since these are defined with respect to the total energy.
<<SF mappings: procedures>>=
subroutine map_breit_wigner (r, factor, p, m, w, x_free)
real(default), intent(out) :: r
real(default), intent(out) :: factor
real(default), intent(in) :: p
real(default), intent(in) :: m
real(default), intent(in) :: w
real(default), intent(in), optional :: x_free
real(default) :: m2, mw, a1, a2, a3, z, tmp
m2 = m ** 2
mw = m * w
if (present (x_free)) then
m2 = m2 / x_free
mw = mw / x_free
end if
a1 = atan (- m2 / mw)
a2 = atan ((1 - m2) / mw)
a3 = (a2 - a1) * mw
z = (1-p) * a1 + p * a2
if (-pi/2 < z .and. z < pi/2) then
tmp = tan (z)
r = max (m2 + mw * tmp, 0._default)
factor = a3 * (1 + tmp ** 2)
else
r = 0
factor = 0
end if
end subroutine map_breit_wigner
subroutine map_breit_wigner_inverse (r, factor, p, m, w, x_free)
real(default), intent(in) :: r
real(default), intent(out) :: factor
real(default), intent(out) :: p
real(default), intent(in) :: m
real(default), intent(in) :: w
real(default) :: m2, mw, a1, a2, a3, tmp
real(default), intent(in), optional :: x_free
m2 = m ** 2
mw = m * w
if (present (x_free)) then
m2 = m2 / x_free
mw = mw / x_free
end if
a1 = atan (- m2 / mw)
a2 = atan ((1 - m2) / mw)
a3 = (a2 - a1) * mw
tmp = (r - m2) / mw
p = (atan (tmp) - a1) / (a2 - a1)
factor = a3 * (1 + tmp ** 2)
end subroutine map_breit_wigner_inverse
@ %def map_breit_wigner
@ %def map_breit_wigner_inverse
@
\subsubsection{Mapping with endpoint enhancement}
This is a mapping which is close to the unit mapping, except that at
the endpoint(s), the output values are exponentially enhanced.
\begin{equation}
y = \tanh (a \tan (\frac{\pi}{2}x))
\end{equation}
We have two variants: one covers endpoints at $0$ and $1$
symmetrically, while the other one (which essentially maps one-half of
the range), covers only the endpoint at $1$.
<<SF mappings: procedures>>=
subroutine map_endpoint_1 (x3, factor, x1, a)
real(default), intent(out) :: x3, factor
real(default), intent(in) :: x1
real(default), intent(in) :: a
real(default) :: x2
if (abs (x1) < 1) then
x2 = tan (x1 * pi / 2)
x3 = tanh (a * x2)
factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
else
x3 = x1
factor = 0
end if
end subroutine map_endpoint_1
subroutine map_endpoint_inverse_1 (x3, factor, x1, a)
real(default), intent(in) :: x3
real(default), intent(out) :: x1, factor
real(default), intent(in) :: a
real(default) :: x2
if (abs (x3) < 1) then
x2 = atanh (x3) / a
x1 = 2 / pi * atan (x2)
factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
else
x1 = x3
factor = 0
end if
end subroutine map_endpoint_inverse_1
subroutine map_endpoint_01 (x4, factor, x0, a)
real(default), intent(out) :: x4, factor
real(default), intent(in) :: x0
real(default), intent(in) :: a
real(default) :: x1, x3
x1 = 2 * x0 - 1
call map_endpoint_1 (x3, factor, x1, a)
x4 = (x3 + 1) / 2
end subroutine map_endpoint_01
subroutine map_endpoint_inverse_01 (x4, factor, x0, a)
real(default), intent(in) :: x4
real(default), intent(out) :: x0, factor
real(default), intent(in) :: a
real(default) :: x1, x3
x3 = 2 * x4 - 1
call map_endpoint_inverse_1 (x3, factor, x1, a)
x0 = (x1 + 1) / 2
end subroutine map_endpoint_inverse_01
@ %def map_endpoint_1
@ %def map_endpoint_inverse_1
@ %def map_endpoint_01
@ %def map_endpoint_inverse_01
@
\subsubsection{Mapping with endpoint enhancement (ISR)}
This is another endpoint mapping. It is designed to flatten the ISR
singularity which is of power type at $x=1$, i.e., if
\begin{equation}
\sigma = \int_0^1 dx\,f(x)\,G(x)
= \int_0^1 dx\,\epsilon(1-x)^{-1+\epsilon} G(x),
\end{equation}
we replace this by
\begin{equation}
r = x^\epsilon \quad\Longrightarrow\quad
\sigma = \int_0^1 dr\,G(1- (1-r)^{1/\epsilon}).
\end{equation}
We expect that $\epsilon$ is small.
The actual mapping is $r\to x$ (so $x$ emerges closer to $1$). The
Jacobian that we return is thus $1/f(x)$. We compute the mapping in
terms of $\bar x\equiv 1 - x$, so we can achieve the required precision.
Because some compilers show quite wild numeric fluctuations, we
internally convert numeric types to explicit [[double]] precision.
<<SF mappings: public>>=
public :: map_power_1
public :: map_power_inverse_1
<<SF mappings: sub interfaces>>=
module subroutine map_power_1 (xb, factor, rb, eps)
real(default), intent(out) :: xb, factor
real(default), intent(in) :: rb
real(default), intent(in) :: eps
end subroutine map_power_1
module subroutine map_power_inverse_1 (xb, factor, rb, eps)
real(default), intent(in) :: xb
real(default), intent(out) :: rb, factor
real(default), intent(in) :: eps
end subroutine map_power_inverse_1
<<SF mappings: procedures>>=
module subroutine map_power_1 (xb, factor, rb, eps)
real(default), intent(out) :: xb, factor
real(default), intent(in) :: rb
real(double) :: rb_db, factor_db, eps_db, xb_db
real(default), intent(in) :: eps
rb_db = real (rb, kind=double)
eps_db = real (eps, kind=double)
xb_db = rb_db ** (1 / eps_db)
if (rb_db > 0) then
factor_db = xb_db / rb_db / eps_db
factor = real (factor_db, kind=default)
else
factor = 0
end if
xb = real (xb_db, kind=default)
end subroutine map_power_1
module subroutine map_power_inverse_1 (xb, factor, rb, eps)
real(default), intent(in) :: xb
real(default), intent(out) :: rb, factor
real(double) :: xb_db, factor_db, eps_db, rb_db
real(default), intent(in) :: eps
xb_db = real (xb, kind=double)
eps_db = real (eps, kind=double)
rb_db = xb_db ** eps_db
if (xb_db > 0) then
factor_db = xb_db / rb_db / eps_db
factor = real (factor_db, kind=default)
else
factor = 0
end if
rb = real (rb_db, kind=default)
end subroutine map_power_inverse_1
@ %def map_power_1
@ %def map_power_inverse_1
@ Here we apply a power mapping to both endpoints. We divide the
interval in two equal halves and apply the power mapping for the
nearest endpoint, either $0$ or $1$.
<<SF mappings: procedures>>=
subroutine map_power_01 (y, yb, factor, r, eps)
real(default), intent(out) :: y, yb, factor
real(default), intent(in) :: r
real(default), intent(in) :: eps
real(default) :: u, ub, zp, zm
u = 2 * r - 1
if (u > 0) then
ub = 2 * (1 - r)
call map_power_1 (zm, factor, ub, eps)
zp = 2 - zm
else if (u < 0) then
ub = 2 * r
call map_power_1 (zp, factor, ub, eps)
zm = 2 - zp
else
factor = 1 / eps
zp = 1
zm = 1
end if
y = zp / 2
yb = zm / 2
end subroutine map_power_01
subroutine map_power_inverse_01 (y, yb, factor, r, eps)
real(default), intent(in) :: y, yb
real(default), intent(out) :: r, factor
real(default), intent(in) :: eps
real(default) :: ub, zp, zm
zp = 2 * y
zm = 2 * yb
if (zm < zp) then
call map_power_inverse_1 (zm, factor, ub, eps)
r = 1 - ub / 2
else if (zp < zm) then
call map_power_inverse_1 (zp, factor, ub, eps)
r = ub / 2
else
factor = 1 / eps
ub = 1
r = ub / 2
end if
end subroutine map_power_inverse_01
@ %def map_power_01
@ %def map_power_inverse_01
@
\subsubsection{Structure-function channels}
A structure-function chain parameterization (channel) may contain a
mapping that applies to multiple structure functions. This is
described by an extension of the [[sf_mapping_t]] type. In addition,
it may contain mappings that apply to (other) individual structure
functions. The details of these mappings are implementation-specific.
The [[sf_channel_t]] type combines this information. It contains an
array of map codes, one for each structure-function entry. The code
values are:
\begin{description}
\item[none] MC input parameters $r$ directly become energy fractions $x$
\item[single] default mapping for a single structure-function entry
\item[multi/s] map $r\to x$ such that one MC input parameter is $\hat s/s$
\item[multi/resonance] as before, adapted to s-channel resonance
\item[multi/on-shell] as before, adapted to an on-shell particle in
the s channel
\item[multi/endpoint] like multi/s, but enhance the region near $r_i=1$
\item[multi/endpoint/res] endpoint mapping with resonance
\item[multi/endpoint/os] endpoint mapping for on-shell
\item[multi/power/os] like multi/endpoint, regulating a power singularity
\end{description}
<<SF mappings: parameters>>=
integer, parameter :: SFMAP_NONE = 0
integer, parameter :: SFMAP_SINGLE = 1
integer, parameter :: SFMAP_MULTI_S = 2
integer, parameter :: SFMAP_MULTI_RES = 3
integer, parameter :: SFMAP_MULTI_ONS = 4
integer, parameter :: SFMAP_MULTI_EP = 5
integer, parameter :: SFMAP_MULTI_EPR = 6
integer, parameter :: SFMAP_MULTI_EPO = 7
integer, parameter :: SFMAP_MULTI_IP = 8
integer, parameter :: SFMAP_MULTI_IPR = 9
integer, parameter :: SFMAP_MULTI_IPO = 10
integer, parameter :: SFMAP_MULTI_EI = 11
integer, parameter :: SFMAP_MULTI_SRS = 13
integer, parameter :: SFMAP_MULTI_SON = 14
@ %def SFMAP_NONE SFMAP_SINGLE
@ %def SFMAP_MULTI_S SFMAP_MULTI_RES SFMAP_MULTI_ONS
@ %def SFMAP_MULTI_EP SFMAP_MULTI_EPR SFMAP_MULTI_EPO
@ %def SFMAP_MULTI_IP SFMAP_MULTI_IPR SFMAP_MULTI_IPO
@ %def SFMAP_MULTI_EI
@ %def SFMAP_MULTI_SRS SFMAP_MULTI_SON
@ Then, it contains an allocatable entry for the multi mapping. This
entry holds the MC-parameter indices on which the mapping applies
(there may be more than one MC parameter per structure-function entry)
and any parameters associated with the mapping.
There can be only one multi-mapping per channel.
<<SF mappings: public>>=
public :: sf_channel_t
<<SF mappings: types>>=
type :: sf_channel_t
integer, dimension(:), allocatable :: map_code
class(sf_mapping_t), allocatable :: multi_mapping
contains
<<SF mappings: sf channel: TBP>>
end type sf_channel_t
@ %def sf_channel_t
@ The output format prints a single character for each
structure-function entry and, if applicable, an account of the mapping
parameters.
<<SF mappings: sf channel: TBP>>=
procedure :: write => sf_channel_write
<<SF mappings: sub interfaces>>=
module subroutine sf_channel_write (object, unit)
class(sf_channel_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_channel_write
<<SF mappings: procedures>>=
module subroutine sf_channel_write (object, unit)
class(sf_channel_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
if (allocated (object%map_code)) then
do i = 1, size (object%map_code)
select case (object%map_code (i))
case (SFMAP_NONE)
write (u, "(1x,A)", advance="no") "-"
case (SFMAP_SINGLE)
write (u, "(1x,A)", advance="no") "+"
case (SFMAP_MULTI_S)
write (u, "(1x,A)", advance="no") "s"
case (SFMAP_MULTI_RES, SFMAP_MULTI_SRS)
write (u, "(1x,A)", advance="no") "r"
case (SFMAP_MULTI_ONS, SFMAP_MULTI_SON)
write (u, "(1x,A)", advance="no") "o"
case (SFMAP_MULTI_EP)
write (u, "(1x,A)", advance="no") "e"
case (SFMAP_MULTI_EPR)
write (u, "(1x,A)", advance="no") "p"
case (SFMAP_MULTI_EPO)
write (u, "(1x,A)", advance="no") "q"
case (SFMAP_MULTI_IP)
write (u, "(1x,A)", advance="no") "i"
case (SFMAP_MULTI_IPR)
write (u, "(1x,A)", advance="no") "i"
case (SFMAP_MULTI_IPO)
write (u, "(1x,A)", advance="no") "i"
case (SFMAP_MULTI_EI)
write (u, "(1x,A)", advance="no") "i"
case default
write (u, "(1x,A)", advance="no") "?"
end select
end do
else
write (u, "(1x,A)", advance="no") "-"
end if
if (allocated (object%multi_mapping)) then
write (u, "(1x,'/')", advance="no")
call object%multi_mapping%write (u)
else
write (u, *)
end if
end subroutine sf_channel_write
@ %def sf_channel_write
@ Initializer for a single [[sf_channel]] object.
<<SF mappings: sf channel: TBP>>=
procedure :: init => sf_channel_init
<<SF mappings: sub interfaces>>=
module subroutine sf_channel_init (channel, n_strfun)
class(sf_channel_t), intent(out) :: channel
integer, intent(in) :: n_strfun
end subroutine sf_channel_init
<<SF mappings: procedures>>=
module subroutine sf_channel_init (channel, n_strfun)
class(sf_channel_t), intent(out) :: channel
integer, intent(in) :: n_strfun
allocate (channel%map_code (n_strfun))
channel%map_code = SFMAP_NONE
end subroutine sf_channel_init
@ %def sf_channel_init
@ Assignment. This merely copies intrinsic assignment.
<<SF mappings: sf channel: TBP>>=
generic :: assignment (=) => sf_channel_assign
procedure :: sf_channel_assign
<<SF mappings: sub interfaces>>=
module subroutine sf_channel_assign (copy, original)
class(sf_channel_t), intent(out) :: copy
type(sf_channel_t), intent(in) :: original
end subroutine sf_channel_assign
<<SF mappings: procedures>>=
module subroutine sf_channel_assign (copy, original)
class(sf_channel_t), intent(out) :: copy
type(sf_channel_t), intent(in) :: original
allocate (copy%map_code (size (original%map_code)))
copy%map_code = original%map_code
if (allocated (original%multi_mapping)) then
allocate (copy%multi_mapping, source = original%multi_mapping)
end if
end subroutine sf_channel_assign
@ %def sf_channel_assign
@ This initializer allocates an array of channels with common number of
structure-function entries, therefore it is not a type-bound procedure.
<<SF mappings: public>>=
public :: allocate_sf_channels
<<SF mappings: sub interfaces>>=
module subroutine allocate_sf_channels (channel, n_channel, n_strfun)
type(sf_channel_t), dimension(:), intent(out), allocatable :: channel
integer, intent(in) :: n_channel
integer, intent(in) :: n_strfun
end subroutine allocate_sf_channels
<<SF mappings: procedures>>=
module subroutine allocate_sf_channels (channel, n_channel, n_strfun)
type(sf_channel_t), dimension(:), intent(out), allocatable :: channel
integer, intent(in) :: n_channel
integer, intent(in) :: n_strfun
integer :: c
allocate (channel (n_channel))
do c = 1, n_channel
call channel(c)%init (n_strfun)
end do
end subroutine allocate_sf_channels
@ %def allocate_sf_channels
@ This marks a given subset of indices as single-mapping.
<<SF mappings: sf channel: TBP>>=
procedure :: activate_mapping => sf_channel_activate_mapping
<<SF mappings: sub interfaces>>=
module subroutine sf_channel_activate_mapping (channel, i_sf)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
end subroutine sf_channel_activate_mapping
<<SF mappings: procedures>>=
module subroutine sf_channel_activate_mapping (channel, i_sf)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
channel%map_code(i_sf) = SFMAP_SINGLE
end subroutine sf_channel_activate_mapping
@ %def sf_channel_activate_mapping
@ This sets an s-channel multichannel mapping. The parameter indices
are not yet set. Gfortran 7/8/9 bug, has to remain in module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_s_mapping => sf_channel_set_s_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_s_mapping (channel, i_sf, power)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: power
channel%map_code(i_sf) = SFMAP_MULTI_S
allocate (sf_s_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_s_mapping_t)
call mapping%init (power)
end select
end subroutine sf_channel_set_s_mapping
@ %def sf_channel_set_s_mapping
@ This sets an s-channel resonance multichannel mapping. Gfortran 7/8/9
bug, has to remain in module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_res_mapping => sf_channel_set_res_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_res_mapping (channel, i_sf, m, w, single)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in) :: m, w
logical, intent(in) :: single
if (single) then
channel%map_code(i_sf) = SFMAP_MULTI_SRS
allocate (sf_res_mapping_single_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_res_mapping_single_t)
call mapping%init (m, w)
end select
else
channel%map_code(i_sf) = SFMAP_MULTI_RES
allocate (sf_res_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_res_mapping_t)
call mapping%init (m, w)
end select
end if
end subroutine sf_channel_set_res_mapping
@ %def sf_channel_set_res_mapping
@ This sets an s-channel on-shell multichannel mapping. The length of the
[[i_sf]] array must be 2. (The first parameter actually becomes an
irrelevant dummy.) Gfortran 7/8/9 bug, has to remain in module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_os_mapping => sf_channel_set_os_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_os_mapping (channel, i_sf, m, single)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in) :: m
logical, intent(in) :: single
if (single) then
channel%map_code(i_sf) = SFMAP_MULTI_SON
allocate (sf_os_mapping_single_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_os_mapping_single_t)
call mapping%init (m)
end select
else
channel%map_code(i_sf) = SFMAP_MULTI_ONS
allocate (sf_os_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_os_mapping_t)
call mapping%init (m)
end select
end if
end subroutine sf_channel_set_os_mapping
@ %def sf_channel_set_os_mapping
@ This sets an s-channel endpoint mapping. The parameter $a$ is the
slope parameter (default 1); increasing it moves the endpoint region
(at $x=1$ to lower values in the input parameter) even more. Gfortran
7/8/9 bug, has to remain in the module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_ep_mapping => sf_channel_set_ep_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_ep_mapping (channel, i_sf, a)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: a
channel%map_code(i_sf) = SFMAP_MULTI_EP
allocate (sf_ep_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_ep_mapping_t)
call mapping%init (a = a)
end select
end subroutine sf_channel_set_ep_mapping
@ %def sf_channel_set_ep_mapping
@ This sets a resonant endpoint mapping. Gfortran
7/8/9 bug, has to remain in the module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_epr_mapping => sf_channel_set_epr_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_epr_mapping (channel, i_sf, a, m, w)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in) :: a, m, w
channel%map_code(i_sf) = SFMAP_MULTI_EPR
allocate (sf_epr_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_epr_mapping_t)
call mapping%init (a, m, w)
end select
end subroutine sf_channel_set_epr_mapping
@ %def sf_channel_set_epr_mapping
@ This sets an on-shell endpoint mapping. Gfortran
7/8/9 bug, has to remain in the module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_epo_mapping => sf_channel_set_epo_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_epo_mapping (channel, i_sf, a, m)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in) :: a, m
channel%map_code(i_sf) = SFMAP_MULTI_EPO
allocate (sf_epo_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_epo_mapping_t)
call mapping%init (a, m)
end select
end subroutine sf_channel_set_epo_mapping
@ %def sf_channel_set_epo_mapping
@ This sets an s-channel power mapping, regulating a singularity of
type $(1-x)^{-1+\epsilon}$. The parameter $\epsilon$ depends on the
structure function. Gfortran 7/8/9 bug, has to remain in the module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_ip_mapping => sf_channel_set_ip_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_ip_mapping (channel, i_sf, eps)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: eps
channel%map_code(i_sf) = SFMAP_MULTI_IP
allocate (sf_ip_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_ip_mapping_t)
call mapping%init (eps)
end select
end subroutine sf_channel_set_ip_mapping
@ %def sf_channel_set_ip_mapping
@ This sets an s-channel resonant power mapping, regulating a
singularity of type $(1-x)^{-1+\epsilon}$ in the presence of an
s-channel resonance. The parameter $\epsilon$ depends on the
structure function. Gfortran 7/8/9 bug, has to remain in the module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_ipr_mapping => sf_channel_set_ipr_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_ipr_mapping (channel, i_sf, eps, m, w)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: eps, m, w
channel%map_code(i_sf) = SFMAP_MULTI_IPR
allocate (sf_ipr_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_ipr_mapping_t)
call mapping%init (eps, m, w)
end select
end subroutine sf_channel_set_ipr_mapping
@ %def sf_channel_set_ipr_mapping
@ This sets an on-shell power mapping, regulating a
singularity of type $(1-x)^{-1+\epsilon}$ for the production of a
single on-shell particle.. The parameter $\epsilon$ depends on the
structure function. Gfortran 7/8/9 bug: has to remain in module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_ipo_mapping => sf_channel_set_ipo_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_ipo_mapping (channel, i_sf, eps, m)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: eps, m
channel%map_code(i_sf) = SFMAP_MULTI_IPO
allocate (sf_ipo_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_ipo_mapping_t)
call mapping%init (eps, m)
end select
end subroutine sf_channel_set_ipo_mapping
@ %def sf_channel_set_ipo_mapping
@ This sets a combined endpoint/ISR mapping. Gfortran 7/8/9 bug, remains
in module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_ei_mapping => sf_channel_set_ei_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_ei_mapping (channel, i_sf, a, eps)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: a, eps
channel%map_code(i_sf) = SFMAP_MULTI_EI
allocate (sf_ei_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_ei_mapping_t)
call mapping%init (a, eps)
end select
end subroutine sf_channel_set_ei_mapping
@ %def sf_channel_set_ei_mapping
@ This sets a combined endpoint/ISR mapping with resonance. Gfortran
7/8/9 bug, remains in module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_eir_mapping => sf_channel_set_eir_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_eir_mapping (channel, i_sf, a, eps, m, w)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: a, eps, m, w
channel%map_code(i_sf) = SFMAP_MULTI_EI
allocate (sf_eir_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_eir_mapping_t)
call mapping%init (a, eps, m, w)
end select
end subroutine sf_channel_set_eir_mapping
@ %def sf_channel_set_eir_mapping
@ This sets a combined endpoint/ISR mapping, on-shell. Gfortran 7/8/9 bug,
remains in module.
<<SF mappings: sf channel: TBP>>=
procedure :: set_eio_mapping => sf_channel_set_eio_mapping
<<SF mappings: main procedures>>=
subroutine sf_channel_set_eio_mapping (channel, i_sf, a, eps, m)
class(sf_channel_t), intent(inout) :: channel
integer, dimension(:), intent(in) :: i_sf
real(default), intent(in), optional :: a, eps, m
channel%map_code(i_sf) = SFMAP_MULTI_EI
allocate (sf_eio_mapping_t :: channel%multi_mapping)
select type (mapping => channel%multi_mapping)
type is (sf_eio_mapping_t)
call mapping%init (a, eps, m)
end select
end subroutine sf_channel_set_eio_mapping
@ %def sf_channel_set_eio_mapping
@ Return true if the mapping code at position [[i_sf]] is [[SFMAP_SINGLE]].
<<SF mappings: sf channel: TBP>>=
procedure :: is_single_mapping => sf_channel_is_single_mapping
<<SF mappings: sub interfaces>>=
module function sf_channel_is_single_mapping (channel, i_sf) result (flag)
class(sf_channel_t), intent(in) :: channel
integer, intent(in) :: i_sf
logical :: flag
end function sf_channel_is_single_mapping
<<SF mappings: procedures>>=
module function sf_channel_is_single_mapping (channel, i_sf) result (flag)
class(sf_channel_t), intent(in) :: channel
integer, intent(in) :: i_sf
logical :: flag
flag = channel%map_code(i_sf) == SFMAP_SINGLE
end function sf_channel_is_single_mapping
@ %def sf_channel_is_single_mapping
@ Return true if the mapping code at position [[i_sf]] is any of the
[[SFMAP_MULTI]] mappings.
<<SF mappings: sf channel: TBP>>=
procedure :: is_multi_mapping => sf_channel_is_multi_mapping
<<SF mappings: sub interfaces>>=
module function sf_channel_is_multi_mapping (channel, i_sf) result (flag)
class(sf_channel_t), intent(in) :: channel
integer, intent(in) :: i_sf
logical :: flag
end function sf_channel_is_multi_mapping
<<SF mappings: procedures>>=
module function sf_channel_is_multi_mapping (channel, i_sf) result (flag)
class(sf_channel_t), intent(in) :: channel
integer, intent(in) :: i_sf
logical :: flag
select case (channel%map_code(i_sf))
case (SFMAP_NONE, SFMAP_SINGLE)
flag = .false.
case default
flag = .true.
end select
end function sf_channel_is_multi_mapping
@ %def sf_channel_is_multi_mapping
@ Return the number of parameters that the multi-mapping requires. The
mapping object must be allocated.
<<SF mappings: sf channel: TBP>>=
procedure :: get_multi_mapping_n_par => sf_channel_get_multi_mapping_n_par
<<SF mappings: sub interfaces>>=
module function sf_channel_get_multi_mapping_n_par (channel) result (n_par)
class(sf_channel_t), intent(in) :: channel
integer :: n_par
end function sf_channel_get_multi_mapping_n_par
<<SF mappings: procedures>>=
module function sf_channel_get_multi_mapping_n_par (channel) result (n_par)
class(sf_channel_t), intent(in) :: channel
integer :: n_par
if (allocated (channel%multi_mapping)) then
n_par = channel%multi_mapping%get_n_dim ()
else
n_par = 0
end if
end function sf_channel_get_multi_mapping_n_par
@ %def sf_channel_get_multi_mapping_n_par
@ Return true if there is any nontrivial mapping in any of the channels.
<<SF mappings: public>>=
public :: any_sf_channel_has_mapping
<<SF mappings: sub interfaces>>=
module function any_sf_channel_has_mapping (channel) result (flag)
type(sf_channel_t), dimension(:), intent(in) :: channel
logical :: flag
end function any_sf_channel_has_mapping
<<SF mappings: procedures>>=
module function any_sf_channel_has_mapping (channel) result (flag)
type(sf_channel_t), dimension(:), intent(in) :: channel
logical :: flag
integer :: c
flag = .false.
do c = 1, size (channel)
flag = flag .or. any (channel(c)%map_code /= SFMAP_NONE)
end do
end function any_sf_channel_has_mapping
@ %def any_sf_channel_has_mapping
@ Set a parameter index for an active multi mapping. We assume that
the index array is allocated properly.
<<SF mappings: sf channel: TBP>>=
procedure :: set_par_index => sf_channel_set_par_index
<<SF mappings: sub interfaces>>=
module subroutine sf_channel_set_par_index (channel, j, i_par)
class(sf_channel_t), intent(inout) :: channel
integer, intent(in) :: j
integer, intent(in) :: i_par
end subroutine sf_channel_set_par_index
<<SF mappings: procedures>>=
module subroutine sf_channel_set_par_index (channel, j, i_par)
class(sf_channel_t), intent(inout) :: channel
integer, intent(in) :: j
integer, intent(in) :: i_par
associate (mapping => channel%multi_mapping)
if (j >= 1 .and. j <= mapping%get_n_dim ()) then
if (mapping%get_index (j) == 0) then
call channel%multi_mapping%set_index (j, i_par)
else
call msg_bug ("Structure-function setup: mapping index set twice")
end if
else
call msg_bug ("Structure-function setup: mapping index out of range")
end if
end associate
end subroutine sf_channel_set_par_index
@ %def sf_channel_set_par_index
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_mappings_ut.f90]]>>=
<<File header>>
module sf_mappings_ut
use unit_tests
use sf_mappings_uti
<<Standard module head>>
<<SF mappings: public test>>
contains
<<SF mappings: test driver>>
end module sf_mappings_ut
@ %def sf_mappings_ut
@
<<[[sf_mappings_uti.f90]]>>=
<<File header>>
module sf_mappings_uti
<<Use kinds>>
use format_defs, only: FMT_11, FMT_12, FMT_13, FMT_14, FMT_15, FMT_16
use sf_mappings
<<Standard module head>>
<<SF mappings: test declarations>>
contains
<<SF mappings: tests>>
end module sf_mappings_uti
@ %def sf_mappings_ut
@ API: driver for the unit tests below.
<<SF mappings: public test>>=
public :: sf_mappings_test
<<SF mappings: test driver>>=
subroutine sf_mappings_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF mappings: execute tests>>
end subroutine sf_mappings_test
@ %def sf_mappings_test
@
\subsubsection{Check standard mapping}
Probe the standard mapping of the unit square for different parameter
values. Also calculates integrals. For a finite number of bins, they differ
slightly from $1$, but the result is well-defined because we are not using
random points.
<<SF mappings: execute tests>>=
call test (sf_mappings_1, "sf_mappings_1", &
"standard pair mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_1
<<SF mappings: tests>>=
subroutine sf_mappings_1 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p
write (u, "(A)") "* Test output: sf_mappings_1"
write (u, "(A)") "* Purpose: probe standard mapping"
write (u, "(A)")
allocate (sf_s_mapping_t :: mapping)
select type (mapping)
type is (sf_s_mapping_t)
call mapping%init ()
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.5):"
p = [0.1_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.1):"
p = [0.1_default, 0.1_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
allocate (sf_s_mapping_t :: mapping)
select type (mapping)
type is (sf_s_mapping_t)
call mapping%init (power=2._default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
write (u, *)
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.5):"
p = [0.1_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.1):"
p = [0.1_default, 0.1_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_1"
end subroutine sf_mappings_1
@ %def sf_mappings_1
@
\subsubsection{Channel entries}
Construct channel entries and print them.
<<SF mappings: execute tests>>=
call test (sf_mappings_2, "sf_mappings_2", &
"structure-function mapping channels", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_2
<<SF mappings: tests>>=
subroutine sf_mappings_2 (u)
integer, intent(in) :: u
type(sf_channel_t), dimension(:), allocatable :: channel
integer :: c
write (u, "(A)") "* Test output: sf_mappings_2"
write (u, "(A)") "* Purpose: construct and display &
&mapping-channel objects"
write (u, "(A)")
call allocate_sf_channels (channel, n_channel = 8, n_strfun = 2)
call channel(2)%activate_mapping ([1])
call channel(3)%set_s_mapping ([1,2])
call channel(4)%set_s_mapping ([1,2], power=2._default)
call channel(5)%set_res_mapping ([1,2], m = 0.5_default, w = 0.1_default, single = .false.)
call channel(6)%set_os_mapping ([1,2], m = 0.5_default, single = .false.)
call channel(7)%set_res_mapping ([1], m = 0.5_default, w = 0.1_default, single = .true.)
call channel(8)%set_os_mapping ([1], m = 0.5_default, single = .true.)
call channel(3)%set_par_index (1, 1)
call channel(3)%set_par_index (2, 4)
call channel(4)%set_par_index (1, 1)
call channel(4)%set_par_index (2, 4)
call channel(5)%set_par_index (1, 1)
call channel(5)%set_par_index (2, 3)
call channel(6)%set_par_index (1, 1)
call channel(6)%set_par_index (2, 2)
call channel(7)%set_par_index (1, 1)
call channel(8)%set_par_index (1, 1)
do c = 1, size (channel)
write (u, "(I0,':')", advance="no") c
call channel(c)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_2"
end subroutine sf_mappings_2
@ %def sf_mappings_2
@
\subsubsection{Check resonance mapping}
Probe the resonance mapping of the unit square for different parameter
values. Also calculates integrals. For a finite number of bins, they differ
slightly from $1$, but the result is well-defined because we are not using
random points.
The resonance mass is at $1/2$ the energy, the width is $1/10$.
<<SF mappings: execute tests>>=
call test (sf_mappings_3, "sf_mappings_3", &
"resonant pair mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_3
<<SF mappings: tests>>=
subroutine sf_mappings_3 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p
write (u, "(A)") "* Test output: sf_mappings_3"
write (u, "(A)") "* Purpose: probe resonance pair mapping"
write (u, "(A)")
allocate (sf_res_mapping_t :: mapping)
select type (mapping)
type is (sf_res_mapping_t)
call mapping%init (0.5_default, 0.1_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.5):"
p = [0.1_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.1):"
p = [0.1_default, 0.1_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_3"
end subroutine sf_mappings_3
@ %def sf_mappings_3
@
\subsubsection{Check on-shell mapping}
Probe the on-shell mapping of the unit square for different parameter
values. Also calculates integrals. In this case, the Jacobian is
constant and given by $|\log m^2|$, so this is also the value of the
integral. The factor results from the variable change in the $\delta$
function $\delta (m^2 - x_1x_2)$ which multiplies the cross section
for the case at hand.
For the test, the (rescaled) resonance mass is set at $1/2$ the
energy.
<<SF mappings: execute tests>>=
call test (sf_mappings_4, "sf_mappings_4", &
"on-shell pair mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_4
<<SF mappings: tests>>=
subroutine sf_mappings_4 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p
write (u, "(A)") "* Test output: sf_mappings_4"
write (u, "(A)") "* Purpose: probe on-shell pair mapping"
write (u, "(A)")
allocate (sf_os_mapping_t :: mapping)
select type (mapping)
type is (sf_os_mapping_t)
call mapping%init (0.5_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0,0.1):"
p = [0._default, 0.1_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0,1.0):"
p = [0._default, 1.0_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_4"
end subroutine sf_mappings_4
@ %def sf_mappings_4
@
\subsubsection{Check endpoint mapping}
Probe the endpoint mapping of the unit square for different parameter
values. Also calculates integrals. For a finite number of bins, they differ
slightly from $1$, but the result is well-defined because we are not using
random points.
<<SF mappings: execute tests>>=
call test (sf_mappings_5, "sf_mappings_5", &
"endpoint pair mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_5
<<SF mappings: tests>>=
subroutine sf_mappings_5 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p
write (u, "(A)") "* Test output: sf_mappings_5"
write (u, "(A)") "* Purpose: probe endpoint pair mapping"
write (u, "(A)")
allocate (sf_ep_mapping_t :: mapping)
select type (mapping)
type is (sf_ep_mapping_t)
call mapping%init ()
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.5):"
p = [0.1_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.7,0.2):"
p = [0.7_default, 0.2_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_5"
end subroutine sf_mappings_5
@ %def sf_mappings_5
@
\subsubsection{Check endpoint resonant mapping}
Probe the endpoint mapping with resonance. Also calculates integrals.
<<SF mappings: execute tests>>=
call test (sf_mappings_6, "sf_mappings_6", &
"endpoint resonant mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_6
<<SF mappings: tests>>=
subroutine sf_mappings_6 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p
write (u, "(A)") "* Test output: sf_mappings_6"
write (u, "(A)") "* Purpose: probe endpoint resonant mapping"
write (u, "(A)")
allocate (sf_epr_mapping_t :: mapping)
select type (mapping)
type is (sf_epr_mapping_t)
call mapping%init (a = 1._default, m = 0.5_default, w = 0.1_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.5):"
p = [0.1_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.7,0.2):"
p = [0.7_default, 0.2_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Same mapping without resonance:"
write (u, "(A)")
allocate (sf_epr_mapping_t :: mapping)
select type (mapping)
type is (sf_epr_mapping_t)
call mapping%init (a = 1._default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.5):"
p = [0.1_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.7,0.2):"
p = [0.7_default, 0.2_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_6"
end subroutine sf_mappings_6
@ %def sf_mappings_6
@
\subsubsection{Check endpoint on-shell mapping}
Probe the endpoint mapping with an on-shell particle. Also calculates
integrals.
<<SF mappings: execute tests>>=
call test (sf_mappings_7, "sf_mappings_7", &
"endpoint on-shell mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_7
<<SF mappings: tests>>=
subroutine sf_mappings_7 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p
write (u, "(A)") "* Test output: sf_mappings_7"
write (u, "(A)") "* Purpose: probe endpoint on-shell mapping"
write (u, "(A)")
allocate (sf_epo_mapping_t :: mapping)
select type (mapping)
type is (sf_epo_mapping_t)
call mapping%init (a = 1._default, m = 0.5_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0):"
p = [0._default, 0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1,0.5):"
p = [0.1_default, 0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.7,0.2):"
p = [0.7_default, 0.2_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_7"
end subroutine sf_mappings_7
@ %def sf_mappings_7
@
\subsubsection{Check power mapping}
Probe the power mapping of the unit square for different parameter
values. Also calculates integrals. For a finite number of bins, they differ
slightly from $1$, but the result is well-defined because we are not using
random points.
<<SF mappings: execute tests>>=
call test (sf_mappings_8, "sf_mappings_8", &
"power pair mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_8
<<SF mappings: tests>>=
subroutine sf_mappings_8 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p, pb
write (u, "(A)") "* Test output: sf_mappings_8"
write (u, "(A)") "* Purpose: probe power pair mapping"
write (u, "(A)")
allocate (sf_ip_mapping_t :: mapping)
select type (mapping)
type is (sf_ip_mapping_t)
call mapping%init (eps = 0.1_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0.5):"
p = [0._default, 0.5_default]
pb= [1._default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
pb= [0.5_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.9,0.5):"
p = [0.9_default, 0.5_default]
pb= [0.1_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7,0.2):"
p = [0.7_default, 0.2_default]
pb= [0.3_default, 0.8_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7,0.8):"
p = [0.7_default, 0.8_default]
pb= [0.3_default, 0.2_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.99,0.02):"
p = [0.99_default, 0.02_default]
pb= [0.01_default, 0.98_default]
call mapping%check (u, p, pb, FMT_14, FMT_12)
write (u, *)
write (u, "(A)") "Probe at (0.99,0.98):"
p = [0.99_default, 0.98_default]
pb= [0.01_default, 0.02_default]
call mapping%check (u, p, pb, FMT_14, FMT_12)
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_8"
end subroutine sf_mappings_8
@ %def sf_mappings_8
@
\subsubsection{Check resonant power mapping}
Probe the power mapping of the unit square, adapted for an s-channel
resonance, for different parameter values. Also calculates integrals.
For a finite number of bins, they differ slightly from $1$, but the
result is well-defined because we are not using random points.
<<SF mappings: execute tests>>=
call test (sf_mappings_9, "sf_mappings_9", &
"power resonance mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_9
<<SF mappings: tests>>=
subroutine sf_mappings_9 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p, pb
write (u, "(A)") "* Test output: sf_mappings_9"
write (u, "(A)") "* Purpose: probe power resonant pair mapping"
write (u, "(A)")
allocate (sf_ipr_mapping_t :: mapping)
select type (mapping)
type is (sf_ipr_mapping_t)
call mapping%init (eps = 0.1_default, m = 0.5_default, w = 0.1_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0.5):"
p = [0._default, 0.5_default]
pb= [1._default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
pb= [0.5_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.9,0.5):"
p = [0.9_default, 0.5_default]
pb= [0.1_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7,0.2):"
p = [0.7_default, 0.2_default]
pb= [0.3_default, 0.8_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7,0.8):"
p = [0.7_default, 0.8_default]
pb= [0.3_default, 0.2_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.9999,0.02):"
p = [0.9999_default, 0.02_default]
pb= [0.0001_default, 0.98_default]
call mapping%check (u, p, pb, FMT_11, FMT_12)
write (u, *)
write (u, "(A)") "Probe at (0.9999,0.98):"
p = [0.9999_default, 0.98_default]
pb= [0.0001_default, 0.02_default]
call mapping%check (u, p, pb, FMT_11, FMT_12)
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Same mapping without resonance:"
write (u, "(A)")
allocate (sf_ipr_mapping_t :: mapping)
select type (mapping)
type is (sf_ipr_mapping_t)
call mapping%init (eps = 0.1_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0.5):"
p = [0._default, 0.5_default]
pb= [1._default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.5,0.5):"
p = [0.5_default, 0.5_default]
pb= [0.5_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.9,0.5):"
p = [0.9_default, 0.5_default]
pb= [0.1_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7,0.2):"
p = [0.7_default, 0.2_default]
pb= [0.3_default, 0.8_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7,0.8):"
p = [0.7_default, 0.8_default]
pb= [0.3_default, 0.2_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_9"
end subroutine sf_mappings_9
@ %def sf_mappings_9
@
\subsubsection{Check on-shell power mapping}
Probe the power mapping of the unit square, adapted for
single-particle production, for different parameter values. Also
calculates integrals. For a finite number of bins, they differ
slightly from $1$, but the result is well-defined because we are not
using random points.
<<SF mappings: execute tests>>=
call test (sf_mappings_10, "sf_mappings_10", &
"power on-shell mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_10
<<SF mappings: tests>>=
subroutine sf_mappings_10 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(2) :: p, pb
write (u, "(A)") "* Test output: sf_mappings_10"
write (u, "(A)") "* Purpose: probe power on-shell mapping"
write (u, "(A)")
allocate (sf_ipo_mapping_t :: mapping)
select type (mapping)
type is (sf_ipo_mapping_t)
call mapping%init (eps = 0.1_default, m = 0.5_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0,0.5):"
p = [0._default, 0.5_default]
pb= [1._default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0,0.02):"
p = [0._default, 0.02_default]
pb= [1._default, 0.98_default]
call mapping%check (u, p, pb, FMT_15, FMT_12)
write (u, *)
write (u, "(A)") "Probe at (0,0.98):"
p = [0._default, 0.98_default]
pb= [1._default, 0.02_default]
call mapping%check (u, p, pb, FMT_15, FMT_12)
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_10"
end subroutine sf_mappings_10
@ %def sf_mappings_10
@
\subsubsection{Check combined endpoint-power mapping}
Probe the mapping for the beamstrahlung/ISR combination.
<<SF mappings: execute tests>>=
call test (sf_mappings_11, "sf_mappings_11", &
"endpoint/power combined mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_11
<<SF mappings: tests>>=
subroutine sf_mappings_11 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(4) :: p, pb
write (u, "(A)") "* Test output: sf_mappings_11"
write (u, "(A)") "* Purpose: probe power pair mapping"
write (u, "(A)")
allocate (sf_ei_mapping_t :: mapping)
select type (mapping)
type is (sf_ei_mapping_t)
call mapping%init (eps = 0.1_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
call mapping%set_index (3, 3)
call mapping%set_index (4, 4)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
call mapping%check (u, p, pb, FMT_13, FMT_12)
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_11"
end subroutine sf_mappings_11
@ %def sf_mappings_11
@
\subsubsection{Check resonant endpoint-power mapping}
Probe the mapping for the beamstrahlung/ISR combination.
<<SF mappings: execute tests>>=
call test (sf_mappings_12, "sf_mappings_12", &
"endpoint/power resonant combined mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_12
<<SF mappings: tests>>=
subroutine sf_mappings_12 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(4) :: p, pb
write (u, "(A)") "* Test output: sf_mappings_12"
write (u, "(A)") "* Purpose: probe resonant combined mapping"
write (u, "(A)")
allocate (sf_eir_mapping_t :: mapping)
select type (mapping)
type is (sf_eir_mapping_t)
call mapping%init (a = 1._default, &
eps = 0.1_default, m = 0.5_default, w = 0.1_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
call mapping%set_index (3, 3)
call mapping%set_index (4, 4)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
call mapping%check (u, p, pb, FMT_15, FMT_12)
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_12"
end subroutine sf_mappings_12
@ %def sf_mappings_12
@
\subsubsection{Check on-shell endpoint-power mapping}
Probe the mapping for the beamstrahlung/ISR combination.
<<SF mappings: execute tests>>=
call test (sf_mappings_13, "sf_mappings_13", &
"endpoint/power on-shell combined mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_13
<<SF mappings: tests>>=
subroutine sf_mappings_13 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(4) :: p, pb
write (u, "(A)") "* Test output: sf_mappings_13"
write (u, "(A)") "* Purpose: probe on-shell combined mapping"
write (u, "(A)")
allocate (sf_eio_mapping_t :: mapping)
select type (mapping)
type is (sf_eio_mapping_t)
call mapping%init (a = 1._default, eps = 0.1_default, m = 0.5_default)
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
call mapping%set_index (3, 3)
call mapping%set_index (4, 4)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
call mapping%check (u, p, pb, FMT_16)
write (u, *)
write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
call mapping%check (u, p, pb, FMT_14, FMT_12)
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_13"
end subroutine sf_mappings_13
@ %def sf_mappings_13
@
\subsubsection{Check rescaling}
Check the rescaling factor in on-shell basic mapping.
<<SF mappings: execute tests>>=
call test (sf_mappings_14, "sf_mappings_14", &
"rescaled on-shell mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_14
<<SF mappings: tests>>=
subroutine sf_mappings_14 (u)
integer, intent(in) :: u
real(default), dimension(2) :: p2, r2
real(default), dimension(1) :: p1, r1
real(default) :: f, x_free, m2
write (u, "(A)") "* Test output: sf_mappings_14"
write (u, "(A)") "* Purpose: probe rescaling in os mapping"
write (u, "(A)")
x_free = 0.9_default
m2 = 0.5_default
write (u, "(A)") "* Two parameters"
write (u, "(A)")
p2 = [0.1_default, 0.2_default]
call map_on_shell (r2, f, p2, -log (m2), x_free)
write (u, "(A,9(1x," // FMT_14 // "))") "p =", p2
write (u, "(A,9(1x," // FMT_14 // "))") "r =", r2
write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
write (u, "(A,9(1x," // FMT_14 // "))") "*r=", x_free * product (r2)
write (u, *)
call map_on_shell_inverse (r2, f, p2, -log (m2), x_free)
write (u, "(A,9(1x," // FMT_14 // "))") "p =", p2
write (u, "(A,9(1x," // FMT_14 // "))") "r =", r2
write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
write (u, "(A,9(1x," // FMT_14 // "))") "*r=", x_free * product (r2)
write (u, "(A)")
write (u, "(A)") "* One parameter"
write (u, "(A)")
p1 = [0.1_default]
call map_on_shell_single (r1, f, p1, -log (m2), x_free)
write (u, "(A,9(1x," // FMT_14 // "))") "p =", p1
write (u, "(A,9(1x," // FMT_14 // "))") "r =", r1
write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
write (u, "(A,9(1x," // FMT_14 // "))") "*r=", x_free * product (r1)
write (u, *)
call map_on_shell_single_inverse (r1, f, p1, -log (m2), x_free)
write (u, "(A,9(1x," // FMT_14 // "))") "p =", p1
write (u, "(A,9(1x," // FMT_14 // "))") "r =", r1
write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
write (u, "(A,9(1x," // FMT_14 // "))") "*r=", x_free * product (r1)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_14"
end subroutine sf_mappings_14
@ %def sf_mappings_14
@
\subsubsection{Check single parameter resonance mapping}
Probe the resonance mapping of the unit interval for different parameter
values. Also calculates integrals.
The resonance mass is at $1/2$ the energy, the width is $1/10$.
<<SF mappings: execute tests>>=
call test (sf_mappings_15, "sf_mappings_15", &
"resonant single mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_15
<<SF mappings: tests>>=
subroutine sf_mappings_15 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(1) :: p
write (u, "(A)") "* Test output: sf_mappings_15"
write (u, "(A)") "* Purpose: probe resonance single mapping"
write (u, "(A)")
allocate (sf_res_mapping_single_t :: mapping)
select type (mapping)
type is (sf_res_mapping_single_t)
call mapping%init (0.5_default, 0.1_default)
call mapping%set_index (1, 1)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0):"
p = [0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5):"
p = [0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.1):"
p = [0.1_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_15"
end subroutine sf_mappings_15
@ %def sf_mappings_15
@
\subsubsection{Check single parameter on-shell mapping}
Probe the on-shell (pseudo) mapping of the unit interval for different parameter
values. Also calculates integrals.
The resonance mass is at $1/2$ the energy.
<<SF mappings: execute tests>>=
call test (sf_mappings_16, "sf_mappings_16", &
"on-shell single mapping", &
u, results)
<<SF mappings: test declarations>>=
public :: sf_mappings_16
<<SF mappings: tests>>=
subroutine sf_mappings_16 (u)
integer, intent(in) :: u
class(sf_mapping_t), allocatable :: mapping
real(default), dimension(1) :: p
write (u, "(A)") "* Test output: sf_mappings_16"
write (u, "(A)") "* Purpose: probe on-shell single mapping"
write (u, "(A)")
allocate (sf_os_mapping_single_t :: mapping)
select type (mapping)
type is (sf_os_mapping_single_t)
call mapping%init (0.5_default)
call mapping%set_index (1, 1)
end select
call mapping%write (u)
write (u, *)
write (u, "(A)") "Probe at (0):"
p = [0._default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Probe at (0.5):"
p = [0.5_default]
call mapping%check (u, p, 1-p, "F7.5")
write (u, *)
write (u, "(A)") "Compute integral:"
write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
deallocate (mapping)
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_mappings_16"
end subroutine sf_mappings_16
@ %def sf_mappings_16
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Structure function base}
<<[[sf_base.f90]]>>=
<<File header>>
module sf_base
<<Use kinds>>
<<Use strings>>
use numeric_utils, only: pacify
use lorentz
use quantum_numbers
use pdg_arrays
use interactions
use evaluators
use beams
use sf_aux
use sf_mappings
<<Standard module head>>
<<SF base: public>>
<<SF base: parameters>>
<<SF base: types>>
<<SF base: interfaces>>
interface
<<SF base: sub interfaces>>
end interface
end module sf_base
@ %def sf_base
@
<<[[sf_base_sub.f90]]>>=
<<File header>>
submodule (sf_base) sf_base_s
use io_units
use format_utils, only: write_separator
use format_defs, only: FMT_17, FMT_19
use constants, only: one, two
use diagnostics
use physics_defs, only: n_beams_rescaled
implicit none
contains
<<SF base: procedures>>
end submodule sf_base_s
@ %def sf_base_s
@
\subsection{Abstract rescale data-type}
NLO calculations require the treatment of initial state parton radiation.
The radiation of a parton rescales the energy fraction which enters the hard process.
We allow for different rescale settings by extending the abstract.
[[sf_rescale_t]] data type.
<<SF base: public>>=
public :: sf_rescale_t
<<SF base: types>>=
type, abstract :: sf_rescale_t
integer :: i_beam = 0
contains
<<SF base: rescaling function: TBP>>
end type sf_rescale_t
@ %def sf_rescale_t
@
<<SF base: rescaling function: TBP>>=
procedure (sf_rescale_apply), deferred :: apply
<<SF base: interfaces>>=
abstract interface
subroutine sf_rescale_apply (func, x)
import
class(sf_rescale_t), intent(in) :: func
real(default), intent(inout) :: x
end subroutine sf_rescale_apply
end interface
@ %def rescale_apply
@
<<SF base: rescaling function: TBP>>=
procedure :: set_i_beam => sf_rescale_set_i_beam
<<SF base: sub interfaces>>=
module subroutine sf_rescale_set_i_beam (func, i_beam)
class(sf_rescale_t), intent(inout) :: func
integer, intent(in) :: i_beam
end subroutine sf_rescale_set_i_beam
<<SF base: procedures>>=
module subroutine sf_rescale_set_i_beam (func, i_beam)
class(sf_rescale_t), intent(inout) :: func
integer, intent(in) :: i_beam
func%i_beam = i_beam
end subroutine sf_rescale_set_i_beam
@ %def rescale_set_i_beam
@
<<SF base: public>>=
public :: sf_rescale_collinear_t
<<SF base: types>>=
type, extends (sf_rescale_t) :: sf_rescale_collinear_t
real(default) :: xi_tilde
contains
<<SF base: rescale collinear: TBP>>
end type sf_rescale_collinear_t
@ %def sf_rescale_collinear_t
@ For the subtraction terms we need to rescale the Born $x$ of both beams in the
collinear limit. This leaves one beam unaffected and rescales the other according to
\begin{equation}
x = \frac{\overline{x}}{1-\xi}
\end{equation}
which is the collinear limit of [[sf_rescale_real_apply]].
<<SF base: rescale collinear: TBP>>=
procedure :: apply => sf_rescale_collinear_apply
<<SF base: sub interfaces>>=
module subroutine sf_rescale_collinear_apply (func, x)
class(sf_rescale_collinear_t), intent(in) :: func
real(default), intent(inout) :: x
end subroutine sf_rescale_collinear_apply
<<SF base: procedures>>=
module subroutine sf_rescale_collinear_apply (func, x)
class(sf_rescale_collinear_t), intent(in) :: func
real(default), intent(inout) :: x
real(default) :: xi
if (debug2_active (D_BEAMS)) then
print *, 'Rescaling function - Collinear: '
print *, 'Input, unscaled x: ', x
print *, 'xi_tilde: ', func%xi_tilde
end if
xi = func%xi_tilde * (one - x)
x = x / (one - xi)
if (debug2_active (D_BEAMS)) print *, 'rescaled x: ', x
end subroutine sf_rescale_collinear_apply
@ %def sf_rescale_collinear_apply
@
<<SF base: rescale collinear: TBP>>=
procedure :: set => sf_rescale_collinear_set
<<SF base: sub interfaces>>=
module subroutine sf_rescale_collinear_set (func, xi_tilde)
class(sf_rescale_collinear_t), intent(inout) :: func
real(default), intent(in) :: xi_tilde
end subroutine sf_rescale_collinear_set
<<SF base: procedures>>=
module subroutine sf_rescale_collinear_set (func, xi_tilde)
class(sf_rescale_collinear_t), intent(inout) :: func
real(default), intent(in) :: xi_tilde
func%xi_tilde = xi_tilde
end subroutine sf_rescale_collinear_set
@ %def sf_rescale_collinear_set
@
<<SF base: public>>=
public :: sf_rescale_real_t
<<SF base: types>>=
type, extends (sf_rescale_t) :: sf_rescale_real_t
real(default) :: xi, y
contains
<<SF base: rescale real: TBP>>
end type sf_rescale_real_t
@ %def sf_rescale_real_t
@ In case of IS Splittings, the beam $x$ changes from Born to real and thus needs to be rescaled according to
\begin{equation}
x_\oplus = \frac{\overline{x}_\oplus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1-y)}{2-\xi(1+y)}}
, \qquad
x_\ominus = \frac{\overline{x}_\ominus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1+y)}{2-\xi(1-y)}}
\end{equation}
Refs:
\begin{itemize}
\item[\textbullet] [0709.2092] Eq. (5.7).
\item[\textbullet] [0907.4076] Eq. (2.21).
\item Christian Weiss' PhD Thesis (DESY-THESIS-2017-025), Eq. (A.2.3).
\end{itemize}
<<SF base: rescale real: TBP>>=
procedure :: apply => sf_rescale_real_apply
<<SF base: sub interfaces>>=
module subroutine sf_rescale_real_apply (func, x)
class(sf_rescale_real_t), intent(in) :: func
real(default), intent(inout) :: x
end subroutine sf_rescale_real_apply
<<SF base: procedures>>=
module subroutine sf_rescale_real_apply (func, x)
class(sf_rescale_real_t), intent(in) :: func
real(default), intent(inout) :: x
real(default) :: onepy, onemy
if (debug2_active (D_BEAMS)) then
print *, 'Rescaling function - Real: '
print *, 'Input, unscaled: ', x
print *, 'Beam index: ', func%i_beam
print *, 'xi: ', func%xi, 'y: ', func%y
end if
x = x / sqrt (one - func%xi)
onepy = one + func%y; onemy = one - func%y
if (func%i_beam == 1) then
x = x * sqrt ((two - func%xi * onemy) / (two - func%xi * onepy))
else if (func%i_beam == 2) then
x = x * sqrt ((two - func%xi * onepy) / (two - func%xi * onemy))
else
call msg_fatal ("sf_rescale_real_apply - invalid beam index")
end if
if (debug2_active (D_BEAMS)) print *, 'rescaled x: ', x
end subroutine sf_rescale_real_apply
@ %def sf_rescale_real_apply
@
<<SF base: rescale real: TBP>>=
procedure :: set => sf_rescale_real_set
<<SF base: sub interfaces>>=
module subroutine sf_rescale_real_set (func, xi, y)
class(sf_rescale_real_t), intent(inout) :: func
real(default), intent(in) :: xi, y
end subroutine sf_rescale_real_set
<<SF base: procedures>>=
module subroutine sf_rescale_real_set (func, xi, y)
class(sf_rescale_real_t), intent(inout) :: func
real(default), intent(in) :: xi, y
func%xi = xi; func%y = y
end subroutine sf_rescale_real_set
@ %def sf_rescale_real_set
<<SF base: public>>=
public :: sf_rescale_dglap_t
<<SF base: types>>=
type, extends(sf_rescale_t) :: sf_rescale_dglap_t
real(default), dimension(:), allocatable :: z
contains
<<SF base: rescale dglap: TBP>>
end type sf_rescale_dglap_t
@ %def sf_rescale_dglap_t
@
<<SF base: rescale dglap: TBP>>=
procedure :: apply => sf_rescale_dglap_apply
<<SF base: sub interfaces>>=
module subroutine sf_rescale_dglap_apply (func, x)
class(sf_rescale_dglap_t), intent(in) :: func
real(default), intent(inout) :: x
end subroutine sf_rescale_dglap_apply
<<SF base: procedures>>=
module subroutine sf_rescale_dglap_apply (func, x)
class(sf_rescale_dglap_t), intent(in) :: func
real(default), intent(inout) :: x
if (debug2_active (D_BEAMS)) then
print *, "Rescaling function - DGLAP:"
print *, "Input: ", x
print *, "Beam index: ", func%i_beam
print *, "z: ", func%z
end if
x = x / func%z(func%i_beam)
if (debug2_active (D_BEAMS)) print *, "scaled x: ", x
end subroutine sf_rescale_dglap_apply
@ %def sf_rescale_dglap_apply
@
<<SF base: rescale dglap: TBP>>=
procedure :: set => sf_rescale_dglap_set
<<SF base: sub interfaces>>=
module subroutine sf_rescale_dglap_set (func, z)
class(sf_rescale_dglap_t), intent(inout) :: func
real(default), dimension(:), intent(in) :: z
end subroutine sf_rescale_dglap_set
<<SF base: procedures>>=
module subroutine sf_rescale_dglap_set (func, z)
class(sf_rescale_dglap_t), intent(inout) :: func
real(default), dimension(:), intent(in) :: z
func%z = z
end subroutine sf_rescale_dglap_set
@ %def sf_rescale_dglap_set
@
\subsection{Abstract structure-function data type}
This type should hold all configuration data for a specific type of
structure function. The base object is empty; the implementations
will fill it.
<<SF base: public>>=
public :: sf_data_t
<<SF base: types>>=
type, abstract :: sf_data_t
contains
<<SF base: sf data: TBP>>
end type sf_data_t
@ %def sf_data_t
@ Output.
<<SF base: sf data: TBP>>=
procedure (sf_data_write), deferred :: write
<<SF base: interfaces>>=
abstract interface
subroutine sf_data_write (data, unit, verbose)
import
class(sf_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine sf_data_write
end interface
@ %def sf_data_write
@ Return true if this structure function is in generator mode. In
that case, all parameters are free, otherwise bound. (We do not
support mixed cases.) Default is: no generator.
<<SF base: sf data: TBP>>=
procedure :: is_generator => sf_data_is_generator
<<SF base: sub interfaces>>=
module function sf_data_is_generator (data) result (flag)
class(sf_data_t), intent(in) :: data
logical :: flag
end function sf_data_is_generator
<<SF base: procedures>>=
module function sf_data_is_generator (data) result (flag)
class(sf_data_t), intent(in) :: data
logical :: flag
flag = .false.
end function sf_data_is_generator
@ %def sf_data_is_generator
@ Return the number of input parameters that determine the
structure function.
<<SF base: sf data: TBP>>=
procedure (sf_data_get_int), deferred :: get_n_par
<<SF base: interfaces>>=
abstract interface
function sf_data_get_int (data) result (n)
import
class(sf_data_t), intent(in) :: data
integer :: n
end function sf_data_get_int
end interface
@ %def sf_data_get_int
@ Return the outgoing particle PDG codes for the current setup. The codes can
be an array of particles, for each beam.
<<SF base: sf data: TBP>>=
procedure (sf_data_get_pdg_out), deferred :: get_pdg_out
<<SF base: interfaces>>=
abstract interface
subroutine sf_data_get_pdg_out (data, pdg_out)
import
class(sf_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine sf_data_get_pdg_out
end interface
@ %def sf_data_get_pdg_out
@ Allocate a matching structure function interaction object and
properly initialize it.
<<SF base: sf data: TBP>>=
procedure (sf_data_allocate_sf_int), deferred :: allocate_sf_int
<<SF base: interfaces>>=
abstract interface
subroutine sf_data_allocate_sf_int (data, sf_int)
import
class(sf_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
end subroutine sf_data_allocate_sf_int
end interface
@ %def sf_data_allocate_sf_int
@ Return the PDF set index, if applicable. We implement a default
method which returns zero. The PDF (builtin and LHA) implementations
will override this.
<<SF base: sf data: TBP>>=
procedure :: get_pdf_set => sf_data_get_pdf_set
<<SF base: sub interfaces>>=
elemental module function sf_data_get_pdf_set (data) result (pdf_set)
class(sf_data_t), intent(in) :: data
integer :: pdf_set
end function sf_data_get_pdf_set
<<SF base: procedures>>=
elemental module function sf_data_get_pdf_set (data) result (pdf_set)
class(sf_data_t), intent(in) :: data
integer :: pdf_set
pdf_set = 0
end function sf_data_get_pdf_set
@ %def sf_data_get_pdf_set
@ Return the spectrum file, if applicable. We implement a default
method which returns zero. CIRCE1, CIRCE2 and the beam spectrum will
override this.
<<SF base: sf data: TBP>>=
procedure :: get_beam_file => sf_data_get_beam_file
<<SF base: sub interfaces>>=
module function sf_data_get_beam_file (data) result (file)
class(sf_data_t), intent(in) :: data
type(string_t) :: file
end function sf_data_get_beam_file
<<SF base: procedures>>=
module function sf_data_get_beam_file (data) result (file)
class(sf_data_t), intent(in) :: data
type(string_t) :: file
file = ""
end function sf_data_get_beam_file
@ %def sf_data_get_beam_file
@
\subsection{Structure-function chain configuration}
This is the data type that the [[process]] module uses for setting
up its structure-function chain. For each structure function described
by the beam data, there is an entry. The [[i]] array indicates the
beam(s) to which this structure function applies, and the [[data]]
object contains the actual configuration data.
<<SF base: public>>=
public :: sf_config_t
<<SF base: types>>=
type :: sf_config_t
integer, dimension(:), allocatable :: i
class(sf_data_t), allocatable :: data
contains
<<SF base: sf config: TBP>>
end type sf_config_t
@ %def sf_config_t
@ Output:
<<SF base: sf config: TBP>>=
procedure :: write => sf_config_write
<<SF base: sub interfaces>>=
module subroutine sf_config_write (object, unit, verbose)
class(sf_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine sf_config_write
<<SF base: procedures>>=
module subroutine sf_config_write (object, unit, verbose)
class(sf_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
if (allocated (object%i)) then
write (u, "(1x,A,2(1x,I0))") "Structure-function configuration: &
&beam(s)", object%i
if (allocated (object%data)) &
call object%data%write (u, verbose = verbose)
else
write (u, "(1x,A)") "Structure-function configuration: [undefined]"
end if
end subroutine sf_config_write
@ %def sf_config_write
@ Initialize.
<<SF base: sf config: TBP>>=
procedure :: init => sf_config_init
<<SF base: sub interfaces>>=
module subroutine sf_config_init (sf_config, i_beam, sf_data)
class(sf_config_t), intent(out) :: sf_config
integer, dimension(:), intent(in) :: i_beam
class(sf_data_t), intent(in) :: sf_data
end subroutine sf_config_init
<<SF base: procedures>>=
module subroutine sf_config_init (sf_config, i_beam, sf_data)
class(sf_config_t), intent(out) :: sf_config
integer, dimension(:), intent(in) :: i_beam
class(sf_data_t), intent(in) :: sf_data
allocate (sf_config%i (size (i_beam)), source = i_beam)
allocate (sf_config%data, source = sf_data)
end subroutine sf_config_init
@ %def sf_config_init
@ Return the PDF set, if any.
<<SF base: sf config: TBP>>=
procedure :: get_pdf_set => sf_config_get_pdf_set
<<SF base: sub interfaces>>=
elemental module function sf_config_get_pdf_set (sf_config) result (pdf_set)
class(sf_config_t), intent(in) :: sf_config
integer :: pdf_set
end function sf_config_get_pdf_set
<<SF base: procedures>>=
elemental module function sf_config_get_pdf_set (sf_config) result (pdf_set)
class(sf_config_t), intent(in) :: sf_config
integer :: pdf_set
pdf_set = sf_config%data%get_pdf_set ()
end function sf_config_get_pdf_set
@ %def sf_config_get_pdf_set
@ Return the beam spectrum file, if any.
<<SF base: sf config: TBP>>=
procedure :: get_beam_file => sf_config_get_beam_file
<<SF base: sub interfaces>>=
module function sf_config_get_beam_file (sf_config) result (file)
class(sf_config_t), intent(in) :: sf_config
type(string_t) :: file
end function sf_config_get_beam_file
<<SF base: procedures>>=
module function sf_config_get_beam_file (sf_config) result (file)
class(sf_config_t), intent(in) :: sf_config
type(string_t) :: file
file = sf_config%data%get_beam_file ()
end function sf_config_get_beam_file
@ %def sf_config_get_beam_file
@
\subsection{Structure-function instance}
The [[sf_int_t]] data type contains an [[interaction_t]] object (it is
an extension of this type) and a pointer to the [[sf_data_t]]
configuration data. This interaction, or copies of it, is used to
implement structure-function kinematics and dynamics in the context of
process evaluation.
The status code [[status]] tells whether the interaction is undefined,
has defined kinematics (but matrix elements invalid), or is completely
defined. There is also a status code for failure. The implementation
is responsible for updating the status.
The entries [[mi2]], [[mr2]], and [[mo2]] hold the squared
invariant masses of the incoming, radiated, and outgoing particle,
respectively. They are supposed to be set upon initialization, but
could also be varied event by event.
If the radiated or outgoing mass is nonzero, we may need to apply an
on-shell projection. The projection mode is stored as
[[on_shell_mode]].
The array [[beam_index]] is the list of beams on which this structure
function applies ($1$, $2$, or both). The arrays [[incoming]],
[[radiated]], and [[outgoing]] contain the indices of the respective
particle sets within the interaction, for convenient lookup. The
array [[par_index]] indicates the MC input parameters that this entry
will use up in the structure-function chain. The first parameter (or
the first two, for a spectrum) in this array determines the momentum
fraction and is thus subject to global mappings.
In the abstract base type, we do not implement the data pointer. This
allows us to restrict its type in the implementations.
<<SF base: public>>=
public :: sf_int_t
<<SF base: types>>=
type, abstract, extends (interaction_t) :: sf_int_t
integer :: status = SF_UNDEFINED
real(default), dimension(:), allocatable :: mi2
real(default), dimension(:), allocatable :: mr2
real(default), dimension(:), allocatable :: mo2
integer :: on_shell_mode = KEEP_ENERGY
logical :: qmin_defined = .false.
logical :: qmax_defined = .false.
real(default), dimension(:), allocatable :: qmin
real(default), dimension(:), allocatable :: qmax
integer, dimension(:), allocatable :: beam_index
integer, dimension(:), allocatable :: incoming
integer, dimension(:), allocatable :: radiated
integer, dimension(:), allocatable :: outgoing
integer, dimension(:), allocatable :: par_index
integer, dimension(:), allocatable :: par_primary
contains
<<SF base: sf int: TBP>>
end type sf_int_t
@ %def sf_int_t
@ Status codes. The codes that refer to links, masks, and
connections, apply to structure-function chains only.
The status codes are public.
<<SF base: parameters>>=
integer, parameter, public :: SF_UNDEFINED = 0
integer, parameter, public :: SF_INITIAL = 1
integer, parameter, public :: SF_DONE_LINKS = 2
integer, parameter, public :: SF_FAILED_MASK = 3
integer, parameter, public :: SF_DONE_MASK = 4
integer, parameter, public :: SF_FAILED_CONNECTIONS = 5
integer, parameter, public :: SF_DONE_CONNECTIONS = 6
integer, parameter, public :: SF_SEED_KINEMATICS = 10
integer, parameter, public :: SF_FAILED_KINEMATICS = 11
integer, parameter, public :: SF_DONE_KINEMATICS = 12
integer, parameter, public :: SF_FAILED_EVALUATION = 13
integer, parameter, public :: SF_EVALUATED = 20
@ %def SF_UNDEFINED SF_INITIAL
@ %def SF_DONE_LINKS SF_DONE_MASK SF_DONE_CONNECTIONS
@ %def SF_DONE_KINEMATICS SF_EVALUATED
@ %def SF_FAILED_MASK SF_FAILED_CONNECTIONS
@ %def SF_FAILED_KINEMATICS SF_FAILED_EVALUATION
@ Write a string version of the status code:
<<SF base: procedures>>=
subroutine write_sf_status (status, u)
integer, intent(in) :: status
integer, intent(in) :: u
select case (status)
case (SF_UNDEFINED)
write (u, "(1x,'[',A,']')") "undefined"
case (SF_INITIAL)
write (u, "(1x,'[',A,']')") "initialized"
case (SF_DONE_LINKS)
write (u, "(1x,'[',A,']')") "links set"
case (SF_FAILED_MASK)
write (u, "(1x,'[',A,']')") "mask mismatch"
case (SF_DONE_MASK)
write (u, "(1x,'[',A,']')") "mask set"
case (SF_FAILED_CONNECTIONS)
write (u, "(1x,'[',A,']')") "connections failed"
case (SF_DONE_CONNECTIONS)
write (u, "(1x,'[',A,']')") "connections set"
case (SF_SEED_KINEMATICS)
write (u, "(1x,'[',A,']')") "incoming momenta set"
case (SF_FAILED_KINEMATICS)
write (u, "(1x,'[',A,']')") "kinematics failed"
case (SF_DONE_KINEMATICS)
write (u, "(1x,'[',A,']')") "kinematics set"
case (SF_FAILED_EVALUATION)
write (u, "(1x,'[',A,']')") "evaluation failed"
case (SF_EVALUATED)
write (u, "(1x,'[',A,']')") "evaluated"
end select
end subroutine write_sf_status
@ %def write_sf_status
@ This is the basic output routine. Display status and interaction.
<<SF base: sf int: TBP>>=
procedure :: base_write => sf_int_base_write
<<SF base: sub interfaces>>=
module subroutine sf_int_base_write (object, unit, testflag)
class(sf_int_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine sf_int_base_write
<<SF base: procedures>>=
module subroutine sf_int_base_write (object, unit, testflag)
class(sf_int_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "SF instance:"
call write_sf_status (object%status, u)
if (allocated (object%beam_index)) &
write (u, "(3x,A,2(1x,I0))") "beam =", object%beam_index
if (allocated (object%incoming)) &
write (u, "(3x,A,2(1x,I0))") "incoming =", object%incoming
if (allocated (object%radiated)) &
write (u, "(3x,A,2(1x,I0))") "radiated =", object%radiated
if (allocated (object%outgoing)) &
write (u, "(3x,A,2(1x,I0))") "outgoing =", object%outgoing
if (allocated (object%par_index)) &
write (u, "(3x,A,2(1x,I0))") "parameter =", object%par_index
if (object%qmin_defined) &
write (u, "(3x,A,1x," // FMT_19 // ")") "q_min =", object%qmin
if (object%qmax_defined) &
write (u, "(3x,A,1x," // FMT_19 // ")") "q_max =", object%qmax
call object%interaction_t%basic_write (u, testflag = testflag)
end subroutine sf_int_base_write
@ %def sf_int_base_write
@ The type string identifies the structure function class, and possibly more
details about the structure function.
<<SF base: sf int: TBP>>=
procedure (sf_int_type_string), deferred :: type_string
<<SF base: interfaces>>=
abstract interface
function sf_int_type_string (object) result (string)
import
class(sf_int_t), intent(in) :: object
type(string_t) :: string
end function sf_int_type_string
end interface
@ %def sf_int_type_string
@ Output of the concrete object. We should not forget to call the
output routine for the base type.
<<SF base: sf int: TBP>>=
procedure (sf_int_write), deferred :: write
<<SF base: interfaces>>=
abstract interface
subroutine sf_int_write (object, unit, testflag)
import
class(sf_int_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine sf_int_write
end interface
@ %def sf_int_write
@ Basic initialization: set the invariant masses for the particles and
initialize the interaction. The caller should then add states to the
interaction and freeze it.
The dimension of the mask should be equal to the sum of the dimensions
of the mass-squared arrays, which determine incoming, radiated, and
outgoing particles, respectively.
Optionally, we can define minimum and maximum values for the momentum
transfer to the outgoing particle(s). If all masses are zero, this is
actually required for non-collinear splitting.
<<SF base: sf int: TBP>>=
procedure :: base_init => sf_int_base_init
<<SF base: sub interfaces>>=
module subroutine sf_int_base_init &
(sf_int, mask, mi2, mr2, mo2, qmin, qmax, hel_lock)
class(sf_int_t), intent(out) :: sf_int
type (quantum_numbers_mask_t), dimension(:), intent(in) :: mask
real(default), dimension(:), intent(in) :: mi2, mr2, mo2
real(default), dimension(:), intent(in), optional :: qmin, qmax
integer, dimension(:), intent(in), optional :: hel_lock
end subroutine sf_int_base_init
<<SF base: procedures>>=
module subroutine sf_int_base_init &
(sf_int, mask, mi2, mr2, mo2, qmin, qmax, hel_lock)
class(sf_int_t), intent(out) :: sf_int
type (quantum_numbers_mask_t), dimension(:), intent(in) :: mask
real(default), dimension(:), intent(in) :: mi2, mr2, mo2
real(default), dimension(:), intent(in), optional :: qmin, qmax
integer, dimension(:), intent(in), optional :: hel_lock
allocate (sf_int%mi2 (size (mi2)))
sf_int%mi2 = mi2
allocate (sf_int%mr2 (size (mr2)))
sf_int%mr2 = mr2
allocate (sf_int%mo2 (size (mo2)))
sf_int%mo2 = mo2
if (present (qmin)) then
sf_int%qmin_defined = .true.
allocate (sf_int%qmin (size (qmin)))
sf_int%qmin = qmin
end if
if (present (qmax)) then
sf_int%qmax_defined = .true.
allocate (sf_int%qmax (size (qmax)))
sf_int%qmax = qmax
end if
call sf_int%interaction_t%basic_init &
(size (mi2), 0, size (mr2) + size (mo2), &
mask = mask, hel_lock = hel_lock, set_relations = .true.)
end subroutine sf_int_base_init
@ %def sf_int_base_init
@ Set the indices of the incoming, radiated, and outgoing particles,
respectively.
<<SF base: sf int: TBP>>=
procedure :: set_incoming => sf_int_set_incoming
procedure :: set_radiated => sf_int_set_radiated
procedure :: set_outgoing => sf_int_set_outgoing
<<SF base: sub interfaces>>=
module subroutine sf_int_set_incoming (sf_int, incoming)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: incoming
end subroutine sf_int_set_incoming
module subroutine sf_int_set_radiated (sf_int, radiated)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: radiated
end subroutine sf_int_set_radiated
module subroutine sf_int_set_outgoing (sf_int, outgoing)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: outgoing
end subroutine sf_int_set_outgoing
<<SF base: procedures>>=
module subroutine sf_int_set_incoming (sf_int, incoming)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: incoming
allocate (sf_int%incoming (size (incoming)))
sf_int%incoming = incoming
end subroutine sf_int_set_incoming
module subroutine sf_int_set_radiated (sf_int, radiated)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: radiated
allocate (sf_int%radiated (size (radiated)))
sf_int%radiated = radiated
end subroutine sf_int_set_radiated
module subroutine sf_int_set_outgoing (sf_int, outgoing)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: outgoing
allocate (sf_int%outgoing (size (outgoing)))
sf_int%outgoing = outgoing
end subroutine sf_int_set_outgoing
@ %def sf_int_set_incoming
@ %def sf_int_set_radiated
@ %def sf_int_set_outgoing
@ Initialization. This proceeds via an abstract data object, which
for the actual implementation should have the matching concrete type.
Since all implementations have the same signature, we can prepare a
deferred procedure. The data object will become the target of a
corresponding pointer within the [[sf_int_t]] implementation.
This should call the previous procedure.
<<SF base: sf int: TBP>>=
procedure (sf_int_init), deferred :: init
<<SF base: interfaces>>=
abstract interface
subroutine sf_int_init (sf_int, data)
import
class(sf_int_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine sf_int_init
end interface
@ %def sf_int_init
@ Complete initialization. This routine contains initializations that can
only be performed after the interaction object got its final shape, i.e.,
redundant helicities have been eliminated by matching with beams and process.
The default implementation does nothing.
The [[target]] attribute is formally required since some overriding
implementations use a temporary pointer (iterator) to the state-matrix
component. It doesn't appear to make a real difference, though.
<<SF base: sf int: TBP>>=
procedure :: setup_constants => sf_int_setup_constants
<<SF base: sub interfaces>>=
module subroutine sf_int_setup_constants (sf_int)
class(sf_int_t), intent(inout), target :: sf_int
end subroutine sf_int_setup_constants
<<SF base: procedures>>=
module subroutine sf_int_setup_constants (sf_int)
class(sf_int_t), intent(inout), target :: sf_int
end subroutine sf_int_setup_constants
@ %def sf_int_setup_constants
@ Set beam indices, i.e., the beam(s) on which
this structure function applies.
<<SF base: sf int: TBP>>=
procedure :: set_beam_index => sf_int_set_beam_index
<<SF base: sub interfaces>>=
module subroutine sf_int_set_beam_index (sf_int, beam_index)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: beam_index
end subroutine sf_int_set_beam_index
<<SF base: procedures>>=
module subroutine sf_int_set_beam_index (sf_int, beam_index)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: beam_index
allocate (sf_int%beam_index (size (beam_index)))
sf_int%beam_index = beam_index
end subroutine sf_int_set_beam_index
@ %def sf_int_set_beam_index
@ Set parameter indices, indicating which MC input parameters are to
be used for evaluating this structure function.
<<SF base: sf int: TBP>>=
procedure :: set_par_index => sf_int_set_par_index
<<SF base: sub interfaces>>=
module subroutine sf_int_set_par_index (sf_int, par_index)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: par_index
end subroutine sf_int_set_par_index
<<SF base: procedures>>=
module subroutine sf_int_set_par_index (sf_int, par_index)
class(sf_int_t), intent(inout) :: sf_int
integer, dimension(:), intent(in) :: par_index
allocate (sf_int%par_index (size (par_index)))
sf_int%par_index = par_index
end subroutine sf_int_set_par_index
@ %def sf_int_set_par_index
@ Initialize the structure-function kinematics, setting incoming
momenta. We assume that array shapes match.
Three versions. The first version relies on the momenta being linked
to another interaction. The second version sets the momenta
explicitly. In the third version, we first compute momenta for the
specified energies and store those.
<<SF base: sf int: TBP>>=
generic :: seed_kinematics => sf_int_receive_momenta
generic :: seed_kinematics => sf_int_seed_momenta
generic :: seed_kinematics => sf_int_seed_energies
procedure :: sf_int_receive_momenta
procedure :: sf_int_seed_momenta
procedure :: sf_int_seed_energies
<<SF base: sub interfaces>>=
module subroutine sf_int_receive_momenta (sf_int)
class(sf_int_t), intent(inout) :: sf_int
end subroutine sf_int_receive_momenta
module subroutine sf_int_seed_momenta (sf_int, k)
class(sf_int_t), intent(inout) :: sf_int
type(vector4_t), dimension(:), intent(in) :: k
end subroutine sf_int_seed_momenta
module subroutine sf_int_seed_energies (sf_int, E)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: E
type(vector4_t), dimension(:), allocatable :: k
end subroutine sf_int_seed_energies
<<SF base: procedures>>=
module subroutine sf_int_receive_momenta (sf_int)
class(sf_int_t), intent(inout) :: sf_int
if (sf_int%status >= SF_INITIAL) then
call sf_int%receive_momenta ()
sf_int%status = SF_SEED_KINEMATICS
end if
end subroutine sf_int_receive_momenta
module subroutine sf_int_seed_momenta (sf_int, k)
class(sf_int_t), intent(inout) :: sf_int
type(vector4_t), dimension(:), intent(in) :: k
if (sf_int%status >= SF_INITIAL) then
call sf_int%set_momenta (k, outgoing=.false.)
sf_int%status = SF_SEED_KINEMATICS
end if
end subroutine sf_int_seed_momenta
module subroutine sf_int_seed_energies (sf_int, E)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: E
type(vector4_t), dimension(:), allocatable :: k
integer :: j
if (sf_int%status >= SF_INITIAL) then
allocate (k (size (E)))
if (all (E**2 >= sf_int%mi2)) then
do j = 1, size (E)
k(j) = vector4_moving (E(j), &
(3-2*j) * sqrt (E(j)**2 - sf_int%mi2(j)), 3)
end do
call sf_int%seed_kinematics (k)
end if
end if
end subroutine sf_int_seed_energies
@ %def sf_int_seed_momenta
@ %def sf_int_seed_energies
@ Tell if in generator mode. By default, this is false. To be
overridden where appropriate; we may refer to the [[is_generator]]
method of the [[data]] component in the concrete type.
<<SF base: sf int: TBP>>=
procedure :: is_generator => sf_int_is_generator
<<SF base: sub interfaces>>=
module function sf_int_is_generator (sf_int) result (flag)
class(sf_int_t), intent(in) :: sf_int
logical :: flag
end function sf_int_is_generator
<<SF base: procedures>>=
module function sf_int_is_generator (sf_int) result (flag)
class(sf_int_t), intent(in) :: sf_int
logical :: flag
flag = .false.
end function sf_int_is_generator
@ %def sf_int_is_generator
@ Generate free parameters [[r]]. Parameters are free if they do not
correspond to integration parameters (i.e., are bound), but are
generated by the structure function object itself. By default, all
parameters are bound, and the output values of this procedure will be
discarded. With free parameters, we have to override this procedure.
The value [[x_free]] is the renormalization factor of the total energy
that corresponds to the free parameters. If there are no free
parameters, the procedure will not change its value, which starts as
unity. Otherwise, the fraction is typically decreased, but may also
be increased in some cases.
<<SF base: sf int: TBP>>=
procedure :: generate_free => sf_int_generate_free
<<SF base: sub interfaces>>=
module subroutine sf_int_generate_free (sf_int, r, rb, x_free)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
end subroutine sf_int_generate_free
<<SF base: procedures>>=
module subroutine sf_int_generate_free (sf_int, r, rb, x_free)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
r = 0
rb= 1
end subroutine sf_int_generate_free
@ %def sf_int_generate_free
@ Complete the structure-function kinematics, derived from an input
parameter (array) $r$ between 0 and 1. The interaction momenta are
calculated, and we return $x$ (the momentum fraction), and $f$ (the
Jacobian factor for the map $r\to x$), if [[map]] is set.
If the [[map]] flag is unset, $r$ and $x$ values will coincide, and $f$ will
become unity. If it is set, the structure-function implementation chooses a
convenient mapping from $r$ to $x$ with Jacobian $f$.
In the [[inverse_kinematics]] variant, we exchange the intent of [[x]]
and [[r]]. The momenta are calculated only if the optional flag
[[set_momenta]] is present and set. Internal parameters of [[sf_int]]
are calculated only if the optional flag [[set_x]] is present and set.
Update 2018-08-22: Throughout this algorithm, we now carry
[[xb]]=$1-x$ together with [[x]] values, as we did for [[r]] before.
This allows us to handle unstable endpoint numerics wherever
necessary. The only place where the changes actually did matter was
for inverse kinematics in the ISR setup, with a very soft photon, but
it might be most sensible to apply the extension with [[xb]] everywhere.
<<SF base: sf int: TBP>>=
procedure (sf_int_complete_kinematics), deferred :: complete_kinematics
procedure (sf_int_inverse_kinematics), deferred :: inverse_kinematics
<<SF base: interfaces>>=
abstract interface
subroutine sf_int_complete_kinematics (sf_int, x, xb, f, r, rb, map)
import
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine sf_int_complete_kinematics
end interface
abstract interface
subroutine sf_int_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
import
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine sf_int_inverse_kinematics
end interface
@ %def sf_int_complete_kinematics
@ %def sf_int_inverse_kinematics
@ Single splitting: compute momenta, given $x$ input parameters. We
assume that the incoming momentum is set. The status code is set to
[[SF_FAILED_KINEMATICS]] if
the $x$ array does not correspond to a valid momentum configuration.
Otherwise, it is updated to [[SF_DONE_KINEMATICS]].
We force the outgoing particle on-shell. The on-shell projection is
determined by the [[on_shell_mode]]. The radiated particle should already be
on shell.
<<SF base: sf int: TBP>>=
procedure :: split_momentum => sf_int_split_momentum
<<SF base: sub interfaces>>=
module subroutine sf_int_split_momentum (sf_int, x, xb)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
end subroutine sf_int_split_momentum
<<SF base: procedures>>=
module subroutine sf_int_split_momentum (sf_int, x, xb)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
type(splitting_data_t) :: sd
real(default) :: E1, E2
logical :: fail
if (sf_int%status >= SF_SEED_KINEMATICS) then
k = sf_int%get_momentum (1)
call sd%init (k, &
sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
collinear = size (x) == 1)
call sd%set_t_bounds (x(1), xb(1))
select case (size (x))
case (1)
case (3)
if (sf_int%qmax_defined) then
if (sf_int%qmin_defined) then
call sd%sample_t (x(2), &
t0 = - sf_int%qmax(1) ** 2, t1 = - sf_int%qmin(1) ** 2)
else
call sd%sample_t (x(2), &
t0 = - sf_int%qmax(1) ** 2)
end if
else
if (sf_int%qmin_defined) then
call sd%sample_t (x(2), t1 = - sf_int%qmin(1) ** 2)
else
call sd%sample_t (x(2))
end if
end if
call sd%sample_phi (x(3))
case default
call msg_bug ("Structure function: impossible number of parameters")
end select
q = sd%split_momentum (k)
call on_shell (q, [sf_int%mr2, sf_int%mo2], &
sf_int%on_shell_mode)
call sf_int%set_momenta (q, outgoing=.true.)
E1 = energy (q(1))
E2 = energy (q(2))
fail = E1 < 0 .or. E2 < 0 &
.or. E1 ** 2 < sf_int%mr2(1) &
.or. E2 ** 2 < sf_int%mo2(1)
if (fail) then
sf_int%status = SF_FAILED_KINEMATICS
else
sf_int%status = SF_DONE_KINEMATICS
end if
end if
end subroutine sf_int_split_momentum
@ %def sf_test_split_momentum
@ Pair splitting: two incoming momenta, two radiated, two outgoing.
This is simple because we insist on all momenta being collinear.
<<SF base: sf int: TBP>>=
procedure :: split_momenta => sf_int_split_momenta
<<SF base: sub interfaces>>=
module subroutine sf_int_split_momenta (sf_int, x, xb)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
end subroutine sf_int_split_momenta
<<SF base: procedures>>=
module subroutine sf_int_split_momenta (sf_int, x, xb)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
type(vector4_t), dimension(2) :: k
type(vector4_t), dimension(4) :: q
real(default), dimension(4) :: E
logical :: fail
if (sf_int%status >= SF_SEED_KINEMATICS) then
select case (size (x))
case (2)
case default
call msg_bug ("Pair structure function: recoil requested &
&but not implemented yet")
end select
k(1) = sf_int%get_momentum (1)
k(2) = sf_int%get_momentum (2)
q(1:2) = xb * k
q(3:4) = x * k
select case (size (sf_int%mr2))
case (2)
call on_shell (q, &
[sf_int%mr2(1), sf_int%mr2(2), &
sf_int%mo2(1), sf_int%mo2(2)], &
sf_int%on_shell_mode)
call sf_int%set_momenta (q, outgoing=.true.)
E = energy (q)
fail = any (E < 0) &
.or. any (E(1:2) ** 2 < sf_int%mr2) &
.or. any (E(3:4) ** 2 < sf_int%mo2)
case default; call msg_bug ("split momenta: incorrect use")
end select
if (fail) then
sf_int%status = SF_FAILED_KINEMATICS
else
sf_int%status = SF_DONE_KINEMATICS
end if
end if
end subroutine sf_int_split_momenta
@ %def sf_int_split_momenta
@ Pair spectrum: the reduced version of the previous splitting,
without radiated momenta.
<<SF base: sf int: TBP>>=
procedure :: reduce_momenta => sf_int_reduce_momenta
<<SF base: sub interfaces>>=
module subroutine sf_int_reduce_momenta (sf_int, x)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
end subroutine sf_int_reduce_momenta
<<SF base: procedures>>=
module subroutine sf_int_reduce_momenta (sf_int, x)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
type(vector4_t), dimension(2) :: k
type(vector4_t), dimension(2) :: q
real(default), dimension(2) :: E
logical :: fail
if (sf_int%status >= SF_SEED_KINEMATICS) then
select case (size (x))
case (2)
case default
call msg_bug ("Pair spectrum: recoil requested &
&but not implemented yet")
end select
k(1) = sf_int%get_momentum (1)
k(2) = sf_int%get_momentum (2)
q = x * k
call on_shell (q, &
[sf_int%mo2(1), sf_int%mo2(2)], &
sf_int%on_shell_mode)
call sf_int%set_momenta (q, outgoing=.true.)
E = energy (q)
fail = any (E < 0) &
.or. any (E ** 2 < sf_int%mo2)
if (fail) then
sf_int%status = SF_FAILED_KINEMATICS
else
sf_int%status = SF_DONE_KINEMATICS
end if
end if
end subroutine sf_int_reduce_momenta
@ %def sf_int_reduce_momenta
@ The inverse procedure: we compute the [[x]] array from the momentum
configuration. In an overriding TBP, we may also set internal data
that depend on this, for convenience.
NOTE: Here and above, the single-particle case is treated in detail,
allowing for non-collinearity and non-vanishing masses and nontrivial
momentum-transfer bounds. For the pair case, we currently implement
only collinear splitting and assume massless particles. This should
be improved.
Update 2017-08-22: recover also [[xb]], using the updated [[recover]]
method of the splitting-data object. Th
<<SF base: sf int: TBP>>=
procedure :: recover_x => sf_int_recover_x
procedure :: base_recover_x => sf_int_recover_x
<<SF base: sub interfaces>>=
module subroutine sf_int_recover_x (sf_int, x, xb, x_free)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
end subroutine sf_int_recover_x
<<SF base: procedures>>=
module subroutine sf_int_recover_x (sf_int, x, xb, x_free)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
type(vector4_t), dimension(:), allocatable :: k
type(vector4_t), dimension(:), allocatable :: q
type(splitting_data_t) :: sd
if (sf_int%status >= SF_SEED_KINEMATICS) then
allocate (k (sf_int%interaction_t%get_n_in ()))
allocate (q (sf_int%interaction_t%get_n_out ()))
k = sf_int%get_momenta (outgoing=.false.)
q = sf_int%get_momenta (outgoing=.true.)
select case (size (k))
case (1)
call sd%init (k(1), &
sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
collinear = size (x) == 1)
call sd%recover (k(1), q, sf_int%on_shell_mode)
x(1) = sd%get_x ()
xb(1) = sd%get_xb ()
select case (size (x))
case (1)
case (3)
if (sf_int%qmax_defined) then
if (sf_int%qmin_defined) then
call sd%inverse_t (x(2), &
t0 = - sf_int%qmax(1) ** 2, t1 = - sf_int%qmin(1) ** 2)
else
call sd%inverse_t (x(2), &
t0 = - sf_int%qmax(1) ** 2)
end if
else
if (sf_int%qmin_defined) then
call sd%inverse_t (x(2), t1 = - sf_int%qmin(1) ** 2)
else
call sd%inverse_t (x(2))
end if
end if
call sd%inverse_phi (x(3))
xb(2:3) = 1 - x(2:3)
case default
call msg_bug ("Structure function: impossible number &
&of parameters")
end select
case (2)
select case (size (x))
case (2)
case default
call msg_bug ("Pair structure function: recoil requested &
&but not implemented yet")
end select
select case (sf_int%on_shell_mode)
case (KEEP_ENERGY)
select case (size (q))
case (4)
x = energy (q(3:4)) / energy (k)
xb= energy (q(1:2)) / energy (k)
case (2)
x = energy (q) / energy (k)
xb= 1 - x
end select
case (KEEP_MOMENTUM)
select case (size (q))
case (4)
x = longitudinal_part (q(3:4)) / longitudinal_part (k)
xb= longitudinal_part (q(1:2)) / longitudinal_part (k)
case (2)
x = longitudinal_part (q) / longitudinal_part (k)
xb= 1 - x
end select
end select
end select
end if
end subroutine sf_int_recover_x
@ %def sf_int_recover_x
@ Apply the structure function, i.e., evaluate the interaction. For
the calculation, we may use the stored momenta, any further
information stored inside the [[sf_int]] implementation during
kinematics setup, and the given energy scale. It may happen that for
the given kinematics the value is not defined. This should be
indicated by the status code.
<<SF base: sf int: TBP>>=
procedure (sf_int_apply), deferred :: apply
<<SF base: interfaces>>=
abstract interface
subroutine sf_int_apply (sf_int, scale, negative_sf, rescale, i_sub)
import
class(sf_int_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine sf_int_apply
end interface
@ %def sf_int_apply
@
\subsection{Accessing the structure function}
Return metadata. Once [[interaction_t]] is rewritten in OO, some of this will
be inherited.
The number of outgoing particles is equal to the number of incoming particles.
The radiated particles are the difference.
<<SF base: sf int: TBP>>=
procedure :: get_n_in => sf_int_get_n_in
procedure :: get_n_rad => sf_int_get_n_rad
procedure :: get_n_out => sf_int_get_n_out
<<SF base: sub interfaces>>=
pure module function sf_int_get_n_in (object) result (n_in)
class(sf_int_t), intent(in) :: object
integer :: n_in
end function sf_int_get_n_in
pure module function sf_int_get_n_rad (object) result (n_rad)
class(sf_int_t), intent(in) :: object
integer :: n_rad
end function sf_int_get_n_rad
pure module function sf_int_get_n_out (object) result (n_out)
class(sf_int_t), intent(in) :: object
integer :: n_out
end function sf_int_get_n_out
<<SF base: procedures>>=
pure module function sf_int_get_n_in (object) result (n_in)
class(sf_int_t), intent(in) :: object
integer :: n_in
n_in = object%interaction_t%get_n_in ()
end function sf_int_get_n_in
pure module function sf_int_get_n_rad (object) result (n_rad)
class(sf_int_t), intent(in) :: object
integer :: n_rad
n_rad = object%interaction_t%get_n_out () &
- object%interaction_t%get_n_in ()
end function sf_int_get_n_rad
pure module function sf_int_get_n_out (object) result (n_out)
class(sf_int_t), intent(in) :: object
integer :: n_out
n_out = object%interaction_t%get_n_in ()
end function sf_int_get_n_out
@ %def sf_int_get_n_in
@ %def sf_int_get_n_rad
@ %def sf_int_get_n_out
@ Number of matrix element entries in the interaction:
<<SF base: sf int: TBP>>=
procedure :: get_n_states => sf_int_get_n_states
<<SF base: sub interfaces>>=
module function sf_int_get_n_states (sf_int) result (n_states)
class(sf_int_t), intent(in) :: sf_int
integer :: n_states
end function sf_int_get_n_states
<<SF base: procedures>>=
module function sf_int_get_n_states (sf_int) result (n_states)
class(sf_int_t), intent(in) :: sf_int
integer :: n_states
n_states = sf_int%get_n_matrix_elements ()
end function sf_int_get_n_states
@ %def sf_int_get_n_states
@ Return a specific state as a quantum-number array.
<<SF base: sf int: TBP>>=
procedure :: get_state => sf_int_get_state
<<SF base: sub interfaces>>=
module function sf_int_get_state (sf_int, i) result (qn)
class(sf_int_t), intent(in) :: sf_int
type(quantum_numbers_t), dimension(:), allocatable :: qn
integer, intent(in) :: i
end function sf_int_get_state
<<SF base: procedures>>=
module function sf_int_get_state (sf_int, i) result (qn)
class(sf_int_t), intent(in) :: sf_int
type(quantum_numbers_t), dimension(:), allocatable :: qn
integer, intent(in) :: i
allocate (qn (sf_int%get_n_tot ()))
qn = sf_int%get_quantum_numbers (i)
end function sf_int_get_state
@ %def sf_int_get_state
@ Return the matrix-element values for all states. We can assume that
the matrix elements are real, so we take the real part.
<<SF base: sf int: TBP>>=
procedure :: get_values => sf_int_get_values
<<SF base: sub interfaces>>=
module subroutine sf_int_get_values (sf_int, value)
class(sf_int_t), intent(in) :: sf_int
real(default), dimension(:), intent(out) :: value
end subroutine sf_int_get_values
<<SF base: procedures>>=
module subroutine sf_int_get_values (sf_int, value)
class(sf_int_t), intent(in) :: sf_int
real(default), dimension(:), intent(out) :: value
integer :: i
if (sf_int%status >= SF_EVALUATED) then
do i = 1, size (value)
value(i) = real (sf_int%get_matrix_element (i))
end do
else
value = 0
end if
end subroutine sf_int_get_values
@ %def sf_int_get_values
@
\subsection{Direct calculations}
Compute a structure function value (array) directly, given an array of $x$
values and a scale. If the energy is also given, we initialize the
kinematics for that energy, otherwise take it from a previous run.
We assume that the [[E]] array has dimension [[n_in]], and the [[x]]
array has [[n_par]].
Note: the output x values ([[xx]] and [[xxb]]) are unused in this use case.
<<SF base: sf int: TBP>>=
procedure :: compute_values => sf_int_compute_values
<<SF base: sub interfaces>>=
module subroutine sf_int_compute_values (sf_int, value, x, xb, scale, E)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: value
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(in) :: scale
real(default), dimension(:), intent(in), optional :: E
end subroutine sf_int_compute_values
<<SF base: procedures>>=
module subroutine sf_int_compute_values (sf_int, value, x, xb, scale, E)
class(sf_int_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: value
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(in) :: scale
real(default), dimension(:), intent(in), optional :: E
real(default), dimension(size (x)) :: xx, xxb
real(default) :: f
if (present (E)) call sf_int%seed_kinematics (E)
if (sf_int%status >= SF_SEED_KINEMATICS) then
call sf_int%complete_kinematics (xx, xxb, f, x, xb, map=.false.)
call sf_int%apply (scale)
call sf_int%get_values (value)
value = value * f
else
value = 0
end if
end subroutine sf_int_compute_values
@ %def sf_int_compute_values
@ Compute just a single value for one of the states, i.e., throw the
others away.
<<SF base: sf int: TBP>>=
procedure :: compute_value => sf_int_compute_value
<<SF base: sub interfaces>>=
module subroutine sf_int_compute_value &
(sf_int, i_state, value, x, xb, scale, E)
class(sf_int_t), intent(inout) :: sf_int
integer, intent(in) :: i_state
real(default), intent(out) :: value
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(in) :: scale
real(default), dimension(:), intent(in), optional :: E
end subroutine sf_int_compute_value
<<SF base: procedures>>=
module subroutine sf_int_compute_value &
(sf_int, i_state, value, x, xb, scale, E)
class(sf_int_t), intent(inout) :: sf_int
integer, intent(in) :: i_state
real(default), intent(out) :: value
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(in) :: scale
real(default), dimension(:), intent(in), optional :: E
real(default), dimension(:), allocatable :: value_array
if (sf_int%status >= SF_INITIAL) then
allocate (value_array (sf_int%get_n_states ()))
call sf_int%compute_values (value_array, x, xb, scale, E)
value = value_array(i_state)
else
value = 0
end if
end subroutine sf_int_compute_value
@ %def sf_int_compute_value
@
\subsection{Structure-function instance}
This is a wrapper for [[sf_int_t]] objects, such that we can
build an array with different structure-function types. The
structure-function contains an array (a sequence) of [[sf_int_t]]
objects.
The object, it holds the evaluator that connects the preceding part of the
structure-function chain to the current interaction.
It also stores the input and output parameter values for the
contained structure function. The [[r]] array has a second dimension,
corresponding to the mapping channels in a multi-channel
configuration. There is a Jacobian entry [[f]] for each channel. The
corresponding logical array [[mapping]] tells whether we apply the
mapping appropriate for the current structure function in this channel.
The [[x]] parameter values (energy fractions) are common to all
channels.
<<SF base: types>>=
type :: sf_instance_t
class(sf_int_t), allocatable :: int
type(evaluator_t) :: eval
real(default), dimension(:,:), allocatable :: r
real(default), dimension(:,:), allocatable :: rb
real(default), dimension(:), allocatable :: f
logical, dimension(:), allocatable :: m
real(default), dimension(:), allocatable :: x
real(default), dimension(:), allocatable :: xb
end type sf_instance_t
@ %def sf_instance_t
@
\subsection{Structure-function chain}
A chain is an array of structure functions [[sf]], initiated by a beam setup.
We do not use this directly for evaluation, but create instances with
copies of the contained interactions.
[[n_par]] is the total number of parameters that is necessary for
completely determining the structure-function chain. [[n_bound]] is
the number of MC input parameters that are requested from the
integrator. The difference of [[n_par]] and [[n_bound]] is the number
of free parameters, which are generated by a structure-function
object in generator mode.
<<SF base: public>>=
public :: sf_chain_t
<<SF base: types>>=
type, extends (beam_t) :: sf_chain_t
type(beam_data_t), pointer :: beam_data => null ()
integer :: n_in = 0
integer :: n_strfun = 0
integer :: n_par = 0
integer :: n_bound = 0
type(sf_instance_t), dimension(:), allocatable :: sf
logical :: trace_enable = .false.
integer :: trace_unit = 0
contains
<<SF base: sf chain: TBP>>
end type sf_chain_t
@ %def sf_chain_t
@ Finalizer.
<<SF base: sf chain: TBP>>=
procedure :: final => sf_chain_final
<<SF base: sub interfaces>>=
module subroutine sf_chain_final (object)
class(sf_chain_t), intent(inout) :: object
end subroutine sf_chain_final
<<SF base: procedures>>=
module subroutine sf_chain_final (object)
class(sf_chain_t), intent(inout) :: object
integer :: i
call object%final_tracing ()
if (allocated (object%sf)) then
do i = 1, size (object%sf, 1)
associate (sf => object%sf(i))
if (allocated (sf%int)) then
call sf%int%final ()
end if
end associate
end do
end if
call beam_final (object%beam_t)
end subroutine sf_chain_final
@ %def sf_chain_final
@ Output.
<<SF base: sf chain: TBP>>=
procedure :: write => sf_chain_write
<<SF base: sub interfaces>>=
module subroutine sf_chain_write (object, unit)
class(sf_chain_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine sf_chain_write
<<SF base: procedures>>=
module subroutine sf_chain_write (object, unit)
class(sf_chain_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "Incoming particles / structure-function chain:"
if (associated (object%beam_data)) then
write (u, "(3x,A,I0)") "n_in = ", object%n_in
write (u, "(3x,A,I0)") "n_strfun = ", object%n_strfun
write (u, "(3x,A,I0)") "n_par = ", object%n_par
if (object%n_par /= object%n_bound) then
write (u, "(3x,A,I0)") "n_bound = ", object%n_bound
end if
call object%beam_data%write (u)
call write_separator (u)
call beam_write (object%beam_t, u)
if (allocated (object%sf)) then
do i = 1, object%n_strfun
associate (sf => object%sf(i))
call write_separator (u)
if (allocated (sf%int)) then
call sf%int%write (u)
else
write (u, "(1x,A)") "SF instance: [undefined]"
end if
end associate
end do
end if
else
write (u, "(3x,A)") "[undefined]"
end if
end subroutine sf_chain_write
@ %def sf_chain_write
@ Initialize: setup beams. The [[beam_data]] target must remain valid
for the lifetime of the chain, since we just establish a pointer. The
structure-function configuration array is used to initialize the
individual structure-function entries. The target attribute is needed
because the [[sf_int]] entries establish pointers to the configuration data.
<<SF base: sf chain: TBP>>=
procedure :: init => sf_chain_init
<<SF base: sub interfaces>>=
module subroutine sf_chain_init (sf_chain, beam_data, sf_config)
class(sf_chain_t), intent(out) :: sf_chain
type(beam_data_t), intent(in), target :: beam_data
type(sf_config_t), dimension(:), intent(in), optional, target :: sf_config
end subroutine sf_chain_init
<<SF base: procedures>>=
module subroutine sf_chain_init (sf_chain, beam_data, sf_config)
class(sf_chain_t), intent(out) :: sf_chain
type(beam_data_t), intent(in), target :: beam_data
type(sf_config_t), dimension(:), intent(in), optional, target :: sf_config
integer :: i
sf_chain%beam_data => beam_data
sf_chain%n_in = beam_data%get_n_in ()
call beam_init (sf_chain%beam_t, beam_data)
if (present (sf_config)) then
sf_chain%n_strfun = size (sf_config)
allocate (sf_chain%sf (sf_chain%n_strfun))
do i = 1, sf_chain%n_strfun
call sf_chain%set_strfun (i, sf_config(i)%i, sf_config(i)%data)
end do
end if
end subroutine sf_chain_init
@ %def sf_chain_init
@ Receive the beam momenta from a source to which the beam interaction
is linked.
<<SF base: sf chain: TBP>>=
procedure :: receive_beam_momenta => sf_chain_receive_beam_momenta
<<SF base: sub interfaces>>=
module subroutine sf_chain_receive_beam_momenta (sf_chain)
class(sf_chain_t), intent(inout), target :: sf_chain
type(interaction_t), pointer :: beam_int
end subroutine sf_chain_receive_beam_momenta
<<SF base: procedures>>=
module subroutine sf_chain_receive_beam_momenta (sf_chain)
class(sf_chain_t), intent(inout), target :: sf_chain
type(interaction_t), pointer :: beam_int
beam_int => sf_chain%get_beam_int_ptr ()
call beam_int%receive_momenta ()
end subroutine sf_chain_receive_beam_momenta
@ %def sf_chain_receive_beam_momenta
@ Explicitly set the beam momenta.
<<SF base: sf chain: TBP>>=
procedure :: set_beam_momenta => sf_chain_set_beam_momenta
<<SF base: sub interfaces>>=
module subroutine sf_chain_set_beam_momenta (sf_chain, p)
class(sf_chain_t), intent(inout) :: sf_chain
type(vector4_t), dimension(:), intent(in) :: p
end subroutine sf_chain_set_beam_momenta
<<SF base: procedures>>=
module subroutine sf_chain_set_beam_momenta (sf_chain, p)
class(sf_chain_t), intent(inout) :: sf_chain
type(vector4_t), dimension(:), intent(in) :: p
call beam_set_momenta (sf_chain%beam_t, p)
end subroutine sf_chain_set_beam_momenta
@ %def sf_chain_set_beam_momenta
@ Set a structure-function entry. We use the [[data]] input to
allocate the [[int]] structure-function instance with appropriate
type, then initialize the entry. The entry establishes a pointer to
[[data]].
The index [[i]] is the structure-function index in the chain.
<<SF base: sf chain: TBP>>=
procedure :: set_strfun => sf_chain_set_strfun
<<SF base: sub interfaces>>=
module subroutine sf_chain_set_strfun (sf_chain, i, beam_index, data)
class(sf_chain_t), intent(inout) :: sf_chain
integer, intent(in) :: i
integer, dimension(:), intent(in) :: beam_index
class(sf_data_t), intent(in), target :: data
end subroutine sf_chain_set_strfun
<<SF base: procedures>>=
module subroutine sf_chain_set_strfun (sf_chain, i, beam_index, data)
class(sf_chain_t), intent(inout) :: sf_chain
integer, intent(in) :: i
integer, dimension(:), intent(in) :: beam_index
class(sf_data_t), intent(in), target :: data
integer :: n_par, j
n_par = data%get_n_par ()
call data%allocate_sf_int (sf_chain%sf(i)%int)
associate (sf_int => sf_chain%sf(i)%int)
call sf_int%init (data)
call sf_int%set_beam_index (beam_index)
call sf_int%set_par_index &
([(j, j = sf_chain%n_par + 1, sf_chain%n_par + n_par)])
sf_chain%n_par = sf_chain%n_par + n_par
if (.not. data%is_generator ()) then
sf_chain%n_bound = sf_chain%n_bound + n_par
end if
end associate
end subroutine sf_chain_set_strfun
@ %def sf_chain_set_strfun
@ Return the number of structure-function parameters.
<<SF base: sf chain: TBP>>=
procedure :: get_n_par => sf_chain_get_n_par
procedure :: get_n_bound => sf_chain_get_n_bound
<<SF base: sub interfaces>>=
module function sf_chain_get_n_par (sf_chain) result (n)
class(sf_chain_t), intent(in) :: sf_chain
integer :: n
end function sf_chain_get_n_par
module function sf_chain_get_n_bound (sf_chain) result (n)
class(sf_chain_t), intent(in) :: sf_chain
integer :: n
end function sf_chain_get_n_bound
<<SF base: procedures>>=
module function sf_chain_get_n_par (sf_chain) result (n)
class(sf_chain_t), intent(in) :: sf_chain
integer :: n
n = sf_chain%n_par
end function sf_chain_get_n_par
module function sf_chain_get_n_bound (sf_chain) result (n)
class(sf_chain_t), intent(in) :: sf_chain
integer :: n
n = sf_chain%n_bound
end function sf_chain_get_n_bound
@ %def sf_chain_get_n_par
@ %def sf_chain_get_n_bound
@ Return a pointer to the beam interaction.
<<SF base: sf chain: TBP>>=
procedure :: get_beam_int_ptr => sf_chain_get_beam_int_ptr
<<SF base: sub interfaces>>=
module function sf_chain_get_beam_int_ptr (sf_chain) result (int)
type(interaction_t), pointer :: int
class(sf_chain_t), intent(in), target :: sf_chain
end function sf_chain_get_beam_int_ptr
<<SF base: procedures>>=
module function sf_chain_get_beam_int_ptr (sf_chain) result (int)
type(interaction_t), pointer :: int
class(sf_chain_t), intent(in), target :: sf_chain
int => beam_get_int_ptr (sf_chain%beam_t)
end function sf_chain_get_beam_int_ptr
@ %def sf_chain_get_beam_int_ptr
@ Enable the trace feature: record structure function data (input
parameters, $x$ values, evaluation result) to an external file.
<<SF base: sf chain: TBP>>=
procedure :: setup_tracing => sf_chain_setup_tracing
procedure :: final_tracing => sf_chain_final_tracing
<<SF base: sub interfaces>>=
module subroutine sf_chain_setup_tracing (sf_chain, file)
class(sf_chain_t), intent(inout) :: sf_chain
type(string_t), intent(in) :: file
end subroutine sf_chain_setup_tracing
module subroutine sf_chain_final_tracing (sf_chain)
class(sf_chain_t), intent(inout) :: sf_chain
end subroutine sf_chain_final_tracing
<<SF base: procedures>>=
module subroutine sf_chain_setup_tracing (sf_chain, file)
class(sf_chain_t), intent(inout) :: sf_chain
type(string_t), intent(in) :: file
if (sf_chain%n_strfun > 0) then
sf_chain%trace_enable = .true.
sf_chain%trace_unit = free_unit ()
open (sf_chain%trace_unit, file = char (file), action = "write", &
status = "replace")
call sf_chain%write_trace_header ()
else
call msg_error ("Beam structure: no structure functions, tracing &
&disabled")
end if
end subroutine sf_chain_setup_tracing
module subroutine sf_chain_final_tracing (sf_chain)
class(sf_chain_t), intent(inout) :: sf_chain
if (sf_chain%trace_enable) then
close (sf_chain%trace_unit)
sf_chain%trace_enable = .false.
end if
end subroutine sf_chain_final_tracing
@ %def sf_chain_setup_tracing
@ %def sf_chain_final_tracing
@ Write the header for the tracing file.
<<SF base: sf chain: TBP>>=
procedure :: write_trace_header => sf_chain_write_trace_header
<<SF base: sub interfaces>>=
module subroutine sf_chain_write_trace_header (sf_chain)
class(sf_chain_t), intent(in) :: sf_chain
end subroutine sf_chain_write_trace_header
<<SF base: procedures>>=
module subroutine sf_chain_write_trace_header (sf_chain)
class(sf_chain_t), intent(in) :: sf_chain
integer :: u
if (sf_chain%trace_enable) then
u = sf_chain%trace_unit
write (u, "('# ',A)") "WHIZARD output: &
&structure-function sampling data"
write (u, "('# ',A,1x,I0)") "Number of sf records:", sf_chain%n_strfun
write (u, "('# ',A,1x,I0)") "Number of parameters:", sf_chain%n_par
write (u, "('# ',A)") "Columns: channel, p(n_par), x(n_par), f, Jac * f"
end if
end subroutine sf_chain_write_trace_header
@ %def sf_chain_write_trace_header
@ Write a record which collects the structure function data for the
current data point. For the selected channel, we print first the
input integration parameters, then the $x$ values, then the
structure-function value summed over all quantum numbers, then the
structure function value times the mapping Jacobian.
<<SF base: sf chain: TBP>>=
procedure :: trace => sf_chain_trace
<<SF base: sub interfaces>>=
module subroutine sf_chain_trace (sf_chain, c_sel, p, x, f, sf_sum)
class(sf_chain_t), intent(in) :: sf_chain
integer, intent(in) :: c_sel
real(default), dimension(:,:), intent(in) :: p
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: f
real(default), intent(in) :: sf_sum
end subroutine sf_chain_trace
<<SF base: procedures>>=
module subroutine sf_chain_trace (sf_chain, c_sel, p, x, f, sf_sum)
class(sf_chain_t), intent(in) :: sf_chain
integer, intent(in) :: c_sel
real(default), dimension(:,:), intent(in) :: p
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: f
real(default), intent(in) :: sf_sum
real(default) :: sf_sum_pac, f_sf_sum_pac
integer :: u, i
if (sf_chain%trace_enable) then
u = sf_chain%trace_unit
write (u, "(1x,I0)", advance="no") c_sel
write (u, "(2x)", advance="no")
do i = 1, sf_chain%n_par
write (u, "(1x," // FMT_17 // ")", advance="no") p(i,c_sel)
end do
write (u, "(2x)", advance="no")
do i = 1, sf_chain%n_par
write (u, "(1x," // FMT_17 // ")", advance="no") x(i)
end do
write (u, "(2x)", advance="no")
sf_sum_pac = sf_sum
f_sf_sum_pac = f(c_sel) * sf_sum
call pacify (sf_sum_pac, 1.E-28_default)
call pacify (f_sf_sum_pac, 1.E-28_default)
write (u, "(2(1x," // FMT_17 // "))") sf_sum_pac, f_sf_sum_pac
end if
end subroutine sf_chain_trace
@ %def sf_chain_trace
@
\subsection{Chain instances}
A structure-function chain instance contains copies of the
interactions in the configuration chain, suitably linked to each other
and connected by evaluators.
After initialization, [[out_sf]] should point, for each beam, to the
last structure function that affects this beam. [[out_sf_i]] should
indicate the index of the corresponding outgoing particle within that
structure-function interaction.
Analogously, [[out_eval]] is the last evaluator in the
structure-function chain, which contains the complete set of outgoing
particles. [[out_eval_i]] should indicate the index of the outgoing
particles, within that evaluator, which will initiate the collision.
When calculating actual kinematics, we fill the [[p]], [[r]], and
[[x]] arrays and the [[f]] factor. The [[p]] array denotes the MC
input parameters as they come from the random-number generator. The
[[r]] array results from applying global mappings. The [[x]] array
results from applying structure-function local mappings. The $x$
values can be interpreted directly as momentum fractions (or angle
fractions, where recoil is involved). The [[f]] factor is the
Jacobian that results from applying all mappings.
Update 2017-08-22: carry and output all complements ([[pb]], [[rb]],
[[xb]]). Previously, [[xb]] was not included in the record, and the
output did not contain either. It does become more verbose, however.
The [[mapping]] entry may store a global mapping that is applied to a
combination of $x$ values and structure functions, as opposed to mappings that
affect only a single structure function. It is applied before the latter
mappings, in the transformation from the [[p]] array to the [[r]] array. For
parameters affected by this mapping, we should ensure that they are not
involved in a local mapping.
<<SF base: public>>=
public :: sf_chain_instance_t
<<SF base: types>>=
type, extends (beam_t) :: sf_chain_instance_t
type(sf_chain_t), pointer :: config => null ()
integer :: status = SF_UNDEFINED
type(sf_instance_t), dimension(:), allocatable :: sf
integer, dimension(:), allocatable :: out_sf
integer, dimension(:), allocatable :: out_sf_i
integer :: out_eval = 0
integer, dimension(:), allocatable :: out_eval_i
integer :: selected_channel = 0
real(default), dimension(:,:), allocatable :: p, pb
real(default), dimension(:,:), allocatable :: r, rb
real(default), dimension(:), allocatable :: f
real(default), dimension(:), allocatable :: x, xb
logical, dimension(:), allocatable :: bound
real(default) :: x_free = 1
type(sf_channel_t), dimension(:), allocatable :: channel
contains
<<SF base: sf chain instance: TBP>>
end type sf_chain_instance_t
@ %def sf_chain_instance_t
@ Finalizer.
<<SF base: sf chain instance: TBP>>=
procedure :: final => sf_chain_instance_final
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_final (object)
class(sf_chain_instance_t), intent(inout) :: object
end subroutine sf_chain_instance_final
<<SF base: procedures>>=
module subroutine sf_chain_instance_final (object)
class(sf_chain_instance_t), intent(inout) :: object
integer :: i
if (allocated (object%sf)) then
do i = 1, size (object%sf, 1)
associate (sf => object%sf(i))
if (allocated (sf%int)) then
call sf%eval%final ()
call sf%int%final ()
end if
end associate
end do
end if
call beam_final (object%beam_t)
end subroutine sf_chain_instance_final
@ %def sf_chain_instance_final
@ Output.
<<SF base: sf chain instance: TBP>>=
procedure :: write => sf_chain_instance_write
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_write (object, unit, col_verbose)
class(sf_chain_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: col_verbose
end subroutine sf_chain_instance_write
<<SF base: procedures>>=
module subroutine sf_chain_instance_write (object, unit, col_verbose)
class(sf_chain_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: col_verbose
integer :: u, i, c
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "Structure-function chain instance:"
call write_sf_status (object%status, u)
if (allocated (object%out_sf)) then
write (u, "(3x,A)", advance="no") "outgoing (interactions) ="
do i = 1, size (object%out_sf)
write (u, "(1x,I0,':',I0)", advance="no") &
object%out_sf(i), object%out_sf_i(i)
end do
write (u, *)
end if
if (object%out_eval /= 0) then
write (u, "(3x,A)", advance="no") "outgoing (evaluators) ="
do i = 1, size (object%out_sf)
write (u, "(1x,I0,':',I0)", advance="no") &
object%out_eval, object%out_eval_i(i)
end do
write (u, *)
end if
if (allocated (object%sf)) then
if (size (object%sf) /= 0) then
write (u, "(1x,A)") "Structure-function parameters:"
do c = 1, size (object%f)
write (u, "(1x,A,I0,A)", advance="no") "Channel #", c, ":"
if (c == object%selected_channel) then
write (u, "(1x,A)") "[selected]"
else
write (u, *)
end if
write (u, "(3x,A,9(1x,F9.7))") "p =", object%p(:,c)
write (u, "(3x,A,9(1x,F9.7))") "pb=", object%pb(:,c)
write (u, "(3x,A,9(1x,F9.7))") "r =", object%r(:,c)
write (u, "(3x,A,9(1x,F9.7))") "rb=", object%rb(:,c)
write (u, "(3x,A,9(1x,ES13.7))") "f =", object%f(c)
write (u, "(3x,A)", advance="no") "m ="
call object%channel(c)%write (u)
end do
write (u, "(3x,A,9(1x,F9.7))") "x =", object%x
write (u, "(3x,A,9(1x,F9.7))") "xb=", object%xb
if (.not. all (object%bound)) then
write (u, "(3x,A,9(1x,L1))") "bound =", object%bound
end if
end if
end if
call write_separator (u)
call beam_write (object%beam_t, u, col_verbose = col_verbose)
if (allocated (object%sf)) then
do i = 1, size (object%sf)
associate (sf => object%sf(i))
call write_separator (u)
if (allocated (sf%int)) then
if (allocated (sf%r)) then
write (u, "(1x,A)") "Structure-function parameters:"
do c = 1, size (sf%f)
write (u, "(1x,A,I0,A)", advance="no") "Channel #", c, ":"
if (c == object%selected_channel) then
write (u, "(1x,A)") "[selected]"
else
write (u, *)
end if
write (u, "(3x,A,9(1x,F9.7))") "r =", sf%r(:,c)
write (u, "(3x,A,9(1x,F9.7))") "rb=", sf%rb(:,c)
write (u, "(3x,A,9(1x,ES13.7))") "f =", sf%f(c)
write (u, "(3x,A,9(1x,L1,7x))") "m =", sf%m(c)
end do
write (u, "(3x,A,9(1x,F9.7))") "x =", sf%x
write (u, "(3x,A,9(1x,F9.7))") "xb=", sf%xb
end if
call sf%int%write(u)
if (.not. sf%eval%is_empty ()) then
call sf%eval%write (u, col_verbose = col_verbose)
end if
end if
end associate
end do
end if
end subroutine sf_chain_instance_write
@ %def sf_chain_instance_write
@ Initialize. This creates a copy of the interactions in the
configuration chain, assumed to be properly initialized. In the copy,
we allocate the [[p]] etc.\ arrays.
The brute-force assignment of the [[sf]] component would be
straightforward, but we provide a more fine-grained copy.
In any case, the copy is deep as far as allocatables are concerned,
but for the contained [[interaction_t]] objects the copy is shallow,
as long as we do not bind defined assignment to the type. Therefore,
we have to re-assign the [[interaction_t]] components explicitly, this
time calling the proper defined assignment. Furthermore, we allocate
the parameter arrays for each structure function.
<<SF base: sf chain instance: TBP>>=
procedure :: init => sf_chain_instance_init
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_init (chain, config, n_channel)
class(sf_chain_instance_t), intent(out), target :: chain
type(sf_chain_t), intent(in), target :: config
integer, intent(in) :: n_channel
end subroutine sf_chain_instance_init
<<SF base: procedures>>=
module subroutine sf_chain_instance_init (chain, config, n_channel)
class(sf_chain_instance_t), intent(out), target :: chain
type(sf_chain_t), intent(in), target :: config
integer, intent(in) :: n_channel
integer :: i, j
integer :: n_par_tot, n_par, n_strfun
chain%config => config
n_strfun = config%n_strfun
chain%beam_t = config%beam_t
allocate (chain%out_sf (config%n_in), chain%out_sf_i (config%n_in))
allocate (chain%out_eval_i (config%n_in))
chain%out_sf = 0
chain%out_sf_i = [(i, i = 1, config%n_in)]
chain%out_eval_i = chain%out_sf_i
n_par_tot = 0
if (n_strfun /= 0) then
allocate (chain%sf (n_strfun))
do i = 1, n_strfun
associate (sf => chain%sf(i))
allocate (sf%int, source=config%sf(i)%int)
sf%int%interaction_t = config%sf(i)%int%interaction_t
n_par = size (sf%int%par_index)
allocate (sf%r (n_par, n_channel)); sf%r = 0
allocate (sf%rb(n_par, n_channel)); sf%rb= 0
allocate (sf%f (n_channel)); sf%f = 0
allocate (sf%m (n_channel)); sf%m = .false.
allocate (sf%x (n_par)); sf%x = 0
allocate (sf%xb(n_par)); sf%xb= 0
n_par_tot = n_par_tot + n_par
end associate
end do
allocate (chain%p (n_par_tot, n_channel)); chain%p = 0
allocate (chain%pb(n_par_tot, n_channel)); chain%pb= 0
allocate (chain%r (n_par_tot, n_channel)); chain%r = 0
allocate (chain%rb(n_par_tot, n_channel)); chain%rb= 0
allocate (chain%f (n_channel)); chain%f = 0
allocate (chain%x (n_par_tot)); chain%x = 0
allocate (chain%xb(n_par_tot)); chain%xb= 0
call allocate_sf_channels &
(chain%channel, n_channel=n_channel, n_strfun=n_strfun)
end if
allocate (chain%bound (n_par_tot), source = .true.)
do i = 1, n_strfun
associate (sf => chain%sf(i))
if (sf%int%is_generator ()) then
do j = 1, size (sf%int%par_index)
chain%bound(sf%int%par_index(j)) = .false.
end do
end if
end associate
end do
chain%status = SF_INITIAL
end subroutine sf_chain_instance_init
@ %def sf_chain_instance_init
@ Manually select a channel.
<<SF base: sf chain instance: TBP>>=
procedure :: select_channel => sf_chain_instance_select_channel
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_select_channel (chain, channel)
class(sf_chain_instance_t), intent(inout) :: chain
integer, intent(in), optional :: channel
end subroutine sf_chain_instance_select_channel
<<SF base: procedures>>=
module subroutine sf_chain_instance_select_channel (chain, channel)
class(sf_chain_instance_t), intent(inout) :: chain
integer, intent(in), optional :: channel
if (present (channel)) then
chain%selected_channel = channel
else
chain%selected_channel = 0
end if
end subroutine sf_chain_instance_select_channel
@ %def sf_chain_instance_select_channel
@ Copy a channel-mapping object to the structure-function
chain instance. We assume that assignment is sufficient, i.e., any
non-static components of the [[channel]] object are allocatable und
thus recursively copied.
After the copy, we extract the single-entry mappings and activate them
for the individual structure functions. If there is a multi-entry
mapping, we obtain the corresponding MC parameter indices and set them
in the copy of the channel object.
<<SF base: sf chain instance: TBP>>=
procedure :: set_channel => sf_chain_instance_set_channel
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_set_channel (chain, c, channel)
class(sf_chain_instance_t), intent(inout) :: chain
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: channel
end subroutine sf_chain_instance_set_channel
<<SF base: procedures>>=
module subroutine sf_chain_instance_set_channel (chain, c, channel)
class(sf_chain_instance_t), intent(inout) :: chain
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: channel
integer :: i, j, k
if (chain%status >= SF_INITIAL) then
chain%channel(c) = channel
j = 0
do i = 1, chain%config%n_strfun
associate (sf => chain%sf(i))
sf%m(c) = channel%is_single_mapping (i)
if (channel%is_multi_mapping (i)) then
do k = 1, size (sf%int%beam_index)
j = j + 1
call chain%channel(c)%set_par_index &
(j, sf%int%par_index(k))
end do
end if
end associate
end do
if (j /= chain%channel(c)%get_multi_mapping_n_par ()) then
print *, "index last filled = ", j
print *, "number of parameters = ", &
chain%channel(c)%get_multi_mapping_n_par ()
call msg_bug ("Structure-function setup: mapping index mismatch")
end if
chain%status = SF_INITIAL
end if
end subroutine sf_chain_instance_set_channel
@ %def sf_chain_instance_set_channel
@ Link the interactions in the chain. First, link the beam instance
to its template in the configuration chain, which should have the
appropriate momenta fixed.
Then, we follow the chain via the
arrays [[out_sf]] and [[out_sf_i]]. The arrays are (up to)
two-dimensional, the entries correspond to the beam particle(s).
For each beam, the entry [[out_sf]] points to the last interaction
that affected this beam, and [[out_sf_i]] is the
out-particle index within that interaction. For the initial beam,
[[out_sf]] is zero by definition.
For each entry in the chain, we scan the affected beams (one or two).
We look for [[out_sf]] and link the out-particle there to the
corresponding in-particle in the current interaction. Then, we update
the entry in [[out_sf]] and [[out_sf_i]] to point to the current
interaction.
<<SF base: sf chain instance: TBP>>=
procedure :: link_interactions => sf_chain_instance_link_interactions
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_link_interactions (chain)
class(sf_chain_instance_t), intent(inout), target :: chain
end subroutine sf_chain_instance_link_interactions
<<SF base: procedures>>=
module subroutine sf_chain_instance_link_interactions (chain)
class(sf_chain_instance_t), intent(inout), target :: chain
type(interaction_t), pointer :: int
integer :: i, j, b
if (chain%status >= SF_INITIAL) then
do b = 1, chain%config%n_in
int => beam_get_int_ptr (chain%beam_t)
call interaction_set_source_link_beam (int, b, &
chain%config%beam_t, b)
end do
if (allocated (chain%sf)) then
do i = 1, size (chain%sf)
associate (sf_int => chain%sf(i)%int)
do j = 1, size (sf_int%beam_index)
b = sf_int%beam_index(j)
call link (sf_int%interaction_t, b, sf_int%incoming(j))
chain%out_sf(b) = i
chain%out_sf_i(b) = sf_int%outgoing(j)
end do
end associate
end do
end if
chain%status = SF_DONE_LINKS
end if
contains
subroutine link (int, b, in_index)
type(interaction_t), intent(inout) :: int
integer, intent(in) :: b, in_index
integer :: i
i = chain%out_sf(b)
select case (i)
case (0)
call interaction_set_source_link_beam (int, in_index, &
chain%beam_t, chain%out_sf_i(b))
case default
call int%set_source_link (in_index, &
chain%sf(i)%int, chain%out_sf_i(b))
end select
end subroutine link
end subroutine sf_chain_instance_link_interactions
@ %def sf_chain_instance_link_interactions
@ Exchange the quantum-number masks between the interactions in the
chain, so we can combine redundant entries and detect any obvious mismatch.
We proceed first in the forward direction and then backwards again.
After this is finished, we finalize initialization by calling the
[[setup_constants]] method, which prepares constant data that depend on the
matrix element structure.
<<SF base: sf chain instance: TBP>>=
procedure :: exchange_mask => sf_chain_exchange_mask
<<SF base: sub interfaces>>=
module subroutine sf_chain_exchange_mask (chain)
class(sf_chain_instance_t), intent(inout), target :: chain
end subroutine sf_chain_exchange_mask
<<SF base: procedures>>=
module subroutine sf_chain_exchange_mask (chain)
class(sf_chain_instance_t), intent(inout), target :: chain
type(interaction_t), pointer :: int
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
integer :: i
if (chain%status >= SF_DONE_LINKS) then
if (allocated (chain%sf)) then
int => beam_get_int_ptr (chain%beam_t)
allocate (mask (int%get_n_out ()))
mask = int%get_mask ()
if (size (chain%sf) /= 0) then
do i = 1, size (chain%sf) - 1
call chain%sf(i)%int%exchange_mask ()
end do
do i = size (chain%sf), 1, -1
call chain%sf(i)%int%exchange_mask ()
end do
if (any (mask .neqv. int%get_mask ())) then
chain%status = SF_FAILED_MASK
return
end if
do i = 1, size (chain%sf)
call chain%sf(i)%int%setup_constants ()
end do
end if
end if
chain%status = SF_DONE_MASK
end if
end subroutine sf_chain_exchange_mask
@ %def sf_chain_exchange_mask
@ Initialize the evaluators that connect the interactions in the
chain.
<<SF base: sf chain instance: TBP>>=
procedure :: init_evaluators => sf_chain_instance_init_evaluators
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_init_evaluators (chain, extended_sf)
class(sf_chain_instance_t), intent(inout), target :: chain
logical, intent(in), optional :: extended_sf
end subroutine sf_chain_instance_init_evaluators
<<SF base: procedures>>=
module subroutine sf_chain_instance_init_evaluators (chain, extended_sf)
class(sf_chain_instance_t), intent(inout), target :: chain
logical, intent(in), optional :: extended_sf
type(interaction_t), pointer :: int
type(quantum_numbers_mask_t) :: mask
integer :: i
logical :: yorn
yorn = .false.; if (present (extended_sf)) yorn = extended_sf
if (chain%status >= SF_DONE_MASK) then
if (allocated (chain%sf)) then
if (size (chain%sf) /= 0) then
mask = quantum_numbers_mask (.false., .false., .true.)
int => beam_get_int_ptr (chain%beam_t)
do i = 1, size (chain%sf)
associate (sf => chain%sf(i))
if (yorn) then
if (int%get_n_sub () == 0) then
call int%declare_subtraction (n_beams_rescaled)
end if
if (sf%int%interaction_t%get_n_sub () == 0) then
call sf%int%interaction_t%declare_subtraction (n_beams_rescaled)
end if
end if
call sf%eval%init_product (int, sf%int%interaction_t, mask,&
& ignore_sub_for_qn = .true.)
if (sf%eval%is_empty ()) then
chain%status = SF_FAILED_CONNECTIONS
return
end if
int => sf%eval%interaction_t
end associate
end do
call find_outgoing_particles ()
end if
else if (chain%out_eval == 0) then
int => beam_get_int_ptr (chain%beam_t)
call int%tag_hard_process ()
end if
chain%status = SF_DONE_CONNECTIONS
end if
contains
<<SF base: init evaluators: find outgoing particles>>
end subroutine sf_chain_instance_init_evaluators
@ %def sf_chain_instance_init_evaluators
@ For debug purposes
<<SF base: sf chain instance: TBP>>=
procedure :: write_interaction => sf_chain_instance_write_interaction
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_write_interaction &
(chain, i_sf, i_int, unit)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: i_sf, i_int
integer, intent(in) :: unit
end subroutine sf_chain_instance_write_interaction
<<SF base: procedures>>=
module subroutine sf_chain_instance_write_interaction &
(chain, i_sf, i_int, unit)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: i_sf, i_int
integer, intent(in) :: unit
class(interaction_t), pointer :: int_in1 => null ()
class(interaction_t), pointer :: int_in2 => null ()
integer :: u
u = given_output_unit (unit); if (u < 0) return
if (chain%status >= SF_DONE_MASK) then
if (allocated (chain%sf)) then
int_in1 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 1)
int_in2 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 2)
if (int_in1%get_tag () == i_int) then
call int_in1%basic_write (u)
else if (int_in2%get_tag () == i_int) then
call int_in2%basic_write (u)
else
write (u, "(A,1x,I0,1x,A,1x,I0)") 'No tag of sf', i_sf, 'matches' , i_int
end if
else
write (u, "(A)") 'No sf_chain allocated!'
end if
else
write (u, "(A)") 'sf_chain not ready!'
end if
end subroutine sf_chain_instance_write_interaction
@ %def sf_chain_instance_write_interaction
@ This is an internal subroutine of the previous one: After evaluators
are set, trace the outgoing particles to the last evaluator. We only
need the first channel, all channels are equivalent for this purpose.
For each beam, the outgoing particle is located by [[out_sf]] (the
structure-function object where it originates) and [[out_sf_i]] (the
index within that object). This particle is referenced by the
corresponding evaluator, which in turn is referenced by the next
evaluator, until we are at the end of the chain. We can trace back
references by [[interaction_find_link]]. Knowing that [[out_eval]] is
the index of the last evaluator, we thus determine [[out_eval_i]], the
index of the outgoing particle within that evaluator.
<<SF base: init evaluators: find outgoing particles>>=
subroutine find_outgoing_particles ()
type(interaction_t), pointer :: int, int_next
integer :: i, j, out_sf, out_i
chain%out_eval = size (chain%sf)
do j = 1, size (chain%out_eval_i)
out_sf = chain%out_sf(j)
out_i = chain%out_sf_i(j)
if (out_sf == 0) then
int => beam_get_int_ptr (chain%beam_t)
out_sf = 1
else
int => chain%sf(out_sf)%int%interaction_t
end if
do i = out_sf, chain%out_eval
int_next => chain%sf(i)%eval%interaction_t
out_i = interaction_find_link (int_next, int, out_i)
int => int_next
end do
chain%out_eval_i(j) = out_i
end do
call int%tag_hard_process (chain%out_eval_i)
end subroutine find_outgoing_particles
@ %def find_outgoing_particles
@ Compute the kinematics in the chain instance. We can assume that
the seed momenta are set in the configuration beams. Scanning the
chain, we first transfer the incoming momenta. Then, the use up the MC input
parameter array [[p]] to compute the radiated and outgoing momenta.
In the multi-channel case, [[c_sel]] is the channel which we use for
computing the kinematics and the [[x]] values. In the other channels,
we invert the kinematics in order to recover the corresponding rows in
the [[r]] array, and the Jacobian [[f]].
We first apply any global mapping to transform the input [[p]] into
the array [[r]]. This is then given to the structure functions which
compute the final array [[x]] and Jacobian factors [[f]], which we
multiply to obtain the overall Jacobian.
<<SF base: sf chain instance: TBP>>=
procedure :: compute_kinematics => sf_chain_instance_compute_kinematics
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_compute_kinematics (chain, c_sel, p_in)
class(sf_chain_instance_t), intent(inout), target :: chain
integer, intent(in) :: c_sel
real(default), dimension(:), intent(in) :: p_in
end subroutine sf_chain_instance_compute_kinematics
<<SF base: procedures>>=
module subroutine sf_chain_instance_compute_kinematics (chain, c_sel, p_in)
class(sf_chain_instance_t), intent(inout), target :: chain
integer, intent(in) :: c_sel
real(default), dimension(:), intent(in) :: p_in
type(interaction_t), pointer :: int
real(default) :: f_mapping
integer :: i, j, c
if (chain%status >= SF_DONE_CONNECTIONS) then
call chain%select_channel (c_sel)
int => beam_get_int_ptr (chain%beam_t)
call int%receive_momenta ()
if (allocated (chain%sf)) then
if (size (chain%sf) /= 0) then
forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
chain%p (:,c_sel) = unpack (p_in, chain%bound, 0._default)
chain%pb(:,c_sel) = 1 - chain%p(:,c_sel)
chain%f = 1
chain%x_free = 1
do i = 1, size (chain%sf)
associate (sf => chain%sf(i))
call sf%int%generate_free (sf%r(:,c_sel), sf%rb(:,c_sel), &
chain%x_free)
do j = 1, size (sf%x)
if (.not. chain%bound(sf%int%par_index(j))) then
chain%p (sf%int%par_index(j),c_sel) = sf%r (j,c_sel)
chain%pb(sf%int%par_index(j),c_sel) = sf%rb(j,c_sel)
end if
end do
end associate
end do
if (allocated (chain%channel(c_sel)%multi_mapping)) then
call chain%channel(c_sel)%multi_mapping%compute &
(chain%r(:,c_sel), chain%rb(:,c_sel), &
f_mapping, &
chain%p(:,c_sel), chain%pb(:,c_sel), &
chain%x_free)
chain%f(c_sel) = f_mapping
else
chain%r (:,c_sel) = chain%p (:,c_sel)
chain%rb(:,c_sel) = chain%pb(:,c_sel)
chain%f(c_sel) = 1
end if
do i = 1, size (chain%sf)
associate (sf => chain%sf(i))
call sf%int%seed_kinematics ()
do j = 1, size (sf%x)
sf%r (j,c_sel) = chain%r (sf%int%par_index(j),c_sel)
sf%rb(j,c_sel) = chain%rb(sf%int%par_index(j),c_sel)
end do
call sf%int%complete_kinematics &
(sf%x, sf%xb, sf%f(c_sel), sf%r(:,c_sel), sf%rb(:,c_sel), &
sf%m(c_sel))
do j = 1, size (sf%x)
chain%x(sf%int%par_index(j)) = sf%x(j)
chain%xb(sf%int%par_index(j)) = sf%xb(j)
end do
if (sf%int%status <= SF_FAILED_KINEMATICS) then
chain%status = SF_FAILED_KINEMATICS
return
end if
do c = 1, size (sf%f)
if (c /= c_sel) then
call sf%int%inverse_kinematics &
(sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c))
do j = 1, size (sf%x)
chain%r (sf%int%par_index(j),c) = sf%r (j,c)
chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
end do
end if
chain%f(c) = chain%f(c) * sf%f(c)
end do
if (.not. sf%eval%is_empty ()) then
call sf%eval%receive_momenta ()
end if
end associate
end do
do c = 1, size (chain%f)
if (c /= c_sel) then
if (allocated (chain%channel(c)%multi_mapping)) then
call chain%channel(c)%multi_mapping%inverse &
(chain%r(:,c), chain%rb(:,c), &
f_mapping, &
chain%p(:,c), chain%pb(:,c), &
chain%x_free)
chain%f(c) = chain%f(c) * f_mapping
else
chain%p (:,c) = chain%r (:,c)
chain%pb(:,c) = chain%rb(:,c)
end if
end if
end do
end if
end if
chain%status = SF_DONE_KINEMATICS
end if
end subroutine sf_chain_instance_compute_kinematics
@ %def sf_chain_instance_compute_kinematics
@ This is a variant of the previous procedure. We know the $x$ parameters and
reconstruct the momenta and the MC input parameters [[p]]. We do not need to
select a channel.
Note: this is probably redundant, since the method we actually want
starts from the momenta, recovers all $x$ parameters, and then
inverts mappings. See below [[recover_kinematics]].
<<SF base: sf chain instance: TBP>>=
procedure :: inverse_kinematics => sf_chain_instance_inverse_kinematics
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_inverse_kinematics (chain, x, xb)
class(sf_chain_instance_t), intent(inout), target :: chain
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
end subroutine sf_chain_instance_inverse_kinematics
<<SF base: procedures>>=
module subroutine sf_chain_instance_inverse_kinematics (chain, x, xb)
class(sf_chain_instance_t), intent(inout), target :: chain
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
type(interaction_t), pointer :: int
real(default) :: f_mapping
integer :: i, j, c
if (chain%status >= SF_DONE_CONNECTIONS) then
call chain%select_channel ()
int => beam_get_int_ptr (chain%beam_t)
call int%receive_momenta ()
if (allocated (chain%sf)) then
chain%f = 1
if (size (chain%sf) /= 0) then
forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
chain%x = x
chain%xb= xb
do i = 1, size (chain%sf)
associate (sf => chain%sf(i))
call sf%int%seed_kinematics ()
do j = 1, size (sf%x)
sf%x(j) = chain%x(sf%int%par_index(j))
sf%xb(j) = chain%xb(sf%int%par_index(j))
end do
do c = 1, size (sf%f)
call sf%int%inverse_kinematics &
(sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
set_momenta = c==1)
chain%f(c) = chain%f(c) * sf%f(c)
do j = 1, size (sf%x)
chain%r (sf%int%par_index(j),c) = sf%r (j,c)
chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
end do
end do
if (.not. sf%eval%is_empty ()) then
call sf%eval%receive_momenta ()
end if
end associate
end do
do c = 1, size (chain%f)
if (allocated (chain%channel(c)%multi_mapping)) then
call chain%channel(c)%multi_mapping%inverse &
(chain%r(:,c), chain%rb(:,c), &
f_mapping, &
chain%p(:,c), chain%pb(:,c), &
chain%x_free)
chain%f(c) = chain%f(c) * f_mapping
else
chain%p (:,c) = chain%r (:,c)
chain%pb(:,c) = chain%rb(:,c)
end if
end do
end if
end if
chain%status = SF_DONE_KINEMATICS
end if
end subroutine sf_chain_instance_inverse_kinematics
@ %def sf_chain_instance_inverse_kinematics
@ Recover the kinematics: assuming that the last evaluator has
been filled with a valid set of momenta, we travel the momentum links
backwards and fill the preceding evaluators and, as a side effect,
interactions. We stop at the beam interaction.
After all momenta are set, apply the [[inverse_kinematics]] procedure
above, suitably modified, to recover the $x$ and $p$ parameters and
the Jacobian factors.
The [[c_sel]] (channel) argument is just used to mark a selected
channel for the records, otherwise the recovery procedure is
independent of this.
<<SF base: sf chain instance: TBP>>=
procedure :: recover_kinematics => sf_chain_instance_recover_kinematics
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_recover_kinematics (chain, c_sel)
class(sf_chain_instance_t), intent(inout), target :: chain
integer, intent(in) :: c_sel
end subroutine sf_chain_instance_recover_kinematics
<<SF base: procedures>>=
module subroutine sf_chain_instance_recover_kinematics (chain, c_sel)
class(sf_chain_instance_t), intent(inout), target :: chain
integer, intent(in) :: c_sel
real(default) :: f_mapping
integer :: i, j, c
if (chain%status >= SF_DONE_CONNECTIONS) then
call chain%select_channel (c_sel)
if (allocated (chain%sf)) then
do i = size (chain%sf), 1, -1
associate (sf => chain%sf(i))
if (.not. sf%eval%is_empty ()) then
call sf%eval%send_momenta ()
end if
end associate
end do
chain%f = 1
if (size (chain%sf) /= 0) then
forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
chain%x_free = 1
do i = 1, size (chain%sf)
associate (sf => chain%sf(i))
call sf%int%seed_kinematics ()
call sf%int%recover_x (sf%x, sf%xb, chain%x_free)
do j = 1, size (sf%x)
chain%x(sf%int%par_index(j)) = sf%x(j)
chain%xb(sf%int%par_index(j)) = sf%xb(j)
end do
do c = 1, size (sf%f)
call sf%int%inverse_kinematics &
(sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
set_momenta = .false.)
chain%f(c) = chain%f(c) * sf%f(c)
do j = 1, size (sf%x)
chain%r (sf%int%par_index(j),c) = sf%r (j,c)
chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
end do
end do
end associate
end do
do c = 1, size (chain%f)
if (allocated (chain%channel(c)%multi_mapping)) then
call chain%channel(c)%multi_mapping%inverse &
(chain%r(:,c), chain%rb(:,c), &
f_mapping, &
chain%p(:,c), chain%pb(:,c), &
chain%x_free)
chain%f(c) = chain%f(c) * f_mapping
else
chain%p (:,c) = chain%r (:,c)
chain%pb(:,c) = chain%rb(:,c)
end if
end do
end if
end if
chain%status = SF_DONE_KINEMATICS
end if
end subroutine sf_chain_instance_recover_kinematics
@ %def sf_chain_instance_recover_kinematics
@ Return the initial beam momenta to their source, thus completing
kinematics recovery. Obviously, this works as a side effect.
<<SF base: sf chain instance: TBP>>=
procedure :: return_beam_momenta => sf_chain_instance_return_beam_momenta
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_return_beam_momenta (chain)
class(sf_chain_instance_t), intent(in), target :: chain
type(interaction_t), pointer :: int
end subroutine sf_chain_instance_return_beam_momenta
<<SF base: procedures>>=
module subroutine sf_chain_instance_return_beam_momenta (chain)
class(sf_chain_instance_t), intent(in), target :: chain
type(interaction_t), pointer :: int
if (chain%status >= SF_DONE_KINEMATICS) then
int => beam_get_int_ptr (chain%beam_t)
call int%send_momenta ()
end if
end subroutine sf_chain_instance_return_beam_momenta
@ %def sf_chain_instance_return_beam_momenta
@ Evaluate all interactions in the chain and the product evaluators.
We provide a [[scale]] argument that is given to all structure
functions in the chain.
Hadronic NLO calculations involve rescaled fractions of the original beam
momentum. In particular, we have to handle the following cases:
\begin{itemize}
\item normal evaluation (where [[i_sub = 0]]) for all terms except the
real non-subtracted,
\item rescaled momentum fraction for both beams in the case of the
real non-subtracted term ([[i_sub = 0]]),
\item and rescaled momentum fraction for one of both beams in the case of the
subtraction and DGLAP component ([[i_sub = 1,2]]).
\end{itemize}
For the collinear final or intial state counter terms, we apply a rescaling to
one beam, and keep the other beam as is. We redo it then vice versa having now two subtractions.
<<SF base: sf chain instance: TBP>>=
procedure :: evaluate => sf_chain_instance_evaluate
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_evaluate &
(chain, scale, negative_sf, sf_rescale)
class(sf_chain_instance_t), intent(inout), target :: chain
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(inout), optional :: sf_rescale
end subroutine sf_chain_instance_evaluate
<<SF base: procedures>>=
module subroutine sf_chain_instance_evaluate &
(chain, scale, negative_sf, sf_rescale)
class(sf_chain_instance_t), intent(inout), target :: chain
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(inout), optional :: sf_rescale
type(interaction_t), pointer :: out_int
real(default) :: sf_sum
integer :: i_beam, i_sub, n_sub
logical :: rescale
n_sub = 0
rescale = .false.; if (present (sf_rescale)) rescale = .true.
if (rescale) then
n_sub = chain%get_n_sub ()
end if
if (chain%status >= SF_DONE_KINEMATICS) then
if (allocated (chain%sf)) then
if (size (chain%sf) /= 0) then
do i_beam = 1, size (chain%sf)
associate (sf => chain%sf(i_beam))
if (rescale) then
call sf_rescale%set_i_beam (i_beam)
do i_sub = 0, n_sub
select case (i_sub)
case (0)
if (n_sub == 0) then
call sf%int%apply (scale, negative_sf, sf_rescale, i_sub = i_sub)
else
call sf%int%apply (scale, negative_sf, i_sub = i_sub)
end if
case default
if (i_beam == i_sub) then
call sf%int%apply (scale, negative_sf, sf_rescale, i_sub = i_sub)
else
call sf%int%apply (scale, negative_sf, i_sub = i_sub)
end if
end select
end do
else
call sf%int%apply (scale, negative_sf, i_sub = n_sub)
end if
if (sf%int%status <= SF_FAILED_EVALUATION) then
chain%status = SF_FAILED_EVALUATION
return
end if
if (.not. sf%eval%is_empty ()) call sf%eval%evaluate ()
end associate
end do
out_int => chain%get_out_int_ptr ()
sf_sum = real (out_int%sum ())
call chain%config%trace &
(chain%selected_channel, chain%p, chain%x, chain%f, sf_sum)
end if
end if
chain%status = SF_EVALUATED
end if
end subroutine sf_chain_instance_evaluate
@ %def sf_chain_instance_evaluate
@
\subsection{Access to the chain instance}
Transfer the outgoing momenta to the array [[p]]. We assume that
array sizes match.
<<SF base: sf chain instance: TBP>>=
procedure :: get_out_momenta => sf_chain_instance_get_out_momenta
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_get_out_momenta (chain, p)
class(sf_chain_instance_t), intent(in), target :: chain
type(vector4_t), dimension(:), intent(out) :: p
end subroutine sf_chain_instance_get_out_momenta
<<SF base: procedures>>=
module subroutine sf_chain_instance_get_out_momenta (chain, p)
class(sf_chain_instance_t), intent(in), target :: chain
type(vector4_t), dimension(:), intent(out) :: p
type(interaction_t), pointer :: int
integer :: i, j
if (chain%status >= SF_DONE_KINEMATICS) then
do j = 1, size (chain%out_sf)
i = chain%out_sf(j)
select case (i)
case (0)
int => beam_get_int_ptr (chain%beam_t)
case default
int => chain%sf(i)%int%interaction_t
end select
p(j) = int%get_momentum (chain%out_sf_i(j))
end do
end if
end subroutine sf_chain_instance_get_out_momenta
@ %def sf_chain_instance_get_out_momenta
@ Return a pointer to the last evaluator in the chain (to the interaction).
<<SF base: sf chain instance: TBP>>=
procedure :: get_out_int_ptr => sf_chain_instance_get_out_int_ptr
<<SF base: sub interfaces>>=
module function sf_chain_instance_get_out_int_ptr (chain) result (int)
class(sf_chain_instance_t), intent(in), target :: chain
type(interaction_t), pointer :: int
end function sf_chain_instance_get_out_int_ptr
<<SF base: procedures>>=
module function sf_chain_instance_get_out_int_ptr (chain) result (int)
class(sf_chain_instance_t), intent(in), target :: chain
type(interaction_t), pointer :: int
if (chain%out_eval == 0) then
int => beam_get_int_ptr (chain%beam_t)
else
int => chain%sf(chain%out_eval)%eval%interaction_t
end if
end function sf_chain_instance_get_out_int_ptr
@ %def sf_chain_instance_get_out_int_ptr
@ Return the index of the [[j]]-th outgoing particle, within the last
evaluator.
<<SF base: sf chain instance: TBP>>=
procedure :: get_out_i => sf_chain_instance_get_out_i
<<SF base: sub interfaces>>=
module function sf_chain_instance_get_out_i (chain, j) result (i)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: j
integer :: i
end function sf_chain_instance_get_out_i
<<SF base: procedures>>=
module function sf_chain_instance_get_out_i (chain, j) result (i)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: j
integer :: i
i = chain%out_eval_i(j)
end function sf_chain_instance_get_out_i
@ %def sf_chain_instance_get_out_i
@ Return the mask for the outgoing particle(s), within the last evaluator.
<<SF base: sf chain instance: TBP>>=
procedure :: get_out_mask => sf_chain_instance_get_out_mask
<<SF base: sub interfaces>>=
module function sf_chain_instance_get_out_mask (chain) result (mask)
class(sf_chain_instance_t), intent(in), target :: chain
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
end function sf_chain_instance_get_out_mask
<<SF base: procedures>>=
module function sf_chain_instance_get_out_mask (chain) result (mask)
class(sf_chain_instance_t), intent(in), target :: chain
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
type(interaction_t), pointer :: int
allocate (mask (chain%config%n_in))
int => chain%get_out_int_ptr ()
mask = int%get_mask (chain%out_eval_i)
end function sf_chain_instance_get_out_mask
@ %def sf_chain_instance_get_out_mask
@ Return the array of MC input parameters that corresponds to channel [[c]].
This is the [[p]] array, the parameters before all mappings.
The [[p]] array may be deallocated. This should correspond to a
zero-size [[r]] argument, so nothing to do then.
<<SF base: sf chain instance: TBP>>=
procedure :: get_mcpar => sf_chain_instance_get_mcpar
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_get_mcpar (chain, c, r)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: c
real(default), dimension(:), intent(out) :: r
end subroutine sf_chain_instance_get_mcpar
<<SF base: procedures>>=
module subroutine sf_chain_instance_get_mcpar (chain, c, r)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: c
real(default), dimension(:), intent(out) :: r
if (allocated (chain%p)) r = pack (chain%p(:,c), chain%bound)
end subroutine sf_chain_instance_get_mcpar
@ %def sf_chain_instance_get_mcpar
@ Return the Jacobian factor that corresponds to channel [[c]].
<<SF base: sf chain instance: TBP>>=
procedure :: get_f => sf_chain_instance_get_f
<<SF base: sub interfaces>>=
module function sf_chain_instance_get_f (chain, c) result (f)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: c
real(default) :: f
end function sf_chain_instance_get_f
<<SF base: procedures>>=
module function sf_chain_instance_get_f (chain, c) result (f)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: c
real(default) :: f
if (allocated (chain%f)) then
f = chain%f(c)
else
f = 1
end if
end function sf_chain_instance_get_f
@ %def sf_chain_instance_get_f
@ Return the evaluation status.
<<SF base: sf chain instance: TBP>>=
procedure :: get_status => sf_chain_instance_get_status
<<SF base: sub interfaces>>=
module function sf_chain_instance_get_status (chain) result (status)
class(sf_chain_instance_t), intent(in) :: chain
integer :: status
end function sf_chain_instance_get_status
<<SF base: procedures>>=
module function sf_chain_instance_get_status (chain) result (status)
class(sf_chain_instance_t), intent(in) :: chain
integer :: status
status = chain%status
end function sf_chain_instance_get_status
@ %def sf_chain_instance_get_status
@
<<SF base: sf chain instance: TBP>>=
procedure :: get_matrix_elements => sf_chain_instance_get_matrix_elements
<<SF base: sub interfaces>>=
module subroutine sf_chain_instance_get_matrix_elements (chain, i, ff)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: i
real(default), intent(out), dimension(:), allocatable :: ff
end subroutine sf_chain_instance_get_matrix_elements
<<SF base: procedures>>=
module subroutine sf_chain_instance_get_matrix_elements (chain, i, ff)
class(sf_chain_instance_t), intent(in) :: chain
integer, intent(in) :: i
real(default), intent(out), dimension(:), allocatable :: ff
associate (sf => chain%sf(i))
ff = real (sf%int%get_matrix_element ())
end associate
end subroutine sf_chain_instance_get_matrix_elements
@ %def sf_chain_instance_get_matrix_elements
@
<<SF base: sf chain instance: TBP>>=
procedure :: get_beam_int_ptr => sf_chain_instance_get_beam_int_ptr
<<SF base: sub interfaces>>=
module function sf_chain_instance_get_beam_int_ptr (chain) result (int)
type(interaction_t), pointer :: int
class(sf_chain_instance_t), intent(in), target :: chain
end function sf_chain_instance_get_beam_int_ptr
<<SF base: procedures>>=
module function sf_chain_instance_get_beam_int_ptr (chain) result (int)
type(interaction_t), pointer :: int
class(sf_chain_instance_t), intent(in), target :: chain
int => beam_get_int_ptr (chain%beam_t)
end function sf_chain_instance_get_beam_int_ptr
@ %def sf_chain_instance_get_beam_ptr
@
<<SF base: sf chain instance: TBP>>=
procedure :: get_n_sub => sf_chain_instance_get_n_sub
<<SF base: sub interfaces>>=
module function sf_chain_instance_get_n_sub (chain) result (n_sub)
type(interaction_t), pointer :: int
class(sf_chain_instance_t), intent(in), target :: chain
integer :: n_sub
end function sf_chain_instance_get_n_sub
<<SF base: procedures>>=
module function sf_chain_instance_get_n_sub (chain) result (n_sub)
type(interaction_t), pointer :: int
class(sf_chain_instance_t), intent(in), target :: chain
integer :: n_sub
int => beam_get_int_ptr (chain%beam_t)
n_sub = int%get_n_sub ()
end function sf_chain_instance_get_n_sub
@ %def sf_chain_instance_get_n_sub
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_base_ut.f90]]>>=
<<File header>>
module sf_base_ut
use unit_tests
use sf_base_uti
<<Standard module head>>
<<SF base: public test auxiliary>>
<<SF base: public test>>
contains
<<SF base: test driver>>
end module sf_base_ut
@ %def sf_base_ut
@
<<[[sf_base_uti.f90]]>>=
<<File header>>
module sf_base_uti
<<Use kinds>>
<<Use strings>>
use io_units
use format_defs, only: FMT_19
use format_utils, only: write_separator
use diagnostics
use lorentz
use pdg_arrays
use flavors
use colors
use helicities
use quantum_numbers
use state_matrices, only: FM_IGNORE_HELICITY
use interactions
use particles
use model_data
use beams
use sf_aux
use sf_mappings
use sf_base
<<Standard module head>>
<<SF base: test declarations>>
<<SF base: public test auxiliary>>
<<SF base: test types>>
contains
<<SF base: tests>>
<<SF base: test auxiliary>>
end module sf_base_uti
@ %def sf_base_ut
@ API: driver for the unit tests below.
<<SF base: public test>>=
public :: sf_base_test
<<SF base: test driver>>=
subroutine sf_base_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF base: execute tests>>
end subroutine sf_base_test
@ %def sf_base_test
@
\subsection{Test implementation: structure function}
This is a template for the actual structure-function implementation
which will be defined in separate modules.
\subsubsection{Configuration data}
The test structure function uses the [[Test]] model. It describes a
scalar within an arbitrary initial particle, which is given in the
initialization. The radiated particle is also a scalar, the same one,
but we set its mass artificially to zero.
<<SF base: public test auxiliary>>=
public :: sf_test_data_t
<<SF base: test types>>=
type, extends (sf_data_t) :: sf_test_data_t
class(model_data_t), pointer :: model => null ()
integer :: mode = 0
type(flavor_t) :: flv_in
type(flavor_t) :: flv_out
type(flavor_t) :: flv_rad
real(default) :: m = 0
logical :: collinear = .true.
real(default), dimension(:), allocatable :: qbounds
contains
<<SF base: sf test data: TBP>>
end type sf_test_data_t
@ %def sf_test_data_t
@ Output.
<<SF base: sf test data: TBP>>=
procedure :: write => sf_test_data_write
<<SF base: test auxiliary>>=
subroutine sf_test_data_write (data, unit, verbose)
class(sf_test_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "SF test data:"
write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
write (u, "(3x,A)", advance="no") "incoming = "
call data%flv_in%write (u); write (u, *)
write (u, "(3x,A)", advance="no") "outgoing = "
call data%flv_out%write (u); write (u, *)
write (u, "(3x,A)", advance="no") "radiated = "
call data%flv_rad%write (u); write (u, *)
write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
write (u, "(3x,A,L1)") "collinear = ", data%collinear
if (.not. data%collinear .and. allocated (data%qbounds)) then
write (u, "(3x,A," // FMT_19 // ")") "qmin = ", data%qbounds(1)
write (u, "(3x,A," // FMT_19 // ")") "qmax = ", data%qbounds(2)
end if
end subroutine sf_test_data_write
@ %def sf_test_data_write
@ Initialization.
<<SF base: sf test data: TBP>>=
procedure :: init => sf_test_data_init
<<SF base: test auxiliary>>=
subroutine sf_test_data_init (data, model, pdg_in, collinear, qbounds, mode)
class(sf_test_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
logical, intent(in), optional :: collinear
real(default), dimension(2), intent(in), optional :: qbounds
integer, intent(in), optional :: mode
data%model => model
if (present (mode)) data%mode = mode
if (pdg_in%get (1) /= 25) then
call msg_fatal ("Test spectrum function: input flavor must be 's'")
end if
call data%flv_in%init (25, model)
data%m = data%flv_in%get_mass ()
if (present (collinear)) data%collinear = collinear
call data%flv_out%init (25, model)
call data%flv_rad%init (25, model)
if (present (qbounds)) then
allocate (data%qbounds (2))
data%qbounds = qbounds
end if
end subroutine sf_test_data_init
@ %def sf_test_data_init
@ Return the number of parameters: 1 if only consider collinear
splitting, 3 otherwise.
<<SF base: sf test data: TBP>>=
procedure :: get_n_par => sf_test_data_get_n_par
<<SF base: test auxiliary>>=
function sf_test_data_get_n_par (data) result (n)
class(sf_test_data_t), intent(in) :: data
integer :: n
if (data%collinear) then
n = 1
else
n = 3
end if
end function sf_test_data_get_n_par
@ %def sf_test_data_get_n_par
@ Return the outgoing particle PDG code: 25
<<SF base: sf test data: TBP>>=
procedure :: get_pdg_out => sf_test_data_get_pdg_out
<<SF base: test auxiliary>>=
subroutine sf_test_data_get_pdg_out (data, pdg_out)
class(sf_test_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
pdg_out(1) = 25
end subroutine sf_test_data_get_pdg_out
@ %def sf_test_data_get_pdg_out
@ Allocate the matching interaction.
<<SF base: sf test data: TBP>>=
procedure :: allocate_sf_int => sf_test_data_allocate_sf_int
<<SF base: test auxiliary>>=
subroutine sf_test_data_allocate_sf_int (data, sf_int)
class(sf_test_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
if (allocated (sf_int)) deallocate (sf_int)
allocate (sf_test_t :: sf_int)
end subroutine sf_test_data_allocate_sf_int
@ %def sf_test_data_allocate_sf_int
@
\subsubsection{Interaction}
<<SF base: test types>>=
type, extends (sf_int_t) :: sf_test_t
type(sf_test_data_t), pointer :: data => null ()
real(default) :: x = 0
contains
<<SF base: sf test int: TBP>>
end type sf_test_t
@ %def sf_test_t
@ Type string: constant
<<SF base: sf test int: TBP>>=
procedure :: type_string => sf_test_type_string
<<SF base: test auxiliary>>=
function sf_test_type_string (object) result (string)
class(sf_test_t), intent(in) :: object
type(string_t) :: string
string = "Test"
end function sf_test_type_string
@ %def sf_test_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF base: sf test int: TBP>>=
procedure :: write => sf_test_write
<<SF base: test auxiliary>>=
subroutine sf_test_write (object, unit, testflag)
class(sf_test_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "SF test data: [undefined]"
end if
end subroutine sf_test_write
@ %def sf_test_write
@ Initialize. We know that [[data]] will be of concrete type
[[sf_test_data_t]], but we have to cast this explicitly.
For this implementation, we set the incoming and outgoing masses equal
to the physical particle mass, but keep the radiated mass zero.
Optionally, we can provide minimum and maximum values for the momentum
transfer.
<<SF base: sf test int: TBP>>=
procedure :: init => sf_test_init
<<SF base: test auxiliary>>=
subroutine sf_test_init (sf_int, data)
class(sf_test_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(3) :: mask
type(helicity_t) :: hel0
type(color_t) :: col0
type(quantum_numbers_t), dimension(3) :: qn
mask = quantum_numbers_mask (.false., .false., .false.)
select type (data)
type is (sf_test_data_t)
if (allocated (data%qbounds)) then
call sf_int%base_init (mask, &
[data%m**2], [0._default], [data%m**2], &
[data%qbounds(1)], [data%qbounds(2)])
else
call sf_int%base_init (mask, &
[data%m**2], [0._default], [data%m**2])
end if
sf_int%data => data
call hel0%init (0)
call col0%init ()
call qn(1)%init (data%flv_in, col0, hel0)
call qn(2)%init (data%flv_rad, col0, hel0)
call qn(3)%init (data%flv_out, col0, hel0)
call sf_int%add_state (qn)
call sf_int%freeze ()
call sf_int%set_incoming ([1])
call sf_int%set_radiated ([2])
call sf_int%set_outgoing ([3])
end select
sf_int%status = SF_INITIAL
end subroutine sf_test_init
@ %def sf_test_init
@ Set kinematics. If [[map]] is unset, the $r$ and $x$ values
coincide, and the Jacobian $f(r)$ is trivial.
If [[map]] is set, we are asked to provide an efficient mapping.
For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
<<SF base: sf test int: TBP>>=
procedure :: complete_kinematics => sf_test_complete_kinematics
<<SF base: test auxiliary>>=
subroutine sf_test_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(sf_test_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
if (map) then
x(1) = r(1)**2
f = 2 * r(1)
else
x(1) = r(1)
f = 1
end if
xb(1) = 1 - x(1)
if (size (x) == 3) then
x(2:3) = r(2:3)
xb(2:3) = rb(2:3)
end if
call sf_int%split_momentum (x, xb)
sf_int%x = x(1)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end subroutine sf_test_complete_kinematics
@ %def sf_test_complete_kinematics
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
<<SF base: sf test int: TBP>>=
procedure :: inverse_kinematics => sf_test_inverse_kinematics
<<SF base: test auxiliary>>=
subroutine sf_test_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
class(sf_test_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
r(1) = sqrt (x(1))
f = 2 * r(1)
else
r(1) = x(1)
f = 1
end if
if (size (x) == 3) r(2:3) = x(2:3)
rb = 1 - r
sf_int%x = x(1)
if (set_mom) then
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end if
end subroutine sf_test_inverse_kinematics
@ %def sf_test_inverse_kinematics
@ Apply the structure function. The matrix element becomes unity and
the application always succeeds.
If the [[mode]] indicator is one, the matrix element is equal to the
parameter~$x$.
<<SF base: sf test int: TBP>>=
procedure :: apply => sf_test_apply
<<SF base: test auxiliary>>=
subroutine sf_test_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(sf_test_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
select case (sf_int%data%mode)
case (0)
call sf_int%set_matrix_element &
(cmplx (1._default, kind=default))
case (1)
call sf_int%set_matrix_element &
(cmplx (sf_int%x, kind=default))
end select
sf_int%status = SF_EVALUATED
end subroutine sf_test_apply
@ %def sf_test_apply
@
\subsection{Test implementation: pair spectrum}
Another template, this time for a incoming particle pair, splitting
into two radiated and two outgoing particles.
\subsubsection{Configuration data}
For simplicity, the spectrum contains two mirror images of the
previous structure-function configuration: the incoming and all
outgoing particles are test scalars.
We have two versions, one with radiated particles, one without.
<<SF base: test types>>=
type, extends (sf_data_t) :: sf_test_spectrum_data_t
class(model_data_t), pointer :: model => null ()
type(flavor_t) :: flv_in
type(flavor_t) :: flv_out
type(flavor_t) :: flv_rad
logical :: with_radiation = .true.
real(default) :: m = 0
contains
<<SF base: sf test spectrum data: TBP>>
end type sf_test_spectrum_data_t
@ %def sf_test_spectrum_data_t
@ Output.
<<SF base: sf test spectrum data: TBP>>=
procedure :: write => sf_test_spectrum_data_write
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_data_write (data, unit, verbose)
class(sf_test_spectrum_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "SF test spectrum data:"
write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
write (u, "(3x,A)", advance="no") "incoming = "
call data%flv_in%write (u); write (u, *)
write (u, "(3x,A)", advance="no") "outgoing = "
call data%flv_out%write (u); write (u, *)
write (u, "(3x,A)", advance="no") "radiated = "
call data%flv_rad%write (u); write (u, *)
write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
end subroutine sf_test_spectrum_data_write
@ %def sf_test_spectrum_data_write
@ Initialization.
<<SF base: sf test spectrum data: TBP>>=
procedure :: init => sf_test_spectrum_data_init
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_data_init (data, model, pdg_in, with_radiation)
class(sf_test_spectrum_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
logical, intent(in) :: with_radiation
data%model => model
data%with_radiation = with_radiation
if (pdg_in%get (1) /= 25) then
call msg_fatal ("Test structure function: input flavor must be 's'")
end if
call data%flv_in%init (25, model)
data%m = data%flv_in%get_mass ()
call data%flv_out%init (25, model)
if (with_radiation) then
call data%flv_rad%init (25, model)
end if
end subroutine sf_test_spectrum_data_init
@ %def sf_test_spectrum_data_init
@ Return the number of parameters: 2, since we have only collinear
splitting here.
<<SF base: sf test spectrum data: TBP>>=
procedure :: get_n_par => sf_test_spectrum_data_get_n_par
<<SF base: test auxiliary>>=
function sf_test_spectrum_data_get_n_par (data) result (n)
class(sf_test_spectrum_data_t), intent(in) :: data
integer :: n
n = 2
end function sf_test_spectrum_data_get_n_par
@ %def sf_test_spectrum_data_get_n_par
@ Return the outgoing particle PDG codes: 25
<<SF base: sf test spectrum data: TBP>>=
procedure :: get_pdg_out => sf_test_spectrum_data_get_pdg_out
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_data_get_pdg_out (data, pdg_out)
class(sf_test_spectrum_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
pdg_out(1) = 25
pdg_out(2) = 25
end subroutine sf_test_spectrum_data_get_pdg_out
@ %def sf_test_spectrum_data_get_pdg_out
@ Allocate the matching interaction.
<<SF base: sf test spectrum data: TBP>>=
procedure :: allocate_sf_int => &
sf_test_spectrum_data_allocate_sf_int
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_data_allocate_sf_int (data, sf_int)
class(sf_test_spectrum_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (sf_test_spectrum_t :: sf_int)
end subroutine sf_test_spectrum_data_allocate_sf_int
@ %def sf_test_spectrum_data_allocate_sf_int
@
\subsubsection{Interaction}
<<SF base: test types>>=
type, extends (sf_int_t) :: sf_test_spectrum_t
type(sf_test_spectrum_data_t), pointer :: data => null ()
contains
<<SF base: sf test spectrum: TBP>>
end type sf_test_spectrum_t
@ %def sf_test_spectrum_t
<<SF base: sf test spectrum: TBP>>=
procedure :: type_string => sf_test_spectrum_type_string
<<SF base: test auxiliary>>=
function sf_test_spectrum_type_string (object) result (string)
class(sf_test_spectrum_t), intent(in) :: object
type(string_t) :: string
string = "Test Spectrum"
end function sf_test_spectrum_type_string
@ %def sf_test_spectrum_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF base: sf test spectrum: TBP>>=
procedure :: write => sf_test_spectrum_write
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_write (object, unit, testflag)
class(sf_test_spectrum_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "SF test spectrum data: [undefined]"
end if
end subroutine sf_test_spectrum_write
@ %def sf_test_spectrum_write
@ Initialize. We know that [[data]] will be of concrete type
[[sf_test_spectrum_data_t]], but we have to cast this explicitly.
For this implementation, we set the incoming and outgoing masses equal
to the physical particle mass, but keep the radiated mass zero.
Optionally, we can provide minimum and maximum values for the momentum
transfer.
<<SF base: sf test spectrum: TBP>>=
procedure :: init => sf_test_spectrum_init
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_init (sf_int, data)
class(sf_test_spectrum_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(6) :: mask
type(helicity_t) :: hel0
type(color_t) :: col0
type(quantum_numbers_t), dimension(6) :: qn
mask = quantum_numbers_mask (.false., .false., .false.)
select type (data)
type is (sf_test_spectrum_data_t)
if (data%with_radiation) then
call sf_int%base_init (mask(1:6), &
[data%m**2, data%m**2], &
[0._default, 0._default], &
[data%m**2, data%m**2])
sf_int%data => data
call hel0%init (0)
call col0%init ()
call qn(1)%init (data%flv_in, col0, hel0)
call qn(2)%init (data%flv_in, col0, hel0)
call qn(3)%init (data%flv_rad, col0, hel0)
call qn(4)%init (data%flv_rad, col0, hel0)
call qn(5)%init (data%flv_out, col0, hel0)
call qn(6)%init (data%flv_out, col0, hel0)
call sf_int%add_state (qn(1:6))
call sf_int%set_incoming ([1,2])
call sf_int%set_radiated ([3,4])
call sf_int%set_outgoing ([5,6])
else
call sf_int%base_init (mask(1:4), &
[data%m**2, data%m**2], &
[real(default) :: ], &
[data%m**2, data%m**2])
sf_int%data => data
call hel0%init (0)
call col0%init ()
call qn(1)%init (data%flv_in, col0, hel0)
call qn(2)%init (data%flv_in, col0, hel0)
call qn(3)%init (data%flv_out, col0, hel0)
call qn(4)%init (data%flv_out, col0, hel0)
call sf_int%add_state (qn(1:4))
call sf_int%set_incoming ([1,2])
call sf_int%set_outgoing ([3,4])
end if
call sf_int%freeze ()
end select
sf_int%status = SF_INITIAL
end subroutine sf_test_spectrum_init
@ %def sf_test_spectrum_init
@ Set kinematics. If [[map]] is unset, the $r$ and $x$ values
coincide, and the Jacobian $f(r)$ is trivial.
If [[map]] is set, we are asked to provide an efficient mapping.
For the test case, we set $x=r^2$ (as above) for both $x$ parameters
and consequently $f(r)=4r_1r_2$.
<<SF base: sf test spectrum: TBP>>=
procedure :: complete_kinematics => sf_test_spectrum_complete_kinematics
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(sf_test_spectrum_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
real(default), dimension(2) :: xb1
if (map) then
x = r**2
f = 4 * r(1) * r(2)
else
x = r
f = 1
end if
xb = 1 - x
if (sf_int%data%with_radiation) then
call sf_int%split_momenta (x, xb)
else
call sf_int%reduce_momenta (x)
end if
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end subroutine sf_test_spectrum_complete_kinematics
@ %def sf_test_spectrum_complete_kinematics
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
<<SF base: sf test spectrum: TBP>>=
procedure :: inverse_kinematics => sf_test_spectrum_inverse_kinematics
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(sf_test_spectrum_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
real(default), dimension(2) :: xb1
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
r = sqrt (x)
f = 4 * r(1) * r(2)
else
r = x
f = 1
end if
rb = 1 - r
if (set_mom) then
if (sf_int%data%with_radiation) then
call sf_int%split_momenta (x, xb)
else
call sf_int%reduce_momenta (x)
end if
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end if
end subroutine sf_test_spectrum_inverse_kinematics
@ %def sf_test_spectrum_inverse_kinematics
@ Apply the structure function. The matrix element becomes unity and
the application always succeeds.
<<SF base: sf test spectrum: TBP>>=
procedure :: apply => sf_test_spectrum_apply
<<SF base: test auxiliary>>=
subroutine sf_test_spectrum_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(sf_test_spectrum_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
call sf_int%set_matrix_element &
(cmplx (1._default, kind=default))
sf_int%status = SF_EVALUATED
end subroutine sf_test_spectrum_apply
@ %def sf_test_spectrum_apply
@
\subsection{Test implementation: generator spectrum}
A generator for two beams, no radiation (for simplicity).
\subsubsection{Configuration data}
For simplicity, the spectrum contains two mirror images of the
previous structure-function configuration: the incoming and all
outgoing particles are test scalars.
We have two versions, one with radiated particles, one without.
<<SF base: test types>>=
type, extends (sf_data_t) :: sf_test_generator_data_t
class(model_data_t), pointer :: model => null ()
type(flavor_t) :: flv_in
type(flavor_t) :: flv_out
type(flavor_t) :: flv_rad
real(default) :: m = 0
contains
<<SF base: sf test generator data: TBP>>
end type sf_test_generator_data_t
@ %def sf_test_generator_data_t
@ Output.
<<SF base: sf test generator data: TBP>>=
procedure :: write => sf_test_generator_data_write
<<SF base: test auxiliary>>=
subroutine sf_test_generator_data_write (data, unit, verbose)
class(sf_test_generator_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "SF test generator data:"
write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
write (u, "(3x,A)", advance="no") "incoming = "
call data%flv_in%write (u); write (u, *)
write (u, "(3x,A)", advance="no") "outgoing = "
call data%flv_out%write (u); write (u, *)
write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
end subroutine sf_test_generator_data_write
@ %def sf_test_generator_data_write
@ Initialization.
<<SF base: sf test generator data: TBP>>=
procedure :: init => sf_test_generator_data_init
<<SF base: test auxiliary>>=
subroutine sf_test_generator_data_init (data, model, pdg_in)
class(sf_test_generator_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
data%model => model
if (pdg_in%get (1) /= 25) then
call msg_fatal ("Test generator: input flavor must be 's'")
end if
call data%flv_in%init (25, model)
data%m = data%flv_in%get_mass ()
call data%flv_out%init (25, model)
end subroutine sf_test_generator_data_init
@ %def sf_test_generator_data_init
@ This structure function is a generator.
<<SF base: sf test generator data: TBP>>=
procedure :: is_generator => sf_test_generator_data_is_generator
<<SF base: test auxiliary>>=
function sf_test_generator_data_is_generator (data) result (flag)
class(sf_test_generator_data_t), intent(in) :: data
logical :: flag
flag = .true.
end function sf_test_generator_data_is_generator
@ %def sf_test_generator_data_is_generator
@ Return the number of parameters: 2, since we have only collinear
splitting here.
<<SF base: sf test generator data: TBP>>=
procedure :: get_n_par => sf_test_generator_data_get_n_par
<<SF base: test auxiliary>>=
function sf_test_generator_data_get_n_par (data) result (n)
class(sf_test_generator_data_t), intent(in) :: data
integer :: n
n = 2
end function sf_test_generator_data_get_n_par
@ %def sf_test_generator_data_get_n_par
@ Return the outgoing particle PDG codes: 25
<<SF base: sf test generator data: TBP>>=
procedure :: get_pdg_out => sf_test_generator_data_get_pdg_out
<<SF base: test auxiliary>>=
subroutine sf_test_generator_data_get_pdg_out (data, pdg_out)
class(sf_test_generator_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
pdg_out(1) = 25
pdg_out(2) = 25
end subroutine sf_test_generator_data_get_pdg_out
@ %def sf_test_generator_data_get_pdg_out
@ Allocate the matching interaction.
<<SF base: sf test generator data: TBP>>=
procedure :: allocate_sf_int => &
sf_test_generator_data_allocate_sf_int
<<SF base: test auxiliary>>=
subroutine sf_test_generator_data_allocate_sf_int (data, sf_int)
class(sf_test_generator_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (sf_test_generator_t :: sf_int)
end subroutine sf_test_generator_data_allocate_sf_int
@ %def sf_test_generator_data_allocate_sf_int
@
\subsubsection{Interaction}
<<SF base: test types>>=
type, extends (sf_int_t) :: sf_test_generator_t
type(sf_test_generator_data_t), pointer :: data => null ()
contains
<<SF base: sf test generator: TBP>>
end type sf_test_generator_t
@ %def sf_test_generator_t
<<SF base: sf test generator: TBP>>=
procedure :: type_string => sf_test_generator_type_string
<<SF base: test auxiliary>>=
function sf_test_generator_type_string (object) result (string)
class(sf_test_generator_t), intent(in) :: object
type(string_t) :: string
string = "Test Generator"
end function sf_test_generator_type_string
@ %def sf_test_generator_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF base: sf test generator: TBP>>=
procedure :: write => sf_test_generator_write
<<SF base: test auxiliary>>=
subroutine sf_test_generator_write (object, unit, testflag)
class(sf_test_generator_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "SF test generator data: [undefined]"
end if
end subroutine sf_test_generator_write
@ %def sf_test_generator_write
@ Initialize. We know that [[data]] will be of concrete type
[[sf_test_generator_data_t]], but we have to cast this explicitly.
For this implementation, we set the incoming and outgoing masses equal
to the physical particle mass. No radiation.
<<SF base: sf test generator: TBP>>=
procedure :: init => sf_test_generator_init
<<SF base: test auxiliary>>=
subroutine sf_test_generator_init (sf_int, data)
class(sf_test_generator_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(4) :: mask
type(helicity_t) :: hel0
type(color_t) :: col0
type(quantum_numbers_t), dimension(4) :: qn
mask = quantum_numbers_mask (.false., .false., .false.)
select type (data)
type is (sf_test_generator_data_t)
call sf_int%base_init (mask(1:4), &
[data%m**2, data%m**2], &
[real(default) :: ], &
[data%m**2, data%m**2])
sf_int%data => data
call hel0%init (0)
call col0%init ()
call qn(1)%init (data%flv_in, col0, hel0)
call qn(2)%init (data%flv_in, col0, hel0)
call qn(3)%init (data%flv_out, col0, hel0)
call qn(4)%init (data%flv_out, col0, hel0)
call sf_int%add_state (qn(1:4))
call sf_int%set_incoming ([1,2])
call sf_int%set_outgoing ([3,4])
call sf_int%freeze ()
end select
sf_int%status = SF_INITIAL
end subroutine sf_test_generator_init
@ %def sf_test_generator_init
@ This structure function is a generator.
<<SF base: sf test generator: TBP>>=
procedure :: is_generator => sf_test_generator_is_generator
<<SF base: test auxiliary>>=
function sf_test_generator_is_generator (sf_int) result (flag)
class(sf_test_generator_t), intent(in) :: sf_int
logical :: flag
flag = sf_int%data%is_generator ()
end function sf_test_generator_is_generator
@ %def sf_test_generator_is_generator
@ Generate free parameters. This mock generator always produces the
nubmers 0.8 and 0.5.
<<SF base: sf test generator: TBP>>=
procedure :: generate_free => sf_test_generator_generate_free
<<SF base: test auxiliary>>=
subroutine sf_test_generator_generate_free (sf_int, r, rb, x_free)
class(sf_test_generator_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
r = [0.8, 0.5]
rb= 1 - r
x_free = x_free * product (r)
end subroutine sf_test_generator_generate_free
@ %def sf_test_generator_generate_free
@ Recover momentum fractions. Since the x values are free, we also set the [[x_free]] parameter.
<<SF base: sf test generator: TBP>>=
procedure :: recover_x => sf_test_generator_recover_x
<<SF base: test auxiliary>>=
subroutine sf_test_generator_recover_x (sf_int, x, xb, x_free)
class(sf_test_generator_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
call sf_int%base_recover_x (x, xb)
if (present (x_free)) x_free = x_free * product (x)
end subroutine sf_test_generator_recover_x
@ %def sf_test_generator_recover_x
@ Set kinematics. Since this is a generator, just transfer input to output.
<<SF base: sf test generator: TBP>>=
procedure :: complete_kinematics => sf_test_generator_complete_kinematics
<<SF base: test auxiliary>>=
subroutine sf_test_generator_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(sf_test_generator_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
x = r
xb= rb
f = 1
call sf_int%reduce_momenta (x)
end subroutine sf_test_generator_complete_kinematics
@ %def sf_test_generator_complete_kinematics
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
<<SF base: sf test generator: TBP>>=
procedure :: inverse_kinematics => sf_test_generator_inverse_kinematics
<<SF base: test auxiliary>>=
subroutine sf_test_generator_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(sf_test_generator_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
r = x
rb= xb
f = 1
if (set_mom) call sf_int%reduce_momenta (x)
end subroutine sf_test_generator_inverse_kinematics
@ %def sf_test_generator_inverse_kinematics
@ Apply the structure function. The matrix element becomes unity and
the application always succeeds.
<<SF base: sf test generator: TBP>>=
procedure :: apply => sf_test_generator_apply
<<SF base: test auxiliary>>=
subroutine sf_test_generator_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(sf_test_generator_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
call sf_int%set_matrix_element &
(cmplx (1._default, kind=default))
sf_int%status = SF_EVALUATED
end subroutine sf_test_generator_apply
@ %def sf_test_generator_apply
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF base: execute tests>>=
call test (sf_base_1, "sf_base_1", &
"structure function configuration", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_1
<<SF base: tests>>=
subroutine sf_base_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(pdg_array_t), dimension(1) :: pdg_out
integer, dimension(:), allocatable :: pdg1
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_base_1"
write (u, "(A)") "* Purpose: initialize and display &
&test structure function data"
write (u, "(A)")
call model%init_test ()
pdg_in = 25
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (model, pdg_in)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle code:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(2x,99(1x,I0))") pdg1
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_1"
end subroutine sf_base_1
@ %def sf_base_1
@
\subsubsection{Test and probe structure function}
Construct and display a structure function object based on the test
structure function.
<<SF base: execute tests>>=
call test (sf_base_2, "sf_base_2", &
"structure function instance", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_2
<<SF base: tests>>=
subroutine sf_base_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_base_2"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
pdg_in = 25
call flv%init (25, model)
call reset_interaction_counter ()
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (model, pdg_in)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=1"
write (u, "(A)")
r = 1
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Set kinematics with mapping for r=0.8"
write (u, "(A)")
r = 0.8_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A)")
write (u, "(A)") "* Compute inverse kinematics for x=0.64 and evaluate"
write (u, "(A)")
x = 0.64_default
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%apply (scale=0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_2"
end subroutine sf_base_2
@ %def sf_base_2
@
\subsubsection{Collinear kinematics}
Scan over the possibilities for mass assignment and on-shell
projections, collinear case.
<<SF base: execute tests>>=
call test (sf_base_3, "sf_base_3", &
"alternatives for collinear kinematics", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_3
<<SF base: tests>>=
subroutine sf_base_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(flavor_t) :: flv
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_base_3"
write (u, "(A)") "* Purpose: check various kinematical setups"
write (u, "(A)") "* for collinear structure-function splitting."
write (u, "(A)") " (two masses equal, one zero)"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
pdg_in = 25
call flv%init (25, model)
call reset_interaction_counter ()
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (model, pdg_in)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%write (u)
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=500"
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set radiated mass to zero"
sf_int%mr2 = 0
sf_int%mo2 = sf_int%mi2
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set outgoing mass to zero"
sf_int%mr2 = sf_int%mi2
sf_int%mo2 = 0
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set incoming mass to zero"
k = vector4_moving (E, E, 3)
call sf_int%seed_kinematics ([k])
sf_int%mr2 = sf_int%mi2
sf_int%mo2 = sf_int%mi2
sf_int%mi2 = 0
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set all masses to zero"
sf_int%mr2 = 0
sf_int%mo2 = 0
sf_int%mi2 = 0
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
write (u, "(A)")
r = 0.5_default
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_3"
end subroutine sf_base_3
@ %def sf_base_3
@
\subsubsection{Non-collinear kinematics}
Scan over the possibilities for mass assignment and on-shell
projections, non-collinear case.
<<SF base: execute tests>>=
call test (sf_base_4, "sf_base_4", &
"alternatives for non-collinear kinematics", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_4
<<SF base: tests>>=
subroutine sf_base_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(flavor_t) :: flv
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_base_4"
write (u, "(A)") "* Purpose: check various kinematical setups"
write (u, "(A)") "* for free structure-function splitting."
write (u, "(A)") " (two masses equal, one zero)"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
pdg_in = 25
call flv%init (25, model)
call reset_interaction_counter ()
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (model, pdg_in, collinear=.false.)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%write (u)
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=500"
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set radiated mass to zero"
sf_int%mr2 = 0
sf_int%mo2 = sf_int%mi2
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set outgoing mass to zero"
sf_int%mr2 = sf_int%mi2
sf_int%mo2 = 0
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set incoming mass to zero"
k = vector4_moving (E, E, 3)
call sf_int%seed_kinematics ([k])
sf_int%mr2 = sf_int%mi2
sf_int%mo2 = sf_int%mi2
sf_int%mi2 = 0
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set all masses to zero"
sf_int%mr2 = 0
sf_int%mo2 = 0
sf_int%mi2 = 0
write (u, "(A)")
write (u, "(A)") "* Re-Initialize structure-function object with Q bounds"
call reset_interaction_counter ()
select type (data)
type is (sf_test_data_t)
call data%init (model, pdg_in, collinear=.false., &
qbounds = [1._default, 100._default])
end select
call sf_int%init (data)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
write (u, "(A)")
r = [0.5_default, 0.5_default, 0.125_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_MOMENTUM
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Recover x and r"
write (u, "(A)")
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_4"
end subroutine sf_base_4
@ %def sf_base_4
@
\subsubsection{Pair spectrum}
Construct and display a structure function object for a pair spectrum
(a structure function involving two particles simultaneously).
<<SF base: execute tests>>=
call test (sf_base_5, "sf_base_5", &
"pair spectrum with radiation", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_5
<<SF base: tests>>=
subroutine sf_base_5 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(pdg_array_t), dimension(2) :: pdg_out
integer, dimension(:), allocatable :: pdg1, pdg2
type(flavor_t) :: flv
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t), dimension(2) :: k
type(vector4_t), dimension(4) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_base_5"
write (u, "(A)") "* Purpose: initialize and fill &
&a pair spectrum object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
allocate (sf_test_spectrum_data_t :: data)
select type (data)
type is (sf_test_spectrum_data_t)
call data%init (model, pdg_in, with_radiation=.true.)
end select
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
pdg2 = pdg_out(2)
write (u, "(2x,99(1x,I0))") pdg1, pdg2
write (u, "(A)")
write (u, "(A)") "* Initialize spectrum object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"
E = 500
k(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
k(2) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call sf_int%seed_kinematics (k)
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.4,0.8"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = [0.4_default, 0.8_default]
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Set kinematics with mapping for r=0.6,0.8"
write (u, "(A)")
r = [0.6_default, 0.8_default]
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call reset_interaction_counter ()
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%seed_kinematics (k)
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A)")
write (u, "(A)") "* Compute inverse kinematics for x=0.36,0.64 &
&and evaluate"
write (u, "(A)")
x = [0.36_default, 0.64_default]
xb = 1 - x
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%apply (scale=0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_5"
end subroutine sf_base_5
@ %def sf_base_5
@
\subsubsection{Pair spectrum without radiation}
Construct and display a structure function object for a pair spectrum
(a structure function involving two particles simultaneously).
<<SF base: execute tests>>=
call test (sf_base_6, "sf_base_6", &
"pair spectrum without radiation", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_6
<<SF base: tests>>=
subroutine sf_base_6 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(flavor_t) :: flv
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t), dimension(2) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_base_6"
write (u, "(A)") "* Purpose: initialize and fill &
&a pair spectrum object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
allocate (sf_test_spectrum_data_t :: data)
select type (data)
type is (sf_test_spectrum_data_t)
call data%init (model, pdg_in, with_radiation=.false.)
end select
write (u, "(A)") "* Initialize spectrum object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"
E = 500
k(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
k(2) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call sf_int%seed_kinematics (k)
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.4,0.8"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = [0.4_default, 0.8_default]
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call reset_interaction_counter ()
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%seed_kinematics (k)
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A)")
write (u, "(A)") "* Compute inverse kinematics for x=0.4,0.8 &
&and evaluate"
write (u, "(A)")
x = [0.4_default, 0.8_default]
xb = 1 - x
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%apply (scale=0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_6"
end subroutine sf_base_6
@ %def sf_base_6
@
\subsubsection{Direct access to structure function}
Probe a structure function directly.
<<SF base: execute tests>>=
call test (sf_base_7, "sf_base_7", &
"direct access", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_7
<<SF base: tests>>=
subroutine sf_base_7 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(flavor_t) :: flv
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
real(default), dimension(:), allocatable :: value
write (u, "(A)") "* Test output: sf_base_7"
write (u, "(A)") "* Purpose: check direct access method"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (model, pdg_in)
end select
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
write (u, "(A)") "* Probe structure function: states"
write (u, "(A)")
write (u, "(A,I0)") "n_states = ", sf_int%get_n_states ()
write (u, "(A,I0)") "n_in = ", sf_int%get_n_in ()
write (u, "(A,I0)") "n_rad = ", sf_int%get_n_rad ()
write (u, "(A,I0)") "n_out = ", sf_int%get_n_out ()
write (u, "(A)")
write (u, "(A)", advance="no") "state(1) = "
call quantum_numbers_write (sf_int%get_state (1), u)
write (u, *)
allocate (value (sf_int%get_n_states ()))
call sf_int%compute_values (value, &
E=[500._default], x=[0.5_default], xb=[0.5_default], scale=0._default)
write (u, "(A)")
write (u, "(A)", advance="no") "value (E=500, x=0.5) ="
write (u, "(9(1x," // FMT_19 // "))") value
call sf_int%compute_values (value, &
x=[0.1_default], xb=[0.9_default], scale=0._default)
write (u, "(A)")
write (u, "(A)", advance="no") "value (E=500, x=0.1) ="
write (u, "(9(1x," // FMT_19 // "))") value
write (u, "(A)")
write (u, "(A)") "* Initialize spectrum object"
write (u, "(A)")
deallocate (value)
call sf_int%final ()
deallocate (sf_int)
deallocate (data)
allocate (sf_test_spectrum_data_t :: data)
select type (data)
type is (sf_test_spectrum_data_t)
call data%init (model, pdg_in, with_radiation=.false.)
end select
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
write (u, "(A)") "* Probe spectrum: states"
write (u, "(A)")
write (u, "(A,I0)") "n_states = ", sf_int%get_n_states ()
write (u, "(A,I0)") "n_in = ", sf_int%get_n_in ()
write (u, "(A,I0)") "n_rad = ", sf_int%get_n_rad ()
write (u, "(A,I0)") "n_out = ", sf_int%get_n_out ()
write (u, "(A)")
write (u, "(A)", advance="no") "state(1) = "
call quantum_numbers_write (sf_int%get_state (1), u)
write (u, *)
allocate (value (sf_int%get_n_states ()))
call sf_int%compute_value (1, value(1), &
E = [500._default, 500._default], &
x = [0.5_default, 0.6_default], &
xb= [0.5_default, 0.4_default], &
scale = 0._default)
write (u, "(A)")
write (u, "(A)", advance="no") "value (E=500,500, x=0.5,0.6) ="
write (u, "(9(1x," // FMT_19 // "))") value
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_7"
end subroutine sf_base_7
@ %def sf_base_7
@
\subsubsection{Structure function chain configuration}
<<SF base: execute tests>>=
call test (sf_base_8, "sf_base_8", &
"structure function chain configuration", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_8
<<SF base: tests>>=
subroutine sf_base_8 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
type(beam_data_t), target :: beam_data
class(sf_data_t), allocatable, target :: data_strfun
class(sf_data_t), allocatable, target :: data_spectrum
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_chain_t) :: sf_chain
write (u, "(A)") "* Test output: sf_base_8"
write (u, "(A)") "* Purpose: set up a structure-function chain"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
call beam_data%init_sqrts (1000._default, [flv, flv])
allocate (sf_test_data_t :: data_strfun)
select type (data_strfun)
type is (sf_test_data_t)
call data_strfun%init (model, pdg_in)
end select
allocate (sf_test_spectrum_data_t :: data_spectrum)
select type (data_spectrum)
type is (sf_test_spectrum_data_t)
call data_spectrum%init (model, pdg_in, with_radiation=.true.)
end select
write (u, "(A)") "* Set up chain with beams only"
write (u, "(A)")
call sf_chain%init (beam_data)
call write_separator (u, 2)
call sf_chain%write (u)
call write_separator (u, 2)
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Set up chain with structure function"
write (u, "(A)")
allocate (sf_config (1))
call sf_config(1)%init ([1], data_strfun)
call sf_chain%init (beam_data, sf_config)
call write_separator (u, 2)
call sf_chain%write (u)
call write_separator (u, 2)
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Set up chain with spectrum and structure function"
write (u, "(A)")
deallocate (sf_config)
allocate (sf_config (2))
call sf_config(1)%init ([1,2], data_spectrum)
call sf_config(2)%init ([2], data_strfun)
call sf_chain%init (beam_data, sf_config)
call write_separator (u, 2)
call sf_chain%write (u)
call write_separator (u, 2)
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_8"
end subroutine sf_base_8
@ %def sf_base_8
@
\subsubsection{Structure function instance configuration}
We create a structure-function chain instance which implements a
configured structure-function chain. We link the momentum entries in
the interactions and compute kinematics.
We do not actually connect the interactions and create evaluators. We
skip this step and manually advance the status of the chain instead.
<<SF base: execute tests>>=
call test (sf_base_9, "sf_base_9", &
"structure function chain instance", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_9
<<SF base: tests>>=
subroutine sf_base_9 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
type(beam_data_t), target :: beam_data
class(sf_data_t), allocatable, target :: data_strfun
class(sf_data_t), allocatable, target :: data_spectrum
type(sf_config_t), dimension(:), allocatable, target :: sf_config
type(sf_chain_t), target :: sf_chain
type(sf_chain_instance_t), target :: sf_chain_instance
type(sf_channel_t), dimension(2) :: sf_channel
type(vector4_t), dimension(2) :: p
integer :: j
write (u, "(A)") "* Test output: sf_base_9"
write (u, "(A)") "* Purpose: set up a structure-function chain &
&and create an instance"
write (u, "(A)") "* compute kinematics"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
call beam_data%init_sqrts (1000._default, [flv, flv])
allocate (sf_test_data_t :: data_strfun)
select type (data_strfun)
type is (sf_test_data_t)
call data_strfun%init (model, pdg_in)
end select
allocate (sf_test_spectrum_data_t :: data_spectrum)
select type (data_spectrum)
type is (sf_test_spectrum_data_t)
call data_spectrum%init (model, pdg_in, with_radiation=.true.)
end select
write (u, "(A)") "* Set up chain with beams only"
write (u, "(A)")
call sf_chain%init (beam_data)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_chain_instance%link_interactions ()
sf_chain_instance%status = SF_DONE_CONNECTIONS
call sf_chain_instance%compute_kinematics (1, [real(default) ::])
call write_separator (u, 2)
call sf_chain%write (u)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
call sf_chain_instance%get_out_momenta (p)
write (u, "(A)")
write (u, "(A)") "* Outgoing momenta:"
do j = 1, 2
write (u, "(A)")
call vector4_write (p(j), u)
end do
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Set up chain with structure function"
write (u, "(A)")
allocate (sf_config (1))
call sf_config(1)%init ([1], data_strfun)
call sf_chain%init (beam_data, sf_config)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(1)%init (1)
call sf_channel(1)%activate_mapping ([1])
call sf_chain_instance%set_channel (1, sf_channel(1))
call sf_chain_instance%link_interactions ()
sf_chain_instance%status = SF_DONE_CONNECTIONS
call sf_chain_instance%compute_kinematics (1, [0.8_default])
call write_separator (u, 2)
call sf_chain%write (u)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
call sf_chain_instance%get_out_momenta (p)
write (u, "(A)")
write (u, "(A)") "* Outgoing momenta:"
do j = 1, 2
write (u, "(A)")
call vector4_write (p(j), u)
end do
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Set up chain with spectrum and structure function"
write (u, "(A)")
deallocate (sf_config)
allocate (sf_config (2))
call sf_config(1)%init ([1,2], data_spectrum)
call sf_config(2)%init ([2], data_strfun)
call sf_chain%init (beam_data, sf_config)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(2)%init (2)
call sf_channel(2)%activate_mapping ([2])
call sf_chain_instance%set_channel (1, sf_channel(2))
call sf_chain_instance%link_interactions ()
sf_chain_instance%status = SF_DONE_CONNECTIONS
call sf_chain_instance%compute_kinematics &
(1, [0.5_default, 0.6_default, 0.8_default])
call write_separator (u, 2)
call sf_chain%write (u)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
call sf_chain_instance%get_out_momenta (p)
write (u, "(A)")
write (u, "(A)") "* Outgoing momenta:"
do j = 1, 2
write (u, "(A)")
call vector4_write (p(j), u)
end do
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_9"
end subroutine sf_base_9
@ %def sf_base_9
@
\subsubsection{Structure function chain mappings}
Set up a structure function chain instance with a pair of
single-particle structure functions. We test different global
mappings for this setup.
Again, we skip evaluators.
<<SF base: execute tests>>=
call test (sf_base_10, "sf_base_10", &
"structure function chain mapping", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_10
<<SF base: tests>>=
subroutine sf_base_10 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
type(beam_data_t), target :: beam_data
class(sf_data_t), allocatable, target :: data_strfun
type(sf_config_t), dimension(:), allocatable, target :: sf_config
type(sf_chain_t), target :: sf_chain
type(sf_chain_instance_t), target :: sf_chain_instance
type(sf_channel_t), dimension(2) :: sf_channel
real(default), dimension(2) :: x_saved
write (u, "(A)") "* Test output: sf_base_10"
write (u, "(A)") "* Purpose: set up a structure-function chain"
write (u, "(A)") "* and check mappings"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
call beam_data%init_sqrts (1000._default, [flv, flv])
allocate (sf_test_data_t :: data_strfun)
select type (data_strfun)
type is (sf_test_data_t)
call data_strfun%init (model, pdg_in)
end select
write (u, "(A)") "* Set up chain with structure function pair &
&and standard mapping"
write (u, "(A)")
allocate (sf_config (2))
call sf_config(1)%init ([1], data_strfun)
call sf_config(2)%init ([2], data_strfun)
call sf_chain%init (beam_data, sf_config)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(1)%init (2)
call sf_channel(1)%set_s_mapping ([1,2])
call sf_chain_instance%set_channel (1, sf_channel(1))
call sf_chain_instance%link_interactions ()
sf_chain_instance%status = SF_DONE_CONNECTIONS
call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
write (u, "(A)")
write (u, "(A)") "* Invert the kinematics calculation"
write (u, "(A)")
x_saved = sf_chain_instance%x
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(2)%init (2)
call sf_channel(2)%set_s_mapping ([1, 2])
call sf_chain_instance%set_channel (1, sf_channel(2))
call sf_chain_instance%link_interactions ()
sf_chain_instance%status = SF_DONE_CONNECTIONS
call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_10"
end subroutine sf_base_10
@ %def sf_base_10
@
\subsubsection{Structure function chain evaluation}
Here, we test the complete workflow for structure-function chains.
First, we create the template chain, then initialize an instance. We
set up links, mask, and evaluators. Finally, we set kinematics and
evaluate the matrix elements and their products.
<<SF base: execute tests>>=
call test (sf_base_11, "sf_base_11", &
"structure function chain evaluation", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_11
<<SF base: tests>>=
subroutine sf_base_11 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
type(beam_data_t), target :: beam_data
class(sf_data_t), allocatable, target :: data_strfun
class(sf_data_t), allocatable, target :: data_spectrum
type(sf_config_t), dimension(:), allocatable, target :: sf_config
type(sf_chain_t), target :: sf_chain
type(sf_chain_instance_t), target :: sf_chain_instance
type(sf_channel_t), dimension(2) :: sf_channel
type(particle_set_t) :: pset
type(interaction_t), pointer :: int
logical :: ok
write (u, "(A)") "* Test output: sf_base_11"
write (u, "(A)") "* Purpose: set up a structure-function chain"
write (u, "(A)") "* create an instance and evaluate"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
call beam_data%init_sqrts (1000._default, [flv, flv])
allocate (sf_test_data_t :: data_strfun)
select type (data_strfun)
type is (sf_test_data_t)
call data_strfun%init (model, pdg_in)
end select
allocate (sf_test_spectrum_data_t :: data_spectrum)
select type (data_spectrum)
type is (sf_test_spectrum_data_t)
call data_spectrum%init (model, pdg_in, with_radiation=.true.)
end select
write (u, "(A)") "* Set up chain with beams only"
write (u, "(A)")
call sf_chain%init (beam_data)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
call sf_chain_instance%compute_kinematics (1, [real(default) ::])
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
int => sf_chain_instance%get_out_int_ptr ()
call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
[0._default, 0._default], .false., .true.)
call sf_chain_instance%final ()
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover chain:"
write (u, "(A)")
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
int => sf_chain_instance%get_out_int_ptr ()
call pset%fill_interaction (int, 2, check_match=.false.)
call sf_chain_instance%recover_kinematics (1)
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
call pset%final ()
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)")
write (u, "(A)")
write (u, "(A)") "* Set up chain with structure function"
write (u, "(A)")
allocate (sf_config (1))
call sf_config(1)%init ([1], data_strfun)
call sf_chain%init (beam_data, sf_config)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(1)%init (1)
call sf_channel(1)%activate_mapping ([1])
call sf_chain_instance%set_channel (1, sf_channel(1))
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
call sf_chain_instance%compute_kinematics (1, [0.8_default])
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
int => sf_chain_instance%get_out_int_ptr ()
call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
[0._default, 0._default], .false., .true.)
call sf_chain_instance%final ()
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover chain:"
write (u, "(A)")
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(1)%init (1)
call sf_channel(1)%activate_mapping ([1])
call sf_chain_instance%set_channel (1, sf_channel(1))
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
int => sf_chain_instance%get_out_int_ptr ()
call pset%fill_interaction (int, 2, check_match=.false.)
call sf_chain_instance%recover_kinematics (1)
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
call pset%final ()
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)")
write (u, "(A)")
write (u, "(A)") "* Set up chain with spectrum and structure function"
write (u, "(A)")
deallocate (sf_config)
allocate (sf_config (2))
call sf_config(1)%init ([1,2], data_spectrum)
call sf_config(2)%init ([2], data_strfun)
call sf_chain%init (beam_data, sf_config)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(2)%init (2)
call sf_channel(2)%activate_mapping ([2])
call sf_chain_instance%set_channel (1, sf_channel(2))
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
call sf_chain_instance%compute_kinematics &
(1, [0.5_default, 0.6_default, 0.8_default])
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
int => sf_chain_instance%get_out_int_ptr ()
call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
[0._default, 0._default], .false., .true.)
call sf_chain_instance%final ()
write (u, "(A)")
write (u, "(A)") "* Particle content:"
write (u, "(A)")
call write_separator (u)
call pset%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Recover chain:"
write (u, "(A)")
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_channel(2)%init (2)
call sf_channel(2)%activate_mapping ([2])
call sf_chain_instance%set_channel (1, sf_channel(2))
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
int => sf_chain_instance%get_out_int_ptr ()
call pset%fill_interaction (int, 2, check_match=.false.)
call sf_chain_instance%recover_kinematics (1)
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
call pset%final ()
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_11"
end subroutine sf_base_11
@ %def sf_base_11
@
\subsubsection{Multichannel case}
We set up a structure-function chain as before, but with three
different parameterizations. The first instance is without mappings,
the second one with single-particle mappings, and the third one with
two-particle mappings.
<<SF base: execute tests>>=
call test (sf_base_12, "sf_base_12", &
"multi-channel structure function chain", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_12
<<SF base: tests>>=
subroutine sf_base_12 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
type(beam_data_t), target :: beam_data
class(sf_data_t), allocatable, target :: data
type(sf_config_t), dimension(:), allocatable, target :: sf_config
type(sf_chain_t), target :: sf_chain
type(sf_chain_instance_t), target :: sf_chain_instance
real(default), dimension(2) :: x_saved
real(default), dimension(2,3) :: p_saved
type(sf_channel_t), dimension(:), allocatable :: sf_channel
write (u, "(A)") "* Test output: sf_base_12"
write (u, "(A)") "* Purpose: set up and evaluate a multi-channel &
&structure-function chain"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
call beam_data%init_sqrts (1000._default, [flv, flv])
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
call data%init (model, pdg_in)
end select
write (u, "(A)") "* Set up chain with structure function pair &
&and three different mappings"
write (u, "(A)")
allocate (sf_config (2))
call sf_config(1)%init ([1], data)
call sf_config(2)%init ([2], data)
call sf_chain%init (beam_data, sf_config)
call sf_chain_instance%init (sf_chain, n_channel = 3)
call allocate_sf_channels (sf_channel, n_channel = 3, n_strfun = 2)
! channel 1: no mapping
call sf_chain_instance%set_channel (1, sf_channel(1))
! channel 2: single-particle mappings
call sf_channel(2)%activate_mapping ([1,2])
! call sf_chain_instance%activate_mapping (2, [1,2])
call sf_chain_instance%set_channel (2, sf_channel(2))
! channel 3: two-particle mapping
call sf_channel(3)%set_s_mapping ([1,2])
! call sf_chain_instance%set_s_mapping (3, [1, 2])
call sf_chain_instance%set_channel (3, sf_channel(3))
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
write (u, "(A)") "* Compute kinematics in channel 1 and evaluate"
write (u, "(A)")
call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
write (u, "(A)")
write (u, "(A)") "* Invert the kinematics calculation"
write (u, "(A)")
x_saved = sf_chain_instance%x
call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
write (u, "(A)")
write (u, "(A)") "* Compute kinematics in channel 2 and evaluate"
write (u, "(A)")
p_saved = sf_chain_instance%p
call sf_chain_instance%compute_kinematics (2, p_saved(:,2))
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
write (u, "(A)")
write (u, "(A)") "* Compute kinematics in channel 3 and evaluate"
write (u, "(A)")
call sf_chain_instance%compute_kinematics (3, p_saved(:,3))
call sf_chain_instance%evaluate (scale=0._default)
call write_separator (u, 2)
call sf_chain_instance%write (u)
call write_separator (u, 2)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_chain_instance%final ()
call sf_chain%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_12"
end subroutine sf_base_12
@ %def sf_base_12
@
\subsubsection{Generated spectrum}
Construct and evaluate a structure function object for a pair spectrum
which is evaluated as a beam-event generator.
<<SF base: execute tests>>=
call test (sf_base_13, "sf_base_13", &
"pair spectrum generator", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_13
<<SF base: tests>>=
subroutine sf_base_13 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t), dimension(2) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f, x_free
write (u, "(A)") "* Test output: sf_base_13"
write (u, "(A)") "* Purpose: initialize and fill &
&a pair generator object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
allocate (sf_test_generator_data_t :: data)
select type (data)
type is (sf_test_generator_data_t)
call data%init (model, pdg_in)
end select
write (u, "(A)") "* Initialize generator object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
write (u, "(A)") "* Generate free r values"
write (u, "(A)")
x_free = 1
call sf_int%generate_free (r, rb, x_free)
write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"
E = 500
k(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
k(2) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call sf_int%seed_kinematics (k)
write (u, "(A)")
write (u, "(A)") "* Complete kinematics"
write (u, "(A)")
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call reset_interaction_counter ()
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%seed_kinematics (k)
call sf_int%set_momenta (q, outgoing=.true.)
x_free = 1
call sf_int%recover_x (x, xb, x_free)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Compute inverse kinematics &
&and evaluate"
write (u, "(A)")
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%apply (scale=0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_13"
end subroutine sf_base_13
@ %def sf_base_13
@
\subsubsection{Structure function chain evaluation}
Here, we test the complete workflow for a structure-function chain
with generator. First, we create the template chain, then initialize
an instance. We set up links, mask, and evaluators. Finally, we set
kinematics and evaluate the matrix elements and their products.
<<SF base: execute tests>>=
call test (sf_base_14, "sf_base_14", &
"structure function generator evaluation", &
u, results)
<<SF base: test declarations>>=
public :: sf_base_14
<<SF base: tests>>=
subroutine sf_base_14 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
type(beam_data_t), target :: beam_data
class(sf_data_t), allocatable, target :: data_strfun
class(sf_data_t), allocatable, target :: data_generator
type(sf_config_t), dimension(:), allocatable, target :: sf_config
real(default), dimension(:), allocatable :: p_in
type(sf_chain_t), target :: sf_chain
type(sf_chain_instance_t), target :: sf_chain_instance
write (u, "(A)") "* Test output: sf_base_14"
write (u, "(A)") "* Purpose: set up a structure-function chain"
write (u, "(A)") "* create an instance and evaluate"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_test ()
call flv%init (25, model)
pdg_in = 25
call reset_interaction_counter ()
call beam_data%init_sqrts (1000._default, [flv, flv])
allocate (sf_test_data_t :: data_strfun)
select type (data_strfun)
type is (sf_test_data_t)
call data_strfun%init (model, pdg_in)
end select
allocate (sf_test_generator_data_t :: data_generator)
select type (data_generator)
type is (sf_test_generator_data_t)
call data_generator%init (model, pdg_in)
end select
write (u, "(A)") "* Set up chain with generator and structure function"
write (u, "(A)")
allocate (sf_config (2))
call sf_config(1)%init ([1,2], data_generator)
call sf_config(2)%init ([2], data_strfun)
call sf_chain%init (beam_data, sf_config)
call sf_chain_instance%init (sf_chain, n_channel = 1)
call sf_chain_instance%link_interactions ()
call sf_chain_instance%exchange_mask ()
call sf_chain_instance%init_evaluators ()
write (u, "(A)") "* Inject integration parameter"
write (u, "(A)")
allocate (p_in (sf_chain%get_n_bound ()), source = 0.9_default)
write (u, "(A,9(1x,F10.7))") "p_in =", p_in
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_chain_instance%compute_kinematics (1, p_in)
call sf_chain_instance%evaluate (scale=0._default)
call sf_chain_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract integration parameter"
write (u, "(A)")
call sf_chain_instance%get_mcpar (1, p_in)
write (u, "(A,9(1x,F10.7))") "p_in =", p_in
call sf_chain_instance%final ()
call sf_chain%final ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_base_14"
end subroutine sf_base_14
@ %def sf_base_14
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Photon radiation: ISR}
<<[[sf_isr.f90]]>>=
<<File header>>
module sf_isr
<<Use kinds>>
<<Use strings>>
use pdg_arrays
use model_data
use flavors
use sf_aux
use sf_mappings
use sf_base
use electron_pdfs
<<Standard module head>>
<<SF isr: public>>
<<SF isr: parameters>>
<<SF isr: types>>
interface
<<SF isr: sub interfaces>>
end interface
contains
<<SF isr: main procedures>>
end module sf_isr
@ %def sf_isr
@
<<[[sf_isr_sub.f90]]>>=
<<File header>>
submodule (sf_isr) sf_isr_s
use io_units
use constants, only: pi
use format_defs, only: FMT_15, FMT_19
use numeric_utils
use diagnostics
use physics_defs, only: PHOTON
use sm_physics, only: Li2
use lorentz
use colors
use quantum_numbers
use polarizations
implicit none
contains
<<SF isr: procedures>>
end submodule sf_isr_s
@ %def sf_isr_s
@
\subsection{Physics}
The ISR structure function is in the most crude approximation (LLA
without $\alpha$ corrections, i.e. $\epsilon^0$)
\begin{equation}
f_0(x) = \epsilon (1-x)^{-1+\epsilon} \qquad\text{with}\qquad
\epsilon = \frac{\alpha}{\pi}q_e^2\ln\frac{s}{m^2},
\end{equation}
where $m$ is the mass of the incoming (and outgoing) particle, which
is initially assumed on-shell.
In $f_0(x)$, there is an integrable singularity at $x=1$ which does
not spoil the integration, but would lead to an unbounded $f_{\rm
max}$. Therefore, we map this singularity like
\begin{equation}\label{ISR-mapping}
x = 1 - (1-x')^{1/\epsilon}
\end{equation}
such that
\begin{equation}
\int dx\,f_0(x) = \int dx'
\end{equation}
For the detailed form of the QED ISR structure function
cf. Chap.~\ref{chap:qed_pdf}.
\subsection{Implementation}
In the concrete implementation, the zeroth order mapping
(\ref{ISR-mapping}) is implemented, and the Jacobian is equal to
$f_i(x)/f_0(x)$. This can be written as
\begin{align}
\frac{f_0(x)}{f_0(x)} &= 1 \\
\frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon - \frac{1-x^2}{2(1-x')} \\
\begin{split}\label{ISR-f2}
\frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
+ \frac{27 - 8\pi^2}{96}\epsilon^2
- \frac{1-x^2}{2(1-x')} \\
&\quad - \frac{(1+3x^2)\ln x
+ (1-x)\left(4(1+x)\ln(1-x) + 5 + x\right)}{8(1-x')}\epsilon
\end{split}
\end{align}
%'
For $x=1$ (i.e., numerically indistinguishable from $1$), this reduces to
\begin{align}
\frac{f_0(x)}{f_0(x)} &= 1 \\
\frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon \\
\frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
+ \frac{27 - 8\pi^2}{96}\epsilon^2
\end{align}
The last line in (\ref{ISR-f2}) is zero for
\begin{equation}
x_{\rm min} = 0.00714053329734592839549879772019
\end{equation}
(Mathematica result), independent of $\epsilon$. For $x$ values less
than this we ignore this correction because of the logarithmic
singularity which should in principle be resummed.
\subsection{The ISR data block}
<<SF isr: public>>=
public :: isr_data_t
<<SF isr: types>>=
type, extends (sf_data_t) :: isr_data_t
private
class(model_data_t), pointer :: model => null ()
type(flavor_t), dimension(:), allocatable :: flv_in
type(qed_pdf_t) :: pdf
real(default) :: alpha = 0
real(default) :: q_max = 0
real(default) :: real_mass = 0
real(default) :: mass = 0
real(default) :: eps = 0
real(default) :: log = 0
logical :: recoil = .false.
logical :: keep_energy = .true.
integer :: order = 3
integer :: error = NONE
contains
<<SF isr: isr data: TBP>>
end type isr_data_t
@ %def isr_data_t
@ Error codes
<<SF isr: parameters>>=
integer, parameter :: NONE = 0
integer, parameter :: ZERO_MASS = 1
integer, parameter :: Q_MAX_TOO_SMALL = 2
integer, parameter :: EPS_TOO_LARGE = 3
integer, parameter :: INVALID_ORDER = 4
integer, parameter :: CHARGE_MIX = 5
integer, parameter :: CHARGE_ZERO = 6
integer, parameter :: MASS_MIX = 7
@ Generate flavor-dependent ISR data:
<<SF isr: isr data: TBP>>=
procedure :: init => isr_data_init
<<SF isr: sub interfaces>>=
module subroutine isr_data_init (data, model, pdg_in, alpha, q_max, &
mass, order, recoil, keep_energy)
class(isr_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
real(default), intent(in) :: alpha
real(default), intent(in) :: q_max
real(default), intent(in), optional :: mass
integer, intent(in), optional :: order
logical, intent(in), optional :: recoil
logical, intent(in), optional :: keep_energy
end subroutine isr_data_init
<<SF isr: procedures>>=
module subroutine isr_data_init (data, model, pdg_in, alpha, q_max, &
mass, order, recoil, keep_energy)
class(isr_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
real(default), intent(in) :: alpha
real(default), intent(in) :: q_max
real(default), intent(in), optional :: mass
integer, intent(in), optional :: order
logical, intent(in), optional :: recoil
logical, intent(in), optional :: keep_energy
integer :: i, n_flv
real(default) :: charge
data%model => model
n_flv = pdg_in%get_length ()
allocate (data%flv_in (n_flv))
do i = 1, n_flv
call data%flv_in(i)%init (pdg_in%get (i), model)
end do
data%alpha = alpha
data%q_max = q_max
if (present (order)) then
call data%set_order (order)
end if
if (present (recoil)) then
data%recoil = recoil
end if
if (present (keep_energy)) then
data%keep_energy = keep_energy
end if
data%real_mass = data%flv_in(1)%get_mass ()
if (present (mass)) then
if (mass > 0) then
data%mass = mass
else
data%mass = data%real_mass
if (any (data%flv_in%get_mass () /= data%mass)) then
data%error = MASS_MIX; return
end if
end if
else
data%mass = data%real_mass
if (any (data%flv_in%get_mass () /= data%mass)) then
data%error = MASS_MIX; return
end if
end if
if (vanishes (data%mass)) then
data%error = ZERO_MASS; return
else if (data%mass >= data%q_max) then
data%error = Q_MAX_TOO_SMALL; return
end if
data%log = log (1 + (data%q_max / data%mass)**2)
charge = data%flv_in(1)%get_charge ()
if (any (abs (data%flv_in%get_charge ()) /= abs (charge))) then
data%error = CHARGE_MIX; return
else if (charge == 0) then
data%error = CHARGE_ZERO; return
end if
data%eps = data%alpha / pi * charge ** 2 &
* (2 * log (data%q_max / data%mass) - 1)
if (data%eps > 1) then
data%error = EPS_TOO_LARGE; return
end if
call data%pdf%init (data%mass, data%alpha, charge, data%q_max, data%order, &
0, 1)
end subroutine isr_data_init
@ %def isr_data_init
@ Explicitly set ISR order
<<SF isr: isr data: TBP>>=
procedure :: set_order => isr_data_set_order
<<SF isr: sub interfaces>>=
elemental module subroutine isr_data_set_order (data, order)
class(isr_data_t), intent(inout) :: data
integer, intent(in) :: order
end subroutine isr_data_set_order
<<SF isr: procedures>>=
elemental module subroutine isr_data_set_order (data, order)
class(isr_data_t), intent(inout) :: data
integer, intent(in) :: order
if (order < 0 .or. order > 3) then
data%error = INVALID_ORDER
else
data%order = order
end if
end subroutine isr_data_set_order
@ %def isr_data_set_order
@ Handle error conditions. Should always be done after
initialization, unless we are sure everything is ok.
<<SF isr: isr data: TBP>>=
procedure :: check => isr_data_check
<<SF isr: sub interfaces>>=
module subroutine isr_data_check (data)
class(isr_data_t), intent(in) :: data
end subroutine isr_data_check
<<SF isr: procedures>>=
module subroutine isr_data_check (data)
class(isr_data_t), intent(in) :: data
select case (data%error)
case (ZERO_MASS)
call msg_fatal ("ISR: Particle mass is zero")
case (Q_MAX_TOO_SMALL)
call msg_fatal ("ISR: Particle mass exceeds Qmax")
case (EPS_TOO_LARGE)
call msg_fatal ("ISR: Expansion parameter too large, " // &
"perturbative expansion breaks down")
case (INVALID_ORDER)
call msg_error ("ISR: LLA order invalid (valid values are 0,1,2,3)")
case (MASS_MIX)
call msg_fatal ("ISR: Incoming particle masses must be uniform")
case (CHARGE_MIX)
call msg_fatal ("ISR: Incoming particle charges must be uniform")
case (CHARGE_ZERO)
call msg_fatal ("ISR: Incoming particle must be charged")
end select
end subroutine isr_data_check
@ %def isr_data_check
@ Output
<<SF isr: isr data: TBP>>=
procedure :: write => isr_data_write
<<SF isr: sub interfaces>>=
module subroutine isr_data_write (data, unit, verbose)
class(isr_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine isr_data_write
<<SF isr: procedures>>=
module subroutine isr_data_write (data, unit, verbose)
class(isr_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "ISR data:"
if (allocated (data%flv_in)) then
write (u, "(3x,A)", advance="no") " flavor = "
do i = 1, size (data%flv_in)
if (i > 1) write (u, "(',',1x)", advance="no")
call data%flv_in(i)%write (u)
end do
write (u, *)
write (u, "(3x,A," // FMT_19 // ")") " alpha = ", data%alpha
write (u, "(3x,A," // FMT_19 // ")") " q_max = ", data%q_max
write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
write (u, "(3x,A," // FMT_19 // ")") " eps = ", data%eps
write (u, "(3x,A," // FMT_19 // ")") " log = ", data%log
write (u, "(3x,A,I2)") " order = ", data%order
write (u, "(3x,A,L2)") " recoil = ", data%recoil
write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
else
write (u, "(3x,A)") "[undefined]"
end if
end subroutine isr_data_write
@ %def isr_data_write
@ For ISR, there is the option to generate transverse momentum is
generated. Hence, there can be up to three parameters, $x$, and two
angles.
<<SF isr: isr data: TBP>>=
procedure :: get_n_par => isr_data_get_n_par
<<SF isr: sub interfaces>>=
module function isr_data_get_n_par (data) result (n)
class(isr_data_t), intent(in) :: data
integer :: n
end function isr_data_get_n_par
<<SF isr: procedures>>=
module function isr_data_get_n_par (data) result (n)
class(isr_data_t), intent(in) :: data
integer :: n
if (data%recoil) then
n = 3
else
n = 1
end if
end function isr_data_get_n_par
@ %def isr_data_get_n_par
@ Return the outgoing particles PDG codes. For ISR, these are
identical to the incoming particles.
<<SF isr: isr data: TBP>>=
procedure :: get_pdg_out => isr_data_get_pdg_out
<<SF isr: sub interfaces>>=
module subroutine isr_data_get_pdg_out (data, pdg_out)
class(isr_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine isr_data_get_pdg_out
<<SF isr: procedures>>=
module subroutine isr_data_get_pdg_out (data, pdg_out)
class(isr_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
pdg_out(1) = data%flv_in%get_pdg ()
end subroutine isr_data_get_pdg_out
@ %def isr_data_get_pdg_out
@ Return the [[eps]] value. We need it for an appropriate mapping of
structure-function parameters.
<<SF isr: isr data: TBP>>=
procedure :: get_eps => isr_data_get_eps
<<SF isr: sub interfaces>>=
module function isr_data_get_eps (data) result (eps)
class(isr_data_t), intent(in) :: data
real(default) :: eps
end function isr_data_get_eps
<<SF isr: procedures>>=
module function isr_data_get_eps (data) result (eps)
class(isr_data_t), intent(in) :: data
real(default) :: eps
eps = data%eps
end function isr_data_get_eps
@ %def isr_data_get_eps
@ Allocate the interaction record. Gfortran 7/8/9 bug, has to remain
in the module.
<<SF isr: isr data: TBP>>=
procedure :: allocate_sf_int => isr_data_allocate_sf_int
<<SF isr: main procedures>>=
subroutine isr_data_allocate_sf_int (data, sf_int)
class(isr_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (isr_t :: sf_int)
end subroutine isr_data_allocate_sf_int
@ %def isr_data_allocate_sf_int
@
\subsection{The ISR object}
The [[isr_t]] data type is a $1\to 2$ interaction, i.e., we allow for
single-photon emission only (but use the multi-photon resummed
radiator function). The particles are ordered as (incoming, photon,
outgoing).
There is no need to handle several flavors (and data blocks) in
parallel, since ISR is always applied immediately after beam
collision. (ISR for partons is accounted for by the PDFs themselves.)
Polarization is carried through, i.e., we retain the polarization of
the incoming particle and treat the emitted photon as unpolarized.
Color is trivially carried through. This implies that particles 1 and
3 should be locked together. For ISR we don't need the q variable.
<<SF isr: public>>=
public :: isr_t
<<SF isr: types>>=
type, extends (sf_int_t) :: isr_t
private
type(isr_data_t), pointer :: data => null ()
real(default) :: x = 0
real(default) :: xb= 0
contains
<<SF isr: isr: TBP>>
end type isr_t
@ %def isr_t
@ Type string: has to be here, but there is no string variable on which ISR
depends. Hence, a dummy routine.
<<SF isr: isr: TBP>>=
procedure :: type_string => isr_type_string
<<SF isr: sub interfaces>>=
module function isr_type_string (object) result (string)
class(isr_t), intent(in) :: object
type(string_t) :: string
end function isr_type_string
<<SF isr: procedures>>=
module function isr_type_string (object) result (string)
class(isr_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "ISR: e+ e- ISR spectrum"
else
string = "ISR: [undefined]"
end if
end function isr_type_string
@ %def isr_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF isr: isr: TBP>>=
procedure :: write => isr_write
<<SF isr: sub interfaces>>=
module subroutine isr_write (object, unit, testflag)
class(isr_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine isr_write
<<SF isr: procedures>>=
module subroutine isr_write (object, unit, testflag)
class(isr_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
if (object%status >= SF_DONE_KINEMATICS) then
write (u, "(1x,A)") "SF parameters:"
write (u, "(3x,A," // FMT_15 // ")") "x =", object%x
write (u, "(3x,A," // FMT_15 // ")") "xb=", object%xb
end if
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "ISR data: [undefined]"
end if
end subroutine isr_write
@ %def isr_write
@ Explicitly set ISR order (for unit test).
<<SF isr: isr: TBP>>=
procedure :: set_order => isr_set_order
<<SF isr: sub interfaces>>=
module subroutine isr_set_order (object, order)
class(isr_t), intent(inout) :: object
integer, intent(in) :: order
end subroutine isr_set_order
<<SF isr: procedures>>=
module subroutine isr_set_order (object, order)
class(isr_t), intent(inout) :: object
integer, intent(in) :: order
call object%data%set_order (order)
call object%data%pdf%set_order (order)
end subroutine isr_set_order
@ %def isr_set_order
@
\subsection{Kinematics}
Set kinematics. If [[map]] is unset, the $r$ and $x$ values
coincide, and the Jacobian $f(r)$ were trivial. The ISR structure
function allows for a straightforward mapping of the unit interval.
So, to leading order, the structure function value is unity, but the
$x$ value is transformed. Higher orders affect the function value.
The structure function implementation applies the above mapping to the
input (random) number [[r]] to generate the momentum fraction [[x]]
and the function value [[f]]. For numerical stability reasons, we
also output [[xb]], which is $\bar x=1-x$.
For the ISR structure function, the mapping Jacobian cancels the
structure function (to order zero). We apply the cancellation
explicitly, therefore both the Jacobian [[f]] and the zeroth-order value
(see the [[apply]] method) are unity if mapping is turned on. If
mapping is turned off, the Jacobian [[f]] includes the value of the
(zeroth-order) structure function, and strongly peaked.
<<SF isr: isr: TBP>>=
procedure :: complete_kinematics => isr_complete_kinematics
<<SF isr: sub interfaces>>=
module subroutine isr_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(isr_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine isr_complete_kinematics
<<SF isr: procedures>>=
module subroutine isr_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(isr_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
real(default) :: eps
eps = sf_int%data%eps
if (map) then
call map_power_1 (sf_int%xb, f, rb(1), eps)
else
sf_int%xb = rb(1)
if (rb(1) > 0) then
f = 1
else
f = 0
end if
end if
sf_int%x = 1 - sf_int%xb
x(1) = sf_int%x
xb(1) = sf_int%xb
if (size (x) == 3) then
x(2:3) = r(2:3)
xb(2:3) = rb(2:3)
end if
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS)
sf_int%x = 0
sf_int%xb= 0
f = 0
end select
end subroutine isr_complete_kinematics
@ %def isr_complete_kinematics
@ Overriding the default method: we compute the [[x]] array from the
momentum configuration. In the specific case of ISR, we also set the
internally stored $x$ and $\bar x$ values, so they can be used in the
following routine.
<<SF isr: isr: TBP>>=
procedure :: recover_x => sf_isr_recover_x
<<SF isr: sub interfaces>>=
module subroutine sf_isr_recover_x (sf_int, x, xb, x_free)
class(isr_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
end subroutine sf_isr_recover_x
<<SF isr: procedures>>=
module subroutine sf_isr_recover_x (sf_int, x, xb, x_free)
class(isr_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
call sf_int%base_recover_x (x, xb, x_free)
sf_int%x = x(1)
sf_int%xb = xb(1)
end subroutine sf_isr_recover_x
@ %def sf_isr_recover_x
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
For extracting $x$, we rely on the stored $\bar x$ value, since the
$x$ value in the argument is likely imprecise. This means that either
[[complete_kinematics]] or [[recover_x]] must be called first, for the
current sampling point (but maybe another channel).
<<SF isr: isr: TBP>>=
procedure :: inverse_kinematics => isr_inverse_kinematics
<<SF isr: sub interfaces>>=
module subroutine isr_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(isr_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine isr_inverse_kinematics
<<SF isr: procedures>>=
module subroutine isr_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(isr_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
real(default) :: eps
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
eps = sf_int%data%eps
if (map) then
call map_power_inverse_1 (xb(1), f, rb(1), eps)
else
rb(1) = xb(1)
if (rb(1) > 0) then
f = 1
else
f = 0
end if
end if
r(1) = 1 - rb(1)
if (size(r) == 3) then
r(2:3) = x(2:3)
rb(2:3)= xb(2:3)
end if
if (set_mom) then
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS)
r = 0
rb= 0
f = 0
end select
end if
end subroutine isr_inverse_kinematics
@ %def isr_inverse_kinematics
@
<<SF isr: isr: TBP>>=
procedure :: init => isr_init
<<SF isr: sub interfaces>>=
module subroutine isr_init (sf_int, data)
class(isr_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine isr_init
<<SF isr: procedures>>=
module subroutine isr_init (sf_int, data)
class(isr_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(3) :: mask
integer, dimension(3) :: hel_lock
type(polarization_t), target :: pol
type(quantum_numbers_t), dimension(1) :: qn_fc
type(flavor_t) :: flv_photon
type(color_t) :: col_photon
type(quantum_numbers_t) :: qn_hel, qn_photon, qn
type(polarization_iterator_t) :: it_hel
real(default) :: m2
integer :: i
mask = quantum_numbers_mask (.false., .false., &
mask_h = [.false., .true., .false.])
hel_lock = [3, 0, 1]
select type (data)
type is (isr_data_t)
m2 = data%mass**2
call sf_int%base_init (mask, [m2], [0._default], [m2], &
hel_lock = hel_lock)
sf_int%data => data
call flv_photon%init (PHOTON, data%model)
call col_photon%init ()
call qn_photon%init (flv_photon, col_photon)
call qn_photon%tag_radiated ()
do i = 1, size (data%flv_in)
call pol%init_generic (data%flv_in(i))
call qn_fc(1)%init (&
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i), 1))
call it_hel%init (pol)
do while (it_hel%is_valid ())
qn_hel = it_hel%get_quantum_numbers ()
qn = qn_hel .merge. qn_fc(1)
call sf_int%add_state ([qn, qn_photon, qn])
call it_hel%advance ()
end do
! call pol%final () !!! Obsolete
end do
call sf_int%freeze ()
if (data%keep_energy) then
sf_int%on_shell_mode = KEEP_ENERGY
else
sf_int%on_shell_mode = KEEP_MOMENTUM
end if
call sf_int%set_incoming ([1])
call sf_int%set_radiated ([2])
call sf_int%set_outgoing ([3])
sf_int%status = SF_INITIAL
end select
end subroutine isr_init
@ %def isr_init
@
\subsection{ISR application}
For ISR, we could in principle compute kinematics and function value
in a single step. In order to be able to reweight matrix elements
including structure functions we split kinematics and structure
function calculation. The structure function works on a single beam,
assuming that the input momentum has been set.
For the structure-function evaluation, we rely on the fact that the
power mapping, which we apply in the kinematics method (if the [[map]]
flag is set), has a Jacobian which is just the inverse lowest-order
structure function. With mapping active, the two should cancel
exactly.
After splitting momenta, we set the outgoing momenta on-shell. We
choose to conserve momentum, so energy conservation may be violated.
<<SF isr: isr: TBP>>=
procedure :: apply => isr_apply
<<SF isr: sub interfaces>>=
module subroutine isr_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(isr_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine isr_apply
<<SF isr: procedures>>=
module subroutine isr_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(isr_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default) :: f, finv, x, xb, eps, rb
real(default) :: log_x, log_xb, x_2
associate (data => sf_int%data)
eps = sf_int%data%eps
x = sf_int%x
xb = sf_int%xb
call map_power_inverse_1 (xb, finv, rb, eps)
if (finv > 0) then
f = 1 / finv
else
f = 0
end if
call data%pdf%evolve_qed_pdf (x, xb, rb, f)
end associate
call sf_int%set_matrix_element (cmplx (f, kind=default))
sf_int%status = SF_EVALUATED
end subroutine isr_apply
@ %def isr_apply
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_isr_ut.f90]]>>=
<<File header>>
module sf_isr_ut
use unit_tests
use sf_isr_uti
<<Standard module head>>
<<SF isr: public test>>
contains
<<SF isr: test driver>>
end module sf_isr_ut
@ %def sf_isr_ut
@
<<[[sf_isr_uti.f90]]>>=
<<File header>>
module sf_isr_uti
<<Use kinds>>
<<Use strings>>
use io_units
use format_defs, only: FMT_12
use physics_defs, only: ELECTRON
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use interactions, only: interaction_t
use model_data
use sf_aux, only: KEEP_ENERGY
use sf_mappings
use sf_base
use sf_isr
<<Standard module head>>
<<SF isr: test declarations>>
contains
<<SF isr: tests>>
end module sf_isr_uti
@ %def sf_isr_ut
@ API: driver for the unit tests below.
<<SF isr: public test>>=
public :: sf_isr_test
<<SF isr: test driver>>=
subroutine sf_isr_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF isr: execute tests>>
end subroutine sf_isr_test
@ %def sf_isr_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF isr: execute tests>>=
call test (sf_isr_1, "sf_isr_1", &
"structure function configuration", &
u, results)
<<SF isr: test declarations>>=
public :: sf_isr_1
<<SF isr: tests>>=
subroutine sf_isr_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(pdg_array_t), dimension(1) :: pdg_out
integer, dimension(:), allocatable :: pdg1
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_isr_1"
write (u, "(A)") "* Purpose: initialize and display &
&test structure function data"
write (u, "(A)")
write (u, "(A)") "* Create empty data object"
write (u, "(A)")
call model%init_qed_test ()
pdg_in = ELECTRON
allocate (isr_data_t :: data)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
select type (data)
type is (isr_data_t)
call data%init (model, pdg_in, 1./137._default, 10._default, &
0.000511_default, order = 3, recoil = .false.)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(2x,99(1x,I0))") pdg1
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_isr_1"
end subroutine sf_isr_1
@ %def sf_isr_1
@
\subsubsection{Structure function without mapping}
Direct ISR evaluation. This is the use case for a double-beam
structure function. The parameter pair is mapped in the calling program.
<<SF isr: execute tests>>=
call test (sf_isr_2, "sf_isr_2", &
"no ISR mapping", &
u, results)
<<SF isr: test declarations>>=
public :: sf_isr_2
<<SF isr: tests>>=
subroutine sf_isr_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(flavor_t) :: flv
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f, f_isr
write (u, "(A)") "* Test output: sf_isr_2"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
pdg_in = ELECTRON
call flv%init (ELECTRON, model)
call reset_interaction_counter ()
allocate (isr_data_t :: data)
select type (data)
type is (isr_data_t)
call data%init (model, pdg_in, 1./137._default, 500._default, &
0.000511_default, order = 3, recoil = .false.)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.9, no ISR mapping, &
&collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.9_default
rb = 1 - r
write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A)")
write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
write (u, "(A,9(1x," // FMT_12 // "))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Invert kinematics"
write (u, "(A)")
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
write (u, "(A,9(1x," // FMT_12 // "))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate ISR structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Structure-function value, default order"
write (u, "(A)")
f_isr = sf_int%get_matrix_element (1)
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f
write (u, "(A)")
write (u, "(A)") "* Re-evaluate structure function, leading order"
write (u, "(A)")
select type (sf_int)
type is (isr_t)
call sf_int%set_order (0)
end select
call sf_int%apply (scale = 100._default)
f_isr = sf_int%get_matrix_element (1)
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_isr_2"
end subroutine sf_isr_2
@ %def sf_isr_2
@
\subsubsection{Structure function with mapping}
Apply the optimal ISR mapping. This is the use case for a single-beam
structure function.
<<SF isr: execute tests>>=
call test (sf_isr_3, "sf_isr_3", &
"ISR mapping", &
u, results)
<<SF isr: test declarations>>=
public :: sf_isr_3
<<SF isr: tests>>=
subroutine sf_isr_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f, f_isr
write (u, "(A)") "* Test output: sf_isr_3"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv%init (ELECTRON, model)
pdg_in = ELECTRON
call reset_interaction_counter ()
allocate (isr_data_t :: data)
select type (data)
type is (isr_data_t)
call data%init (model, pdg_in, 1./137._default, 500._default, &
0.000511_default, order = 3, recoil = .false.)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.7, with ISR mapping, &
&collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.7_default
rb = 1 - r
write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
write (u, "(A)")
write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
write (u, "(A,9(1x," // FMT_12 // "))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Invert kinematics"
write (u, "(A)")
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
write (u, "(A,9(1x," // FMT_12 // "))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate ISR structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Structure-function value, default order"
write (u, "(A)")
f_isr = sf_int%get_matrix_element (1)
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f
write (u, "(A)")
write (u, "(A)") "* Re-evaluate structure function, leading order"
write (u, "(A)")
select type (sf_int)
type is (isr_t)
call sf_int%set_order (0)
end select
call sf_int%apply (scale = 100._default)
f_isr = sf_int%get_matrix_element (1)
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_isr_3"
end subroutine sf_isr_3
@ %def sf_isr_3
@
\subsubsection{Non-collinear ISR splitting}
Construct and display a structure function object based on the ISR
structure function. We blank out numerical fluctuations for 32bit.
<<SF isr: execute tests>>=
call test (sf_isr_4, "sf_isr_4", &
"ISR non-collinear", &
u, results)
<<SF isr: test declarations>>=
public :: sf_isr_4
<<SF isr: tests>>=
subroutine sf_isr_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f, f_isr
character(len=80) :: buffer
integer :: u_scratch, iostat
write (u, "(A)") "* Test output: sf_isr_4"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv%init (ELECTRON, model)
pdg_in = ELECTRON
call reset_interaction_counter ()
write (u, "(A)")
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
allocate (isr_data_t :: data)
select type (data)
type is (isr_data_t)
call data%init (model, pdg_in, 1./137._default, 500._default, &
0.000511_default, order = 3, recoil = .true.)
end select
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.25, with ISR mapping, "
write (u, "(A)") " non-coll., keeping energy"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = [0.5_default, 0.5_default, 0.25_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%pacify_momenta (1e-10_default)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x and r from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A)")
write (u, "(A)") "* Evaluate ISR structure function"
write (u, "(A)")
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%pacify_momenta (1e-10_default)
call sf_int%apply (scale = 10._default)
u_scratch = free_unit ()
open (u_scratch, status="scratch", action = "readwrite")
call sf_int%write (u_scratch, testflag = .true.)
rewind (u_scratch)
do
read (u_scratch, "(A)", iostat=iostat) buffer
if (iostat /= 0) exit
if (buffer(1:25) == " P = 0.000000E+00 9.57") then
buffer = replace (buffer, 26, "XXXX")
end if
if (buffer(1:25) == " P = 0.000000E+00 -9.57") then
buffer = replace (buffer, 26, "XXXX")
end if
write (u, "(A)") buffer
end do
close (u_scratch)
write (u, "(A)")
write (u, "(A)") "* Structure-function value"
write (u, "(A)")
f_isr = sf_int%get_matrix_element (1)
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_isr_4"
end subroutine sf_isr_4
@ %def sf_isr_4
@
\subsubsection{Structure function pair with mapping}
Apply the ISR mapping for a ISR pair.
structure function.
<<SF isr: execute tests>>=
call test (sf_isr_5, "sf_isr_5", &
"ISR pair mapping", &
u, results)
<<SF isr: test declarations>>=
public :: sf_isr_5
<<SF isr: tests>>=
subroutine sf_isr_5 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_mapping_t), allocatable :: mapping
class(sf_int_t), dimension(:), allocatable :: sf_int
type(vector4_t), dimension(2) :: k
real(default) :: E, f_map
real(default), dimension(:), allocatable :: p, pb, r, rb, x, xb
real(default), dimension(2) :: f, f_isr
integer :: i
write (u, "(A)") "* Test output: sf_isr_5"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv%init (ELECTRON, model)
pdg_in = ELECTRON
call reset_interaction_counter ()
allocate (isr_data_t :: data)
select type (data)
type is (isr_data_t)
call data%init (model, pdg_in, 1./137._default, 500._default, &
0.000511_default, order = 3, recoil = .false.)
end select
allocate (sf_ip_mapping_t :: mapping)
select type (mapping)
type is (sf_ip_mapping_t)
select type (data)
type is (isr_data_t)
call mapping%init (eps = data%get_eps ())
end select
call mapping%set_index (1, 1)
call mapping%set_index (2, 2)
end select
call mapping%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
allocate (isr_t :: sf_int (2))
do i = 1, 2
call sf_int(i)%init (data)
call sf_int(i)%set_beam_index ([i])
end do
write (u, "(A)") "* Initialize incoming momenta with E=500"
write (u, "(A)")
E = 500
k(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
k(2) = vector4_moving (E, - sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
do i = 1, 2
call vector4_write (k(i), u)
call sf_int(i)%seed_kinematics (k(i:i))
end do
write (u, "(A)")
write (u, "(A)") "* Set kinematics for p=[0.7,0.4], collinear"
write (u, "(A)")
allocate (p (2 * data%get_n_par ()))
allocate (pb(size (p)))
allocate (r (size (p)))
allocate (rb(size (p)))
allocate (x (size (p)))
allocate (xb(size (p)))
p = [0.7_default, 0.4_default]
pb= 1 - p
call mapping%compute (r, rb, f_map, p, pb)
write (u, "(A,9(1x," // FMT_12 // "))") "p =", p
write (u, "(A,9(1x," // FMT_12 // "))") "pb=", pb
write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
write (u, "(A,9(1x," // FMT_12 // "))") "fm=", f_map
do i = 1, 2
call sf_int(i)%complete_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
map=.false.)
end do
write (u, "(A)")
write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
write (u, "(A,9(1x," // FMT_12 // "))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Invert kinematics"
write (u, "(A)")
do i = 1, 2
call sf_int(i)%inverse_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
map=.false.)
end do
call mapping%inverse (r, rb, f_map, p, pb)
write (u, "(A,9(1x," // FMT_12 // "))") "p =", p
write (u, "(A,9(1x," // FMT_12 // "))") "pb=", pb
write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
write (u, "(A,9(1x," // FMT_12 // "))") "fm=", f_map
write (u, "(A)")
write (u, "(A)") "* Evaluate ISR structure function"
call sf_int(1)%apply (scale = 100._default)
call sf_int(2)%apply (scale = 100._default)
write (u, "(A)")
write (u, "(A)") "* Structure function #1"
write (u, "(A)")
call sf_int(1)%write (u, testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Structure function #2"
write (u, "(A)")
call sf_int(2)%write (u, testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Structure-function value, default order"
write (u, "(A)")
do i = 1, 2
f_isr(i) = sf_int(i)%get_matrix_element (1)
end do
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", &
product (f_isr)
write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", &
product (f_isr * f) * f_map
write (u, "(A)")
write (u, "(A)") "* Cleanup"
do i = 1, 2
call sf_int(i)%final ()
end do
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_isr_5"
end subroutine sf_isr_5
@ %def sf_isr_5
@
\clearpage
%------------------------------------------------------------------------
\section{EPA}
<<[[sf_epa.f90]]>>=
<<File header>>
module sf_epa
<<Use kinds>>
<<Use strings>>
use lorentz
use pdg_arrays
use model_data
use flavors
use quantum_numbers
use state_matrices
use polarizations
use interactions
use sf_aux
use sf_base
<<Standard module head>>
<<SF epa: public>>
<<SF epa: parameters>>
<<SF epa: types>>
interface
<<SF epa: sub interfaces>>
end interface
contains
<<SF epa: main procedures>>
end module sf_epa
@ %def sf_epa
@
<<[[sf_epa_sub.f90]]>>=
<<File header>>
submodule (sf_epa) sf_epa_s
use io_units
use constants, only: pi
use format_defs, only: FMT_17, FMT_19
use numeric_utils
use diagnostics
use physics_defs, only: PHOTON
use colors
implicit none
contains
<<SF epa: procedures>>
end submodule sf_epa_s
@ %def sf_epa_s
@
\subsection{Physics}
The EPA structure function for a photon inside an (elementary)
particle $p$ with energy $E$, mass $m$ and charge $q_p$ (e.g.,
electron) is given by ($\bar x \equiv 1-x$)
There are several variants of the EPA, which are steered by the
[[\$epa\_mode]] switch. The formula (6.17b) from the report by Budnev
et al. is given by
%% %\cite{Budnev:1974de}
%% \bibitem{Budnev:1974de}
%% V.~M.~Budnev, I.~F.~Ginzburg, G.~V.~Meledin and V.~G.~Serbo,
%% %``The Two photon particle production mechanism. Physical problems.
%% %Applications. Equivalent photon approximation,''
%% Phys.\ Rept.\ {\bf 15} (1974) 181.
%% %%CITATION = PRPLC,15,181;%%
\begin{multline}
\label{EPA_617}
f(x) =
\frac{\alpha}{\pi}\,q_p^2\,
\frac{1}{x}\,
\biggl[\left(\bar x + \frac{x^2}{2}\right)
\ln\frac{Q^2_{\rm max}}{Q^2_{\rm min}}
\\
- \left(1 - \frac{x}{2}\right)^2
\ln\frac{x^2+\frac{Q^2_{\rm max}}{E^2}}
{x^2+\frac{Q^2_{\rm min}}{E^2}}
- x^2\frac{m^2}{Q^2_{\rm min}}
\left(1 - \frac{Q^2_{\rm min}}{Q^2_{\rm max}}\right)
\biggr].
\end{multline}
If no explicit $Q$ bounds are provided, the kinematical bounds are
\begin{align}
-Q^2_{\rm max} &= t_0 = -2\bar x(E^2+p\bar p) + 2m^2 \approx -4\bar x E^2,
\\
-Q^2_{\rm min} &= t_1 = -2\bar x(E^2-p\bar p) + 2m^2
\approx
-\frac{x^2}{\bar x}m^2.
\end{align}
The second and third terms in (\ref{EPA_617}) are negative definite (and
subleading). Noting that $\bar x + x^2/2$ is bounded between
$1/2$ and $1$, we derive that $f(x)$ is always smaller than
\begin{equation}
\bar f(x) = \frac{\alpha}{\pi}\,q_p^2\,\frac{L - 2\ln x}{x}
\qquad\text{where}\qquad
L = \ln\frac{\min(4E_{\rm max}^2,Q^2_{\rm max})}{\max(m^2,Q_{\rm min}^2)},
\end{equation}
where we allow for explicit $Q$ bounds that narrow the kinematical range.
Therefore, we generate this distribution:
\begin{equation}\label{EPA-subst}
\int_{x_0}^{x_1} dx\,\bar f(x) = C(x_0,x_1)\int_0^1 dx'
\end{equation}
We set
\begin{equation}\label{EPA-x(x')}
\ln x = \frac12\left\{ L - \sqrt{L^2 - 4\left[ x'\ln x_1(L-\ln x_1)
+ \bar x'\ln x_0(L-\ln x_0) \right]} \right\}
\end{equation}
such that $x(0)=x_0$ and $x(1)=x_1$ and
\begin{equation}
\frac{dx}{dx'} = \left(\frac{\alpha}{\pi} q_p^2 \right)^{-1}
x\frac{C(x_0,x_1)}{L - 2\ln x}
\end{equation}
with
\begin{equation}
C(x_0,x_1) = \frac{\alpha}{\pi} q_p^2\,\left[\ln x_1(L-\ln x_1) - \ln
x_0(L-\ln x_0)\right]
\end{equation}
such that (\ref{EPA-subst}) is satisfied. Finally, we have
\begin{equation}
\int_{x_0}^{x_1} dx\,f(x) = C(x_0,x_1)\int_0^1 dx'\,
\frac{f(x(x'))}{\bar f(x(x'))}
\end{equation}
where $x'$ is calculated from $x$ via (\ref{EPA-x(x')}).
The structure of the mapping is most obvious from:
\begin{equation}
x'(x) = \frac{\log x ( L - \log x) - \log x_0 (L - \log x_0)}
{\log x_1 ( L - \log x_1) - \log x_0 (L - \log x_0)} \; .
\end{equation}
Taking the Eq. (6.16e) from the Budnev et al. report, and integrating
it over $q^2$ yields the modified result
\begin{equation}
\label{EPA_616e}
f(x) =
\frac{\alpha}{\pi}\,q_p^2\,
\frac{1}{x}\,
\biggl[\left(\bar x + \frac{x^2}{2}\right)
\ln\frac{Q^2_{\rm max}}{Q^2_{\rm min}}
- x^2\frac{m^2}{Q^2_{\rm min}}
\left(1 - \frac{Q^2_{\rm min}}{Q^2_{\rm max}}\right)
\biggr].
\end{equation}
This is closer to many standard papers from LEP times, and to textbook
formulae like e.g. in Peskin/Schroeder. For historical reasons, we
keep Eq.~(\ref{EPA_617}) as the default in \whizard.
\subsection{The EPA data block}
The EPA parameters are: $\alpha$, $E_{\rm max}$, $m$, $Q_{\rm min}$, and
$x_{\rm min}$. Instead of $m$ we can use the incoming particle PDG
code as input; from this we can deduce the mass and charge.
Internally we store in addition $C_{0/1} = \frac{\alpha}{\pi}q_e^2\ln
x_{0/1} (L - \ln x_{0/1})$, the c.m. energy squared and the incoming
particle mass.
<<SF epa: public>>=
public :: EPA_MODE_DEFAULT
public :: EPA_MODE_BUDNEV_617
public :: EPA_MODE_BUDNEV_616E
public :: EPA_MODE_LOG_POWER
public :: EPA_MODE_LOG_SIMPLE
public :: EPA_MODE_LOG
<<SF epa: parameters>>=
integer, parameter :: EPA_MODE_DEFAULT = 0
integer, parameter :: EPA_MODE_BUDNEV_617 = 0
integer, parameter :: EPA_MODE_BUDNEV_616E = 1
integer, parameter :: EPA_MODE_LOG_POWER = 2
integer, parameter :: EPA_MODE_LOG_SIMPLE = 3
integer, parameter :: EPA_MODE_LOG = 4
@ %def EPA_MODE_DEFAULT EPA_MODE_BUDNEV_617 EPA_MODE_BUDNEV_616E
@ %def EPA_MODE_LOG_POWER EPA_MODE_LOG_SIMPLE EPA_MODE_LOG
-@
+@
<<SF epa: public>>=
public :: epa_data_t
<<SF epa: types>>=
type, extends(sf_data_t) :: epa_data_t
private
class(model_data_t), pointer :: model => null ()
type(flavor_t), dimension(:), allocatable :: flv_in
real(default) :: alpha
real(default) :: x_min
real(default) :: x_max
real(default) :: q_min
real(default) :: q_max
real(default) :: E_max
real(default) :: mass
real(default) :: log
real(default) :: a
real(default) :: c0
real(default) :: c1
real(default) :: dc
integer :: mode = EPA_MODE_DEFAULT
integer :: error = NONE
logical :: recoil = .false.
logical :: keep_energy = .true.
contains
<<SF epa: epa data: TBP>>
end type epa_data_t
@ %def epa_data_t
@ Error codes
<<SF epa: parameters>>=
integer, parameter :: NONE = 0
integer, parameter :: ZERO_QMIN = 1
integer, parameter :: Q_MAX_TOO_SMALL = 2
integer, parameter :: ZERO_XMIN = 3
integer, parameter :: MASS_MIX = 4
integer, parameter :: NO_EPA = 5
<<SF epa: epa data: TBP>>=
procedure :: init => epa_data_init
<<SF epa: sub interfaces>>=
module subroutine epa_data_init (data, model, mode, pdg_in, alpha, &
x_min, q_min, q_max, mass, recoil, keep_energy)
class(epa_data_t), intent(inout) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
integer, intent(in) :: mode
real(default), intent(in) :: alpha, x_min, q_min, q_max
real(default), intent(in), optional :: mass
logical, intent(in), optional :: recoil
logical, intent(in), optional :: keep_energy
end subroutine epa_data_init
<<SF epa: procedures>>=
module subroutine epa_data_init (data, model, mode, pdg_in, alpha, &
x_min, q_min, q_max, mass, recoil, keep_energy)
class(epa_data_t), intent(inout) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
integer, intent(in) :: mode
real(default), intent(in) :: alpha, x_min, q_min, q_max
real(default), intent(in), optional :: mass
logical, intent(in), optional :: recoil
logical, intent(in), optional :: keep_energy
integer :: n_flv, i
data%model => model
data%mode = mode
n_flv = pdg_in%get_length ()
allocate (data%flv_in (n_flv))
do i = 1, n_flv
call data%flv_in(i)%init (pdg_in%get (i), model)
end do
data%alpha = alpha
data%E_max = q_max / 2
data%x_min = x_min
data%x_max = 1
if (vanishes (data%x_min)) then
data%error = ZERO_XMIN; return
end if
data%q_min = q_min
data%q_max = q_max
select case (char (data%model%get_name ()))
case ("QCD","Test")
data%error = NO_EPA; return
end select
if (present (recoil)) then
data%recoil = recoil
end if
if (present (keep_energy)) then
data%keep_energy = keep_energy
end if
if (present (mass)) then
data%mass = mass
else
data%mass = data%flv_in(1)%get_mass ()
if (any (data%flv_in%get_mass () /= data%mass)) then
data%error = MASS_MIX; return
end if
end if
if (max (data%mass, data%q_min) == 0) then
data%error = ZERO_QMIN; return
else if (max (data%mass, data%q_min) >= data%E_max) then
data%error = Q_MAX_TOO_SMALL; return
end if
data%log = log ((data%q_max / max (data%mass, data%q_min)) ** 2 )
data%a = data%alpha / pi
data%c0 = log (data%x_min) * (data%log - log (data%x_min))
data%c1 = log (data%x_max) * (data%log - log (data%x_max))
data%dc = data%c1 - data%c0
end subroutine epa_data_init
@ %def epa_data_init
@ Handle error conditions. Should always be done after
initialization, unless we are sure everything is ok.
<<SF epa: epa data: TBP>>=
procedure :: check => epa_data_check
<<SF epa: sub interfaces>>=
module subroutine epa_data_check (data)
class(epa_data_t), intent(in) :: data
end subroutine epa_data_check
<<SF epa: procedures>>=
module subroutine epa_data_check (data)
class(epa_data_t), intent(in) :: data
select case (data%error)
case (NO_EPA)
call msg_fatal ("EPA structure function not available for model " &
// char (data%model%get_name ()) // ".")
case (ZERO_QMIN)
call msg_fatal ("EPA: Particle mass is zero")
case (Q_MAX_TOO_SMALL)
call msg_fatal ("EPA: Particle mass exceeds Qmax")
case (ZERO_XMIN)
call msg_fatal ("EPA: x_min must be larger than zero")
case (MASS_MIX)
call msg_fatal ("EPA: incoming particle masses must be uniform")
end select
end subroutine epa_data_check
@ %def epa_data_check
@ Output
<<SF epa: epa data: TBP>>=
procedure :: write => epa_data_write
<<SF epa: sub interfaces>>=
module subroutine epa_data_write (data, unit, verbose)
class(epa_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine epa_data_write
<<SF epa: procedures>>=
module subroutine epa_data_write (data, unit, verbose)
class(epa_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "EPA data:"
if (allocated (data%flv_in)) then
write (u, "(3x,A)", advance="no") " flavor = "
do i = 1, size (data%flv_in)
if (i > 1) write (u, "(',',1x)", advance="no")
call data%flv_in(i)%write (u)
end do
write (u, *)
write (u, "(3x,A," // FMT_19 // ")") " alpha = ", data%alpha
write (u, "(3x,A," // FMT_19 // ")") " x_min = ", data%x_min
write (u, "(3x,A," // FMT_19 // ")") " x_max = ", data%x_max
write (u, "(3x,A," // FMT_19 // ")") " q_min = ", data%q_min
write (u, "(3x,A," // FMT_19 // ")") " q_max = ", data%q_max
write (u, "(3x,A," // FMT_19 // ")") " E_max = ", data%e_max
write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
write (u, "(3x,A," // FMT_19 // ")") " a = ", data%a
write (u, "(3x,A," // FMT_19 // ")") " c0 = ", data%c0
write (u, "(3x,A," // FMT_19 // ")") " c1 = ", data%c1
write (u, "(3x,A," // FMT_19 // ")") " log = ", data%log
write (u, "(3x,A,L2)") " recoil = ", data%recoil
write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
else
write (u, "(3x,A)") "[undefined]"
end if
end subroutine epa_data_write
@ %def epa_data_write
@ The number of kinematic parameters.
<<SF epa: epa data: TBP>>=
procedure :: get_n_par => epa_data_get_n_par
<<SF epa: sub interfaces>>=
module function epa_data_get_n_par (data) result (n)
class(epa_data_t), intent(in) :: data
integer :: n
end function epa_data_get_n_par
<<SF epa: procedures>>=
module function epa_data_get_n_par (data) result (n)
class(epa_data_t), intent(in) :: data
integer :: n
if (data%recoil) then
n = 3
else
n = 1
end if
end function epa_data_get_n_par
@ %def epa_data_get_n_par
@ Return the outgoing particles PDG codes. The outgoing particle is always
the photon while the radiated particle is identical to the incoming one.
<<SF epa: epa data: TBP>>=
procedure :: get_pdg_out => epa_data_get_pdg_out
<<SF epa: sub interfaces>>=
module subroutine epa_data_get_pdg_out (data, pdg_out)
class(epa_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine epa_data_get_pdg_out
<<SF epa: procedures>>=
module subroutine epa_data_get_pdg_out (data, pdg_out)
class(epa_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
pdg_out(1) = PHOTON
end subroutine epa_data_get_pdg_out
@ %def epa_data_get_pdg_out
@ Allocate the interaction record. Gfortran 7/8/9 bug, has to remain
in module.
<<SF epa: epa data: TBP>>=
procedure :: allocate_sf_int => epa_data_allocate_sf_int
<<SF epa: main procedures>>=
subroutine epa_data_allocate_sf_int (data, sf_int)
class(epa_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (epa_t :: sf_int)
end subroutine epa_data_allocate_sf_int
@ %def epa_data_allocate_sf_int
@
\subsection{The EPA object}
The [[epa_t]] data type is a $1\to 2$ interaction. We should be able
to handle several flavors in parallel, since EPA is not necessarily
applied immediately after beam collision: Photons may be radiated
from quarks. In that case, the partons are massless and $q_{\rm min}$
applies instead, so we do not need to generate several kinematical
configurations in parallel.
The squared charge values multiply the matrix elements, depending on the
flavour. We scan the interaction after building it, so we have the correct
assignments.
The particles are ordered as (incoming, radiated, photon), where the
photon initiates the hard interaction.
We generate an unpolarized photon and transfer initial polarization to
the radiated parton. Color is transferred in the same way.
<<SF epa: types>>=
type, extends (sf_int_t) :: epa_t
type(epa_data_t), pointer :: data => null ()
real(default) :: x = 0
real(default) :: xb = 0
real(default) :: E = 0
real(default), dimension(:), allocatable :: charge2
contains
<<SF epa: epa: TBP>>
end type epa_t
@ %def epa_t
@ Type string: has to be here, but there is no string variable on which EPA
depends. Hence, a dummy routine.
<<SF epa: epa: TBP>>=
procedure :: type_string => epa_type_string
<<SF epa: sub interfaces>>=
module function epa_type_string (object) result (string)
class(epa_t), intent(in) :: object
type(string_t) :: string
end function epa_type_string
<<SF epa: procedures>>=
module function epa_type_string (object) result (string)
class(epa_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "EPA: equivalent photon approx."
else
string = "EPA: [undefined]"
end if
end function epa_type_string
@ %def epa_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF epa: epa: TBP>>=
procedure :: write => epa_write
<<SF epa: sub interfaces>>=
module subroutine epa_write (object, unit, testflag)
class(epa_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine epa_write
<<SF epa: procedures>>=
module subroutine epa_write (object, unit, testflag)
class(epa_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
if (object%status >= SF_DONE_KINEMATICS) then
write (u, "(1x,A)") "SF parameters:"
write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
if (object%status >= SF_FAILED_EVALUATION) then
write (u, "(3x,A," // FMT_17 // ")") "E =", object%E
end if
end if
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "EPA data: [undefined]"
end if
end subroutine epa_write
@ %def epa_write
@ Prepare the interaction object. We have to construct transition matrix
elements for all flavor and helicity combinations.
<<SF epa: epa: TBP>>=
procedure :: init => epa_init
<<SF epa: sub interfaces>>=
module subroutine epa_init (sf_int, data)
class(epa_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine epa_init
<<SF epa: procedures>>=
module subroutine epa_init (sf_int, data)
class(epa_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(3) :: mask
integer, dimension(3) :: hel_lock
type(polarization_t), target :: pol
type(quantum_numbers_t), dimension(1) :: qn_fc
type(flavor_t) :: flv_photon
type(color_t) :: col_photon
type(quantum_numbers_t) :: qn_hel, qn_photon, qn, qn_rad
type(polarization_iterator_t) :: it_hel
integer :: i
mask = quantum_numbers_mask (.false., .false., &
mask_h = [.false., .false., .true.])
hel_lock = [2, 1, 0]
select type (data)
type is (epa_data_t)
call sf_int%base_init (mask, [data%mass**2], &
[data%mass**2], [0._default], hel_lock = hel_lock)
sf_int%data => data
call flv_photon%init (PHOTON, data%model)
call col_photon%init ()
call qn_photon%init (flv_photon, col_photon)
do i = 1, size (data%flv_in)
call pol%init_generic (data%flv_in(i))
call qn_fc(1)%init ( &
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i), 1))
call it_hel%init (pol)
do while (it_hel%is_valid ())
qn_hel = it_hel%get_quantum_numbers ()
qn = qn_hel .merge. qn_fc(1)
qn_rad = qn
call qn_rad%tag_radiated ()
call sf_int%add_state ([qn, qn_rad, qn_photon])
call it_hel%advance ()
end do
! call pol%final ()
end do
call sf_int%freeze ()
if (data%keep_energy) then
sf_int%on_shell_mode = KEEP_ENERGY
else
sf_int%on_shell_mode = KEEP_MOMENTUM
end if
call sf_int%set_incoming ([1])
call sf_int%set_radiated ([2])
call sf_int%set_outgoing ([3])
end select
end subroutine epa_init
@ %def epa_init
@ Prepare the charge array. This is separate from the previous routine since
the state matrix may be helicity-contracted.
<<SF epa: epa: TBP>>=
procedure :: setup_constants => epa_setup_constants
<<SF epa: sub interfaces>>=
module subroutine epa_setup_constants (sf_int)
class(epa_t), intent(inout), target :: sf_int
end subroutine epa_setup_constants
<<SF epa: procedures>>=
module subroutine epa_setup_constants (sf_int)
class(epa_t), intent(inout), target :: sf_int
type(state_iterator_t) :: it
type(flavor_t) :: flv
integer :: i, n_me
n_me = sf_int%get_n_matrix_elements ()
allocate (sf_int%charge2 (n_me))
call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
do while (it%is_valid ())
i = it%get_me_index ()
flv = it%get_flavor (1)
sf_int%charge2(i) = flv%get_charge () ** 2
call it%advance ()
end do
sf_int%status = SF_INITIAL
end subroutine epa_setup_constants
@ %def epa_setup_constants
@
\subsection{Kinematics}
Set kinematics. If [[map]] is unset, the $r$ and $x$ values
coincide, and the Jacobian $f(r)$ is trivial.
The EPA structure function allows for a straightforward mapping of the
unit interval. The $x$ value is transformed, and the mapped structure
function becomes unity at its upper boundary.
The structure function implementation applies the above mapping to the
input (random) number [[r]] to generate the momentum fraction [[x]]
and the function value [[f]]. For numerical stability reasons, we
also output [[xb]], which is $\bar x=1-x$.
<<SF epa: epa: TBP>>=
procedure :: complete_kinematics => epa_complete_kinematics
<<SF epa: sub interfaces>>=
module subroutine epa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(epa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine epa_complete_kinematics
<<SF epa: procedures>>=
module subroutine epa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(epa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
real(default) :: delta, sqrt_delta, lx
if (map) then
associate (data => sf_int%data)
delta = data%log ** 2 - 4 * (r(1) * data%c1 + rb(1) * data%c0)
if (delta > 0) then
sqrt_delta = sqrt (delta)
lx = (data%log - sqrt_delta) / 2
else
sf_int%status = SF_FAILED_KINEMATICS
f = 0
return
end if
x(1) = exp (lx)
f = x(1) * data%dc / sqrt_delta
end associate
else
x(1) = r(1)
if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
f = 1
else
sf_int%status = SF_FAILED_KINEMATICS
f = 0
return
end if
end if
xb(1) = 1 - x(1)
if (size(x) == 3) then
x(2:3) = r(2:3)
xb(2:3) = rb(2:3)
end if
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_DONE_KINEMATICS)
sf_int%x = x(1)
sf_int%xb= xb(1)
sf_int%E = energy (sf_int%get_momentum (1))
case (SF_FAILED_KINEMATICS)
sf_int%x = 0
sf_int%xb= 0
f = 0
end select
end subroutine epa_complete_kinematics
@ %def epa_complete_kinematics
@ Overriding the default method: we compute the [[x]] array from the
momentum configuration. In the specific case of EPA, we also set the
internally stored $x$ and $\bar x$ values, so they can be used in the
following routine.
Note: the extraction of $\bar x$ is not numerically safe, but it cannot
be as long as the base [[recover_x]] is not.
<<SF epa: epa: TBP>>=
procedure :: recover_x => sf_epa_recover_x
<<SF epa: sub interfaces>>=
module subroutine sf_epa_recover_x (sf_int, x, xb, x_free)
class(epa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
end subroutine sf_epa_recover_x
<<SF epa: procedures>>=
module subroutine sf_epa_recover_x (sf_int, x, xb, x_free)
class(epa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
call sf_int%base_recover_x (x, xb, x_free)
sf_int%x = x(1)
sf_int%xb = xb(1)
end subroutine sf_epa_recover_x
@ %def sf_epa_recover_x
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
<<SF epa: epa: TBP>>=
procedure :: inverse_kinematics => epa_inverse_kinematics
<<SF epa: sub interfaces>>=
module subroutine epa_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(epa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine epa_inverse_kinematics
<<SF epa: procedures>>=
module subroutine epa_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(epa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
real(default) :: lx, delta, sqrt_delta, c
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
associate (data => sf_int%data)
lx = log (x(1))
sqrt_delta = data%log - 2 * lx
delta = sqrt_delta ** 2
c = (data%log ** 2 - delta) / 4
r (1) = (c - data%c0) / data%dc
rb(1) = (data%c1 - c) / data%dc
f = x(1) * data%dc / sqrt_delta
end associate
else
r (1) = x(1)
rb(1) = xb(1)
if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
f = 1
else
f = 0
end if
end if
if (size(r) == 3) then
r (2:3) = x(2:3)
rb(2:3) = xb(2:3)
end if
if (set_mom) then
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end if
sf_int%E = energy (sf_int%get_momentum (1))
end subroutine epa_inverse_kinematics
@ %def epa_inverse_kinematics
@
\subsection{EPA application}
For EPA, we can in principle compute kinematics and function value in
a single step. In order to be able to reweight events, kinematics and
structure function application are separated. This function works on a
single beam, assuming that the input momentum has been set. We need
three random numbers as input: one for $x$, and two for the polar and
azimuthal angles. Alternatively, for the no-recoil case, we can skip
$p_T$ generation; in this case, we only need one.
For obtaining splitting kinematics, we rely on the assumption that all
in-particles are mass-degenerate (or there is only one), so the
generated $x$ values are identical.
Fix 2020-03-10: Divide by two if there is polarization.
In the polarized case, the outgoing electron/positron
retains the incoming polarization. The latter is summed over
when convoluting with the beam, but there are still two
states with different outgoing polarization but identical
structure-function value. This leads to double-counting for the
overall cross section.
Fix 2022-02-18: The above fix was wrong! The structure function was divided
by 4 because there are four entries in the complete electron density
matrix. Now it is divided by 2 if there is more than one entry, unchanged
otherwise.
<<SF epa: epa: TBP>>=
procedure :: apply => epa_apply
<<SF epa: sub interfaces>>=
module subroutine epa_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(epa_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine epa_apply
<<SF epa: procedures>>=
module subroutine epa_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(epa_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default) :: x, xb, qminsq, qmaxsq, f, E, m2
associate (data => sf_int%data)
x = sf_int%x
xb= sf_int%xb
E = sf_int%E
m2 = data%mass ** 2
qminsq = max (x ** 2 / xb * data%mass ** 2, data%q_min ** 2)
select case (data%mode)
case (0)
qmaxsq = min (4 * xb * E ** 2, data%q_max ** 2)
if (qminsq < qmaxsq) then
f = data%a / x &
* ((xb + x ** 2 / 2) * log (qmaxsq / qminsq) &
- (1 - x / 2) ** 2 &
* log ((x**2 + qmaxsq / E ** 2) / (x**2 + qminsq / E ** 2)) &
- x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
else
f = 0
end if
case (1)
qmaxsq = min (4 * xb * E ** 2, data%q_max ** 2)
if (qminsq < qmaxsq) then
f = data%a / x &
* ((xb + x ** 2 / 2) * log (qmaxsq / qminsq) &
- x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
else
f = 0
end if
case (2)
qmaxsq = data%q_max ** 2
if (data%mass ** 2 < qmaxsq) then
f = data%a / x &
* ((xb + x ** 2 / 2) * log (qmaxsq / m2) &
- x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
else
f = 0
end if
case (3)
qmaxsq = data%q_max ** 2
if (data%mass ** 2 < qmaxsq) then
f = data%a / x &
* ((xb + x ** 2 / 2) * log (qmaxsq / m2) &
- x ** 2 * (1 - m2 / qmaxsq))
else
f = 0
end if
case (4)
qmaxsq = data%q_max ** 2
if (data%mass ** 2 < qmaxsq) then
f = data%a / x &
* ((xb + x ** 2 / 2) * log (qmaxsq / m2))
else
f = 0
end if
end select
if (sf_int%get_n_matrix_elements () > 1) then
f = f / 2
end if
call sf_int%set_matrix_element &
(cmplx (f, kind=default) * sf_int%charge2)
end associate
sf_int%status = SF_EVALUATED
end subroutine epa_apply
@ %def epa_apply
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_epa_ut.f90]]>>=
<<File header>>
module sf_epa_ut
use unit_tests
use sf_epa_uti
<<Standard module head>>
<<SF epa: public test>>
contains
<<SF epa: test driver>>
end module sf_epa_ut
@ %def sf_epa_ut
@
<<[[sf_epa_uti.f90]]>>=
<<File header>>
module sf_epa_uti
<<Use kinds>>
use physics_defs, only: ELECTRON
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use sf_aux
use sf_base
use sf_epa
<<Standard module head>>
<<SF epa: test declarations>>
contains
<<SF epa: tests>>
end module sf_epa_uti
@ %def sf_epa_ut
@ API: driver for the unit tests below.
<<SF epa: public test>>=
public :: sf_epa_test
<<SF epa: test driver>>=
subroutine sf_epa_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF epa: execute tests>>
end subroutine sf_epa_test
@ %def sf_epa_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF epa: execute tests>>=
call test (sf_epa_1, "sf_epa_1", &
"structure function configuration", &
u, results)
<<SF epa: test declarations>>=
public :: sf_epa_1
<<SF epa: tests>>=
subroutine sf_epa_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(pdg_array_t), dimension(1) :: pdg_out
integer, dimension(:), allocatable :: pdg1
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_epa_1"
write (u, "(A)") "* Purpose: initialize and display &
&test structure function data"
write (u, "(A)")
write (u, "(A)") "* Create empty data object"
write (u, "(A)")
call model%init_qed_test ()
pdg_in = ELECTRON
allocate (epa_data_t :: data)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
select type (data)
type is (epa_data_t)
call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
10._default, 100._default, 0.000511_default, recoil = .false.)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(2x,99(1x,I0))") pdg1
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_epa_1"
end subroutine sf_epa_1
@ %def sf_epa_1
@
\subsubsection{Test and probe structure function}
Construct and display a structure function object based on the EPA
structure function.
<<SF epa: execute tests>>=
call test (sf_epa_2, "sf_epa_2", &
"structure function instance", &
u, results)
<<SF epa: test declarations>>=
public :: sf_epa_2
<<SF epa: tests>>=
subroutine sf_epa_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_epa_2"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv%init (ELECTRON, model)
pdg_in = ELECTRON
call reset_interaction_counter ()
allocate (epa_data_t :: data)
select type (data)
type is (epa_data_t)
call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
10._default, 100._default, 0.000511_default, recoil = .false.)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.4, no EPA mapping, collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.4_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
set_momenta=.true.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EPA structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_epa_2"
end subroutine sf_epa_2
@ %def sf_epa_2
@
\subsubsection{Standard mapping}
Construct and display a structure function object based on the EPA
structure function, applying the standard single-particle mapping.
<<SF epa: execute tests>>=
call test (sf_epa_3, "sf_epa_3", &
"apply mapping", &
u, results)
<<SF epa: test declarations>>=
public :: sf_epa_3
<<SF epa: tests>>=
subroutine sf_epa_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_epa_3"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv%init (ELECTRON, model)
pdg_in = ELECTRON
call reset_interaction_counter ()
allocate (epa_data_t :: data)
select type (data)
type is (epa_data_t)
call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
10._default, 100._default, 0.000511_default, recoil = .false.)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.4, with EPA mapping, collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.4_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
set_momenta=.true.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EPA structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_epa_3"
end subroutine sf_epa_3
@ %def sf_epa_3
@
\subsubsection{Non-collinear case}
Construct and display a structure function object based on the EPA
structure function.
<<SF epa: execute tests>>=
call test (sf_epa_4, "sf_epa_4", &
"non-collinear", &
u, results)
<<SF epa: test declarations>>=
public :: sf_epa_4
<<SF epa: tests>>=
subroutine sf_epa_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E, m
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_epa_4"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv%init (ELECTRON, model)
pdg_in = ELECTRON
call reset_interaction_counter ()
allocate (epa_data_t :: data)
select type (data)
type is (epa_data_t)
call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
10._default, 100._default, 5.0_default, recoil = .true.)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
write (u, "(A)") "* Initialize incoming momentum with E=500, me = 5 GeV"
write (u, "(A)")
E = 500
m = 5
k = vector4_moving (E, sqrt (E**2 - m**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.5/0.5/0.25, with EPA mapping, "
write (u, "(A)") " non-coll., keeping energy, me = 5 GeV"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = [0.5_default, 0.5_default, 0.25_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%pacify_momenta (1e-10_default)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x and r from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
set_momenta=.true.)
call sf_int%pacify_momenta (1e-10_default)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EPA structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u, testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_epa_4"
end subroutine sf_epa_4
@ %def sf_epa_4
@
\subsubsection{Structure function for multiple flavors}
Construct and display a structure function object based on the EPA
structure function. The incoming state has multiple particles with
non-uniform charge.
<<SF epa: execute tests>>=
call test (sf_epa_5, "sf_epa_5", &
"multiple flavors", &
u, results)
<<SF epa: test declarations>>=
public :: sf_epa_5
<<SF epa: tests>>=
subroutine sf_epa_5 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_epa_5"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_sm_test ()
call flv%init (1, model)
pdg_in = [1, 2, -1, -2]
call reset_interaction_counter ()
allocate (epa_data_t :: data)
select type (data)
type is (epa_data_t)
call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
10._default, 100._default, 0.000511_default, recoil = .false.)
call data%check ()
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.4, no EPA mapping, collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.4_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EPA structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_epa_5"
end subroutine sf_epa_5
@ %def sf_epa_5
@
\clearpage
%------------------------------------------------------------------------
\section{EWA}
<<[[sf_ewa.f90]]>>=
<<File header>>
module sf_ewa
<<Use kinds>>
<<Use strings>>
use pdg_arrays
use model_data
use flavors
use quantum_numbers
use state_matrices
use polarizations
use interactions
use sf_aux
use sf_base
<<Standard module head>>
<<SF ewa: public>>
<<SF ewa: parameters>>
<<SF ewa: types>>
interface
<<SF ewa: sub interfaces>>
end interface
contains
<<SF ewa: main procedures>>
end module sf_ewa
@ %def sf_ewa
@
<<[[sf_ewa_sub.f90]]>>=
<<File header>>
submodule (sf_ewa) sf_ewa_s
use io_units
use constants, only: pi
use format_defs, only: FMT_17, FMT_19
use numeric_utils
use diagnostics
use physics_defs, only: W_BOSON, Z_BOSON
use lorentz
use colors
implicit none
contains
<<SF ewa: procedures>>
end submodule sf_ewa_s
@ %def sf_ewa_s
@
\subsection{Physics}
The EWA structure function for a $Z$ or $W$ inside a fermion (lepton
or quark) depends on the vector-boson polarization. We distinguish
transversal ($\pm$) and longitudinal ($0$) polarization.
\begin{align}
F_{+}(x) &= \frac{1}{16\pi^2}\,\frac{(v-a)^2 + (v+a)^2\bar x^2}{x}
\left[
\ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
-
\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
\right]
\\
F_{-}(x) &= \frac{1}{16\pi^2}\,\frac{(v+a)^2 + (v-a)^2\bar x^2}{x}
\left[
\ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
-
\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
\right]
\\
F_0(x) &= \frac{v^2+a^2}{8\pi^2}\,\frac{2\bar x}{x}\,
\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
\end{align}
where $p_{\perp,\textrm{max}}$ is the cutoff in transversal momentum, $M$ is
the vector-boson mass, $v$ and $a$ are the vector and axial-vector
couplings, and $\bar x\equiv 1-x$. Note that the longitudinal
structure function is finite for large cutoff, while the transversal
structure function is logarithmically divergent.
The maximal transverse momentum is given by the kinematical limit, it is
\begin{equation}
p_{\perp,\textrm{max}} = \bar x \sqrt{s}/2.
\end{equation}
The vector and axial couplings for a fermion branching into a $W$ are
\begin{align}
v_W &= \frac{g}{2\sqrt 2},
& a_W &= \frac{g}{2\sqrt 2}.
\end{align}
For $Z$ emission, this is replaced by
\begin{align}
v_Z &= \frac{g}{2\cos\theta_w}\left(t_3 - 2q\sin^2\theta_w\right),
& a_Z &= \frac{g}{2\cos\theta_w}t_3,
\end{align}
where $t_3=\pm\frac12$ is the fermion isospin, and $q$ its charge.
For an initial antifermion, the signs of the axial couplings are
inverted. Note that a common sign change of $v$ and $a$ is
irrelevant.
%% Differentiating with respect to the cutoff, we get structure functions
%% \begin{align}
%% f_{W,\pm}(x,p_T) &= \frac{g^2}{16\pi^2}\,
%% \frac{1+\bar x^2}{x}
%% \frac{p_\perp}{p_\perp^2 + \bar x M^2}
%% \\
%% f_{W,0}(x,p_T) &= \frac{g^2}{16\pi^2}\,
%% \frac{2\bar x}{x}\,
%% \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
%% \\
%% F_{Z,\pm}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}
%% \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
%% \frac{1+\bar x^2}{x}
%% \frac{p_\perp}{p_\perp^2 + \bar x M^2}
%% \\
%% F_{Z,0}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}\,
%% \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
%% \frac{2\bar x}{x}\,
%% \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
%% \end{align}
%% Here, $t_3^f$ is the $SU(2)_L$ quantum number of the fermion
%% $(\pm\frac12)$, and $q^f$ is the fermion charge in units of the
%% positron charge.
The EWA depends on the parameters $g$, $\sin^2\theta_w$, $M_W$, and
$M_Z$. These can all be taken from the SM input, and the prefactors
are calculated from those and the incoming particle type.
Since these structure functions have a $1/x$ singularity (which is not
really relevant in practice, however, since the vector boson mass is
finite), we map this singularity allowing for nontrivial $x$ bounds:
\begin{equation}
x = \exp(\bar r\ln x_0 + r\ln x_1)
\end{equation}
such that
\begin{equation}
\int_{x_0}^{x_1}\frac{dx}{x} = (\ln x_1 - \ln x_0)\int_0^1 dr.
\end{equation}
As a user parameter, we have the cutoff $p_{\perp,\textrm{max}}$.
The divergence $1/x$ also requires a $x_0$ cutoff; and for
completeness we introduce a corresponding $x_1$. Physically, the
minimal sensible value of $x$ is $M^2/s$, although the approximation
loses its value already at higher $x$ values.
\subsection{The EWA data block}
The EWA parameters are: $p_{T,\rm max}$, $c_V$, $c_A$, and
$m$. Instead of $m$ we can use the incoming particle PDG code as
input; from this we can deduce the mass and charges. In the
initialization phase it is not yet determined whether a $W$ or a $Z$
is radiated, hence we set the vector and axial-vector couplings equal
to the common prefactors $g/2 = e/2/\sin\theta_W$.
In principle, for EWA it would make sense to allow the user to also
set the upper bound for $x$, $x_{\rm max}$, but we fix it to one here.
<<SF ewa: public>>=
public :: ewa_data_t
<<SF ewa: types>>=
type, extends(sf_data_t) :: ewa_data_t
private
class(model_data_t), pointer :: model => null ()
type(flavor_t), dimension(:), allocatable :: flv_in
type(flavor_t), dimension(:), allocatable :: flv_out
real(default) :: pt_max
real(default) :: sqrts
real(default) :: x_min
real(default) :: x_max
real(default) :: mass
real(default) :: m_out
real(default) :: q_min
real(default) :: cv
real(default) :: ca
real(default) :: costhw
real(default) :: sinthw
real(default) :: mW
real(default) :: mZ
real(default) :: coeff
logical :: mass_set = .false.
logical :: recoil = .false.
logical :: keep_energy = .false.
integer :: id = 0
integer :: error = NONE
contains
<<SF ewa: ewa data: TBP>>
end type ewa_data_t
@ %def ewa_data_t
@ Error codes
<<SF ewa: parameters>>=
integer, parameter :: NONE = 0
integer, parameter :: ZERO_QMIN = 1
integer, parameter :: Q_MAX_TOO_SMALL = 2
integer, parameter :: ZERO_XMIN = 3
integer, parameter :: MASS_MIX = 4
integer, parameter :: ZERO_SW = 5
integer, parameter :: ISOSPIN_MIX = 6
integer, parameter :: WRONG_PRT = 7
integer, parameter :: MASS_MIX_OUT = 8
integer, parameter :: NO_EWA = 9
<<SF ewa: ewa data: TBP>>=
procedure :: init => ewa_data_init
<<SF ewa: sub interfaces>>=
module subroutine ewa_data_init (data, model, pdg_in, x_min, pt_max, &
sqrts, recoil, keep_energy, mass)
class(ewa_data_t), intent(inout) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
real(default), intent(in) :: x_min, pt_max, sqrts
logical, intent(in) :: recoil, keep_energy
real(default), intent(in), optional :: mass
end subroutine ewa_data_init
<<SF ewa: procedures>>=
module subroutine ewa_data_init (data, model, pdg_in, x_min, pt_max, &
sqrts, recoil, keep_energy, mass)
class(ewa_data_t), intent(inout) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
real(default), intent(in) :: x_min, pt_max, sqrts
logical, intent(in) :: recoil, keep_energy
real(default), intent(in), optional :: mass
real(default) :: g, ee
integer :: n_flv, i
data%model => model
if (.not. any (pdg_in .match. &
[1,2,3,4,5,6,11,13,15,-1,-2,-3,-4,-5,-6,-11,-13,-15])) then
data%error = WRONG_PRT; return
end if
n_flv = pdg_in%get_length ()
allocate (data%flv_in (n_flv))
allocate (data%flv_out(n_flv))
do i = 1, n_flv
call data%flv_in(i)%init (pdg_in%get (i), model)
end do
data%pt_max = pt_max
data%sqrts = sqrts
data%x_min = x_min
data%x_max = 1
if (vanishes (data%x_min)) then
data%error = ZERO_XMIN; return
end if
select case (char (data%model%get_name ()))
case ("QCD","QED","Test")
data%error = NO_EWA; return
end select
ee = data%model%get_real (var_str ("ee"))
data%sinthw = data%model%get_real (var_str ("sw"))
data%costhw = data%model%get_real (var_str ("cw"))
data%mZ = data%model%get_real (var_str ("mZ"))
data%mW = data%model%get_real (var_str ("mW"))
if (data%sinthw /= 0) then
g = ee / data%sinthw
else
data%error = ZERO_SW; return
end if
data%cv = g / 2._default
data%ca = g / 2._default
data%coeff = 1._default / (8._default * PI**2)
data%recoil = recoil
data%keep_energy = keep_energy
if (present (mass)) then
data%mass = mass
data%m_out = mass
data%mass_set = .true.
else
data%mass = data%flv_in(1)%get_mass ()
if (any (data%flv_in%get_mass () /= data%mass)) then
data%error = MASS_MIX; return
end if
end if
end subroutine ewa_data_init
@ %def ewa_data_init
@ Set the vector boson ID for distinguishing $W$ and $Z$ bosons.
<<SF ewa: ewa data: TBP>>=
procedure :: set_id => ewa_set_id
<<SF ewa: sub interfaces>>=
module subroutine ewa_set_id (data, id)
class(ewa_data_t), intent(inout) :: data
integer, intent(in) :: id
end subroutine ewa_set_id
<<SF ewa: procedures>>=
module subroutine ewa_set_id (data, id)
class(ewa_data_t), intent(inout) :: data
integer, intent(in) :: id
integer :: i, isospin, pdg
if (.not. allocated (data%flv_in)) &
call msg_bug ("EWA: incoming particles not set")
data%id = id
select case (data%id)
case (23)
data%m_out = data%mass
data%flv_out = data%flv_in
case (24)
do i = 1, size (data%flv_in)
pdg = data%flv_in(i)%get_pdg ()
isospin = data%flv_in(i)%get_isospin_type ()
if (isospin > 0) then
!!! up-type quark or neutrinos
if (data%flv_in(i)%is_antiparticle ()) then
call data%flv_out(i)%init (pdg + 1, data%model)
else
call data%flv_out(i)%init (pdg - 1, data%model)
end if
else
!!! down-type quark or lepton
if (data%flv_in(i)%is_antiparticle ()) then
call data%flv_out(i)%init (pdg - 1, data%model)
else
call data%flv_out(i)%init (pdg + 1, data%model)
end if
end if
end do
if (.not. data%mass_set) then
data%m_out = data%flv_out(1)%get_mass ()
if (any (data%flv_out%get_mass () /= data%m_out)) then
data%error = MASS_MIX_OUT; return
end if
end if
end select
end subroutine ewa_set_id
@ %def ewa_set_id
@ Handle error conditions. Should always be done after
initialization, unless we are sure everything is ok.
<<SF ewa: ewa data: TBP>>=
procedure :: check => ewa_data_check
<<SF ewa: sub interfaces>>=
module subroutine ewa_data_check (data)
class(ewa_data_t), intent(in) :: data
end subroutine ewa_data_check
<<SF ewa: procedures>>=
module subroutine ewa_data_check (data)
class(ewa_data_t), intent(in) :: data
select case (data%error)
case (WRONG_PRT)
call msg_fatal ("EWA structure function only accessible for " &
// "SM quarks and leptons.")
case (NO_EWA)
call msg_fatal ("EWA structure function not available for model " &
// char (data%model%get_name ()))
case (ZERO_SW)
call msg_fatal ("EWA: Vanishing value of sin(theta_w)")
case (ZERO_QMIN)
call msg_fatal ("EWA: Particle mass is zero")
case (Q_MAX_TOO_SMALL)
call msg_fatal ("EWA: Particle mass exceeds Qmax")
case (ZERO_XMIN)
call msg_fatal ("EWA: x_min must be larger than zero")
case (MASS_MIX)
call msg_fatal ("EWA: incoming particle masses must be uniform")
case (MASS_MIX_OUT)
call msg_fatal ("EWA: outgoing particle masses must be uniform")
case (ISOSPIN_MIX)
call msg_fatal ("EWA: incoming particle isospins must be uniform")
end select
end subroutine ewa_data_check
@ %def ewa_data_check
@ Output
<<SF ewa: ewa data: TBP>>=
procedure :: write => ewa_data_write
<<SF ewa: sub interfaces>>=
module subroutine ewa_data_write (data, unit, verbose)
class(ewa_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine ewa_data_write
<<SF ewa: procedures>>=
module subroutine ewa_data_write (data, unit, verbose)
class(ewa_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "EWA data:"
if (allocated (data%flv_in) .and. allocated (data%flv_out)) then
write (u, "(3x,A)", advance="no") " flavor(in) = "
do i = 1, size (data%flv_in)
if (i > 1) write (u, "(',',1x)", advance="no")
call data%flv_in(i)%write (u)
end do
write (u, *)
write (u, "(3x,A)", advance="no") " flavor(out) = "
do i = 1, size (data%flv_out)
if (i > 1) write (u, "(',',1x)", advance="no")
call data%flv_out(i)%write (u)
end do
write (u, *)
write (u, "(3x,A," // FMT_19 // ")") " x_min = ", data%x_min
write (u, "(3x,A," // FMT_19 // ")") " x_max = ", data%x_max
write (u, "(3x,A," // FMT_19 // ")") " pt_max = ", data%pt_max
write (u, "(3x,A," // FMT_19 // ")") " sqrts = ", data%sqrts
write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
write (u, "(3x,A," // FMT_19 // ")") " cv = ", data%cv
write (u, "(3x,A," // FMT_19 // ")") " ca = ", data%ca
write (u, "(3x,A," // FMT_19 // ")") " coeff = ", data%coeff
write (u, "(3x,A," // FMT_19 // ")") " costhw = ", data%costhw
write (u, "(3x,A," // FMT_19 // ")") " sinthw = ", data%sinthw
write (u, "(3x,A," // FMT_19 // ")") " mZ = ", data%mZ
write (u, "(3x,A," // FMT_19 // ")") " mW = ", data%mW
write (u, "(3x,A,L2)") " recoil = ", data%recoil
write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
write (u, "(3x,A,I2)") " PDG (VB) = ", data%id
else
write (u, "(3x,A)") "[undefined]"
end if
end subroutine ewa_data_write
@ %def ewa_data_write
@ The number of parameters is one for collinear splitting, in case the
[[recoil]] option is set, we take the recoil into account.
<<SF ewa: ewa data: TBP>>=
procedure :: get_n_par => ewa_data_get_n_par
<<SF ewa: sub interfaces>>=
module function ewa_data_get_n_par (data) result (n)
class(ewa_data_t), intent(in) :: data
integer :: n
end function ewa_data_get_n_par
<<SF ewa: procedures>>=
module function ewa_data_get_n_par (data) result (n)
class(ewa_data_t), intent(in) :: data
integer :: n
if (data%recoil) then
n = 3
else
n = 1
end if
end function ewa_data_get_n_par
@ %def ewa_data_get_n_par
@ Return the outgoing particles PDG codes. This depends, whether this
is a charged-current or neutral-current interaction.
<<SF ewa: ewa data: TBP>>=
procedure :: get_pdg_out => ewa_data_get_pdg_out
<<SF ewa: sub interfaces>>=
module subroutine ewa_data_get_pdg_out (data, pdg_out)
class(ewa_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine ewa_data_get_pdg_out
<<SF ewa: procedures>>=
module subroutine ewa_data_get_pdg_out (data, pdg_out)
class(ewa_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer, dimension(:), allocatable :: pdg1
integer :: i, n_flv
if (allocated (data%flv_out)) then
n_flv = size (data%flv_out)
else
n_flv = 0
end if
allocate (pdg1 (n_flv))
do i = 1, n_flv
pdg1(i) = data%flv_out(i)%get_pdg ()
end do
pdg_out(1) = pdg1
end subroutine ewa_data_get_pdg_out
@ %def ewa_data_get_pdg_out
@ Allocate the interaction record. Due to a gfortran 7/8/9 bug, this
has to remain in the main module.
<<SF ewa: ewa data: TBP>>=
procedure :: allocate_sf_int => ewa_data_allocate_sf_int
<<SF ewa: main procedures>>=
subroutine ewa_data_allocate_sf_int (data, sf_int)
class(ewa_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (ewa_t :: sf_int)
end subroutine ewa_data_allocate_sf_int
@ %def ewa_data_allocate_sf_int
@
\subsection{The EWA object}
The [[ewa_t]] data type is a $1\to 2$ interaction. We should be able
to handle several flavors in parallel, since EWA is not necessarily
applied immediately after beam collision: $W/Z$ bosons may be radiated
from quarks. In that case, the partons are massless and $q_{\rm min}$
applies instead, so we do not need to generate several kinematical
configurations in parallel.
The particles are ordered as (incoming, radiated, W/Z), where the
W/Z initiates the hard interaction.
In the case of EPA, we generated an unpolarized photon and transferred
initial polarization to the radiated parton. Color is transferred in
the same way. I do not know whether the same can/should be done for
EWA, as the structure functions depend on the W/Z polarization. If we
are having $Z$ bosons, both up- and down-type fermions can
participate. Otherwise, with a $W^+$ an up-type fermion is transferred
to a down-type fermion, and the other way round.
<<SF ewa: types>>=
type, extends (sf_int_t) :: ewa_t
type(ewa_data_t), pointer :: data => null ()
real(default) :: x = 0
real(default) :: xb = 0
integer :: n_me = 0
real(default), dimension(:), allocatable :: cv
real(default), dimension(:), allocatable :: ca
contains
<<SF ewa: ewa: TBP>>
end type ewa_t
@ %def ewa_t
@ Type string: has to be here, but there is no string variable on which EWA
depends. Hence, a dummy routine.
<<SF ewa: ewa: TBP>>=
procedure :: type_string => ewa_type_string
<<SF ewa: sub interfaces>>=
module function ewa_type_string (object) result (string)
class(ewa_t), intent(in) :: object
type(string_t) :: string
end function ewa_type_string
<<SF ewa: procedures>>=
module function ewa_type_string (object) result (string)
class(ewa_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "EWA: equivalent W/Z approx."
else
string = "EWA: [undefined]"
end if
end function ewa_type_string
@ %def ewa_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF ewa: ewa: TBP>>=
procedure :: write => ewa_write
<<SF ewa: sub interfaces>>=
module subroutine ewa_write (object, unit, testflag)
class(ewa_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine ewa_write
<<SF ewa: procedures>>=
module subroutine ewa_write (object, unit, testflag)
class(ewa_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
if (object%status >= SF_DONE_KINEMATICS) then
write (u, "(1x,A)") "SF parameters:"
write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
write (u, "(3x,A," // FMT_17 // ")") "xb=", object%xb
end if
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "EWA data: [undefined]"
end if
end subroutine ewa_write
@ %def ewa_write
@ The current implementation requires uniform isospin for all incoming
particles, therefore we need to probe only the first one.
<<SF ewa: ewa: TBP>>=
procedure :: init => ewa_init
<<SF ewa: sub interfaces>>=
module subroutine ewa_init (sf_int, data)
class(ewa_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine ewa_init
<<SF ewa: procedures>>=
module subroutine ewa_init (sf_int, data)
class(ewa_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(3) :: mask
integer, dimension(3) :: hel_lock
type(polarization_t), target :: pol
type(quantum_numbers_t), dimension(1) :: qn_fc, qn_fc_fin
type(flavor_t) :: flv_z, flv_wp, flv_wm
type(color_t) :: col0
type(quantum_numbers_t) :: qn_hel, qn_z, qn_wp, qn_wm, qn, qn_rad, qn_w
type(polarization_iterator_t) :: it_hel
integer :: i, isospin
select type (data)
type is (ewa_data_t)
mask = quantum_numbers_mask (.false., .false., &
mask_h = [.false., .false., .true.])
hel_lock = [2, 1, 0]
call col0%init ()
select case (data%id)
case (23)
!!! Z boson, flavor is not changing
call sf_int%base_init (mask, [data%mass**2], [data%mass**2], &
[data%mZ**2], hel_lock = hel_lock)
sf_int%data => data
call flv_z%init (Z_BOSON, data%model)
call qn_z%init (flv_z, col0)
do i = 1, size (data%flv_in)
call pol%init_generic (data%flv_in(i))
call qn_fc(1)%init ( &
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i), 1))
call it_hel%init (pol)
do while (it_hel%is_valid ())
qn_hel = it_hel%get_quantum_numbers ()
qn = qn_hel .merge. qn_fc(1)
qn_rad = qn
call qn_rad%tag_radiated ()
call sf_int%add_state ([qn, qn_rad, qn_z])
call it_hel%advance ()
end do
! call pol%final ()
end do
case (24)
call sf_int%base_init (mask, [data%mass**2], [data%m_out**2], &
[data%mW**2], hel_lock = hel_lock)
sf_int%data => data
call flv_wp%init (W_BOSON, data%model)
call flv_wm%init (- W_BOSON, data%model)
call qn_wp%init (flv_wp, col0)
call qn_wm%init (flv_wm, col0)
do i = 1, size (data%flv_in)
isospin = data%flv_in(i)%get_isospin_type ()
if (isospin > 0) then
!!! up-type quark or neutrinos
if (data%flv_in(i)%is_antiparticle ()) then
qn_w = qn_wm
else
qn_w = qn_wp
end if
else
!!! down-type quark or lepton
if (data%flv_in(i)%is_antiparticle ()) then
qn_w = qn_wp
else
qn_w = qn_wm
end if
end if
call pol%init_generic (data%flv_in(i))
call qn_fc(1)%init ( &
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i), 1))
call qn_fc_fin(1)%init ( &
flv = data%flv_out(i), &
col = color_from_flavor (data%flv_out(i), 1))
call it_hel%init (pol)
do while (it_hel%is_valid ())
qn_hel = it_hel%get_quantum_numbers ()
qn = qn_hel .merge. qn_fc(1)
qn_rad = qn_hel .merge. qn_fc_fin(1)
call qn_rad%tag_radiated ()
call sf_int%add_state ([qn, qn_rad, qn_w])
call it_hel%advance ()
end do
! call pol%final ()
end do
case default
call msg_fatal ("EWA initialization failed: wrong particle type.")
end select
call sf_int%freeze ()
if (data%keep_energy) then
sf_int%on_shell_mode = KEEP_ENERGY
else
sf_int%on_shell_mode = KEEP_MOMENTUM
end if
call sf_int%set_incoming ([1])
call sf_int%set_radiated ([2])
call sf_int%set_outgoing ([3])
end select
end subroutine ewa_init
@ %def ewa_init
@ Prepare the coupling arrays. This is separate from the previous routine since
the state matrix may be helicity-contracted.
<<SF ewa: ewa: TBP>>=
procedure :: setup_constants => ewa_setup_constants
<<SF ewa: sub interfaces>>=
module subroutine ewa_setup_constants (sf_int)
class(ewa_t), intent(inout), target :: sf_int
end subroutine ewa_setup_constants
<<SF ewa: procedures>>=
module subroutine ewa_setup_constants (sf_int)
class(ewa_t), intent(inout), target :: sf_int
type(state_iterator_t) :: it
type(flavor_t) :: flv
real(default) :: q, t3
integer :: i
sf_int%n_me = sf_int%get_n_matrix_elements ()
allocate (sf_int%cv (sf_int%n_me))
allocate (sf_int%ca (sf_int%n_me))
associate (data => sf_int%data)
select case (data%id)
case (23)
call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
do while (it%is_valid ())
i = it%get_me_index ()
flv = it%get_flavor (1)
q = flv%get_charge ()
t3 = flv%get_isospin ()
if (flv%is_antiparticle ()) then
sf_int%cv(i) = - data%cv &
* (t3 - 2._default * q * data%sinthw**2) / data%costhw
sf_int%ca(i) = data%ca * t3 / data%costhw
else
sf_int%cv(i) = data%cv &
* (t3 - 2._default * q * data%sinthw**2) / data%costhw
sf_int%ca(i) = data%ca * t3 / data%costhw
end if
call it%advance ()
end do
case (24)
call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
do while (it%is_valid ())
i = it%get_me_index ()
flv = it%get_flavor (1)
if (flv%is_antiparticle ()) then
sf_int%cv(i) = data%cv / sqrt(2._default)
sf_int%ca(i) = - data%ca / sqrt(2._default)
else
sf_int%cv(i) = data%cv / sqrt(2._default)
sf_int%ca(i) = data%ca / sqrt(2._default)
end if
call it%advance ()
end do
end select
end associate
sf_int%status = SF_INITIAL
end subroutine ewa_setup_constants
@ %def ewa_setup_constants
@
\subsection{Kinematics}
Set kinematics. The EWA structure function allows for a
straightforward mapping of the unit interval. So, to leading order,
the structure function value is unity, but the $x$ value is
transformed. Higher orders affect the function value.
If [[map]] is unset, the $r$ and $x$ values coincide, and the Jacobian
$f(r)$ is trivial.
If [[map]] is set, the exponential mapping for the $1/x$ singularity
discussed above is applied.
<<SF ewa: ewa: TBP>>=
procedure :: complete_kinematics => ewa_complete_kinematics
<<SF ewa: sub interfaces>>=
module subroutine ewa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(ewa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine ewa_complete_kinematics
<<SF ewa: procedures>>=
module subroutine ewa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(ewa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
real(default) :: e_1
real(default) :: x0, x1, lx0, lx1, lx
e_1 = energy (sf_int%get_momentum (1))
if (sf_int%data%recoil) then
select case (sf_int%data%id)
case (23)
x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
case (24)
x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
end select
else
x0 = sf_int%data%x_min
end if
x1 = sf_int%data%x_max
if ( x0 >= x1) then
f = 0
sf_int%status = SF_FAILED_KINEMATICS
return
end if
if (map) then
lx0 = log (x0)
lx1 = log (x1)
lx = lx1 * r(1) + lx0 * rb(1)
x(1) = exp(lx)
f = x(1) * (lx1 - lx0)
else
x(1) = r(1)
if (x0 < x(1) .and. x(1) < x1) then
f = 1
else
sf_int%status = SF_FAILED_KINEMATICS
f = 0
return
end if
end if
xb(1) = 1 - x(1)
if (size(x) == 3) then
x(2:3) = r(2:3)
xb(2:3) = rb(2:3)
end if
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_DONE_KINEMATICS)
sf_int%x = x(1)
sf_int%xb = xb(1)
case (SF_FAILED_KINEMATICS)
sf_int%x = 0
sf_int%xb = 0
f = 0
end select
end subroutine ewa_complete_kinematics
@ %def ewa_complete_kinematics
@ Overriding the default method: we compute the [[x]] array from the
momentum configuration. In the specific case of EWA, we also set the
internally stored $x$ and $\bar x$ values, so they can be used in the
following routine.
<<SF ewa: ewa: TBP>>=
procedure :: recover_x => sf_ewa_recover_x
<<SF ewa: sub interfaces>>=
module subroutine sf_ewa_recover_x (sf_int, x, xb, x_free)
class(ewa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
end subroutine sf_ewa_recover_x
<<SF ewa: procedures>>=
module subroutine sf_ewa_recover_x (sf_int, x, xb, x_free)
class(ewa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
call sf_int%base_recover_x (x, xb, x_free)
sf_int%x = x(1)
sf_int%xb = xb(1)
end subroutine sf_ewa_recover_x
@ %def sf_ewa_recover_x
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
<<SF ewa: ewa: TBP>>=
procedure :: inverse_kinematics => ewa_inverse_kinematics
<<SF ewa: sub interfaces>>=
module subroutine ewa_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(ewa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine ewa_inverse_kinematics
<<SF ewa: procedures>>=
module subroutine ewa_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(ewa_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
real(default) :: x0, x1, lx0, lx1, lx, e_1
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
e_1 = energy (sf_int%get_momentum (1))
if (sf_int%data%recoil) then
select case (sf_int%data%id)
case (23)
x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
case (24)
x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
end select
else
x0 = sf_int%data%x_min
end if
x1 = sf_int%data%x_max
if (map) then
lx0 = log (x0)
lx1 = log (x1)
lx = log (x(1))
r(1) = (lx - lx0) / (lx1 - lx0)
rb(1) = (lx1 - lx) / (lx1 - lx0)
f = x(1) * (lx1 - lx0)
else
r (1) = x(1)
rb(1) = 1 - x(1)
if (x0 < x(1) .and. x(1) < x1) then
f = 1
else
f = 0
end if
end if
if (size(r) == 3) then
r (2:3) = x(2:3)
rb(2:3) = xb(2:3)
end if
if (set_mom) then
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end if
end subroutine ewa_inverse_kinematics
@ %def ewa_inverse_kinematics
@
\subsection{EWA application}
For EWA, we can compute kinematics and function value in a single
step. This function works on a single beam, assuming that the input
momentum has been set. We need four random numbers as input: one for
$x$, one for $Q^2$, and two for the polar and azimuthal angles.
Alternatively, we can skip $p_T$ generation; in this case, we only
need one.
For obtaining splitting kinematics, we rely on the assumption that all
in-particles are mass-degenerate (or there is only one), so the
generated $x$ values are identical.
<<SF ewa: ewa: TBP>>=
procedure :: apply => ewa_apply
<<SF ewa: sub interfaces>>=
module subroutine ewa_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(ewa_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine ewa_apply
<<SF ewa: procedures>>=
module subroutine ewa_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(ewa_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default) :: x, xb, pt2, c1, c2
real(default) :: cv, ca
real(default) :: f, fm, fp, fL
integer :: i
associate (data => sf_int%data)
x = sf_int%x
xb = sf_int%xb
pt2 = min ((data%pt_max)**2, (xb * data%sqrts / 2)**2)
select case (data%id)
case (23)
!!! Z boson structure function
c1 = log (1 + pt2 / (xb * (data%mZ)**2))
c2 = 1 / (1 + (xb * (data%mZ)**2) / pt2)
case (24)
!!! W boson structure function
c1 = log (1 + pt2 / (xb * (data%mW)**2))
c2 = 1 / (1 + (xb * (data%mW)**2) / pt2)
end select
do i = 1, sf_int%n_me
cv = sf_int%cv(i)
ca = sf_int%ca(i)
fm = data%coeff * &
((cv + ca)**2 + ((cv - ca) * xb)**2) * (c1 - c2) / (2 * x)
fp = data%coeff * &
((cv - ca)**2 + ((cv + ca) * xb)**2) * (c1 - c2) / (2 * x)
fL = data%coeff * &
(cv**2 + ca**2) * (2 * xb / x) * c2
f = fp + fm + fL
if (.not. vanishes (f)) then
fp = fp / f
fm = fm / f
fL = fL / f
end if
call sf_int%set_matrix_element (i, cmplx (f, kind=default))
end do
end associate
sf_int%status = SF_EVALUATED
end subroutine ewa_apply
@ %def ewa_apply
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_ewa_ut.f90]]>>=
<<File header>>
module sf_ewa_ut
use unit_tests
use sf_ewa_uti
<<Standard module head>>
<<SF ewa: public test>>
contains
<<SF ewa: test driver>>
end module sf_ewa_ut
@ %def sf_ewa_ut
@
<<[[sf_ewa_uti.f90]]>>=
<<File header>>
module sf_ewa_uti
<<Use kinds>>
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use sf_aux
use sf_base
use sf_ewa
<<Standard module head>>
<<SF ewa: test declarations>>
contains
<<SF ewa: tests>>
end module sf_ewa_uti
@ %def sf_ewa_ut
@ API: driver for the unit tests below.
<<SF ewa: public test>>=
public :: sf_ewa_test
<<SF ewa: test driver>>=
subroutine sf_ewa_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF ewa: execute tests>>
end subroutine sf_ewa_test
@ %def sf_ewa_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF ewa: execute tests>>=
call test (sf_ewa_1, "sf_ewa_1", &
"structure function configuration", &
u, results)
<<SF ewa: test declarations>>=
public :: sf_ewa_1
<<SF ewa: tests>>=
subroutine sf_ewa_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(pdg_array_t), dimension(1) :: pdg_out
integer, dimension(:), allocatable :: pdg1
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_ewa_1"
write (u, "(A)") "* Purpose: initialize and display &
&test structure function data"
write (u, "(A)")
write (u, "(A)") "* Create empty data object"
write (u, "(A)")
call model%init_sm_test ()
pdg_in = 2
allocate (ewa_data_t :: data)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize for Z boson"
write (u, "(A)")
select type (data)
type is (ewa_data_t)
call data%init (model, pdg_in, 0.01_default, &
500._default, 5000._default, .false., .false.)
call data%set_id (23)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(2x,99(1x,I0))") pdg1
write (u, "(A)")
write (u, "(A)") "* Initialize for W boson"
write (u, "(A)")
deallocate (data)
allocate (ewa_data_t :: data)
select type (data)
type is (ewa_data_t)
call data%init (model, pdg_in, 0.01_default, &
500._default, 5000._default, .false., .false.)
call data%set_id (24)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(2x,99(1x,I0))") pdg1
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_ewa_1"
end subroutine sf_ewa_1
@ %def sf_ewa_1
@
\subsubsection{Test and probe structure function}
Construct and display a structure function object based on the EWA
structure function.
<<SF ewa: execute tests>>=
call test (sf_ewa_2, "sf_ewa_2", &
"structure function instance", &
u, results)
<<SF ewa: test declarations>>=
public :: sf_ewa_2
<<SF ewa: tests>>=
subroutine sf_ewa_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_ewa_2"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_sm_test ()
call flv%init (2, model)
pdg_in = 2
call reset_interaction_counter ()
allocate (ewa_data_t :: data)
select type (data)
type is (ewa_data_t)
call data%init (model, pdg_in, 0.01_default, &
500._default, 3000._default, .false., .true.)
call data%set_id (24)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=1500"
write (u, "(A)")
E = 1500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.4, no EWA mapping, collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.4_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
set_momenta=.true.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EWA structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_ewa_2"
end subroutine sf_ewa_2
@ %def sf_ewa_2
@
\subsubsection{Standard mapping}
Construct and display a structure function object based on the EWA
structure function, applying the standard single-particle mapping.
<<SF ewa: execute tests>>=
call test (sf_ewa_3, "sf_ewa_3", &
"apply mapping", &
u, results)
<<SF ewa: test declarations>>=
public :: sf_ewa_3
<<SF ewa: tests>>=
subroutine sf_ewa_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_ewa_3"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_sm_test ()
call flv%init (2, model)
pdg_in = 2
call reset_interaction_counter ()
allocate (ewa_data_t :: data)
select type (data)
type is (ewa_data_t)
call data%init (model, pdg_in, 0.01_default, &
500._default, 3000._default, .false., .true.)
call data%set_id (24)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=1500"
write (u, "(A)")
E = 1500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.4, with EWA mapping, collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.4_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
set_momenta=.true.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EWA structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_ewa_3"
end subroutine sf_ewa_3
@ %def sf_ewa_3
@
\subsubsection{Non-collinear case}
Construct and display a structure function object based on the EPA
structure function.
<<SF ewa: execute tests>>=
call test (sf_ewa_4, "sf_ewa_4", &
"non-collinear", &
u, results)
<<SF ewa: test declarations>>=
public :: sf_ewa_4
<<SF ewa: tests>>=
subroutine sf_ewa_4 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_ewa_4"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call modeL%init_sm_test ()
call flv%init (2, model)
pdg_in = 2
call reset_interaction_counter ()
allocate (ewa_data_t :: data)
select type (data)
type is (ewa_data_t)
call data%init (model, pdg_in, 0.01_default, &
500._default, 3000.0_default, .true., .true.)
call data%set_id (24)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
write (u, "(A)") "* Initialize incoming momentum with E=1500"
write (u, "(A)")
E = 1500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.5/0.5/0.25, with EWA mapping, "
write (u, "(A)") " non-coll., keeping energy"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = [0.5_default, 0.5_default, 0.25_default]
rb = 1 - r
sf_int%on_shell_mode = KEEP_ENERGY
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
call sf_int%pacify_momenta (1e-10_default)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x and r from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
set_momenta=.true.)
call sf_int%pacify_momenta (1e-10_default)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EWA structure function"
write (u, "(A)")
call sf_int%apply (scale = 1500._default)
call sf_int%write (u, testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_ewa_4"
end subroutine sf_ewa_4
@ %def sf_ewa_4
@
\subsubsection{Structure function for multiple flavors}
Construct and display a structure function object based on the EWA
structure function. The incoming state has multiple particles with
non-uniform quantum numbers.
<<SF ewa: execute tests>>=
call test (sf_ewa_5, "sf_ewa_5", &
"structure function instance", &
u, results)
<<SF ewa: test declarations>>=
public :: sf_ewa_5
<<SF ewa: tests>>=
subroutine sf_ewa_5 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_ewa_5"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_sm_test ()
call flv%init (2, model)
pdg_in = [1, 2, -1, -2]
call reset_interaction_counter ()
allocate (ewa_data_t :: data)
select type (data)
type is (ewa_data_t)
call data%init (model, pdg_in, 0.01_default, &
500._default, 3000._default, .false., .true.)
call data%set_id (24)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%setup_constants ()
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=1500"
write (u, "(A)")
E = 1500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call pacify (k, 1e-10_default)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for r=0.4, no EWA mapping, collinear"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.4_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Evaluate EWA structure function"
write (u, "(A)")
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_ewa_5"
end subroutine sf_ewa_5
@ %def sf_ewa_5
@
\clearpage
%------------------------------------------------------------------------
\section{Energy-scan spectrum}
This spectrum is actually a trick that allows us to plot the c.m.\ energy
dependence of a cross section without scanning the input energy. We
start with the observation that a spectrum $f(x)$, applied to one of
the incoming beams only, results in a cross section
\begin{equation}
\sigma = \int dx\,f(x)\,\hat\sigma(xs).
\end{equation}
We want to compute the distribution of $E=\sqrt{\hat s}=\sqrt{xs}$, i.e.,
\begin{equation}
\frac{d\sigma}{dE} = \frac{2\sqrt{x}}{\sqrt{s}}\,\frac{d\sigma}{dx}
= \frac{2\sqrt{x}}{\sqrt{s}}\,f(x)\,\hat\sigma(xs),
\end{equation}
so if we set
\begin{equation}
f(x) = \frac{\sqrt{s}}{2\sqrt{x}},
\end{equation}
we get the distribution
\begin{equation}
\frac{d\sigma}{dE} = \hat\sigma(\hat s=E^2).
\end{equation}
We implement this as a spectrum with a single parameter $x$. The
parameters for the individual beams are computed as $x_i=\sqrt{x}$, so
they are equal and the kinematics is always symmetric.
<<[[sf_escan.f90]]>>=
<<File header>>
module sf_escan
<<Use kinds>>
<<Use strings>>
use pdg_arrays
use model_data
use flavors
use quantum_numbers
use state_matrices
use polarizations
use sf_base
<<Standard module head>>
<<SF escan: public>>
<<SF escan: types>>
interface
<<SF escan: sub interfaces>>
end interface
contains
<<SF escan: main procedures>>
end module sf_escan
@ %def sf_escan
@
<<[[sf_escan_sub.f90]]>>=
<<File header>>
submodule (sf_escan) sf_escan_s
use io_units
use format_defs, only: FMT_12
use numeric_utils
use diagnostics
use lorentz
implicit none
contains
<<SF escan: procedures>>
end submodule sf_escan_s
@ %def sf_escan_s
@
\subsection{Data type}
The [[norm]] is unity if the total cross section should be normalized
to one, and $\sqrt{s}$ if it should be normalized to the total
energy. In the latter case, the differential distribution
$d\sigma/d\sqrt{\hat s}$ coincides with the partonic cross section
$\hat\sigma$ as a function of $\sqrt{\hat s}$.
<<SF escan: public>>=
public :: escan_data_t
<<SF escan: types>>=
type, extends(sf_data_t) :: escan_data_t
private
type(flavor_t), dimension(:,:), allocatable :: flv_in
integer, dimension(2) :: n_flv = 0
real(default) :: norm = 1
contains
<<SF escan: escan data: TBP>>
end type escan_data_t
@ %def escan_data_t
<<SF escan: escan data: TBP>>=
procedure :: init => escan_data_init
<<SF escan: sub interfaces>>=
module subroutine escan_data_init (data, model, pdg_in, norm)
class(escan_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), intent(in), optional :: norm
end subroutine escan_data_init
<<SF escan: procedures>>=
module subroutine escan_data_init (data, model, pdg_in, norm)
class(escan_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), intent(in), optional :: norm
real(default), dimension(2) :: m2
integer :: i, j
data%n_flv = pdg_in%get_length ()
allocate (data%flv_in (maxval (data%n_flv), 2))
do i = 1, 2
do j = 1, data%n_flv(i)
call data%flv_in(j, i)%init (pdg_in(i)%get (j), model)
end do
end do
m2 = data%flv_in(1,:)%get_mass ()
do i = 1, 2
if (.not. any (nearly_equal (data%flv_in(1:data%n_flv(i),i)%get_mass (), m2(i)))) then
call msg_fatal ("Energy scan: incoming particle mass must be uniform")
end if
end do
if (present (norm)) data%norm = norm
end subroutine escan_data_init
@ %def escan_data_init
@ Output
<<SF escan: escan data: TBP>>=
procedure :: write => escan_data_write
<<SF escan: sub interfaces>>=
module subroutine escan_data_write (data, unit, verbose)
class(escan_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine escan_data_write
<<SF escan: procedures>>=
module subroutine escan_data_write (data, unit, verbose)
class(escan_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i, j
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "Energy-scan data:"
write (u, "(3x,A)", advance="no") "prt_in = "
do i = 1, 2
if (i > 1) write (u, "(',',1x)", advance="no")
do j = 1, data%n_flv(i)
if (j > 1) write (u, "(':')", advance="no")
write (u, "(A)", advance="no") char (data%flv_in(j,i)%get_name ())
end do
end do
write (u, *)
write (u, "(3x,A," // FMT_12 // ")") "norm =", data%norm
end subroutine escan_data_write
@ %def escan_data_write
@ Kinematics is completely collinear, hence there is only one
parameter for a pair spectrum.
<<SF escan: escan data: TBP>>=
procedure :: get_n_par => escan_data_get_n_par
<<SF escan: sub interfaces>>=
module function escan_data_get_n_par (data) result (n)
class(escan_data_t), intent(in) :: data
integer :: n
end function escan_data_get_n_par
<<SF escan: procedures>>=
module function escan_data_get_n_par (data) result (n)
class(escan_data_t), intent(in) :: data
integer :: n
n = 1
end function escan_data_get_n_par
@ %def escan_data_get_n_par
@ Return the outgoing particles PDG codes. This is always the same as
the incoming particle, where we use two indices for the two beams.
<<SF escan: escan data: TBP>>=
procedure :: get_pdg_out => escan_data_get_pdg_out
<<SF escan: sub interfaces>>=
module subroutine escan_data_get_pdg_out (data, pdg_out)
class(escan_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine escan_data_get_pdg_out
<<SF escan: procedures>>=
module subroutine escan_data_get_pdg_out (data, pdg_out)
class(escan_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer :: i, n
n = 2
do i = 1, n
pdg_out(i) = data%flv_in(1:data%n_flv(i),i)%get_pdg ()
end do
end subroutine escan_data_get_pdg_out
@ %def escan_data_get_pdg_out
@ Allocate the interaction record. Due to a gfortran 7/8/9 this has to
remain in the main module.
<<SF escan: escan data: TBP>>=
procedure :: allocate_sf_int => escan_data_allocate_sf_int
<<SF escan: main procedures>>=
subroutine escan_data_allocate_sf_int (data, sf_int)
class(escan_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (escan_t :: sf_int)
end subroutine escan_data_allocate_sf_int
@ %def escan_data_allocate_sf_int
@
\subsection{The Energy-scan object}
This is a spectrum, not a radiation. We create an interaction with
two incoming and two outgoing particles, flavor, color, and helicity
being carried through. $x$ nevertheless is only one-dimensional, as we
are always using only one beam parameter.
<<SF escan: types>>=
type, extends (sf_int_t) :: escan_t
type(escan_data_t), pointer :: data => null ()
contains
<<SF escan: escan: TBP>>
end type escan_t
@ %def escan_t
@ Type string: for the energy scan this is just a dummy function.
<<SF escan: escan: TBP>>=
procedure :: type_string => escan_type_string
<<SF escan: sub interfaces>>=
module function escan_type_string (object) result (string)
class(escan_t), intent(in) :: object
type(string_t) :: string
end function escan_type_string
<<SF escan: procedures>>=
module function escan_type_string (object) result (string)
class(escan_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "Escan: energy scan"
else
string = "Escan: [undefined]"
end if
end function escan_type_string
@ %def escan_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF escan: escan: TBP>>=
procedure :: write => escan_write
<<SF escan: sub interfaces>>=
module subroutine escan_write (object, unit, testflag)
class(escan_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine escan_write
<<SF escan: procedures>>=
module subroutine escan_write (object, unit, testflag)
class(escan_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "Energy scan data: [undefined]"
end if
end subroutine escan_write
@ %def escan_write
@
<<SF escan: escan: TBP>>=
procedure :: init => escan_init
<<SF escan: sub interfaces>>=
module subroutine escan_init (sf_int, data)
class(escan_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine escan_init
<<SF escan: procedures>>=
module subroutine escan_init (sf_int, data)
class(escan_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(4) :: mask
integer, dimension(4) :: hel_lock
real(default), dimension(2) :: m2
real(default), dimension(0) :: mr2
type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
type(polarization_t), target :: pol1, pol2
type(polarization_iterator_t) :: it_hel1, it_hel2
integer :: j1, j2
select type (data)
type is (escan_data_t)
hel_lock = [3, 4, 1, 2]
m2 = data%flv_in(1,:)%get_mass ()
call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
sf_int%data => data
do j1 = 1, data%n_flv(1)
call qn_fc(1)%init ( &
flv = data%flv_in(j1,1), &
col = color_from_flavor (data%flv_in(j1,1)))
call qn_fc(3)%init ( &
flv = data%flv_in(j1,1), &
col = color_from_flavor (data%flv_in(j1,1)))
call pol1%init_generic (data%flv_in(j1,1))
do j2 = 1, data%n_flv(2)
call qn_fc(2)%init ( &
flv = data%flv_in(j2,2), &
col = color_from_flavor (data%flv_in(j2,2)))
call qn_fc(4)%init ( &
flv = data%flv_in(j2,2), &
col = color_from_flavor (data%flv_in(j2,2)))
call pol2%init_generic (data%flv_in(j2,2))
call it_hel1%init (pol1)
do while (it_hel1%is_valid ())
qn_hel(1) = it_hel1%get_quantum_numbers ()
qn_hel(3) = it_hel1%get_quantum_numbers ()
call it_hel2%init (pol2)
do while (it_hel2%is_valid ())
qn_hel(2) = it_hel2%get_quantum_numbers ()
qn_hel(4) = it_hel2%get_quantum_numbers ()
qn = qn_hel .merge. qn_fc
call sf_int%add_state (qn)
call it_hel2%advance ()
end do
call it_hel1%advance ()
end do
! call pol2%final ()
end do
! call pol1%final ()
end do
call sf_int%set_incoming ([1,2])
call sf_int%set_outgoing ([3,4])
call sf_int%freeze ()
sf_int%status = SF_INITIAL
end select
end subroutine escan_init
@ %def escan_init
@
\subsection{Kinematics}
Set kinematics. We have a single parameter, but reduce both beams.
The [[map]] flag is ignored.
<<SF escan: escan: TBP>>=
procedure :: complete_kinematics => escan_complete_kinematics
<<SF escan: sub interfaces>>=
module subroutine escan_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(escan_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default) :: sqrt_x
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine escan_complete_kinematics
<<SF escan: procedures>>=
module subroutine escan_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(escan_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default) :: sqrt_x
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
x = r
xb= rb
sqrt_x = sqrt (x(1))
if (sqrt_x > 0) then
f = 1 / (2 * sqrt_x)
else
f = 0
sf_int%status = SF_FAILED_KINEMATICS
return
end if
call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
end subroutine escan_complete_kinematics
@ %def escan_complete_kinematics
@ Recover $x$. The base procedure should return two momentum
fractions for the two beams, while we have only one parameter. This
is the product of the extracted momentum fractions.
<<SF escan: escan: TBP>>=
procedure :: recover_x => escan_recover_x
<<SF escan: sub interfaces>>=
module subroutine escan_recover_x (sf_int, x, xb, x_free)
class(escan_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
end subroutine escan_recover_x
<<SF escan: procedures>>=
module subroutine escan_recover_x (sf_int, x, xb, x_free)
class(escan_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
real(default), dimension(2) :: xi, xib
call sf_int%base_recover_x (xi, xib, x_free)
x = product (xi)
xb= 1 - x
end subroutine escan_recover_x
@ %def escan_recover_x
@ Compute inverse kinematics.
<<SF escan: escan: TBP>>=
procedure :: inverse_kinematics => escan_inverse_kinematics
<<SF escan: sub interfaces>>=
module subroutine escan_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(escan_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine escan_inverse_kinematics
<<SF escan: procedures>>=
module subroutine escan_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(escan_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
real(default) :: sqrt_x
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
sqrt_x = sqrt (x(1))
if (sqrt_x > 0) then
f = 1 / (2 * sqrt_x)
else
f = 0
sf_int%status = SF_FAILED_KINEMATICS
return
end if
r = x
rb = xb
if (set_mom) then
call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
end if
end subroutine escan_inverse_kinematics
@ %def escan_inverse_kinematics
@
\subsection{Energy scan application}
Here, we insert the predefined norm.
<<SF escan: escan: TBP>>=
procedure :: apply => escan_apply
<<SF escan: sub interfaces>>=
module subroutine escan_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(escan_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine escan_apply
<<SF escan: procedures>>=
module subroutine escan_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(escan_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default) :: f
associate (data => sf_int%data)
f = data%norm
end associate
call sf_int%set_matrix_element (cmplx (f, kind=default))
sf_int%status = SF_EVALUATED
end subroutine escan_apply
@ %def escan_apply
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_escan_ut.f90]]>>=
<<File header>>
module sf_escan_ut
use unit_tests
use sf_escan_uti
<<Standard module head>>
<<SF escan: public test>>
contains
<<SF escan: test driver>>
end module sf_escan_ut
@ %def sf_escan_ut
@
<<[[sf_escan_uti.f90]]>>=
<<File header>>
module sf_escan_uti
<<Use kinds>>
use physics_defs, only: ELECTRON
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use sf_aux
use sf_base
use sf_escan
<<Standard module head>>
<<SF escan: test declarations>>
contains
<<SF escan: tests>>
end module sf_escan_uti
@ %def sf_escan_ut
@ API: driver for the unit tests below.
<<SF escan: public test>>=
public :: sf_escan_test
<<SF escan: test driver>>=
subroutine sf_escan_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF escan: execute tests>>
end subroutine sf_escan_test
@ %def sf_escan_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF escan: execute tests>>=
call test (sf_escan_1, "sf_escan_1", &
"structure function configuration", &
u, results)
<<SF escan: test declarations>>=
public :: sf_escan_1
<<SF escan: tests>>=
subroutine sf_escan_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t), dimension(2) :: pdg_in
type(pdg_array_t), dimension(2) :: pdg_out
integer, dimension(:), allocatable :: pdg1, pdg2
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_escan_1"
write (u, "(A)") "* Purpose: initialize and display &
&energy-scan structure function data"
write (u, "(A)")
call model%init_qed_test ()
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
allocate (escan_data_t :: data)
select type (data)
type is (escan_data_t)
call data%init (model, pdg_in, norm = 2._default)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
pdg2 = pdg_out(2)
write (u, "(2x,99(1x,I0))") pdg1, pdg2
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_escan_1"
end subroutine sf_escan_1
@ %def sf_escan_1
g@
\subsubsection{Probe the structure-function object}
Active the beam event reader, generate an event.
<<SF escan: execute tests>>=
call test (sf_escan_2, "sf_escan_2", &
"generate event", &
u, results)
<<SF escan: test declarations>>=
public :: sf_escan_2
<<SF escan: tests>>=
subroutine sf_escan_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(2) :: flv
type(pdg_array_t), dimension(2) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k1, k2
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: x_free, f
write (u, "(A)") "* Test output: sf_escan_2"
write (u, "(A)") "* Purpose: initialize and display &
&beam-events structure function data"
write (u, "(A)")
call model%init_qed_test ()
call flv(1)%init (ELECTRON, model)
call flv(2)%init (-ELECTRON, model)
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
call reset_interaction_counter ()
allocate (escan_data_t :: data)
select type (data)
type is (escan_data_t)
call data%init (model, pdg_in)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1,2])
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 250
k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
call vector4_write (k1, u)
call vector4_write (k2, u)
call sf_int%seed_kinematics ([k1, k2])
write (u, "(A)")
write (u, "(A)") "* Set dummy parameters and generate x"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.8
rb = 1 - r
x_free = 1
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Inverse kinematics"
write (u, "(A)")
call sf_int%recover_x (x, xb, x_free)
call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_int%apply (scale = 0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_escan_2"
end subroutine sf_escan_2
@ %def sf_escan_2
@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Gaussian beam spread}
Instead of an analytic beam description, beam data may be provided in
form of an event file. In its most simple form, the event file
contains pairs of $x$ values, relative to nominal beam energies. More
advanced formats may include polarization, etc. The current
implementation carries beam polarization through, if specified.
The code is very similar to the energy scan described above.
However, we must include a file-handle manager for the beam-event
files. Two different processes may access a given beam-event file at
the same time (i.e., serially but alternating). Accessing an open
file from two different units is non-standard and not supported by all
compilers. Therefore, we keep a global registry of open files,
associated units, and reference counts. The [[gaussian_t]] objects
act as proxies to this registry.
<<[[sf_gaussian.f90]]>>=
<<File header>>
module sf_gaussian
<<Use kinds>>
<<Use strings>>
use rng_base
use pdg_arrays
use model_data
use flavors
use quantum_numbers
use state_matrices
use polarizations
use sf_base
<<Standard module head>>
<<SF gaussian: public>>
<<SF gaussian: types>>
interface
<<SF gaussian: sub interfaces>>
end interface
contains
<<SF gaussian: main procedures>>
end module sf_gaussian
@ %def sf_gaussian
@
<<[[sf_gaussian_sub.f90]]>>=
<<File header>>
submodule (sf_gaussian) sf_gaussian_s
use io_units
use format_defs, only: FMT_12
use file_registries
use diagnostics
use lorentz
implicit none
contains
<<SF gaussian: procedures>>
end submodule sf_gaussian_s
@ %def sf_gaussian_s
@
\subsection{The beam-data file registry}
We manage data files via the [[file_registries]] module. To this end,
we keep the registry as a private module variable here.
<<CCC SF gaussian: variables>>=
type(file_registry_t), save :: beam_file_registry
@ %def beam_file_registry
@
\subsection{Data type}
We store the spread for each beam, as a relative number related to the beam
energy. For the actual generation, we include an (abstract) random-number
generator factory.
<<SF gaussian: public>>=
public :: gaussian_data_t
<<SF gaussian: types>>=
type, extends(sf_data_t) :: gaussian_data_t
private
type(flavor_t), dimension(2) :: flv_in
real(default), dimension(2) :: spread
class(rng_factory_t), allocatable :: rng_factory
contains
<<SF gaussian: gaussian data: TBP>>
end type gaussian_data_t
@ %def gaussian_data_t
<<SF gaussian: gaussian data: TBP>>=
procedure :: init => gaussian_data_init
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_data_init &
(data, model, pdg_in, spread, rng_factory)
class(gaussian_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), dimension(2), intent(in) :: spread
class(rng_factory_t), intent(inout), allocatable :: rng_factory
end subroutine gaussian_data_init
<<SF gaussian: procedures>>=
module subroutine gaussian_data_init &
(data, model, pdg_in, spread, rng_factory)
class(gaussian_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), dimension(2), intent(in) :: spread
class(rng_factory_t), intent(inout), allocatable :: rng_factory
if (any (spread < 0)) then
call msg_fatal ("Gaussian beam spread: must not be negative")
end if
call data%flv_in(1)%init (pdg_in(1)%get (1), model)
call data%flv_in(2)%init (pdg_in(2)%get (1), model)
data%spread = spread
call move_alloc (from = rng_factory, to = data%rng_factory)
end subroutine gaussian_data_init
@ %def gaussian_data_init
@ Return true since this spectrum is always in generator mode.
<<SF gaussian: gaussian data: TBP>>=
procedure :: is_generator => gaussian_data_is_generator
<<SF gaussian: sub interfaces>>=
module function gaussian_data_is_generator (data) result (flag)
class(gaussian_data_t), intent(in) :: data
logical :: flag
end function gaussian_data_is_generator
<<SF gaussian: procedures>>=
module function gaussian_data_is_generator (data) result (flag)
class(gaussian_data_t), intent(in) :: data
logical :: flag
flag = .true.
end function gaussian_data_is_generator
@ %def gaussian_data_is_generator
@ The number of parameters is two. They are free parameters.
<<SF gaussian: gaussian data: TBP>>=
procedure :: get_n_par => gaussian_data_get_n_par
<<SF gaussian: sub interfaces>>=
module function gaussian_data_get_n_par (data) result (n)
class(gaussian_data_t), intent(in) :: data
integer :: n
end function gaussian_data_get_n_par
<<SF gaussian: procedures>>=
module function gaussian_data_get_n_par (data) result (n)
class(gaussian_data_t), intent(in) :: data
integer :: n
n = 2
end function gaussian_data_get_n_par
@ %def gaussian_data_get_n_par
<<SF gaussian: gaussian data: TBP>>=
procedure :: get_pdg_out => gaussian_data_get_pdg_out
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_data_get_pdg_out (data, pdg_out)
class(gaussian_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine gaussian_data_get_pdg_out
<<SF gaussian: procedures>>=
module subroutine gaussian_data_get_pdg_out (data, pdg_out)
class(gaussian_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer :: i, n
n = 2
do i = 1, n
pdg_out(i) = data%flv_in(i)%get_pdg ()
end do
end subroutine gaussian_data_get_pdg_out
@ %def gaussian_data_get_pdg_out
@ Allocate the interaction record. Due to a gfortran 7/8/9 bug has to
remain in the main module.
<<SF gaussian: gaussian data: TBP>>=
procedure :: allocate_sf_int => gaussian_data_allocate_sf_int
<<SF gaussian: main procedures>>=
subroutine gaussian_data_allocate_sf_int (data, sf_int)
class(gaussian_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (gaussian_t :: sf_int)
end subroutine gaussian_data_allocate_sf_int
@ %def gaussian_data_allocate_sf_int
@ Output
<<SF gaussian: gaussian data: TBP>>=
procedure :: write => gaussian_data_write
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_data_write (data, unit, verbose)
class(gaussian_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine gaussian_data_write
<<SF gaussian: procedures>>=
module subroutine gaussian_data_write (data, unit, verbose)
class(gaussian_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "Gaussian beam spread data:"
write (u, "(3x,A,A,A,A)") "prt_in = ", &
char (data%flv_in(1)%get_name ()), &
", ", char (data%flv_in(2)%get_name ())
write (u, "(3x,A,2(1x," // FMT_12 // "))") "spread =", data%spread
call data%rng_factory%write (u)
end subroutine gaussian_data_write
@ %def gaussian_data_write
@
\subsection{The gaussian object}
Flavor and polarization carried through, no radiated particles. The generator
needs a random-number generator, obviously.
<<SF gaussian: public>>=
public :: gaussian_t
<<SF gaussian: types>>=
type, extends (sf_int_t) :: gaussian_t
type(gaussian_data_t), pointer :: data => null ()
class(rng_t), allocatable :: rng
contains
<<SF gaussian: gaussian: TBP>>
end type gaussian_t
@ %def gaussian_t
@ Type string: show gaussian file.
<<SF gaussian: gaussian: TBP>>=
procedure :: type_string => gaussian_type_string
<<SF gaussian: sub interfaces>>=
module function gaussian_type_string (object) result (string)
class(gaussian_t), intent(in) :: object
type(string_t) :: string
end function gaussian_type_string
<<SF gaussian: procedures>>=
module function gaussian_type_string (object) result (string)
class(gaussian_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "Gaussian: gaussian beam-energy spread"
else
string = "Gaussian: [undefined]"
end if
end function gaussian_type_string
@ %def gaussian_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF gaussian: gaussian: TBP>>=
procedure :: write => gaussian_write
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_write (object, unit, testflag)
class(gaussian_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine gaussian_write
<<SF gaussian: procedures>>=
module subroutine gaussian_write (object, unit, testflag)
class(gaussian_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
call object%rng%write (u)
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "gaussian data: [undefined]"
end if
end subroutine gaussian_write
@ %def gaussian_write
@
<<SF gaussian: gaussian: TBP>>=
procedure :: init => gaussian_init
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_init (sf_int, data)
class(gaussian_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine gaussian_init
<<SF gaussian: procedures>>=
module subroutine gaussian_init (sf_int, data)
class(gaussian_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
real(default), dimension(2) :: m2
real(default), dimension(0) :: mr2
type(quantum_numbers_mask_t), dimension(4) :: mask
integer, dimension(4) :: hel_lock
type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
type(polarization_t), target :: pol1, pol2
type(polarization_iterator_t) :: it_hel1, it_hel2
integer :: i
select type (data)
type is (gaussian_data_t)
m2 = data%flv_in%get_mass () ** 2
hel_lock = [3, 4, 1, 2]
mask = quantum_numbers_mask (.false., .false., .false.)
call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
sf_int%data => data
do i = 1, 2
call qn_fc(i)%init ( &
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i)))
call qn_fc(i+2)%init ( &
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i)))
end do
call pol1%init_generic (data%flv_in(1))
call it_hel1%init (pol1)
do while (it_hel1%is_valid ())
qn_hel(1) = it_hel1%get_quantum_numbers ()
qn_hel(3) = it_hel1%get_quantum_numbers ()
call pol2%init_generic (data%flv_in(2))
call it_hel2%init (pol2)
do while (it_hel2%is_valid ())
qn_hel(2) = it_hel2%get_quantum_numbers ()
qn_hel(4) = it_hel2%get_quantum_numbers ()
qn = qn_hel .merge. qn_fc
call sf_int%add_state (qn)
call it_hel2%advance ()
end do
! call pol2%final ()
call it_hel1%advance ()
end do
! call pol1%final ()
call sf_int%freeze ()
call sf_int%set_incoming ([1,2])
call sf_int%set_outgoing ([3,4])
sf_int%status = SF_INITIAL
end select
call sf_int%data%rng_factory%make (sf_int%rng)
end subroutine gaussian_init
@ %def gaussian_init
@ This spectrum type needs a finalizer, which closes the data file.
<<SF gaussian: gaussian: TBP>>=
procedure :: final => sf_gaussian_final
<<SF gaussian: sub interfaces>>=
module subroutine sf_gaussian_final (object)
class(gaussian_t), intent(inout) :: object
end subroutine sf_gaussian_final
<<SF gaussian: procedures>>=
module subroutine sf_gaussian_final (object)
class(gaussian_t), intent(inout) :: object
call object%interaction_t%final ()
end subroutine sf_gaussian_final
@ %def sf_gaussian_final
@
\subsection{Kinematics}
Refer to the [[data]] component.
<<SF gaussian: gaussian: TBP>>=
procedure :: is_generator => gaussian_is_generator
<<SF gaussian: sub interfaces>>=
module function gaussian_is_generator (sf_int) result (flag)
class(gaussian_t), intent(in) :: sf_int
logical :: flag
end function gaussian_is_generator
<<SF gaussian: procedures>>=
module function gaussian_is_generator (sf_int) result (flag)
class(gaussian_t), intent(in) :: sf_int
logical :: flag
flag = sf_int%data%is_generator ()
end function gaussian_is_generator
@ %def gaussian_is_generator
@ Generate free parameters. The $x$ value should be distributed with mean $1$
and $\sigma$ given by the spread. We reject negative $x$ values. (This
cut slightly biases the distribution, but for reasonable (small)
spreads negative $r$ should not occur.
<<SF gaussian: gaussian: TBP>>=
procedure :: generate_free => gaussian_generate_free
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_generate_free (sf_int, r, rb, x_free)
class(gaussian_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
end subroutine gaussian_generate_free
<<SF gaussian: procedures>>=
module subroutine gaussian_generate_free (sf_int, r, rb, x_free)
class(gaussian_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
real(default), dimension(size(r)) :: z
associate (data => sf_int%data)
do
call sf_int%rng%generate_gaussian (z)
rb = z * data%spread
r = 1 - rb
x_free = x_free * product (r)
if (all (r > 0)) exit
end do
end associate
end subroutine gaussian_generate_free
@ %def gaussian_generate_free
@ Set kinematics. Trivial transfer since this is a pure generator.
The [[map]] flag doesn't apply.
<<SF gaussian: gaussian: TBP>>=
procedure :: complete_kinematics => gaussian_complete_kinematics
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(gaussian_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine gaussian_complete_kinematics
<<SF gaussian: procedures>>=
module subroutine gaussian_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(gaussian_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
if (map) then
call msg_fatal ("gaussian: map flag not supported")
else
x = r
xb= rb
f = 1
end if
call sf_int%reduce_momenta (x)
end subroutine gaussian_complete_kinematics
@ %def gaussian_complete_kinematics
@ Compute inverse kinematics. Trivial in this case.
<<SF gaussian: gaussian: TBP>>=
procedure :: inverse_kinematics => gaussian_inverse_kinematics
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(gaussian_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine gaussian_inverse_kinematics
<<SF gaussian: procedures>>=
module subroutine gaussian_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(gaussian_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
call msg_fatal ("gaussian: map flag not supported")
else
r = x
rb= xb
f = 1
end if
if (set_mom) then
call sf_int%reduce_momenta (x)
end if
end subroutine gaussian_inverse_kinematics
@ %def gaussian_inverse_kinematics
@
\subsection{gaussian application}
Trivial, just set the unit weight.
<<SF gaussian: gaussian: TBP>>=
procedure :: apply => gaussian_apply
<<SF gaussian: sub interfaces>>=
module subroutine gaussian_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(gaussian_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine gaussian_apply
<<SF gaussian: procedures>>=
module subroutine gaussian_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(gaussian_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default) :: f
f = 1
call sf_int%set_matrix_element (cmplx (f, kind=default))
sf_int%status = SF_EVALUATED
end subroutine gaussian_apply
@ %def gaussian_apply
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_gaussian_ut.f90]]>>=
<<File header>>
module sf_gaussian_ut
use unit_tests
use sf_gaussian_uti
<<Standard module head>>
<<SF gaussian: public test>>
contains
<<SF gaussian: test driver>>
end module sf_gaussian_ut
@ %def sf_gaussian_ut
@
<<[[sf_gaussian_uti.f90]]>>=
<<File header>>
module sf_gaussian_uti
<<Use kinds>>
use numeric_utils, only: pacify
use physics_defs, only: ELECTRON
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use rng_base
use sf_aux
use sf_base
use sf_gaussian
use rng_base_ut, only: rng_test_factory_t
<<Standard module head>>
<<SF gaussian: test declarations>>
contains
<<SF gaussian: tests>>
end module sf_gaussian_uti
@ %def sf_gaussian_ut
@ API: driver for the unit tests below.
<<SF gaussian: public test>>=
public :: sf_gaussian_test
<<SF gaussian: test driver>>=
subroutine sf_gaussian_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF gaussian: execute tests>>
end subroutine sf_gaussian_test
@ %def sf_gaussian_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF gaussian: execute tests>>=
call test (sf_gaussian_1, "sf_gaussian_1", &
"structure function configuration", &
u, results)
<<SF gaussian: test declarations>>=
public :: sf_gaussian_1
<<SF gaussian: tests>>=
subroutine sf_gaussian_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t), dimension(2) :: pdg_in
type(pdg_array_t), dimension(2) :: pdg_out
integer, dimension(:), allocatable :: pdg1, pdg2
class(sf_data_t), allocatable :: data
class(rng_factory_t), allocatable :: rng_factory
write (u, "(A)") "* Test output: sf_gaussian_1"
write (u, "(A)") "* Purpose: initialize and display &
&gaussian-spread structure function data"
write (u, "(A)")
call model%init_qed_test ()
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
allocate (gaussian_data_t :: data)
allocate (rng_test_factory_t :: rng_factory)
select type (data)
type is (gaussian_data_t)
call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
pdg2 = pdg_out(2)
write (u, "(2x,99(1x,I0))") pdg1, pdg2
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_gaussian_1"
end subroutine sf_gaussian_1
@ %def sf_gaussian_1
@
\subsubsection{Probe the structure-function object}
Active the beam event reader, generate an event.
<<SF gaussian: execute tests>>=
call test (sf_gaussian_2, "sf_gaussian_2", &
"generate event", &
u, results)
<<SF gaussian: test declarations>>=
public :: sf_gaussian_2
<<SF gaussian: tests>>=
subroutine sf_gaussian_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(2) :: flv
type(pdg_array_t), dimension(2) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(rng_factory_t), allocatable :: rng_factory
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k1, k2
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: x_free, f
integer :: i
write (u, "(A)") "* Test output: sf_gaussian_2"
write (u, "(A)") "* Purpose: initialize and display &
&gaussian-spread structure function data"
write (u, "(A)")
call model%init_qed_test ()
call flv(1)%init (ELECTRON, model)
call flv(2)%init (-ELECTRON, model)
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
call reset_interaction_counter ()
allocate (gaussian_data_t :: data)
allocate (rng_test_factory_t :: rng_factory)
select type (data)
type is (gaussian_data_t)
call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1,2])
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 250
k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
call vector4_write (k1, u)
call vector4_write (k2, u)
call sf_int%seed_kinematics ([k1, k2])
write (u, "(A)")
write (u, "(A)") "* Set dummy parameters and generate x."
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0
rb = 0
x_free = 1
call sf_int%generate_free (r, rb, x_free)
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call pacify (rb, 1.e-8_default)
call pacify (xb, 1.e-8_default)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_int%apply (scale = 0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate more events"
write (u, "(A)")
select type (sf_int)
type is (gaussian_t)
do i = 1, 3
call sf_int%generate_free (r, rb, x_free)
write (u, "(A,9(1x,F10.7))") "r =", r
end do
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_gaussian_2"
end subroutine sf_gaussian_2
@ %def sf_gaussian_2
@
\clearpage
@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Using beam event data}
Instead of an analytic beam description, beam data may be provided in
form of an event file. In its most simple form, the event file
contains pairs of $x$ values, relative to nominal beam energies. More
advanced formats may include polarization, etc. The current
implementation carries beam polarization through, if specified.
The code is very similar to the energy scan described above.
However, we must include a file-handle manager for the beam-event
files. Two different processes may access a given beam-event file at
the same time (i.e., serially but alternating). Accessing an open
file from two different units is non-standard and not supported by all
compilers. Therefore, we keep a global registry of open files,
associated units, and reference counts. The [[beam_events_t]] objects
act as proxies to this registry.
<<[[sf_beam_events.f90]]>>=
<<File header>>
module sf_beam_events
<<Use kinds>>
<<Use strings>>
use file_registries
use pdg_arrays
use model_data
use flavors
use quantum_numbers
use state_matrices
use polarizations
use sf_base
<<Standard module head>>
<<SF beam events: public>>
<<SF beam events: types>>
<<SF beam events: variables>>
interface
<<SF beam events: sub interfaces>>
end interface
contains
<<SF beam events: main procedures>>
end module sf_beam_events
@ %def sf_beam_events
@
<<[[sf_beam_events_sub.f90]]>>=
<<File header>>
submodule (sf_beam_events) sf_beam_events_s
use io_units
use diagnostics
use lorentz
implicit none
contains
<<SF beam events: procedures>>
end submodule sf_beam_events_s
@ %def sf_beam_events_s
@
\subsection{The beam-data file registry}
We manage data files via the [[file_registries]] module. To this end,
we keep the registry as a private module variable here.
This is public only for the unit tests.
<<SF beam events: public>>=
public :: beam_file_registry
<<SF beam events: variables>>=
type(file_registry_t), save :: beam_file_registry
@ %def beam_file_registry
@
\subsection{Data type}
<<SF beam events: public>>=
public :: beam_events_data_t
<<SF beam events: types>>=
type, extends(sf_data_t) :: beam_events_data_t
private
type(flavor_t), dimension(2) :: flv_in
type(string_t) :: dir
type(string_t) :: file
type(string_t) :: fqn
integer :: unit = 0
logical :: warn_eof = .true.
contains
<<SF beam events: beam events data: TBP>>
end type beam_events_data_t
@ %def beam_events_data_t
<<SF beam events: beam events data: TBP>>=
procedure :: init => beam_events_data_init
<<SF beam events: sub interfaces>>=
module subroutine beam_events_data_init &
(data, model, pdg_in, dir, file, warn_eof)
class(beam_events_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
type(string_t), intent(in) :: dir
type(string_t), intent(in) :: file
logical, intent(in), optional :: warn_eof
end subroutine beam_events_data_init
<<SF beam events: procedures>>=
module subroutine beam_events_data_init &
(data, model, pdg_in, dir, file, warn_eof)
class(beam_events_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
type(string_t), intent(in) :: dir
type(string_t), intent(in) :: file
logical, intent(in), optional :: warn_eof
if (any (pdg_in%get_length () /= 1)) then
call msg_fatal ("Beam events: incoming beam particles must be unique")
end if
call data%flv_in(1)%init (pdg_in(1)%get (1), model)
call data%flv_in(2)%init (pdg_in(2)%get (1), model)
data%dir = dir
data%file = file
if (present (warn_eof)) data%warn_eof = warn_eof
end subroutine beam_events_data_init
@ %def beam_events_data_init
@ Return true since this spectrum is always in generator mode.
<<SF beam events: beam events data: TBP>>=
procedure :: is_generator => beam_events_data_is_generator
<<SF beam events: sub interfaces>>=
module function beam_events_data_is_generator (data) result (flag)
class(beam_events_data_t), intent(in) :: data
logical :: flag
end function beam_events_data_is_generator
<<SF beam events: procedures>>=
module function beam_events_data_is_generator (data) result (flag)
class(beam_events_data_t), intent(in) :: data
logical :: flag
flag = .true.
end function beam_events_data_is_generator
@ %def beam_events_data_is_generator
@ The number of parameters is two. They are free parameters.
<<SF beam events: beam events data: TBP>>=
procedure :: get_n_par => beam_events_data_get_n_par
<<SF beam events: sub interfaces>>=
module function beam_events_data_get_n_par (data) result (n)
class(beam_events_data_t), intent(in) :: data
integer :: n
end function beam_events_data_get_n_par
<<SF beam events: procedures>>=
module function beam_events_data_get_n_par (data) result (n)
class(beam_events_data_t), intent(in) :: data
integer :: n
n = 2
end function beam_events_data_get_n_par
@ %def beam_events_data_get_n_par
<<SF beam events: beam events data: TBP>>=
procedure :: get_pdg_out => beam_events_data_get_pdg_out
<<SF beam events: sub interfaces>>=
module subroutine beam_events_data_get_pdg_out (data, pdg_out)
class(beam_events_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine beam_events_data_get_pdg_out
<<SF beam events: procedures>>=
module subroutine beam_events_data_get_pdg_out (data, pdg_out)
class(beam_events_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer :: i, n
n = 2
do i = 1, n
pdg_out(i) = data%flv_in(i)%get_pdg ()
end do
end subroutine beam_events_data_get_pdg_out
@ %def beam_events_data_get_pdg_out
@ Allocate the interaction record. Due to a gfortran 7/8/9 bug has to
remain in the main module.
<<SF beam events: beam events data: TBP>>=
procedure :: allocate_sf_int => beam_events_data_allocate_sf_int
<<SF beam events: main procedures>>=
subroutine beam_events_data_allocate_sf_int (data, sf_int)
class(beam_events_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (beam_events_t :: sf_int)
end subroutine beam_events_data_allocate_sf_int
@ %def beam_events_data_allocate_sf_int
@ Output
<<SF beam events: beam events data: TBP>>=
procedure :: write => beam_events_data_write
<<SF beam events: sub interfaces>>=
module subroutine beam_events_data_write (data, unit, verbose)
class(beam_events_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine beam_events_data_write
<<SF beam events: procedures>>=
module subroutine beam_events_data_write (data, unit, verbose)
class(beam_events_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "Beam-event file data:"
write (u, "(3x,A,A,A,A)") "prt_in = ", &
char (data%flv_in(1)%get_name ()), &
", ", char (data%flv_in(2)%get_name ())
write (u, "(3x,A,A,A)") "file = '", char (data%file), "'"
write (u, "(3x,A,I0)") "unit = ", data%unit
write (u, "(3x,A,L1)") "warn = ", data%warn_eof
end subroutine beam_events_data_write
@ %def beam_events_data_write
@ The data file needs to be opened and closed explicitly. The
open/close message is communicated to the file handle registry, which
does the actual work.
We determine first whether to look in the local directory or in the
given system directory.
<<SF beam events: beam events data: TBP>>=
procedure :: open => beam_events_data_open
procedure :: close => beam_events_data_close
<<SF beam events: sub interfaces>>=
module subroutine beam_events_data_open (data)
class(beam_events_data_t), intent(inout) :: data
end subroutine beam_events_data_open
module subroutine beam_events_data_close (data)
class(beam_events_data_t), intent(inout) :: data
end subroutine beam_events_data_close
<<SF beam events: procedures>>=
module subroutine beam_events_data_open (data)
class(beam_events_data_t), intent(inout) :: data
logical :: exist
if (data%unit == 0) then
data%fqn = data%file
if (data%fqn == "") &
call msg_fatal ("Beam events: $beam_events_file is not set")
inquire (file = char (data%fqn), exist = exist)
if (.not. exist) then
data%fqn = data%dir // "/" // data%file
inquire (file = char (data%fqn), exist = exist)
if (.not. exist) then
data%fqn = ""
call msg_fatal ("Beam events: file '" &
// char (data%file) // "' not found")
return
end if
end if
call msg_message ("Beam events: reading from file '" &
// char (data%file) // "'")
call beam_file_registry%open (data%fqn, data%unit)
else
call msg_bug ("Beam events: file '" &
// char (data%file) // "' is already open")
end if
end subroutine beam_events_data_open
module subroutine beam_events_data_close (data)
class(beam_events_data_t), intent(inout) :: data
if (data%unit /= 0) then
call beam_file_registry%close (data%fqn)
call msg_message ("Beam events: closed file '" &
// char (data%file) // "'")
data%unit = 0
end if
end subroutine beam_events_data_close
@ %def beam_events_data_close
@ Return the beam event file.
<<SF beam events: beam events data: TBP>>=
procedure :: get_beam_file => beam_events_data_get_beam_file
<<SF beam events: sub interfaces>>=
module function beam_events_data_get_beam_file (data) result (file)
class(beam_events_data_t), intent(in) :: data
type(string_t) :: file
end function beam_events_data_get_beam_file
<<SF beam events: procedures>>=
module function beam_events_data_get_beam_file (data) result (file)
class(beam_events_data_t), intent(in) :: data
type(string_t) :: file
file = "Beam events: " // data%file
end function beam_events_data_get_beam_file
@ %def beam_events_data_get_beam_file
@
\subsection{The beam events object}
Flavor and polarization carried through, no radiated particles.
<<SF beam events: public>>=
public :: beam_events_t
<<SF beam events: types>>=
type, extends (sf_int_t) :: beam_events_t
type(beam_events_data_t), pointer :: data => null ()
integer :: count = 0
contains
<<SF beam events: beam events: TBP>>
end type beam_events_t
@ %def beam_events_t
@ Type string: show beam events file.
<<SF beam events: beam events: TBP>>=
procedure :: type_string => beam_events_type_string
<<SF beam events: sub interfaces>>=
module function beam_events_type_string (object) result (string)
class(beam_events_t), intent(in) :: object
type(string_t) :: string
end function beam_events_type_string
<<SF beam events: procedures>>=
module function beam_events_type_string (object) result (string)
class(beam_events_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "Beam events: " // object%data%file
else
string = "Beam events: [undefined]"
end if
end function beam_events_type_string
@ %def beam_events_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF beam events: beam events: TBP>>=
procedure :: write => beam_events_write
<<SF beam events: sub interfaces>>=
module subroutine beam_events_write (object, unit, testflag)
class(beam_events_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine beam_events_write
<<SF beam events: procedures>>=
module subroutine beam_events_write (object, unit, testflag)
class(beam_events_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "Beam events data: [undefined]"
end if
end subroutine beam_events_write
@ %def beam_events_write
@
<<SF beam events: beam events: TBP>>=
procedure :: init => beam_events_init
<<SF beam events: sub interfaces>>=
module subroutine beam_events_init (sf_int, data)
class(beam_events_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine beam_events_init
<<SF beam events: procedures>>=
module subroutine beam_events_init (sf_int, data)
class(beam_events_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
real(default), dimension(2) :: m2
real(default), dimension(0) :: mr2
type(quantum_numbers_mask_t), dimension(4) :: mask
integer, dimension(4) :: hel_lock
type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
type(polarization_t), target :: pol1, pol2
type(polarization_iterator_t) :: it_hel1, it_hel2
integer :: i
select type (data)
type is (beam_events_data_t)
m2 = data%flv_in%get_mass () ** 2
hel_lock = [3, 4, 1, 2]
mask = quantum_numbers_mask (.false., .false., .false.)
call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
sf_int%data => data
do i = 1, 2
call qn_fc(i)%init ( &
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i)))
call qn_fc(i+2)%init ( &
flv = data%flv_in(i), &
col = color_from_flavor (data%flv_in(i)))
end do
call pol1%init_generic (data%flv_in(1))
call it_hel1%init (pol1)
do while (it_hel1%is_valid ())
qn_hel(1) = it_hel1%get_quantum_numbers ()
qn_hel(3) = it_hel1%get_quantum_numbers ()
call pol2%init_generic (data%flv_in(2))
call it_hel2%init (pol2)
do while (it_hel2%is_valid ())
qn_hel(2) = it_hel2%get_quantum_numbers ()
qn_hel(4) = it_hel2%get_quantum_numbers ()
qn = qn_hel .merge. qn_fc
call sf_int%add_state (qn)
call it_hel2%advance ()
end do
! call pol2%final ()
call it_hel1%advance ()
end do
! call pol1%final ()
call sf_int%freeze ()
call sf_int%set_incoming ([1,2])
call sf_int%set_outgoing ([3,4])
call sf_int%data%open ()
sf_int%status = SF_INITIAL
end select
end subroutine beam_events_init
@ %def beam_events_init
@ This spectrum type needs a finalizer, which closes the data file.
<<SF beam events: beam events: TBP>>=
procedure :: final => sf_beam_events_final
<<SF beam events: sub interfaces>>=
module subroutine sf_beam_events_final (object)
class(beam_events_t), intent(inout) :: object
end subroutine sf_beam_events_final
<<SF beam events: procedures>>=
module subroutine sf_beam_events_final (object)
class(beam_events_t), intent(inout) :: object
call object%data%close ()
call object%interaction_t%final ()
end subroutine sf_beam_events_final
@ %def sf_beam_events_final
@
\subsection{Kinematics}
Refer to the [[data]] component.
<<SF beam events: beam events: TBP>>=
procedure :: is_generator => beam_events_is_generator
<<SF beam events: sub interfaces>>=
module function beam_events_is_generator (sf_int) result (flag)
class(beam_events_t), intent(in) :: sf_int
logical :: flag
end function beam_events_is_generator
<<SF beam events: procedures>>=
module function beam_events_is_generator (sf_int) result (flag)
class(beam_events_t), intent(in) :: sf_int
logical :: flag
flag = sf_int%data%is_generator ()
end function beam_events_is_generator
@ %def beam_events_is_generator
@ Generate free parameters. We read them from file.
<<SF beam events: beam events: TBP>>=
procedure :: generate_free => beam_events_generate_free
<<SF beam events: sub interfaces>>=
recursive module subroutine beam_events_generate_free &
(sf_int, r, rb, x_free)
class(beam_events_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
end subroutine beam_events_generate_free
<<SF beam events: procedures>>=
recursive module subroutine beam_events_generate_free &
(sf_int, r, rb, x_free)
class(beam_events_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
integer :: iostat
associate (data => sf_int%data)
if (data%unit /= 0) then
read (data%unit, fmt=*, iostat=iostat) r
if (iostat > 0) then
write (msg_buffer, "(A,I0,A)") &
"Beam events: I/O error after reading ", sf_int%count, &
" events"
call msg_fatal ()
else if (iostat < 0) then
if (sf_int%count == 0) then
call msg_fatal ("Beam events: file is empty")
else if (sf_int%data%warn_eof) then
write (msg_buffer, "(A,I0,A)") &
"Beam events: End of file after reading ", sf_int%count, &
" events, rewinding"
call msg_warning ()
end if
rewind (data%unit)
sf_int%count = 0
call sf_int%generate_free (r, rb, x_free)
else
sf_int%count = sf_int%count + 1
rb = 1 - r
x_free = x_free * product (r)
end if
else
call msg_bug ("Beam events: file is not open for reading")
end if
end associate
end subroutine beam_events_generate_free
@ %def beam_events_generate_free
@ Set kinematics. Trivial transfer since this is a pure generator.
The [[map]] flag doesn't apply.
<<SF beam events: beam events: TBP>>=
procedure :: complete_kinematics => beam_events_complete_kinematics
<<SF beam events: sub interfaces>>=
module subroutine beam_events_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(beam_events_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine beam_events_complete_kinematics
<<SF beam events: procedures>>=
module subroutine beam_events_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(beam_events_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
if (map) then
call msg_fatal ("Beam events: map flag not supported")
else
x = r
xb= rb
f = 1
end if
call sf_int%reduce_momenta (x)
end subroutine beam_events_complete_kinematics
@ %def beam_events_complete_kinematics
@ Compute inverse kinematics. Trivial in this case.
<<SF beam events: beam events: TBP>>=
procedure :: inverse_kinematics => beam_events_inverse_kinematics
<<SF beam events: sub interfaces>>=
module subroutine beam_events_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(beam_events_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine beam_events_inverse_kinematics
<<SF beam events: procedures>>=
module subroutine beam_events_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(beam_events_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
call msg_fatal ("Beam events: map flag not supported")
else
r = x
rb= xb
f = 1
end if
if (set_mom) then
call sf_int%reduce_momenta (x)
end if
end subroutine beam_events_inverse_kinematics
@ %def beam_events_inverse_kinematics
@
\subsection{Beam events application}
Trivial, just set the unit weight.
<<SF beam events: beam events: TBP>>=
procedure :: apply => beam_events_apply
<<SF beam events: sub interfaces>>=
module subroutine beam_events_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(beam_events_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine beam_events_apply
<<SF beam events: procedures>>=
module subroutine beam_events_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(beam_events_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default) :: f
f = 1
call sf_int%set_matrix_element (cmplx (f, kind=default))
sf_int%status = SF_EVALUATED
end subroutine beam_events_apply
@ %def beam_events_apply
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_beam_events_ut.f90]]>>=
<<File header>>
module sf_beam_events_ut
use unit_tests
use sf_beam_events_uti
<<Standard module head>>
<<SF beam events: public test>>
contains
<<SF beam events: test driver>>
end module sf_beam_events_ut
@ %def sf_beam_events_ut
@
<<[[sf_beam_events_uti.f90]]>>=
<<File header>>
module sf_beam_events_uti
<<Use kinds>>
<<Use strings>>
use io_units
use numeric_utils, only: pacify
use physics_defs, only: ELECTRON
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use sf_aux
use sf_base
use sf_beam_events
<<Standard module head>>
<<SF beam events: test declarations>>
contains
<<SF beam events: tests>>
end module sf_beam_events_uti
@ %def sf_beam_events_ut
@ API: driver for the unit tests below.
<<SF beam events: public test>>=
public :: sf_beam_events_test
<<SF beam events: test driver>>=
subroutine sf_beam_events_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF beam events: execute tests>>
end subroutine sf_beam_events_test
@ %def sf_beam_events_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF beam events: execute tests>>=
call test (sf_beam_events_1, "sf_beam_events_1", &
"structure function configuration", &
u, results)
<<SF beam events: test declarations>>=
public :: sf_beam_events_1
<<SF beam events: tests>>=
subroutine sf_beam_events_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t), dimension(2) :: pdg_in
type(pdg_array_t), dimension(2) :: pdg_out
integer, dimension(:), allocatable :: pdg1, pdg2
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_beam_events_1"
write (u, "(A)") "* Purpose: initialize and display &
&beam-events structure function data"
write (u, "(A)")
call model%init_qed_test ()
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
allocate (beam_events_data_t :: data)
select type (data)
type is (beam_events_data_t)
call data%init (model, pdg_in, var_str (""), var_str ("beam_events.dat"))
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
pdg2 = pdg_out(2)
write (u, "(2x,99(1x,I0))") pdg1, pdg2
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_beam_events_1"
end subroutine sf_beam_events_1
@ %def sf_beam_events_1
@
\subsubsection{Probe the structure-function object}
Active the beam event reader, generate an event.
<<SF beam events: execute tests>>=
call test (sf_beam_events_2, "sf_beam_events_2", &
"generate event", &
u, results)
<<SF beam events: test declarations>>=
public :: sf_beam_events_2
<<SF beam events: tests>>=
subroutine sf_beam_events_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(2) :: flv
type(pdg_array_t), dimension(2) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k1, k2
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: x_free, f
integer :: i
write (u, "(A)") "* Test output: sf_beam_events_2"
write (u, "(A)") "* Purpose: initialize and display &
&beam-events structure function data"
write (u, "(A)")
call model%init_qed_test ()
call flv(1)%init (ELECTRON, model)
call flv(2)%init (-ELECTRON, model)
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
call reset_interaction_counter ()
allocate (beam_events_data_t :: data)
select type (data)
type is (beam_events_data_t)
call data%init (model, pdg_in, &
var_str (""), var_str ("test_beam_events.dat"))
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1,2])
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 250
k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
call vector4_write (k1, u)
call vector4_write (k2, u)
call sf_int%seed_kinematics ([k1, k2])
write (u, "(A)")
write (u, "(A)") "* Set dummy parameters and generate x."
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0
rb = 0
x_free = 1
call sf_int%generate_free (r, rb, x_free)
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,9(1x,F10.7))") "rb=", rb
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
select type (sf_int)
type is (beam_events_t)
write (u, "(A,1x,I0)") "count =", sf_int%count
end select
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_int%apply (scale = 0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate more events, rewind"
write (u, "(A)")
select type (sf_int)
type is (beam_events_t)
do i = 1, 3
call sf_int%generate_free (r, rb, x_free)
write (u, "(A,9(1x,F10.7))") "r =", r
write (u, "(A,1x,I0)") "count =", sf_int%count
end do
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_beam_events_2"
end subroutine sf_beam_events_2
@ %def sf_beam_events_2
@
\subsubsection{Check the file handle registry}
Open and close some files, checking the registry contents.
<<SF beam events: execute tests>>=
call test (sf_beam_events_3, "sf_beam_events_3", &
"check registry", &
u, results)
<<SF beam events: test declarations>>=
public :: sf_beam_events_3
<<SF beam events: tests>>=
subroutine sf_beam_events_3 (u)
integer, intent(in) :: u
integer :: u1
write (u, "(A)") "* Test output: sf_beam_events_2"
write (u, "(A)") "* Purpose: check file handle registry"
write (u, "(A)")
write (u, "(A)") "* Create some empty files"
write (u, "(A)")
u1 = free_unit ()
open (u1, file = "sf_beam_events_f1.tmp", action="write", status="new")
close (u1)
open (u1, file = "sf_beam_events_f2.tmp", action="write", status="new")
close (u1)
open (u1, file = "sf_beam_events_f3.tmp", action="write", status="new")
close (u1)
write (u, "(A)") "* Empty registry"
write (u, "(A)")
call beam_file_registry%write (u)
write (u, "(A)")
write (u, "(A)") "* Insert three entries"
write (u, "(A)")
call beam_file_registry%open (var_str ("sf_beam_events_f3.tmp"))
call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
call beam_file_registry%open (var_str ("sf_beam_events_f1.tmp"))
call beam_file_registry%write (u)
write (u, "(A)")
write (u, "(A)") "* Open a second channel"
write (u, "(A)")
call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
call beam_file_registry%write (u)
write (u, "(A)")
write (u, "(A)") "* Close second entry twice"
write (u, "(A)")
call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
call beam_file_registry%write (u)
write (u, "(A)")
write (u, "(A)") "* Close last entry"
write (u, "(A)")
call beam_file_registry%close (var_str ("sf_beam_events_f3.tmp"))
call beam_file_registry%write (u)
write (u, "(A)")
write (u, "(A)") "* Close remaining entry"
write (u, "(A)")
call beam_file_registry%close (var_str ("sf_beam_events_f1.tmp"))
call beam_file_registry%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
open (u1, file = "sf_beam_events_f1.tmp", action="write")
close (u1, status = "delete")
open (u1, file = "sf_beam_events_f2.tmp", action="write")
close (u1, status = "delete")
open (u1, file = "sf_beam_events_f3.tmp", action="write")
close (u1, status = "delete")
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_beam_events_3"
end subroutine sf_beam_events_3
@ %def sf_beam_events_3
@
\clearpage
%------------------------------------------------------------------------
\section{Lepton collider beamstrahlung: CIRCE1}
<<[[sf_circe1.f90]]>>=
<<File header>>
module sf_circe1
<<Use kinds>>
use kinds, only: double
<<Use strings>>
use rng_base
use pdg_arrays
use model_data
use flavors
use polarizations
use sf_mappings
use sf_base
use circe1, circe1_rng_t => rng_type !NODEP!
<<Standard module head>>
<<SF circe1: public>>
<<SF circe1: types>>
interface
<<SF circe1: sub interfaces>>
end interface
contains
<<SF circe1: main procedures>>
end module sf_circe1
@ %def sf_circe1
@
<<[[sf_circe1_sub.f90]]>>=
<<File header>>
submodule (sf_circe1) sf_circe1_s
use io_units
use format_defs, only: FMT_17, FMT_19
use diagnostics
use physics_defs, only: ELECTRON, PHOTON
use lorentz
use colors
use quantum_numbers
use state_matrices
implicit none
contains
<<SF circe1: procedures>>
end submodule sf_circe1_s
@ %def sf_circe1_s
@
\subsection{Physics}
Beamstrahlung is applied before ISR. The [[CIRCE1]] implementation has
a single structure function for both beams (which makes sense since it
has to be switched on or off for both beams simultaneously).
Nevertheless it is factorized:
The functional form in the [[CIRCE1]] parameterization is defined for
electrons or photons
\begin{equation}
f(x) = \alpha\,x^\beta\,(1-x)^\gamma
\end{equation}
for $x<1-\epsilon$ (resp.\ $x>\epsilon$ in the photon case). In the
remaining interval, the standard form is zero, with a delta
singularity at $x=1$ (resp.\ $x=0$). Equivalently, the delta part may be
distributed uniformly among this interval. This latter form is
implemented in the [[kirke]] version of the [[CIRCE1]] subroutines, and
is used here.
The parameter [[circe1\_eps]] sets the peak mapping of the [[CIRCE1]]
structure function. Its default value is $10^{-5}$.
The other parameters are the parameterization version and revision
number, the accelerator type, and the $\sqrt{s}$ value used by
[[CIRCE1]]. The chattiness can also be set.
Since the energy is distributed in a narrow region around unity (for
electrons) or zero (for photons), it is advantageous to map the
interval first. The mapping is controlled by the parameter
[[circe1\_epsilon]] which is taken from the [[CIRCE1]]
internal data structure.
The $\sqrt{s}$ value, if not explicitly set, is taken from the
process data. Note that interpolating $\sqrt{s}$ is not recommended;
one should rather choose one of the distinct values known to [[CIRCE1]].
\subsection{The CIRCE1 data block}
The CIRCE1 parameters are: The incoming flavors, the flags whether the photon
or the lepton is the parton in the hard interaction, the flags for the
generation mode (generator/mapping/no mapping), the mapping parameter
$\epsilon$, $\sqrt{s}$ and several steering parameters: [[ver]],
[[rev]], [[acc]], [[chat]].
In generator mode, the $x$ values are actually discarded and a random number
generator is used instead.
<<SF circe1: public>>=
public :: circe1_data_t
<<SF circe1: types>>=
type, extends (sf_data_t) :: circe1_data_t
private
class(model_data_t), pointer :: model => null ()
type(flavor_t), dimension(2) :: flv_in
integer, dimension(2) :: pdg_in
real(default), dimension(2) :: m_in = 0
logical, dimension(2) :: photon = .false.
logical :: generate = .false.
class(rng_factory_t), allocatable :: rng_factory
real(default) :: sqrts = 0
real(default) :: eps = 0
integer :: ver = 0
integer :: rev = 0
character(6) :: acc = "?"
integer :: chat = 0
logical :: with_radiation = .false.
contains
<<SF circe1: circe1 data: TBP>>
end type circe1_data_t
@ %def circe1_data_t
@
<<SF circe1: circe1 data: TBP>>=
procedure :: init => circe1_data_init
<<SF circe1: sub interfaces>>=
module subroutine circe1_data_init &
(data, model, pdg_in, sqrts, eps, out_photon, &
ver, rev, acc, chat, with_radiation)
class(circe1_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), intent(in) :: sqrts
real(default), intent(in) :: eps
logical, dimension(2), intent(in) :: out_photon
character(*), intent(in) :: acc
integer, intent(in) :: ver, rev, chat
logical, intent(in) :: with_radiation
end subroutine circe1_data_init
<<SF circe1: procedures>>=
module subroutine circe1_data_init &
(data, model, pdg_in, sqrts, eps, out_photon, &
ver, rev, acc, chat, with_radiation)
class(circe1_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), intent(in) :: sqrts
real(default), intent(in) :: eps
logical, dimension(2), intent(in) :: out_photon
character(*), intent(in) :: acc
integer, intent(in) :: ver, rev, chat
logical, intent(in) :: with_radiation
data%model => model
if (any (pdg_in%get_length () /= 1)) then
call msg_fatal ("CIRCE1: incoming beam particles must be unique")
end if
call data%flv_in(1)%init (pdg_in(1)%get (1), model)
call data%flv_in(2)%init (pdg_in(2)%get (1), model)
data%pdg_in = data%flv_in%get_pdg ()
data%m_in = data%flv_in%get_mass ()
data%sqrts = sqrts
data%eps = eps
data%photon = out_photon
data%ver = ver
data%rev = rev
data%acc = acc
data%chat = chat
data%with_radiation = with_radiation
call data%check ()
call circex (0.d0, 0.d0, dble (data%sqrts), &
data%acc, data%ver, data%rev, data%chat)
end subroutine circe1_data_init
@ %def circe1_data_init
@ Activate the generator mode. We import a RNG factory into the data
type, which can then spawn RNG generator objects.
<<SF circe1: circe1 data: TBP>>=
procedure :: set_generator_mode => circe1_data_set_generator_mode
<<SF circe1: sub interfaces>>=
module subroutine circe1_data_set_generator_mode (data, rng_factory)
class(circe1_data_t), intent(inout) :: data
class(rng_factory_t), intent(inout), allocatable :: rng_factory
end subroutine circe1_data_set_generator_mode
<<SF circe1: procedures>>=
module subroutine circe1_data_set_generator_mode (data, rng_factory)
class(circe1_data_t), intent(inout) :: data
class(rng_factory_t), intent(inout), allocatable :: rng_factory
data%generate = .true.
call move_alloc (from = rng_factory, to = data%rng_factory)
end subroutine circe1_data_set_generator_mode
@ %def circe1_data_set_generator_mode
@ Handle error conditions.
<<SF circe1: circe1 data: TBP>>=
procedure :: check => circe1_data_check
<<SF circe1: sub interfaces>>=
module subroutine circe1_data_check (data)
class(circe1_data_t), intent(in) :: data
end subroutine circe1_data_check
<<SF circe1: procedures>>=
module subroutine circe1_data_check (data)
class(circe1_data_t), intent(in) :: data
type(flavor_t) :: flv_electron, flv_photon
call flv_electron%init (ELECTRON, data%model)
call flv_photon%init (PHOTON, data%model)
if (.not. flv_electron%is_defined () &
.or. .not. flv_photon%is_defined ()) then
call msg_fatal ("CIRCE1: model must contain photon and electron")
end if
if (any (abs (data%pdg_in) /= ELECTRON) &
.or. (data%pdg_in(1) /= - data%pdg_in(2))) then
call msg_fatal ("CIRCE1: applicable only for e+e- or e-e+ collisions")
end if
if (data%eps <= 0) then
call msg_error ("CIRCE1: circe1_eps = 0: integration will &
&miss x=1 peak")
end if
end subroutine circe1_data_check
@ %def circe1_data_check
@ Output
<<SF circe1: circe1 data: TBP>>=
procedure :: write => circe1_data_write
<<SF circe1: sub interfaces>>=
module subroutine circe1_data_write (data, unit, verbose)
class(circe1_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine circe1_data_write
<<SF circe1: procedures>>=
module subroutine circe1_data_write (data, unit, verbose)
class(circe1_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
logical :: verb
verb = .false.; if (present (verbose)) verb = verbose
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "CIRCE1 data:"
write (u, "(3x,A,2(1x,A))") "prt_in =", &
char (data%flv_in(1)%get_name ()), &
char (data%flv_in(2)%get_name ())
write (u, "(3x,A,2(1x,L1))") "photon =", data%photon
write (u, "(3x,A,L1)") "generate = ", data%generate
write (u, "(3x,A,2(1x," // FMT_19 // "))") "m_in =", data%m_in
write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", data%sqrts
write (u, "(3x,A," // FMT_19 // ")") "eps = ", data%eps
write (u, "(3x,A,I0)") "ver = ", data%ver
write (u, "(3x,A,I0)") "rev = ", data%rev
write (u, "(3x,A,A)") "acc = ", data%acc
write (u, "(3x,A,I0)") "chat = ", data%chat
write (u, "(3x,A,L1)") "with rad.= ", data%with_radiation
if (data%generate) then
if (verb) then
call data%rng_factory%write (u)
end if
end if
end subroutine circe1_data_write
@ %def circe1_data_write
@ Return true if this structure function is in generator mode. In
that case, all parameters are free, otherwise bound. (We do not
support mixed cases.) Default is: no generator.
<<SF circe1: circe1 data: TBP>>=
procedure :: is_generator => circe1_data_is_generator
<<SF circe1: sub interfaces>>=
module function circe1_data_is_generator (data) result (flag)
class(circe1_data_t), intent(in) :: data
logical :: flag
end function circe1_data_is_generator
<<SF circe1: procedures>>=
module function circe1_data_is_generator (data) result (flag)
class(circe1_data_t), intent(in) :: data
logical :: flag
flag = data%generate
end function circe1_data_is_generator
@ %def circe1_data_is_generator
@ The number of parameters is two, collinear splitting for the two beams.
<<SF circe1: circe1 data: TBP>>=
procedure :: get_n_par => circe1_data_get_n_par
<<SF circe1: sub interfaces>>=
module function circe1_data_get_n_par (data) result (n)
class(circe1_data_t), intent(in) :: data
integer :: n
end function circe1_data_get_n_par
<<SF circe1: procedures>>=
module function circe1_data_get_n_par (data) result (n)
class(circe1_data_t), intent(in) :: data
integer :: n
n = 2
end function circe1_data_get_n_par
@ %def circe1_data_get_n_par
@ Return the outgoing particles PDG codes. This is either the incoming
particle (if a photon is radiated), or the photon if that is the particle
of the hard interaction. The latter is determined via the [[photon]]
flag. There are two entries for the two beams.
<<SF circe1: circe1 data: TBP>>=
procedure :: get_pdg_out => circe1_data_get_pdg_out
<<SF circe1: sub interfaces>>=
module subroutine circe1_data_get_pdg_out (data, pdg_out)
class(circe1_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine circe1_data_get_pdg_out
<<SF circe1: procedures>>=
module subroutine circe1_data_get_pdg_out (data, pdg_out)
class(circe1_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer :: i, n
n = 2
do i = 1, n
if (data%photon(i)) then
pdg_out(i) = PHOTON
else
pdg_out(i) = data%pdg_in(i)
end if
end do
end subroutine circe1_data_get_pdg_out
@ %def circe1_data_get_pdg_out
@ This variant is not inherited, it returns integers.
<<SF circe1: circe1 data: TBP>>=
procedure :: get_pdg_int => circe1_data_get_pdg_int
<<SF circe1: sub interfaces>>=
module function circe1_data_get_pdg_int (data) result (pdg)
class(circe1_data_t), intent(in) :: data
integer, dimension(2) :: pdg
end function circe1_data_get_pdg_int
<<SF circe1: procedures>>=
module function circe1_data_get_pdg_int (data) result (pdg)
class(circe1_data_t), intent(in) :: data
integer, dimension(2) :: pdg
integer :: i
do i = 1, 2
if (data%photon(i)) then
pdg(i) = PHOTON
else
pdg(i) = data%pdg_in(i)
end if
end do
end function circe1_data_get_pdg_int
@ %def circe1_data_get_pdg_int
@ Allocate the interaction record. Due to the gfortran 7/8/9 bug this
has to remain in the main module.
<<SF circe1: circe1 data: TBP>>=
procedure :: allocate_sf_int => circe1_data_allocate_sf_int
<<SF circe1: main procedures>>=
subroutine circe1_data_allocate_sf_int (data, sf_int)
class(circe1_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (circe1_t :: sf_int)
end subroutine circe1_data_allocate_sf_int
@ %def circe1_data_allocate_sf_int
@ Return the accelerator type.
<<SF circe1: circe1 data: TBP>>=
procedure :: get_beam_file => circe1_data_get_beam_file
<<SF circe1: sub interfaces>>=
module function circe1_data_get_beam_file (data) result (file)
class(circe1_data_t), intent(in) :: data
type(string_t) :: file
end function circe1_data_get_beam_file
<<SF circe1: procedures>>=
module function circe1_data_get_beam_file (data) result (file)
class(circe1_data_t), intent(in) :: data
type(string_t) :: file
file = "CIRCE1: " // data%acc
end function circe1_data_get_beam_file
@ %def circe1_data_get_beam_file
@
\subsection{Random Number Generator for CIRCE}
The CIRCE implementation now supports a generic random-number
generator object that allows for a local state as a component. To
support this, we must extend the abstract type provided by CIRCE and
delegate the generator call to the (also abstract) RNG used by WHIZARD.
<<SF circe1: types>>=
type, extends (circe1_rng_t) :: rng_obj_t
class(rng_t), allocatable :: rng
contains
procedure :: generate => rng_obj_generate
end type rng_obj_t
@ %def rng_obj_t
<<SF circe1: sub interfaces>>=
module subroutine rng_obj_generate (rng_obj, u)
class(rng_obj_t), intent(inout) :: rng_obj
real(double), intent(out) :: u
end subroutine rng_obj_generate
<<SF circe1: procedures>>=
module subroutine rng_obj_generate (rng_obj, u)
class(rng_obj_t), intent(inout) :: rng_obj
real(double), intent(out) :: u
real(default) :: x
call rng_obj%rng%generate (x)
u = x
end subroutine rng_obj_generate
@ %def rng_obj_generate
@
\subsection{The CIRCE1 object}
This is a $2\to 4$ interaction, where, depending on the parameters, any two of
the four outgoing particles are connected to the hard interactions, the others
are radiated. Knowing that all particles are colorless, we do not have to
deal with color.
The flavors are sorted such that the first two particles are the incoming
leptons, the next two are the radiated particles, and the last two are the
partons initiating the hard interaction.
CIRCE1 does not support polarized beams explicitly. For simplicity, we
nevertheless carry beam polarization through to the outgoing electrons and
make the photons unpolarized.
In the case that no radiated particle is kept (which actually is the
default), polarization is always transferred to the electrons, too. If
there is a recoil photon in the event, the radiated particles are 3
and 4, respectively, and 5 and 6 are the outgoing ones (triggering the
hard scattering process), while in the case of no radiation, the
outgoing particles are 3 and 4, respectively. In the case of the
electron being the radiated particle, helicity is not kept.
<<SF circe1: public>>=
public :: circe1_t
<<SF circe1: types>>=
type, extends (sf_int_t) :: circe1_t
type(circe1_data_t), pointer :: data => null ()
real(default), dimension(2) :: x = 0
real(default), dimension(2) :: xb= 0
real(default) :: f = 0
logical, dimension(2) :: continuum = .true.
logical, dimension(2) :: peak = .true.
type(rng_obj_t) :: rng_obj
contains
<<SF circe1: circe1: TBP>>
end type circe1_t
@ %def circe1_t
@ Type string: has to be here, but there is no string variable on which CIRCE1
depends. Hence, a dummy routine.
<<SF circe1: circe1: TBP>>=
procedure :: type_string => circe1_type_string
<<SF circe1: sub interfaces>>=
module function circe1_type_string (object) result (string)
class(circe1_t), intent(in) :: object
type(string_t) :: string
end function circe1_type_string
<<SF circe1: procedures>>=
module function circe1_type_string (object) result (string)
class(circe1_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "CIRCE1: beamstrahlung"
else
string = "CIRCE1: [undefined]"
end if
end function circe1_type_string
@ %def circe1_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF circe1: circe1: TBP>>=
procedure :: write => circe1_write
<<SF circe1: sub interfaces>>=
module subroutine circe1_write (object, unit, testflag)
class(circe1_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine circe1_write
<<SF circe1: procedures>>=
module subroutine circe1_write (object, unit, testflag)
class(circe1_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
if (object%data%generate) call object%rng_obj%rng%write (u)
if (object%status >= SF_DONE_KINEMATICS) then
write (u, "(3x,A,2(1x," // FMT_17 // "))") "x =", object%x
write (u, "(3x,A,2(1x," // FMT_17 // "))") "xb=", object%xb
if (object%status >= SF_FAILED_EVALUATION) then
write (u, "(3x,A,1x," // FMT_17 // ")") "f =", object%f
end if
end if
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "CIRCE1 data: [undefined]"
end if
end subroutine circe1_write
@ %def circe1_write
@
<<SF circe1: circe1: TBP>>=
procedure :: init => circe1_init
<<SF circe1: sub interfaces>>=
module subroutine circe1_init (sf_int, data)
class(circe1_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine circe1_init
<<SF circe1: procedures>>=
module subroutine circe1_init (sf_int, data)
class(circe1_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
logical, dimension(6) :: mask_h
type(quantum_numbers_mask_t), dimension(6) :: mask
integer, dimension(6) :: hel_lock
type(polarization_t), target :: pol1, pol2
type(quantum_numbers_t), dimension(1) :: qn_fc1, qn_fc2
type(flavor_t) :: flv_photon
type(color_t) :: col0
real(default), dimension(2) :: mi2, mr2, mo2
type(quantum_numbers_t) :: qn_hel1, qn_hel2, qn_photon, qn1, qn2
type(quantum_numbers_t), dimension(6) :: qn
type(polarization_iterator_t) :: it_hel1, it_hel2
hel_lock = 0
mask_h = .false.
select type (data)
type is (circe1_data_t)
mi2 = data%m_in**2
if (data%with_radiation) then
if (data%photon(1)) then
hel_lock(1) = 3; hel_lock(3) = 1; mask_h(5) = .true.
mr2(1) = mi2(1)
mo2(1) = 0._default
else
hel_lock(1) = 5; hel_lock(5) = 1; mask_h(3) = .true.
mr2(1) = 0._default
mo2(1) = mi2(1)
end if
if (data%photon(2)) then
hel_lock(2) = 4; hel_lock(4) = 2; mask_h(6) = .true.
mr2(2) = mi2(2)
mo2(2) = 0._default
else
hel_lock(2) = 6; hel_lock(6) = 2; mask_h(4) = .true.
mr2(2) = 0._default
mo2(2) = mi2(2)
end if
mask = quantum_numbers_mask (.false., .false., mask_h)
call sf_int%base_init (mask, mi2, mr2, mo2, &
hel_lock = hel_lock)
sf_int%data => data
call flv_photon%init (PHOTON, data%model)
call col0%init ()
call qn_photon%init (flv_photon, col0)
call pol1%init_generic (data%flv_in(1))
call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
call pol2%init_generic (data%flv_in(2))
call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
call it_hel1%init (pol1)
do while (it_hel1%is_valid ())
qn_hel1 = it_hel1%get_quantum_numbers ()
qn1 = qn_hel1 .merge. qn_fc1(1)
qn(1) = qn1
if (data%photon(1)) then
qn(3) = qn1; qn(5) = qn_photon
else
qn(3) = qn_photon; qn(5) = qn1
end if
call it_hel2%init (pol2)
do while (it_hel2%is_valid ())
qn_hel2 = it_hel2%get_quantum_numbers ()
qn2 = qn_hel2 .merge. qn_fc2(1)
qn(2) = qn2
if (data%photon(2)) then
qn(4) = qn2; qn(6) = qn_photon
else
qn(4) = qn_photon; qn(6) = qn2
end if
call qn(3:4)%tag_radiated ()
call sf_int%add_state (qn)
call it_hel2%advance ()
end do
call it_hel1%advance ()
end do
! call pol1%final ()
! call pol2%final ()
call sf_int%freeze ()
call sf_int%set_incoming ([1,2])
call sf_int%set_radiated ([3,4])
call sf_int%set_outgoing ([5,6])
else
if (data%photon(1)) then
mask_h(3) = .true.
mo2(1) = 0._default
else
hel_lock(1) = 3; hel_lock(3) = 1
mo2(1) = mi2(1)
end if
if (data%photon(2)) then
mask_h(4) = .true.
mo2(2) = 0._default
else
hel_lock(2) = 4; hel_lock(4) = 2
mo2(2) = mi2(2)
end if
mask = quantum_numbers_mask (.false., .false., mask_h)
call sf_int%base_init (mask(1:4), mi2, [real(default) :: ], mo2, &
hel_lock = hel_lock(1:4))
sf_int%data => data
call flv_photon%init (PHOTON, data%model)
call col0%init ()
call qn_photon%init (flv_photon, col0)
call pol1%init_generic (data%flv_in(1))
call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
call pol2%init_generic (data%flv_in(2))
call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
call it_hel1%init (pol1)
do while (it_hel1%is_valid ())
qn_hel1 = it_hel1%get_quantum_numbers ()
qn1 = qn_hel1 .merge. qn_fc1(1)
qn(1) = qn1
if (data%photon(1)) then
qn(3) = qn_photon
else
qn(3) = qn1
end if
call it_hel2%init (pol2)
do while (it_hel2%is_valid ())
qn_hel2 = it_hel2%get_quantum_numbers ()
qn2 = qn_hel2 .merge. qn_fc2(1)
qn(2) = qn2
if (data%photon(2)) then
qn(4) = qn_photon
else
qn(4) = qn2
end if
call sf_int%add_state (qn(1:4))
call it_hel2%advance ()
end do
call it_hel1%advance ()
end do
! call pol1%final ()
! call pol2%final ()
call sf_int%freeze ()
call sf_int%set_incoming ([1,2])
call sf_int%set_outgoing ([3,4])
end if
sf_int%status = SF_INITIAL
end select
if (sf_int%data%generate) then
call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
end if
end subroutine circe1_init
@ %def circe1_init
@
\subsection{Kinematics}
Refer to the [[data]] component.
<<SF circe1: circe1: TBP>>=
procedure :: is_generator => circe1_is_generator
<<SF circe1: sub interfaces>>=
module function circe1_is_generator (sf_int) result (flag)
class(circe1_t), intent(in) :: sf_int
logical :: flag
end function circe1_is_generator
<<SF circe1: procedures>>=
module function circe1_is_generator (sf_int) result (flag)
class(circe1_t), intent(in) :: sf_int
logical :: flag
flag = sf_int%data%is_generator ()
end function circe1_is_generator
@ %def circe1_is_generator
@ Generate free parameters, if generator mode is on. Otherwise, the
parameters will be discarded.
<<SF circe1: circe1: TBP>>=
procedure :: generate_free => circe1_generate_free
<<SF circe1: sub interfaces>>=
module subroutine circe1_generate_free (sf_int, r, rb, x_free)
class(circe1_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
end subroutine circe1_generate_free
<<SF circe1: procedures>>=
module subroutine circe1_generate_free (sf_int, r, rb, x_free)
class(circe1_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
if (sf_int%data%generate) then
call circe_generate (r, sf_int%data%get_pdg_int (), sf_int%rng_obj)
rb = 1 - r
x_free = x_free * product (r)
else
r = 0
rb= 1
end if
end subroutine circe1_generate_free
@ %def circe1_generate_free
@ Generator mode: depending on the particle codes, call one of the
available [[girce]] generators. Illegal particle code combinations
should have been caught during data initialization.
<<SF circe1: procedures>>=
subroutine circe_generate (x, pdg, rng_obj)
real(default), dimension(2), intent(out) :: x
integer, dimension(2), intent(in) :: pdg
class(rng_obj_t), intent(inout) :: rng_obj
real(double) :: xc1, xc2
select case (abs (pdg(1)))
case (ELECTRON)
select case (abs (pdg(2)))
case (ELECTRON)
call gircee (xc1, xc2, rng_obj = rng_obj)
case (PHOTON)
call girceg (xc1, xc2, rng_obj = rng_obj)
end select
case (PHOTON)
select case (abs (pdg(2)))
case (ELECTRON)
call girceg (xc2, xc1, rng_obj = rng_obj)
case (PHOTON)
call gircgg (xc1, xc2, rng_obj = rng_obj)
end select
end select
x = [xc1, xc2]
end subroutine circe_generate
@ %def circe_generate
@ Set kinematics. The $r$ values (either from integration or from the
generator call above) are copied to $x$ unchanged, and $f$ is unity.
We store the $x$ values, so we can use them for the evaluation later.
<<SF circe1: circe1: TBP>>=
procedure :: complete_kinematics => circe1_complete_kinematics
<<SF circe1: sub interfaces>>=
module subroutine circe1_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(circe1_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine circe1_complete_kinematics
<<SF circe1: procedures>>=
module subroutine circe1_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(circe1_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
x = r
xb = rb
sf_int%x = x
sf_int%xb= xb
f = 1
if (sf_int%data%with_radiation) then
call sf_int%split_momenta (x, xb)
else
call sf_int%reduce_momenta (x)
end if
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end subroutine circe1_complete_kinematics
@ %def circe1_complete_kinematics
@ Compute inverse kinematics. In generator mode, the $r$ values are
meaningless, but we copy them anyway.
<<SF circe1: circe1: TBP>>=
procedure :: inverse_kinematics => circe1_inverse_kinematics
<<SF circe1: sub interfaces>>=
module subroutine circe1_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(circe1_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine circe1_inverse_kinematics
<<SF circe1: procedures>>=
module subroutine circe1_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(circe1_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
r = x
rb = xb
sf_int%x = x
sf_int%xb= xb
f = 1
if (set_mom) then
call sf_int%split_momenta (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end if
end subroutine circe1_inverse_kinematics
@ %def circe1_inverse_kinematics
@
\subsection{CIRCE1 application}
CIRCE is applied for the two beams at once. We can safely assume that no
structure functions are applied before this, so the incoming particles are
on-shell electrons/positrons.
The scale is ignored.
<<SF circe1: circe1: TBP>>=
procedure :: apply => circe1_apply
<<SF circe1: sub interfaces>>=
module subroutine circe1_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(circe1_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine circe1_apply
<<SF circe1: procedures>>=
module subroutine circe1_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(circe1_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default), dimension(2) :: xb
real(double), dimension(2) :: xc
real(double), parameter :: one = 1
associate (data => sf_int%data)
xc = sf_int%x
xb = sf_int%xb
if (data%generate) then
sf_int%f = 1
else
sf_int%f = 0
if (all (sf_int%continuum)) then
sf_int%f = circe (xc(1), xc(2), data%pdg_in(1), data%pdg_in(2))
end if
if (sf_int%continuum(2) .and. sf_int%peak(1)) then
sf_int%f = sf_int%f &
+ circe (one, xc(2), data%pdg_in(1), data%pdg_in(2)) &
* peak (xb(1), data%eps)
end if
if (sf_int%continuum(1) .and. sf_int%peak(2)) then
sf_int%f = sf_int%f &
+ circe (xc(1), one, data%pdg_in(1), data%pdg_in(2)) &
* peak (xb(2), data%eps)
end if
if (all (sf_int%peak)) then
sf_int%f = sf_int%f &
+ circe (one, one, data%pdg_in(1), data%pdg_in(2)) &
* peak (xb(1), data%eps) * peak (xb(2), data%eps)
end if
end if
end associate
call sf_int%set_matrix_element (cmplx (sf_int%f, kind=default))
sf_int%status = SF_EVALUATED
end subroutine circe1_apply
@ %def circe1_apply
@ This is a smeared delta peak at zero, as an endpoint singularity.
We choose an exponentially decreasing function, starting at zero, with
integral (from $0$ to $1$) $1-e^{-1/\epsilon}$. For small $\epsilon$,
this reduces to one.
<<SF circe1: procedures>>=
function peak (x, eps) result (f)
real(default), intent(in) :: x, eps
real(default) :: f
f = exp (-x / eps) / eps
end function peak
@ %def peak
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_circe1_ut.f90]]>>=
<<File header>>
module sf_circe1_ut
use unit_tests
use sf_circe1_uti
<<Standard module head>>
<<SF circe1: public test>>
contains
<<SF circe1: test driver>>
end module sf_circe1_ut
@ %def sf_circe1_ut
@
<<[[sf_circe1_uti.f90]]>>=
<<File header>>
module sf_circe1_uti
<<Use kinds>>
use physics_defs, only: ELECTRON
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use rng_base
use sf_aux
use sf_base
use sf_circe1
use rng_base_ut, only: rng_test_factory_t
<<Standard module head>>
<<SF circe1: test declarations>>
contains
<<SF circe1: tests>>
end module sf_circe1_uti
@ %def sf_circe1_ut
@ API: driver for the unit tests below.
<<SF circe1: public test>>=
public :: sf_circe1_test
<<SF circe1: test driver>>=
subroutine sf_circe1_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF circe1: execute tests>>
end subroutine sf_circe1_test
@ %def sf_circe1_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF circe1: execute tests>>=
call test (sf_circe1_1, "sf_circe1_1", &
"structure function configuration", &
u, results)
<<SF circe1: test declarations>>=
public :: sf_circe1_1
<<SF circe1: tests>>=
subroutine sf_circe1_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t), dimension(2) :: pdg_in
type(pdg_array_t), dimension(2) :: pdg_out
integer, dimension(:), allocatable :: pdg1, pdg2
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_circe1_1"
write (u, "(A)") "* Purpose: initialize and display &
&CIRCE structure function data"
write (u, "(A)")
write (u, "(A)") "* Create empty data object"
write (u, "(A)")
call model%init_qed_test ()
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
allocate (circe1_data_t :: data)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
select type (data)
type is (circe1_data_t)
call data%init (model, pdg_in, &
sqrts = 500._default, &
eps = 1e-6_default, &
out_photon = [.false., .false.], &
ver = 0, &
rev = 0, &
acc = "SBAND", &
chat = 0, &
with_radiation = .true.)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
pdg2 = pdg_out(2)
write (u, "(2x,99(1x,I0))") pdg1, pdg2
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_circe1_1"
end subroutine sf_circe1_1
@ %def sf_circe1_1
@
\subsubsection{Test and probe structure function}
Construct and display a structure function object based on the PDF builtin
structure function.
<<SF circe1: execute tests>>=
call test (sf_circe1_2, "sf_circe1_2", &
"structure function instance", &
u, results)
<<SF circe1: test declarations>>=
public :: sf_circe1_2
<<SF circe1: tests>>=
subroutine sf_circe1_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(2) :: flv
type(pdg_array_t), dimension(2) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k1, k2
type(vector4_t), dimension(4) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_circe1_2"
write (u, "(A)") "* Purpose: initialize and fill &
&circe1 structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv(1)%init (ELECTRON, model)
call flv(2)%init (-ELECTRON, model)
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
call reset_interaction_counter ()
allocate (circe1_data_t :: data)
select type (data)
type is (circe1_data_t)
call data%init (model, pdg_in, &
sqrts = 500._default, &
eps = 1e-6_default, &
out_photon = [.false., .false.], &
ver = 0, &
rev = 0, &
acc = "SBAND", &
chat = 0, &
with_radiation = .true.)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1,2])
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 250
k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
call vector4_write (k1, u)
call vector4_write (k2, u)
call sf_int%seed_kinematics ([k1, k2])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.95,0.85."
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = [0.9_default, 0.8_default]
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1, 2])
call sf_int%seed_kinematics ([k1, k2])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%apply (scale = 0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_circe1_2"
end subroutine sf_circe1_2
@ %def sf_circe1_2
@
\subsubsection{Generator mode}
Construct and evaluate a structure function object in generator mode.
<<SF circe1: execute tests>>=
call test (sf_circe1_3, "sf_circe1_3", &
"generator mode", &
u, results)
<<SF circe1: test declarations>>=
public :: sf_circe1_3
<<SF circe1: tests>>=
subroutine sf_circe1_3 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t), dimension(2) :: flv
type(pdg_array_t), dimension(2) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(rng_factory_t), allocatable :: rng_factory
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k1, k2
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f, x_free
write (u, "(A)") "* Test output: sf_circe1_3"
write (u, "(A)") "* Purpose: initialize and fill &
&circe1 structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_qed_test ()
call flv(1)%init (ELECTRON, model)
call flv(2)%init (-ELECTRON, model)
pdg_in(1) = ELECTRON
pdg_in(2) = -ELECTRON
call reset_interaction_counter ()
allocate (circe1_data_t :: data)
allocate (rng_test_factory_t :: rng_factory)
select type (data)
type is (circe1_data_t)
call data%init (model, pdg_in, &
sqrts = 500._default, &
eps = 1e-6_default, &
out_photon = [.false., .false.], &
ver = 0, &
rev = 0, &
acc = "SBAND", &
chat = 0, &
with_radiation = .true.)
call data%set_generator_mode (rng_factory)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1,2])
select type (sf_int)
type is (circe1_t)
call sf_int%rng_obj%rng%init (3)
end select
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 250
k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
call vector4_write (k1, u)
call vector4_write (k2, u)
call sf_int%seed_kinematics ([k1, k2])
write (u, "(A)")
write (u, "(A)") "* Generate x"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0
rb = 0
x_free = 1
call sf_int%generate_free (r, rb, x_free)
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_int%apply (scale = 0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_circe1_3"
end subroutine sf_circe1_3
@ %def sf_circe1_3
@
\clearpage
%------------------------------------------------------------------------
\section{Lepton Collider Beamstrahlung and Photon collider: CIRCE2}
<<[[sf_circe2.f90]]>>=
<<File header>>
module sf_circe2
<<Use kinds>>
<<Use strings>>
use os_interface
use rng_base
use selectors
use pdg_arrays
use model_data
use flavors
use polarizations
use sf_base
use circe2, circe2_rng_t => rng_type !NODEP!
<<Standard module head>>
<<SF circe2: public>>
<<SF circe2: types>>
interface
<<SF circe2: sub interfaces>>
end interface
contains
<<SF circe2: main procedures>>
end module sf_circe2
@ %def sf_circe2
@
<<[[sf_circe2_sub.f90]]>>=
<<File header>>
submodule (sf_circe2) sf_circe2_s
use io_units
use format_defs, only: FMT_19
use numeric_utils
use diagnostics
use physics_defs, only: PHOTON, ELECTRON
use lorentz
use colors
use helicities
use quantum_numbers
use state_matrices
implicit none
contains
<<SF circe2: procedures>>
end submodule sf_circe2_s
@ %def sf_circe2_s
@
\subsection{Physics}
[[CIRCE2]] describes photon spectra
Beamstrahlung is applied before ISR. The [[CIRCE2]] implementation has
a single structure function for both beams (which makes sense since it
has to be switched on or off for both beams simultaneously).
\subsection{The CIRCE2 data block}
The CIRCE2 parameters are: file and collider specification, incoming
(= outgoing) particles. The luminosity is returned by [[circe2_luminosity]].
<<SF circe2: public>>=
public :: circe2_data_t
<<SF circe2: types>>=
type, extends (sf_data_t) :: circe2_data_t
private
class(model_data_t), pointer :: model => null ()
type(flavor_t), dimension(2) :: flv_in
integer, dimension(2) :: pdg_in
real(default) :: sqrts = 0
logical :: polarized = .false.
logical :: beams_polarized = .false.
class(rng_factory_t), allocatable :: rng_factory
type(string_t) :: filename
type(string_t) :: file
type(string_t) :: design
real(default) :: lumi = 0
real(default), dimension(4) :: lumi_hel_frac = 0
integer, dimension(0:4) :: h1 = [0, -1, -1, 1, 1]
integer, dimension(0:4) :: h2 = [0, -1, 1,-1, 1]
integer :: error = 1
contains
<<SF circe2: circe2 data: TBP>>
end type circe2_data_t
@ %def circe2_data_t
<<SF circe2: types>>=
type(circe2_state) :: circe2_global_state
@
<<SF circe2: circe2 data: TBP>>=
procedure :: init => circe2_data_init
<<SF circe2: sub interfaces>>=
module subroutine circe2_data_init (data, os_data, model, pdg_in, &
sqrts, polarized, beam_pol, file, design)
class(circe2_data_t), intent(out) :: data
type(os_data_t), intent(in) :: os_data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), intent(in) :: sqrts
logical, intent(in) :: polarized, beam_pol
type(string_t), intent(in) :: file, design
end subroutine circe2_data_init
<<SF circe2: procedures>>=
module subroutine circe2_data_init (data, os_data, model, pdg_in, &
sqrts, polarized, beam_pol, file, design)
class(circe2_data_t), intent(out) :: data
type(os_data_t), intent(in) :: os_data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), dimension(2), intent(in) :: pdg_in
real(default), intent(in) :: sqrts
logical, intent(in) :: polarized, beam_pol
type(string_t), intent(in) :: file, design
integer :: h
data%model => model
if (any (pdg_in%get_length () /= 1)) then
call msg_fatal ("CIRCE2: incoming beam particles must be unique")
end if
call data%flv_in(1)%init (pdg_in(1)%get (1), model)
call data%flv_in(2)%init (pdg_in(2)%get (1), model)
data%pdg_in = data%flv_in%get_pdg ()
data%sqrts = sqrts
data%polarized = polarized
data%beams_polarized = beam_pol
data%filename = file
data%design = design
call data%check_file (os_data)
call circe2_load (circe2_global_state, trim (char(data%file)), &
trim (char(data%design)), data%sqrts, data%error)
call data%check ()
data%lumi = circe2_luminosity (circe2_global_state, data%pdg_in, [0, 0])
if (vanishes (data%lumi)) then
call msg_fatal ("CIRCE2: luminosity vanishes for specified beams.")
end if
if (data%polarized) then
do h = 1, 4
data%lumi_hel_frac(h) = &
circe2_luminosity (circe2_global_state, data%pdg_in, &
[data%h1(h), data%h2(h)]) &
/ data%lumi
end do
end if
end subroutine circe2_data_init
@ %def circe2_data_init
@ Activate the generator mode. We import a RNG factory into the data
type, which can then spawn RNG generator objects.
<<SF circe2: circe2 data: TBP>>=
procedure :: set_generator_mode => circe2_data_set_generator_mode
<<SF circe2: sub interfaces>>=
module subroutine circe2_data_set_generator_mode (data, rng_factory)
class(circe2_data_t), intent(inout) :: data
class(rng_factory_t), intent(inout), allocatable :: rng_factory
end subroutine circe2_data_set_generator_mode
<<SF circe2: procedures>>=
module subroutine circe2_data_set_generator_mode (data, rng_factory)
class(circe2_data_t), intent(inout) :: data
class(rng_factory_t), intent(inout), allocatable :: rng_factory
call move_alloc (from = rng_factory, to = data%rng_factory)
end subroutine circe2_data_set_generator_mode
@ %def circe2_data_set_generator_mode
@ Check whether the requested data file is in the system directory or
in the current directory.
<<SF circe2: circe2 data: TBP>>=
procedure :: check_file => circe2_check_file
<<SF circe2: sub interfaces>>=
module subroutine circe2_check_file (data, os_data)
class(circe2_data_t), intent(inout) :: data
type(os_data_t), intent(in) :: os_data
end subroutine circe2_check_file
<<SF circe2: procedures>>=
module subroutine circe2_check_file (data, os_data)
class(circe2_data_t), intent(inout) :: data
type(os_data_t), intent(in) :: os_data
logical :: exist
type(string_t) :: file
file = data%filename
if (file == "") &
call msg_fatal ("CIRCE2: $circe2_file is not set")
inquire (file = char (file), exist = exist)
if (exist) then
data%file = file
else
file = os_data%whizard_circe2path // "/" // data%filename
inquire (file = char (file), exist = exist)
if (exist) then
data%file = file
else
call msg_fatal ("CIRCE2: data file '" // char (data%filename) &
// "' not found")
end if
end if
end subroutine circe2_check_file
@ %def circe2_check_file
@ Handle error conditions.
<<SF circe2: circe2 data: TBP>>=
procedure :: check => circe2_data_check
<<SF circe2: sub interfaces>>=
module subroutine circe2_data_check (data)
class(circe2_data_t), intent(in) :: data
end subroutine circe2_data_check
<<SF circe2: procedures>>=
module subroutine circe2_data_check (data)
class(circe2_data_t), intent(in) :: data
type(flavor_t) :: flv_photon, flv_electron
call flv_photon%init (PHOTON, data%model)
if (.not. flv_photon%is_defined ()) then
call msg_fatal ("CIRCE2: model must contain photon")
end if
call flv_electron%init (ELECTRON, data%model)
if (.not. flv_electron%is_defined ()) then
call msg_fatal ("CIRCE2: model must contain electron")
end if
if (any (abs (data%pdg_in) /= PHOTON .and. abs (data%pdg_in) /= ELECTRON)) &
then
call msg_fatal ("CIRCE2: applicable only for e+e- or photon collisions")
end if
select case (data%error)
case (-1)
call msg_fatal ("CIRCE2: data file not found.")
case (-2)
call msg_fatal ("CIRCE2: beam setup does not match data file.")
case (-3)
call msg_fatal ("CIRCE2: invalid format of data file.")
case (-4)
call msg_fatal ("CIRCE2: data file too large.")
end select
end subroutine circe2_data_check
@ %def circe2_data_check
@ Output
<<SF circe2: circe2 data: TBP>>=
procedure :: write => circe2_data_write
<<SF circe2: sub interfaces>>=
module subroutine circe2_data_write (data, unit, verbose)
class(circe2_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine circe2_data_write
<<SF circe2: procedures>>=
module subroutine circe2_data_write (data, unit, verbose)
class(circe2_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, h
logical :: verb
verb = .false.; if (present (verbose)) verb = verbose
u = given_output_unit (unit)
write (u, "(1x,A)") "CIRCE2 data:"
write (u, "(3x,A,A)") "file = ", char(data%filename)
write (u, "(3x,A,A)") "design = ", char(data%design)
write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", data%sqrts
write (u, "(3x,A,A,A,A)") "prt_in = ", &
char (data%flv_in(1)%get_name ()), &
", ", char (data%flv_in(2)%get_name ())
write (u, "(3x,A,L1)") "polarized = ", data%polarized
write (u, "(3x,A,L1)") "beams pol. = ", data%beams_polarized
write (u, "(3x,A," // FMT_19 // ")") "luminosity = ", data%lumi
if (data%polarized) then
do h = 1, 4
write (u, "(6x,'(',I2,1x,I2,')',1x,'=',1x)", advance="no") &
data%h1(h), data%h2(h)
write (u, "(6x, " // FMT_19 // ")") data%lumi_hel_frac(h)
end do
end if
if (verb) then
call data%rng_factory%write (u)
end if
end subroutine circe2_data_write
@ %def circe2_data_write
@ This is always in generator mode.
<<SF circe2: circe2 data: TBP>>=
procedure :: is_generator => circe2_data_is_generator
<<SF circe2: sub interfaces>>=
module function circe2_data_is_generator (data) result (flag)
class(circe2_data_t), intent(in) :: data
logical :: flag
end function circe2_data_is_generator
<<SF circe2: procedures>>=
module function circe2_data_is_generator (data) result (flag)
class(circe2_data_t), intent(in) :: data
logical :: flag
flag = .true.
end function circe2_data_is_generator
@ %def circe2_data_is_generator
@ The number of parameters is two, collinear splitting for
the two beams.
<<SF circe2: circe2 data: TBP>>=
procedure :: get_n_par => circe2_data_get_n_par
<<SF circe2: sub interfaces>>=
module function circe2_data_get_n_par (data) result (n)
class(circe2_data_t), intent(in) :: data
integer :: n
end function circe2_data_get_n_par
<<SF circe2: procedures>>=
module function circe2_data_get_n_par (data) result (n)
class(circe2_data_t), intent(in) :: data
integer :: n
n = 2
end function circe2_data_get_n_par
@ %def circe2_data_get_n_par
@ Return the outgoing particles PDG codes. They are equal to the
incoming ones.
<<SF circe2: circe2 data: TBP>>=
procedure :: get_pdg_out => circe2_data_get_pdg_out
<<SF circe2: sub interfaces>>=
module subroutine circe2_data_get_pdg_out (data, pdg_out)
class(circe2_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine circe2_data_get_pdg_out
<<SF circe2: procedures>>=
module subroutine circe2_data_get_pdg_out (data, pdg_out)
class(circe2_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer :: i, n
n = 2
do i = 1, n
pdg_out(i) = data%pdg_in(i)
end do
end subroutine circe2_data_get_pdg_out
@ %def circe2_data_get_pdg_out
@ Allocate the interaction record. Due to gfortran 7/8/9 bug has to
remain in the main module.
<<SF circe2: circe2 data: TBP>>=
procedure :: allocate_sf_int => circe2_data_allocate_sf_int
<<SF circe2: main procedures>>=
subroutine circe2_data_allocate_sf_int (data, sf_int)
class(circe2_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (circe2_t :: sf_int)
end subroutine circe2_data_allocate_sf_int
@ %def circe2_data_allocate_sf_int
@ Return the beam file.
<<SF circe2: circe2 data: TBP>>=
procedure :: get_beam_file => circe2_data_get_beam_file
<<SF circe2: sub interfaces>>=
module function circe2_data_get_beam_file (data) result (file)
class(circe2_data_t), intent(in) :: data
type(string_t) :: file
end function circe2_data_get_beam_file
<<SF circe2: procedures>>=
module function circe2_data_get_beam_file (data) result (file)
class(circe2_data_t), intent(in) :: data
type(string_t) :: file
file = "CIRCE2: " // data%filename
end function circe2_data_get_beam_file
@ %def circe2_data_get_beam_file
@
\subsection{Random Number Generator for CIRCE}
The CIRCE implementation now supports a generic random-number
generator object that allows for a local state as a component. To
support this, we must extend the abstract type provided by CIRCE and
delegate the generator call to the (also abstract) RNG used by WHIZARD.
<<SF circe2: types>>=
type, extends (circe2_rng_t) :: rng_obj_t
class(rng_t), allocatable :: rng
contains
procedure :: generate => rng_obj_generate
end type rng_obj_t
@ %def rng_obj_t
<<SF circe2: sub interfaces>>=
module subroutine rng_obj_generate (rng_obj, u)
class(rng_obj_t), intent(inout) :: rng_obj
real(default), intent(out) :: u
end subroutine rng_obj_generate
<<SF circe2: procedures>>=
module subroutine rng_obj_generate (rng_obj, u)
class(rng_obj_t), intent(inout) :: rng_obj
real(default), intent(out) :: u
real(default) :: x
call rng_obj%rng%generate (x)
u = x
end subroutine rng_obj_generate
@ %def rng_obj_generate
@
\subsection{The CIRCE2 object}
For CIRCE2 spectra it does not make sense to describe the state matrix
as a radiation interaction, even if photons originate from laser
backscattering. Instead, it is a $2\to 2$ interaction where the
incoming particles are identical to the outgoing ones.
The current implementation of CIRCE2 does support polarization and
classical correlations, but no entanglement, so the density matrix of
the outgoing particles is diagonal. The incoming particles are
unpolarized (user-defined polarization for beams is meaningless, since
polarization is described by the data file). The outgoing particles
are polarized or polarization-averaged, depending on user request.
When assigning matrix elements, we scan the previously initialized
state matrix. For each entry, we extract helicity and call the
structure function. In the unpolarized case, the helicity is
undefined and replaced by value zero. In the polarized case, there
are four entries. If the generator is used, only one entry is nonzero
in each call. Which one, is determined by comparing with a previously
(randomly, distributed by relative luminosity) selected pair of
helicities.
<<SF circe2: public>>=
public :: circe2_t
<<SF circe2: types>>=
type, extends (sf_int_t) :: circe2_t
type(circe2_data_t), pointer :: data => null ()
type(rng_obj_t) :: rng_obj
type(selector_t) :: selector
integer :: h_sel = 0
contains
<<SF circe2: circe2: TBP>>
end type circe2_t
@ %def circe2_t
@ Type string: show file and design of [[CIRCE2]] structure function.
<<SF circe2: circe2: TBP>>=
procedure :: type_string => circe2_type_string
<<SF circe2: sub interfaces>>=
module function circe2_type_string (object) result (string)
class(circe2_t), intent(in) :: object
type(string_t) :: string
end function circe2_type_string
<<SF circe2: procedures>>=
module function circe2_type_string (object) result (string)
class(circe2_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "CIRCE2: " // object%data%design
else
string = "CIRCE2: [undefined]"
end if
end function circe2_type_string
@ %def circe2_type_string
@
@ Output. Call the interaction routine after displaying the configuration.
<<SF circe2: circe2: TBP>>=
procedure :: write => circe2_write
<<SF circe2: sub interfaces>>=
module subroutine circe2_write (object, unit, testflag)
class(circe2_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine circe2_write
<<SF circe2: procedures>>=
module subroutine circe2_write (object, unit, testflag)
class(circe2_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "CIRCE2 data: [undefined]"
end if
end subroutine circe2_write
@ %def circe2_write
@
<<SF circe2: circe2: TBP>>=
procedure :: init => circe2_init
<<SF circe2: sub interfaces>>=
module subroutine circe2_init (sf_int, data)
class(circe2_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine circe2_init
<<SF circe2: procedures>>=
module subroutine circe2_init (sf_int, data)
class(circe2_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
logical, dimension(4) :: mask_h
real(default), dimension(2) :: m2_array
real(default), dimension(0) :: null_array
type(quantum_numbers_mask_t), dimension(4) :: mask
type(quantum_numbers_t), dimension(4) :: qn
type(helicity_t) :: hel
type(color_t) :: col0
integer :: h
select type (data)
type is (circe2_data_t)
if (data%polarized .and. data%beams_polarized) then
call msg_fatal ("CIRCE2: Beam polarization can't be set &
&for polarized data file")
else if (data%beams_polarized) then
call msg_warning ("CIRCE2: User-defined beam polarization set &
&for unpolarized CIRCE2 data file")
end if
mask_h(1:2) = .not. data%beams_polarized
mask_h(3:4) = .not. (data%polarized .or. data%beams_polarized)
mask = quantum_numbers_mask (.false., .false., mask_h)
m2_array(:) = (data%flv_in(:)%get_mass ())**2
call sf_int%base_init (mask, m2_array, null_array, m2_array)
sf_int%data => data
if (data%polarized) then
if (vanishes (sum (data%lumi_hel_frac)) .or. &
any (data%lumi_hel_frac < 0)) then
call msg_fatal ("CIRCE2: Helicity-dependent lumi " &
// "fractions all vanish or", &
[var_str ("are negative: Please inspect the " &
// "CIRCE2 file or "), &
var_str ("switch off the polarized" // &
" option for CIRCE2.")])
else
call sf_int%selector%init (data%lumi_hel_frac)
end if
end if
call col0%init ()
if (data%beams_polarized) then
do h = 1, 4
call hel%init (data%h1(h))
call qn(1)%init &
(flv = data%flv_in(1), col = col0, hel = hel)
call qn(3)%init &
(flv = data%flv_in(1), col = col0, hel = hel)
call hel%init (data%h2(h))
call qn(2)%init &
(flv = data%flv_in(2), col = col0, hel = hel)
call qn(4)%init &
(flv = data%flv_in(2), col = col0, hel = hel)
call sf_int%add_state (qn)
end do
else if (data%polarized) then
call qn(1)%init (flv = data%flv_in(1), col = col0)
call qn(2)%init (flv = data%flv_in(2), col = col0)
do h = 1, 4
call hel%init (data%h1(h))
call qn(3)%init &
(flv = data%flv_in(1), col = col0, hel = hel)
call hel%init (data%h2(h))
call qn(4)%init &
(flv = data%flv_in(2), col = col0, hel = hel)
call sf_int%add_state (qn)
end do
else
call qn(1)%init (flv = data%flv_in(1), col = col0)
call qn(2)%init (flv = data%flv_in(2), col = col0)
call qn(3)%init (flv = data%flv_in(1), col = col0)
call qn(4)%init (flv = data%flv_in(2), col = col0)
call sf_int%add_state (qn)
end if
call sf_int%freeze ()
call sf_int%set_incoming ([1,2])
call sf_int%set_outgoing ([3,4])
call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
sf_int%status = SF_INITIAL
end select
end subroutine circe2_init
@ %def circe2_init
@
\subsection{Kinematics}
Refer to the [[data]] component.
<<SF circe2: circe2: TBP>>=
procedure :: is_generator => circe2_is_generator
<<SF circe2: sub interfaces>>=
module function circe2_is_generator (sf_int) result (flag)
class(circe2_t), intent(in) :: sf_int
logical :: flag
end function circe2_is_generator
<<SF circe2: procedures>>=
module function circe2_is_generator (sf_int) result (flag)
class(circe2_t), intent(in) :: sf_int
logical :: flag
flag = sf_int%data%is_generator ()
end function circe2_is_generator
@ %def circe2_is_generator
@ Generate free parameters. We first select a helicity, which we have
to store, then generate $x$ values for that helicity.
<<SF circe2: circe2: TBP>>=
procedure :: generate_free => circe2_generate_whizard_free
<<SF circe2: sub interfaces>>=
module subroutine circe2_generate_whizard_free (sf_int, r, rb, x_free)
class(circe2_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
end subroutine circe2_generate_whizard_free
<<SF circe2: procedures>>=
module subroutine circe2_generate_whizard_free (sf_int, r, rb, x_free)
class(circe2_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: r, rb
real(default), intent(inout) :: x_free
integer :: h_sel
if (sf_int%data%polarized) then
call sf_int%selector%generate (sf_int%rng_obj%rng, h_sel)
else
h_sel = 0
end if
sf_int%h_sel = h_sel
call circe2_generate_whizard (r, sf_int%data%pdg_in, &
[sf_int%data%h1(h_sel), sf_int%data%h2(h_sel)], &
sf_int%rng_obj)
rb = 1 - r
x_free = x_free * product (r)
end subroutine circe2_generate_whizard_free
@ %def circe2_generate_whizard_free
@ Generator mode: call the CIRCE2 generator for the given particles
and helicities. (For unpolarized generation, helicities are zero.)
<<SF circe2: sub interfaces>>=
module subroutine circe2_generate_whizard (x, pdg, hel, rng_obj)
real(default), dimension(2), intent(out) :: x
integer, dimension(2), intent(in) :: pdg
integer, dimension(2), intent(in) :: hel
class(rng_obj_t), intent(inout) :: rng_obj
end subroutine circe2_generate_whizard
<<SF circe2: procedures>>=
module subroutine circe2_generate_whizard (x, pdg, hel, rng_obj)
real(default), dimension(2), intent(out) :: x
integer, dimension(2), intent(in) :: pdg
integer, dimension(2), intent(in) :: hel
class(rng_obj_t), intent(inout) :: rng_obj
call circe2_generate (circe2_global_state, rng_obj, x, pdg, hel)
end subroutine circe2_generate_whizard
@ %def circe2_generate_whizard
@ Set kinematics. Trivial here.
<<SF circe2: circe2: TBP>>=
procedure :: complete_kinematics => circe2_complete_kinematics
<<SF circe2: sub interfaces>>=
module subroutine circe2_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(circe2_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine circe2_complete_kinematics
<<SF circe2: procedures>>=
module subroutine circe2_complete_kinematics (sf_int, x, xb, f, r, rb, map)
class(circe2_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
if (map) then
call msg_fatal ("CIRCE2: map flag not supported")
else
x = r
xb= rb
f = 1
end if
call sf_int%reduce_momenta (x)
end subroutine circe2_complete_kinematics
@ %def circe2_complete_kinematics
@ Compute inverse kinematics.
<<SF circe2: circe2: TBP>>=
procedure :: inverse_kinematics => circe2_inverse_kinematics
<<SF circe2: sub interfaces>>=
module subroutine circe2_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(circe2_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine circe2_inverse_kinematics
<<SF circe2: procedures>>=
module subroutine circe2_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(circe2_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
call msg_fatal ("CIRCE2: map flag not supported")
else
r = x
rb= xb
f = 1
end if
if (set_mom) then
call sf_int%reduce_momenta (x)
end if
end subroutine circe2_inverse_kinematics
@ %def circe2_inverse_kinematics
@
\subsection{CIRCE2 application}
This function works on both beams. In polarized mode, we set only the
selected helicity. In unpolarized mode,
the interaction has only one entry, and the factor is unity.
<<SF circe2: circe2: TBP>>=
procedure :: apply => circe2_apply
<<SF circe2: sub interfaces>>=
module subroutine circe2_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(circe2_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine circe2_apply
<<SF circe2: procedures>>=
module subroutine circe2_apply (sf_int, scale, negative_sf, rescale, i_sub)
class(circe2_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
complex(default) :: f
associate (data => sf_int%data)
f = 1
if (data%beams_polarized) then
call sf_int%set_matrix_element (f)
else if (data%polarized) then
call sf_int%set_matrix_element (sf_int%h_sel, f)
else
call sf_int%set_matrix_element (1, f)
end if
end associate
sf_int%status = SF_EVALUATED
end subroutine circe2_apply
@ %def circe2_apply
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_circe2_ut.f90]]>>=
<<File header>>
module sf_circe2_ut
use unit_tests
use sf_circe2_uti
<<Standard module head>>
<<SF circe2: public test>>
contains
<<SF circe2: test driver>>
end module sf_circe2_ut
@ %def sf_circe2_ut
@
<<[[sf_circe2_uti.f90]]>>=
<<File header>>
module sf_circe2_uti
<<Use kinds>>
<<Use strings>>
use os_interface
use physics_defs, only: PHOTON
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use rng_base
use sf_aux
use sf_base
use sf_circe2
use rng_base_ut, only: rng_test_factory_t
<<Standard module head>>
<<SF circe2: test declarations>>
contains
<<SF circe2: tests>>
end module sf_circe2_uti
@ %def sf_circe2_ut
@ API: driver for the unit tests below.
<<SF circe2: public test>>=
public :: sf_circe2_test
<<SF circe2: test driver>>=
subroutine sf_circe2_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF circe2: execute tests>>
end subroutine sf_circe2_test
@ %def sf_circe2_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF circe2: execute tests>>=
call test (sf_circe2_1, "sf_circe2_1", &
"structure function configuration", &
u, results)
<<SF circe2: test declarations>>=
public :: sf_circe2_1
<<SF circe2: tests>>=
subroutine sf_circe2_1 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(pdg_array_t), dimension(2) :: pdg_in
type(pdg_array_t), dimension(2) :: pdg_out
integer, dimension(:), allocatable :: pdg1, pdg2
class(sf_data_t), allocatable :: data
class(rng_factory_t), allocatable :: rng_factory
write (u, "(A)") "* Test output: sf_circe2_1"
write (u, "(A)") "* Purpose: initialize and display &
&CIRCE structure function data"
write (u, "(A)")
write (u, "(A)") "* Create empty data object"
write (u, "(A)")
call os_data%init ()
call model%init_qed_test ()
pdg_in(1) = PHOTON
pdg_in(2) = PHOTON
allocate (circe2_data_t :: data)
allocate (rng_test_factory_t :: rng_factory)
write (u, "(A)")
write (u, "(A)") "* Initialize (unpolarized)"
write (u, "(A)")
select type (data)
type is (circe2_data_t)
call data%init (os_data, model, pdg_in, &
sqrts = 500._default, &
polarized = .false., &
beam_pol = .false., &
file = var_str ("teslagg_500_polavg.circe"), &
design = var_str ("TESLA/GG"))
call data%set_generator_mode (rng_factory)
end select
call data%write (u, verbose = .true.)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
pdg2 = pdg_out(2)
write (u, "(2x,99(1x,I0))") pdg1, pdg2
write (u, "(A)")
write (u, "(A)") "* Initialize (polarized)"
write (u, "(A)")
allocate (rng_test_factory_t :: rng_factory)
select type (data)
type is (circe2_data_t)
call data%init (os_data, model, pdg_in, &
sqrts = 500._default, &
polarized = .true., &
beam_pol = .false., &
file = var_str ("teslagg_500.circe"), &
design = var_str ("TESLA/GG"))
call data%set_generator_mode (rng_factory)
end select
call data%write (u, verbose = .true.)
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_circe2_1"
end subroutine sf_circe2_1
@ %def sf_circe2_1
@
\subsubsection{Generator mode, unpolarized}
Construct and evaluate a structure function object in generator mode.
<<SF circe2: execute tests>>=
call test (sf_circe2_2, "sf_circe2_2", &
"generator, unpolarized", &
u, results)
<<SF circe2: test declarations>>=
public :: sf_circe2_2
<<SF circe2: tests>>=
subroutine sf_circe2_2 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(flavor_t), dimension(2) :: flv
type(pdg_array_t), dimension(2) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(rng_factory_t), allocatable :: rng_factory
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k1, k2
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f, x_free
write (u, "(A)") "* Test output: sf_circe2_2"
write (u, "(A)") "* Purpose: initialize and fill &
&circe2 structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call os_data%init ()
call model%init_qed_test ()
call flv(1)%init (PHOTON, model)
call flv(2)%init (PHOTON, model)
pdg_in(1) = PHOTON
pdg_in(2) = PHOTON
call reset_interaction_counter ()
allocate (circe2_data_t :: data)
allocate (rng_test_factory_t :: rng_factory)
select type (data)
type is (circe2_data_t)
call data%init (os_data, model, pdg_in, &
sqrts = 500._default, &
polarized = .false., &
beam_pol = .false., &
file = var_str ("teslagg_500_polavg.circe"), &
design = var_str ("TESLA/GG"))
call data%set_generator_mode (rng_factory)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1,2])
select type (sf_int)
type is (circe2_t)
call sf_int%rng_obj%rng%init (3)
end select
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 250
k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
call vector4_write (k1, u)
call vector4_write (k2, u)
call sf_int%seed_kinematics ([k1, k2])
write (u, "(A)")
write (u, "(A)") "* Generate x"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0
rb = 0
x_free = 1
call sf_int%generate_free (r, rb, x_free)
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_int%apply (scale = 0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_circe2_2"
end subroutine sf_circe2_2
@ %def sf_circe2_2
@
\subsubsection{Generator mode, polarized}
Construct and evaluate a structure function object in generator mode.
<<SF circe2: execute tests>>=
call test (sf_circe2_3, "sf_circe2_3", &
"generator, polarized", &
u, results)
<<SF circe2: test declarations>>=
public :: sf_circe2_3
<<SF circe2: tests>>=
subroutine sf_circe2_3 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(flavor_t), dimension(2) :: flv
type(pdg_array_t), dimension(2) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(rng_factory_t), allocatable :: rng_factory
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k1, k2
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f, x_free
write (u, "(A)") "* Test output: sf_circe2_3"
write (u, "(A)") "* Purpose: initialize and fill &
&circe2 structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call os_data%init ()
call model%init_qed_test ()
call flv(1)%init (PHOTON, model)
call flv(2)%init (PHOTON, model)
pdg_in(1) = PHOTON
pdg_in(2) = PHOTON
call reset_interaction_counter ()
allocate (circe2_data_t :: data)
allocate (rng_test_factory_t :: rng_factory)
select type (data)
type is (circe2_data_t)
call data%init (os_data, model, pdg_in, &
sqrts = 500._default, &
polarized = .true., &
beam_pol = .false., &
file = var_str ("teslagg_500.circe"), &
design = var_str ("TESLA/GG"))
call data%set_generator_mode (rng_factory)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1,2])
select type (sf_int)
type is (circe2_t)
call sf_int%rng_obj%rng%init (3)
end select
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 250
k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
call vector4_write (k1, u)
call vector4_write (k2, u)
call sf_int%seed_kinematics ([k1, k2])
write (u, "(A)")
write (u, "(A)") "* Generate x"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0
rb = 0
x_free = 1
call sf_int%generate_free (r, rb, x_free)
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A,9(1x,F10.7))") "xf=", x_free
write (u, "(A)")
write (u, "(A)") "* Evaluate"
write (u, "(A)")
call sf_int%apply (scale = 0._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_circe2_3"
end subroutine sf_circe2_3
@ %def sf_circe2_3
@
\clearpage
%------------------------------------------------------------------------
\section{HOPPET interface}
Interface to the HOPPET wrapper necessary to perform
the LO vs. NLO matching of processes containing an initial
b quark.
<<[[hoppet_interface.f90]]>>=
<<File header>>
module hoppet_interface
use lhapdf !NODEP!
<<Standard module head>>
public :: hoppet_init, hoppet_eval
contains
subroutine hoppet_init (pdf_builtin, pdf, pdf_id)
logical, intent(in) :: pdf_builtin
type(lhapdf_pdf_t), intent(inout), optional :: pdf
integer, intent(in), optional :: pdf_id
external InitForWhizard
call InitForWhizard (pdf_builtin, pdf, pdf_id)
end subroutine hoppet_init
subroutine hoppet_eval (x, q, f)
double precision, intent(in) :: x, q
double precision, intent(out) :: f(-6:6)
external EvalForWhizard
call EvalForWhizard (x, q, f)
end subroutine hoppet_eval
end module hoppet_interface
@ %def hoppet_interface
@
\clearpage
%------------------------------------------------------------------------
\section{Builtin PDF sets}
For convenience in order not to depend on the external package LHAPDF,
we ship some PDFs with WHIZARD.
@
\subsection{The module}
<<[[sf_pdf_builtin.f90]]>>=
<<File header>>
module sf_pdf_builtin
<<Use kinds>>
use kinds, only: double
<<Use strings>>
use sm_qcd
use pdg_arrays
use model_data
use flavors
use polarizations
use sf_base
<<Standard module head>>
<<SF pdf builtin: public>>
<<SF pdf builtin: types>>
interface
<<SF pdf builtin: sub interfaces>>
end interface
contains
<<SF pdf builtin: main procedures>>
end module sf_pdf_builtin
@ %def sf_pdf_builtin
@
<<[[sf_pdf_builtin_sub.f90]]>>=
<<File header>>
submodule (sf_pdf_builtin) sf_pdf_builtin_s
use io_units
use format_defs, only: FMT_17
use diagnostics
use os_interface
use physics_defs, only: PROTON, PHOTON, GLUON
use physics_defs, only: HADRON_REMNANT_SINGLET
use physics_defs, only: HADRON_REMNANT_TRIPLET
use physics_defs, only: HADRON_REMNANT_OCTET
use lorentz
use colors
use quantum_numbers
use state_matrices
use pdf_builtin !NODEP!
use hoppet_interface
implicit none
<<SF pdf builtin: parameters>>
contains
<<SF pdf builtin: procedures>>
end submodule sf_pdf_builtin_s
@ %def sf_pdf_builtin_s
@
\subsection{Codes for default PDF sets}
<<SF pdf builtin: parameters>>=
character(*), parameter :: PDF_BUILTIN_DEFAULT_PROTON = "CTEQ6L"
! character(*), parameter :: PDF_BUILTIN_DEFAULT_PION = "NONE"
! character(*), parameter :: PDF_BUILTIN_DEFAULT_PHOTON = "MRST2004QEDp"
@ %def PDF_BUILTIN_DEFAULT_SET
@
\subsection{The PDF builtin data block}
The data block holds the incoming flavor (which has to be proton,
pion, or photon), the corresponding pointer to the global access data
(1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
bounds as returned by LHAPDF for the specified set, and a mask that
determines which partons will be actually in use.
<<SF pdf builtin: public>>=
public :: pdf_builtin_data_t
<<SF pdf builtin: types>>=
type, extends (sf_data_t) :: pdf_builtin_data_t
private
integer :: id = -1
type (string_t) :: name
class(model_data_t), pointer :: model => null ()
type(flavor_t) :: flv_in
logical :: invert
logical :: has_photon
logical :: photon
logical, dimension(-6:6) :: mask
logical :: mask_photon
logical :: hoppet_b_matching = .false.
contains
<<SF pdf builtin: pdf builtin data: TBP>>
end type pdf_builtin_data_t
@ %def pdf_builtin_data_t
@ Generate PDF data and initialize the requested set. Pion and photon PDFs
are disabled at the moment until we ship appropiate structure functions.
needed.
<<SF pdf builtin: pdf builtin data: TBP>>=
procedure :: init => pdf_builtin_data_init
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_data_init (data, &
model, pdg_in, name, path, hoppet_b_matching)
class(pdf_builtin_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
type(string_t), intent(in) :: name
type(string_t), intent(in) :: path
logical, intent(in), optional :: hoppet_b_matching
end subroutine pdf_builtin_data_init
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_data_init (data, &
model, pdg_in, name, path, hoppet_b_matching)
class(pdf_builtin_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
type(string_t), intent(in) :: name
type(string_t), intent(in) :: path
logical, intent(in), optional :: hoppet_b_matching
data%model => model
if (pdg_in%get_length () /= 1) &
call msg_fatal ("PDF: incoming particle must be unique")
call data%flv_in%init (pdg_in%get (1), model)
data%mask = .true.
data%mask_photon = .true.
select case (pdg_in%get (1))
case (PROTON)
data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
data%invert = .false.
data%photon = .false.
case (-PROTON)
data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
data%invert = .true.
data%photon = .false.
! case (PIPLUS)
! data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
! data%invert = .false.
! data%photon = .false.
! case (-PIPLUS)
! data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
! data%invert = .true.
! data%photon = .false.
! case (PHOTON)
! data%name = var_str (PDF_BUILTIN_DEFAULT_PHOTON)
! data%invert = .false.
! data%photon = .true.
case default
call msg_fatal ("PDF: " &
// "incoming particle must either proton or antiproton.")
return
end select
data%name = name
data%id = pdf_get_id (data%name)
if (data%id < 0) call msg_fatal ("unknown PDF set " // char (data%name))
data%has_photon = pdf_provides_photon (data%id)
if (present (hoppet_b_matching)) data%hoppet_b_matching = hoppet_b_matching
call pdf_init (data%id, path)
if (data%hoppet_b_matching) call hoppet_init (.true., pdf_id = data%id)
end subroutine pdf_builtin_data_init
@ %def pdf_builtin_data_init
@ Enable/disable partons explicitly. If a mask entry is true,
applying the PDF will generate the corresponding flavor on output.
<<SF pdf builtin: pdf builtin data: TBP>>=
procedure :: set_mask => pdf_builtin_data_set_mask
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_data_set_mask (data, mask)
class(pdf_builtin_data_t), intent(inout) :: data
logical, dimension(-6:6), intent(in) :: mask
end subroutine pdf_builtin_data_set_mask
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_data_set_mask (data, mask)
class(pdf_builtin_data_t), intent(inout) :: data
logical, dimension(-6:6), intent(in) :: mask
data%mask = mask
end subroutine pdf_builtin_data_set_mask
@ %def pdf_builtin_data_set_mask
@ Output.
<<SF pdf builtin: pdf builtin data: TBP>>=
procedure :: write => pdf_builtin_data_write
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_data_write (data, unit, verbose)
class(pdf_builtin_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine pdf_builtin_data_write
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_data_write (data, unit, verbose)
class(pdf_builtin_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "PDF builtin data:"
if (data%id < 0) then
write (u, "(3x,A)") "[undefined]"
return
end if
write (u, "(3x,A)", advance="no") "flavor = "
call data%flv_in%write (u); write (u, *)
write (u, "(3x,A,A)") "name = ", char (data%name)
write (u, "(3x,A,L1)") "invert = ", data%invert
write (u, "(3x,A,L1)") "has photon = ", data%has_photon
write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
"mask =", &
data%mask(-6:-1), "*", data%mask(0), "*", data%mask(1:6)
write (u, "(3x,A,L1)") "photon mask = ", data%mask_photon
write (u, "(3x,A,L1)") "hoppet_b = ", data%hoppet_b_matching
end subroutine pdf_builtin_data_write
@ %def pdf_builtin_data_write
@ The number of parameters is one. We do not generate transverse momentum.
<<SF pdf builtin: pdf builtin data: TBP>>=
procedure :: get_n_par => pdf_builtin_data_get_n_par
<<SF pdf builtin: sub interfaces>>=
module function pdf_builtin_data_get_n_par (data) result (n)
class(pdf_builtin_data_t), intent(in) :: data
integer :: n
end function pdf_builtin_data_get_n_par
<<SF pdf builtin: procedures>>=
module function pdf_builtin_data_get_n_par (data) result (n)
class(pdf_builtin_data_t), intent(in) :: data
integer :: n
n = 1
end function pdf_builtin_data_get_n_par
@ %def pdf_builtin_data_get_n_par
@ Return the outgoing particle PDG codes. This is based on the mask.
<<SF pdf builtin: pdf builtin data: TBP>>=
procedure :: get_pdg_out => pdf_builtin_data_get_pdg_out
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_data_get_pdg_out (data, pdg_out)
class(pdf_builtin_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine pdf_builtin_data_get_pdg_out
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_data_get_pdg_out (data, pdg_out)
class(pdf_builtin_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer, dimension(:), allocatable :: pdg1
integer :: n, np, i
n = count (data%mask)
np = 0; if (data%has_photon .and. data%mask_photon) np = 1
allocate (pdg1 (n + np))
pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
if (np == 1) pdg1(n+np) = PHOTON
pdg_out(1) = pdg1
end subroutine pdf_builtin_data_get_pdg_out
@ %def pdf_builtin_data_get_pdg_out
@ Allocate the interaction record. Due to gfortran 7/8/9 bug this has
to remain in the main module.
<<SF pdf builtin: pdf builtin data: TBP>>=
procedure :: allocate_sf_int => pdf_builtin_data_allocate_sf_int
<<SF pdf builtin: main procedures>>=
subroutine pdf_builtin_data_allocate_sf_int (data, sf_int)
class(pdf_builtin_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (pdf_builtin_t :: sf_int)
end subroutine pdf_builtin_data_allocate_sf_int
@ %def pdf_builtin_data_allocate_sf_int
@ Return the numerical PDF set index.
<<SF pdf builtin: pdf builtin data: TBP>>=
procedure :: get_pdf_set => pdf_builtin_data_get_pdf_set
<<SF pdf builtin: sub interfaces>>=
elemental module function pdf_builtin_data_get_pdf_set &
(data) result (pdf_set)
class(pdf_builtin_data_t), intent(in) :: data
integer :: pdf_set
end function pdf_builtin_data_get_pdf_set
<<SF pdf builtin: procedures>>=
elemental module function pdf_builtin_data_get_pdf_set &
(data) result (pdf_set)
class(pdf_builtin_data_t), intent(in) :: data
integer :: pdf_set
pdf_set = data%id
end function pdf_builtin_data_get_pdf_set
@ %def pdf_builtin_data_get_pdf_set
@
\subsection{The PDF object}
The PDF $1\to 2$ interaction which describes
the splitting of an (anti)proton into a parton and a beam remnant. We
stay in the strict forward-splitting limit, but allow some invariant
mass for the beam remnant such that the outgoing parton is exactly
massless. For a real event, we would replace this by a parton
cascade, where the outgoing partons have virtuality as dictated by
parton-shower kinematics, and transverse momentum is generated.
The PDF application is a $1\to 2$ splitting process, where the
particles are ordered as (hadron, remnant, parton).
Polarization is ignored completely. The beam particle is colorless,
while partons and beam remnant carry color. The remnant gets a
special flavor code.
<<SF pdf builtin: public>>=
public :: pdf_builtin_t
<<SF pdf builtin: types>>=
type, extends (sf_int_t) :: pdf_builtin_t
type(pdf_builtin_data_t), pointer :: data => null ()
real(default) :: x = 0
real(default) :: q = 0
contains
<<SF pdf builtin: pdf builtin: TBP>>
end type pdf_builtin_t
@ %def pdf_builtin_t
@ Type string: display the chosen PDF set.
<<SF pdf builtin: pdf builtin: TBP>>=
procedure :: type_string => pdf_builtin_type_string
<<SF pdf builtin: sub interfaces>>=
module function pdf_builtin_type_string (object) result (string)
class(pdf_builtin_t), intent(in) :: object
type(string_t) :: string
end function pdf_builtin_type_string
<<SF pdf builtin: procedures>>=
module function pdf_builtin_type_string (object) result (string)
class(pdf_builtin_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "PDF builtin: " // object%data%name
else
string = "PDF builtin: [undefined]"
end if
end function pdf_builtin_type_string
@ %def pdf_builtin_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF pdf builtin: pdf builtin: TBP>>=
procedure :: write => pdf_builtin_write
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_write (object, unit, testflag)
class(pdf_builtin_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine pdf_builtin_write
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_write (object, unit, testflag)
class(pdf_builtin_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
if (object%status >= SF_DONE_KINEMATICS) then
write (u, "(1x,A)") "SF parameters:"
write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
if (object%status >= SF_FAILED_EVALUATION) then
write (u, "(3x,A," // FMT_17 // ")") "Q =", object%q
end if
end if
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "PDF builtin data: [undefined]"
end if
end subroutine pdf_builtin_write
@ %def pdf_builtin_write
@ Initialize. We know that [[data]] will be of concrete type
[[sf_test_data_t]], but we have to cast this explicitly.
For this implementation, we set the incoming and outgoing masses equal
to the physical particle mass, but keep the radiated mass zero.
Optionally, we can provide minimum and maximum values for the momentum
transfer.
<<SF pdf builtin: pdf builtin: TBP>>=
procedure :: init => pdf_builtin_init
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_init (sf_int, data)
class(pdf_builtin_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine pdf_builtin_init
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_init (sf_int, data)
class(pdf_builtin_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(3) :: mask
type(flavor_t) :: flv, flv_remnant
type(color_t) :: col0
type(quantum_numbers_t), dimension(3) :: qn
integer :: i
select type (data)
type is (pdf_builtin_data_t)
mask = quantum_numbers_mask (.false., .false., .true.)
call col0%init ()
call sf_int%base_init (mask, [0._default], [0._default], [0._default])
sf_int%data => data
do i = -6, 6
if (data%mask(i)) then
call qn(1)%init (data%flv_in, col = col0)
if (i == 0) then
call flv%init (GLUON, data%model)
call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
else
call flv%init (i, data%model)
call flv_remnant%init &
(sign (HADRON_REMNANT_TRIPLET, -i), data%model)
end if
call qn(2)%init ( &
flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
call qn(2)%tag_radiated ()
call qn(3)%init ( &
flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
call sf_int%add_state (qn)
end if
end do
if (data%has_photon .and. data%mask_photon) then
call flv%init (PHOTON, data%model)
call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
call qn(2)%init (flv = flv_remnant, &
col = color_from_flavor (flv_remnant, 1))
call qn(2)%tag_radiated ()
call qn(3)%init (flv = flv, &
col = color_from_flavor (flv, 1, reverse = .true.))
call sf_int%add_state (qn)
end if
call sf_int%freeze ()
call sf_int%set_incoming ([1])
call sf_int%set_radiated ([2])
call sf_int%set_outgoing ([3])
sf_int%status = SF_INITIAL
end select
end subroutine pdf_builtin_init
@ %def pdf_builtin_init
@
\subsection{Kinematics}
Set kinematics. If [[map]] is unset, the $r$ and $x$ values
coincide, and the Jacobian $f(r)$ is trivial.
If [[map]] is set, we are asked to provide an efficient mapping.
For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
<<SF pdf builtin: pdf builtin: TBP>>=
procedure :: complete_kinematics => pdf_builtin_complete_kinematics
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine pdf_builtin_complete_kinematics
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
if (map) then
call msg_fatal ("PDF builtin: map flag not supported")
else
x(1) = r(1)
xb(1)= rb(1)
f = 1
end if
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_DONE_KINEMATICS)
sf_int%x = x(1)
case (SF_FAILED_KINEMATICS)
sf_int%x = 0
f = 0
end select
end subroutine pdf_builtin_complete_kinematics
@ %def pdf_builtin_complete_kinematics
@ Overriding the default method: we compute the [[x]] value from the
momentum configuration. In this specific case, we also set the
internally stored $x$ value, so it can be used in the
following routine.
<<SF pdf builtin: pdf builtin: TBP>>=
procedure :: recover_x => pdf_builtin_recover_x
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_recover_x (sf_int, x, xb, x_free)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
end subroutine pdf_builtin_recover_x
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_recover_x (sf_int, x, xb, x_free)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
call sf_int%base_recover_x (x, xb, x_free)
sf_int%x = x(1)
end subroutine pdf_builtin_recover_x
@ %def sf_pdf_builtin_recover_x
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
<<SF pdf builtin: pdf builtin: TBP>>=
procedure :: inverse_kinematics => pdf_builtin_inverse_kinematics
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine pdf_builtin_inverse_kinematics
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
call msg_fatal ("PDF builtin: map flag not supported")
else
r(1) = x(1)
rb(1)= xb(1)
f = 1
end if
if (set_mom) then
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end if
end subroutine pdf_builtin_inverse_kinematics
@ %def pdf_builtin_inverse_kinematics
@
\subsection{Structure function}
Once the scale is also known, we can actually call the PDF and
set the values. Contrary to LHAPDF, the wrapper already takes care of
adjusting to the $x$ and $Q$ bounds. Account for the Jacobian.
The parameter [[negative_sf]] is necessary to determine if we allow for negative PDF values.
The class [[rescale]] gives rescaling prescription for NLO convolution of the
structure function in combination with [[i_sub]].
<<SF pdf builtin: pdf builtin: TBP>>=
procedure :: apply => pdf_builtin_apply
<<SF pdf builtin: sub interfaces>>=
module subroutine pdf_builtin_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine pdf_builtin_apply
<<SF pdf builtin: procedures>>=
module subroutine pdf_builtin_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(pdf_builtin_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default), dimension(-6:6) :: ff
real(double), dimension(-6:6) :: ff_dbl
real(default) :: x, fph
real(double) :: xx, qq
complex(default), dimension(:), allocatable :: fc
integer :: i, j_sub, i_sub_opt
logical :: negative_sf_opt
i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
negative_sf_opt = .false.; if (present(negative_sf)) negative_sf_opt = negative_sf
associate (data => sf_int%data)
sf_int%q = scale
x = sf_int%x
if (present (rescale)) call rescale%apply (x)
if (debug2_active (D_BEAMS)) then
call msg_debug2 (D_BEAMS, "pdf_builtin_apply")
call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
call msg_debug2 (D_BEAMS, "x: ", x)
end if
xx = x
qq = scale
if (data%invert) then
if (data%has_photon) then
call pdf_evolve (data%id, x, scale, ff(6:-6:-1), fph)
else
if (data%hoppet_b_matching) then
call hoppet_eval (xx, qq, ff_dbl(6:-6:-1))
ff = ff_dbl
else
call pdf_evolve (data%id, x, scale, ff(6:-6:-1))
end if
end if
else
if (data%has_photon) then
call pdf_evolve (data%id, x, scale, ff, fph)
else
if (data%hoppet_b_matching) then
call hoppet_eval (xx, qq, ff_dbl)
ff = ff_dbl
else
call pdf_evolve (data%id, x, scale, ff)
end if
end if
end if
if (data%has_photon) then
allocate (fc (count ([data%mask, data%mask_photon])))
if (negative_sf_opt) then
fc = pack ([ff, fph], [data%mask, data%mask_photon])
else
fc = max( pack ([ff, fph], [data%mask, data%mask_photon]), 0._default)
end if
else
allocate (fc (count (data%mask)))
if (negative_sf_opt) then
fc = pack (ff, data%mask)
else
fc = max( pack (ff, data%mask), 0._default)
end if
end if
end associate
if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
sf_int%status = SF_EVALUATED
end subroutine pdf_builtin_apply
@ %def pdf_builtin_apply
@
\subsection{Strong Coupling}
Since the PDF codes provide a function for computing the running
$\alpha_s$ value, we make this available as an implementation of the
abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
<<SF pdf builtin: public>>=
public :: alpha_qcd_pdf_builtin_t
<<SF pdf builtin: types>>=
type, extends (alpha_qcd_t) :: alpha_qcd_pdf_builtin_t
type(string_t) :: pdfset_name
integer :: pdfset_id = -1
contains
<<SF pdf builtin: alpha qcd: TBP>>
end type alpha_qcd_pdf_builtin_t
@ %def alpha_qcd_pdf_builtin_t
@ Output.
<<SF pdf builtin: alpha qcd: TBP>>=
procedure :: write => alpha_qcd_pdf_builtin_write
<<SF pdf builtin: sub interfaces>>=
module subroutine alpha_qcd_pdf_builtin_write (object, unit)
class(alpha_qcd_pdf_builtin_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine alpha_qcd_pdf_builtin_write
<<SF pdf builtin: procedures>>=
module subroutine alpha_qcd_pdf_builtin_write (object, unit)
class(alpha_qcd_pdf_builtin_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A)") "QCD parameters (pdf_builtin):"
write (u, "(5x,A,A)") "PDF set = ", char (object%pdfset_name)
write (u, "(5x,A,I0)") "PDF ID = ", object%pdfset_id
end subroutine alpha_qcd_pdf_builtin_write
@ %def alpha_qcd_pdf_builtin_write
@ Calculation: the numeric ID selects the correct PDF set, which must
be properly initialized.
<<SF pdf builtin: alpha qcd: TBP>>=
procedure :: get => alpha_qcd_pdf_builtin_get
<<SF pdf builtin: sub interfaces>>=
module function alpha_qcd_pdf_builtin_get (alpha_qcd, scale) result (alpha)
class(alpha_qcd_pdf_builtin_t), intent(in) :: alpha_qcd
real(default), intent(in) :: scale
real(default) :: alpha
end function alpha_qcd_pdf_builtin_get
<<SF pdf builtin: procedures>>=
module function alpha_qcd_pdf_builtin_get (alpha_qcd, scale) result (alpha)
class(alpha_qcd_pdf_builtin_t), intent(in) :: alpha_qcd
real(default), intent(in) :: scale
real(default) :: alpha
alpha = pdf_alphas (alpha_qcd%pdfset_id, scale)
end function alpha_qcd_pdf_builtin_get
@ %def alpha_qcd_pdf_builtin_get
@
Initialization. We need to access the global initialization status.
<<SF pdf builtin: alpha qcd: TBP>>=
procedure :: init => alpha_qcd_pdf_builtin_init
<<SF pdf builtin: sub interfaces>>=
module subroutine alpha_qcd_pdf_builtin_init (alpha_qcd, name, path)
class(alpha_qcd_pdf_builtin_t), intent(out) :: alpha_qcd
type(string_t), intent(in) :: name
type(string_t), intent(in) :: path
end subroutine alpha_qcd_pdf_builtin_init
<<SF pdf builtin: procedures>>=
module subroutine alpha_qcd_pdf_builtin_init (alpha_qcd, name, path)
class(alpha_qcd_pdf_builtin_t), intent(out) :: alpha_qcd
type(string_t), intent(in) :: name
type(string_t), intent(in) :: path
alpha_qcd%pdfset_name = name
alpha_qcd%pdfset_id = pdf_get_id (name)
if (alpha_qcd%pdfset_id < 0) &
call msg_fatal ("QCD parameter initialization: PDF set " &
// char (name) // " is unknown")
call pdf_init (alpha_qcd%pdfset_id, path)
end subroutine alpha_qcd_pdf_builtin_init
@ %def alpha_qcd_pdf_builtin_init
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_pdf_builtin_ut.f90]]>>=
<<File header>>
module sf_pdf_builtin_ut
use unit_tests
use sf_pdf_builtin_uti
<<Standard module head>>
<<SF pdf builtin: public test>>
contains
<<SF pdf builtin: test driver>>
end module sf_pdf_builtin_ut
@ %def sf_pdf_builtin_ut
@
<<[[sf_pdf_builtin_uti.f90]]>>=
<<File header>>
module sf_pdf_builtin_uti
<<Use kinds>>
<<Use strings>>
use os_interface
use physics_defs, only: PROTON
use sm_qcd
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use sf_base
use sf_pdf_builtin
<<Standard module head>>
<<SF pdf builtin: test declarations>>
contains
<<SF pdf builtin: tests>>
end module sf_pdf_builtin_uti
@ %def sf_pdf_builtin_ut
@ API: driver for the unit tests below.
<<SF pdf builtin: public test>>=
public :: sf_pdf_builtin_test
<<SF pdf builtin: test driver>>=
subroutine sf_pdf_builtin_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF pdf builtin: execute tests>>
end subroutine sf_pdf_builtin_test
@ %def sf_pdf_builtin_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF pdf builtin: execute tests>>=
call test (sf_pdf_builtin_1, "sf_pdf_builtin_1", &
"structure function configuration", &
u, results)
<<SF pdf builtin: test declarations>>=
public :: sf_pdf_builtin_1
<<SF pdf builtin: tests>>=
subroutine sf_pdf_builtin_1 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(pdg_array_t), dimension(1) :: pdg_out
integer, dimension(:), allocatable :: pdg1
class(sf_data_t), allocatable :: data
type(string_t) :: name
write (u, "(A)") "* Test output: sf_pdf_builtin_1"
write (u, "(A)") "* Purpose: initialize and display &
&test structure function data"
write (u, "(A)")
write (u, "(A)") "* Create empty data object"
write (u, "(A)")
call os_data%init ()
call model%init_sm_test ()
pdg_in = PROTON
allocate (pdf_builtin_data_t :: data)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
name = "CTEQ6L"
select type (data)
type is (pdf_builtin_data_t)
call data%init (model, pdg_in, name, &
os_data%pdf_builtin_datapath)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(2x,99(1x,I0))") pdg1
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_pdf_builtin_1"
end subroutine sf_pdf_builtin_1
@ %def sf_pdf_builtin_1
@
\subsubsection{Test and probe structure function}
Construct and display a structure function object based on the PDF builtin
structure function.
<<SF pdf builtin: execute tests>>=
call test (sf_pdf_builtin_2, "sf_pdf_builtin_2", &
"structure function instance", &
u, results)
<<SF pdf builtin: test declarations>>=
public :: sf_pdf_builtin_2
<<SF pdf builtin: tests>>=
subroutine sf_pdf_builtin_2 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(string_t) :: name
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_pdf_builtin_2"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call os_data%init ()
call model%init_sm_test ()
call flv%init (PROTON, model)
pdg_in = PROTON
call reset_interaction_counter ()
name = "CTEQ6L"
allocate (pdf_builtin_data_t :: data)
select type (data)
type is (pdf_builtin_data_t)
call data%init (model, pdg_in, name, &
os_data%pdf_builtin_datapath)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.5_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A)")
write (u, "(A)") "* Evaluate for Q = 100 GeV"
write (u, "(A)")
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%apply (scale = 100._default)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_pdf_builtin_2"
end subroutine sf_pdf_builtin_2
@ %def sf_pdf_builtin_2
@
\subsubsection{Strong Coupling}
Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
type.
<<SF pdf builtin: execute tests>>=
call test (sf_pdf_builtin_3, "sf_pdf_builtin_3", &
"running alpha_s", &
u, results)
<<SF pdf builtin: test declarations>>=
public :: sf_pdf_builtin_3
<<SF pdf builtin: tests>>=
subroutine sf_pdf_builtin_3 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(qcd_t) :: qcd
type(string_t) :: name
write (u, "(A)") "* Test output: sf_pdf_builtin_3"
write (u, "(A)") "* Purpose: initialize and evaluate alpha_s"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call os_data%init ()
name = "CTEQ6L"
write (u, "(A)") "* Initialize qcd object"
write (u, "(A)")
allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
select type (alpha => qcd%alpha)
type is (alpha_qcd_pdf_builtin_t)
call alpha%init (name, os_data%pdf_builtin_datapath)
end select
call qcd%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for Q = 100"
write (u, "(A)")
write (u, "(1x,A,F8.5)") "alpha = ", qcd%alpha%get (100._default)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_pdf_builtin_3"
end subroutine sf_pdf_builtin_3
@ %def sf_pdf_builtin_3
@
\clearpage
%------------------------------------------------------------------------
\section{LHAPDF}
Parton distribution functions (PDFs) are available via an interface to
the LHAPDF standard library.
@
\subsection{The module}
<<[[sf_lhapdf.f90]]>>=
<<File header>>
module sf_lhapdf
<<Use kinds>>
<<Use strings>>
use sm_qcd
use pdg_arrays
use model_data
use flavors
use polarizations
use sf_base
use lhapdf !NODEP!
<<Standard module head>>
<<SF lhapdf: public>>
<<SF lhapdf: types>>
<<SF lhapdf: variables>>
<<SF lhapdf: interfaces>>
interface
<<SF lhapdf: sub interfaces>>
end interface
contains
<<SF lhapdf: main procedures>>
end module sf_lhapdf
@ %def sf_lhapdf
@
<<[[sf_lhapdf_sub.f90]]>>=
<<File header>>
submodule (sf_lhapdf) sf_lhapdf_s
use format_defs, only: FMT_17, FMT_19
use io_units
use system_dependencies, only: LHAPDF_PDFSETS_PATH
use system_dependencies, only: LHAPDF5_AVAILABLE
use system_dependencies, only: LHAPDF6_AVAILABLE
use diagnostics
use physics_defs, only: PROTON, PHOTON, PIPLUS, GLUON
use physics_defs, only: HADRON_REMNANT_SINGLET
use physics_defs, only: HADRON_REMNANT_TRIPLET
use physics_defs, only: HADRON_REMNANT_OCTET
use lorentz
use colors
use quantum_numbers
use state_matrices
use hoppet_interface
implicit none
<<SF lhapdf: parameters>>
contains
<<SF lhapdf: procedures>>
end submodule sf_lhapdf_s
@ %def sf_lhapdf_s
@
\subsection{Codes for default PDF sets}
The default PDF for protons set is chosen to be CTEQ6ll (LO fit with
LO $\alpha_s$).
<<SF lhapdf: parameters>>=
character(*), parameter :: LHAPDF5_DEFAULT_PROTON = "cteq6ll.LHpdf"
character(*), parameter :: LHAPDF5_DEFAULT_PION = "ABFKWPI.LHgrid"
character(*), parameter :: LHAPDF5_DEFAULT_PHOTON = "GSG960.LHgrid"
character(*), parameter :: LHAPDF6_DEFAULT_PROTON = "CT10"
@ %def LHAPDF5_DEFAULT_PROTON LHAPDF5_DEFAULT_PION
@ %def LHAPDF5_DEFAULT_PHOTON LHAPDF6_DEFAULT_PROTON
@
\subsection{LHAPDF library interface}
Here we specify explicit interfaces for all LHAPDF routines that we
use below.
<<SF lhapdf: interfaces>>=
interface
subroutine InitPDFsetM (set, file)
integer, intent(in) :: set
character(*), intent(in) :: file
end subroutine InitPDFsetM
end interface
@ %def InitPDFsetM
<<SF lhapdf: interfaces>>=
interface
subroutine InitPDFM (set, mem)
integer, intent(in) :: set, mem
end subroutine InitPDFM
end interface
@ %def InitPDFM
<<SF lhapdf: interfaces>>=
interface
subroutine numberPDFM (set, n_members)
integer, intent(in) :: set
integer, intent(out) :: n_members
end subroutine numberPDFM
end interface
@ %def numberPDFM
<<SF lhapdf: interfaces>>=
interface
subroutine evolvePDFM (set, x, q, ff)
integer, intent(in) :: set
double precision, intent(in) :: x, q
double precision, dimension(-6:6), intent(out) :: ff
end subroutine evolvePDFM
end interface
@ %def evolvePDFM
<<SF lhapdf: interfaces>>=
interface
subroutine evolvePDFphotonM (set, x, q, ff, fphot)
integer, intent(in) :: set
double precision, intent(in) :: x, q
double precision, dimension(-6:6), intent(out) :: ff
double precision, intent(out) :: fphot
end subroutine evolvePDFphotonM
end interface
@ %def evolvePDFphotonM
<<SF lhapdf: interfaces>>=
interface
subroutine evolvePDFpM (set, x, q, s, scheme, ff)
integer, intent(in) :: set
double precision, intent(in) :: x, q, s
integer, intent(in) :: scheme
double precision, dimension(-6:6), intent(out) :: ff
end subroutine evolvePDFpM
end interface
@ %def evolvePDFpM
<<SF lhapdf: interfaces>>=
interface
subroutine GetXminM (set, mem, xmin)
integer, intent(in) :: set, mem
double precision, intent(out) :: xmin
end subroutine GetXminM
end interface
@ %def GetXminM
<<SF lhapdf: interfaces>>=
interface
subroutine GetXmaxM (set, mem, xmax)
integer, intent(in) :: set, mem
double precision, intent(out) :: xmax
end subroutine GetXmaxM
end interface
@ %def GetXmaxM
<<SF lhapdf: interfaces>>=
interface
subroutine GetQ2minM (set, mem, q2min)
integer, intent(in) :: set, mem
double precision, intent(out) :: q2min
end subroutine GetQ2minM
end interface
@ %def GetQ2minM
<<SF lhapdf: interfaces>>=
interface
subroutine GetQ2maxM (set, mem, q2max)
integer, intent(in) :: set, mem
double precision, intent(out) :: q2max
end subroutine GetQ2maxM
end interface
@ %def GetQ2maxM
<<SF lhapdf: interfaces>>=
interface
function has_photon () result(flag)
logical :: flag
end function has_photon
end interface
@ %def has_photon
@
\subsection{The LHAPDF status}
This type holds the initialization status of the LHAPDF system. Entry
1 is for proton PDFs, entry 2 for pion PDFs, entry 3 for photon PDFs.
Since it is connected to the external LHAPDF library, this is a truly
global object. We implement it as a a private module variable. To
access it from elsewhere, the caller has to create and initialize an
object of type [[lhapdf_status_t]], which acts as a proxy.
<<SF lhapdf: types>>=
type :: lhapdf_global_status_t
private
logical, dimension(3) :: initialized = .false.
end type lhapdf_global_status_t
@ %def lhapdf_global_status_t
<<SF lhapdf: variables>>=
type(lhapdf_global_status_t), save :: lhapdf_global_status
@ %def lhapdf_global_status
<<SF lhapdf: procedures>>=
function lhapdf_global_status_is_initialized (set) result (flag)
logical :: flag
integer, intent(in), optional :: set
if (present (set)) then
select case (set)
case (1:3); flag = lhapdf_global_status%initialized(set)
case default; flag = .false.
end select
else
flag = any (lhapdf_global_status%initialized)
end if
end function lhapdf_global_status_is_initialized
@ %def lhapdf_global_status_is_initialized
<<SF lhapdf: procedures>>=
subroutine lhapdf_global_status_set_initialized (set)
integer, intent(in) :: set
lhapdf_global_status%initialized(set) = .true.
end subroutine lhapdf_global_status_set_initialized
@ %def lhapdf_global_status_set_initialized
@ This is the only public procedure, it tells the system to forget
about previous initialization, allowing for changing the chosen PDF
set. Note that such a feature works only if the global program flow
is serial, so no two distinct sets are accessed simultaneously. But
this applies to LHAPDF anyway.
<<SF lhapdf: public>>=
public :: lhapdf_global_reset
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_global_reset ()
end subroutine lhapdf_global_reset
<<SF lhapdf: procedures>>=
module subroutine lhapdf_global_reset ()
lhapdf_global_status%initialized = .false.
end subroutine lhapdf_global_reset
@ %def lhapdf_global_status_reset
@
\subsection{LHAPDF initialization}
Before using LHAPDF, we have to initialize it with a particular data
set and member. This applies not just if we use structure functions,
but also if we just use an $\alpha_s$ formula. The integer [[set]]
should be $1$ for proton, $2$ for pion, and $3$ for photon, but this
is just convention.
It appears as if LHAPDF does not allow for multiple data sets being
used concurrently (?), so multi-threaded usage with different sets
(e.g., a scan) is excluded. The current setup with a global flag that
indicates initialization is fine as long as Whizard itself is run in
serial mode at the Sindarin level. If we introduce multithreading in
any form from Sindarin, we have to rethink the implementation of the
LHAPDF interface. (The same considerations apply to builtin PDFs.)
If the particular set has already been initialized, do nothing. This
implies that whenever we want to change the setup for a particular
set, we have to reset the LHAPDF status.
[[lhapdf_initialize]] has an obvious name clash with [[lhapdf_init]],
the reason it works for [[pdf_builtin]] is that there things are
outsourced to a separate module (inc. [[lhapdf_status]] etc.).
<<SF lhapdf: public>>=
public :: lhapdf_initialize
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_initialize &
(set, prefix, file, member, pdf, b_match)
integer, intent(in) :: set
type(string_t), intent(inout) :: prefix
type(string_t), intent(inout) :: file
type(lhapdf_pdf_t), intent(inout), optional :: pdf
integer, intent(inout) :: member
logical, intent(in), optional :: b_match
end subroutine lhapdf_initialize
<<SF lhapdf: procedures>>=
module subroutine lhapdf_initialize &
(set, prefix, file, member, pdf, b_match)
integer, intent(in) :: set
type(string_t), intent(inout) :: prefix
type(string_t), intent(inout) :: file
type(lhapdf_pdf_t), intent(inout), optional :: pdf
integer, intent(inout) :: member
logical, intent(in), optional :: b_match
if (prefix == "") prefix = LHAPDF_PDFSETS_PATH
if (LHAPDF5_AVAILABLE) then
if (lhapdf_global_status_is_initialized (set)) return
if (file == "") then
select case (set)
case (1); file = LHAPDF5_DEFAULT_PROTON
case (2); file = LHAPDF5_DEFAULT_PION
case (3); file = LHAPDF5_DEFAULT_PHOTON
end select
end if
if (data_file_exists (prefix // "/" // file)) then
call InitPDFsetM (set, char (prefix // "/" // file))
else
call msg_fatal ("LHAPDF: Data file '" &
// char (file) // "' not found in '" // char (prefix) // "'.")
return
end if
if (.not. dataset_member_exists (set, member)) then
call msg_error (" LHAPDF: Chosen member does not exist for set '" &
// char (file) // "', using default.")
member = 0
end if
call InitPDFM (set, member)
else if (LHAPDF6_AVAILABLE) then
! TODO: (bcn 2015-07-07) we should have a closer look why this global
! check must not be executed
! if (lhapdf_global_status_is_initialized (set) .and. &
! pdf%is_associated ()) return
if (file == "") then
select case (set)
case (1); file = LHAPDF6_DEFAULT_PROTON
case (2);
call msg_fatal ("LHAPDF6: no pion PDFs supported")
case (3);
call msg_fatal ("LHAPDF6: no photon PDFs supported")
end select
end if
if (data_file_exists (prefix // "/" // file // "/" // file // ".info")) then
call pdf%init (char (file), member)
else
call msg_fatal ("LHAPDF: Data file '" &
// char (file) // "' not found in '" // char (prefix) // "'.")
return
end if
end if
if (present (b_match)) then
if (b_match) then
if (LHAPDF5_AVAILABLE) then
call hoppet_init (.false.)
else if (LHAPDF6_AVAILABLE) then
call hoppet_init (.false., pdf)
end if
end if
end if
call lhapdf_global_status_set_initialized (set)
contains
function data_file_exists (fq_name) result (exist)
type(string_t), intent(in) :: fq_name
logical :: exist
inquire (file = char(fq_name), exist = exist)
end function data_file_exists
function dataset_member_exists (set, member) result (exist)
integer, intent(in) :: set, member
logical :: exist
integer :: n_members
call numberPDFM (set, n_members)
exist = member >= 0 .and. member <= n_members
end function dataset_member_exists
end subroutine lhapdf_initialize
@ %def lhapdf_initialize
@
\subsection{Kinematics}
Set kinematics. If [[map]] is unset, the $r$ and $x$ values
coincide, and the Jacobian $f(r)$ is trivial.
If [[map]] is set, we are asked to provide an efficient mapping.
For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
<<SF lhapdf: lhapdf: TBP>>=
procedure :: complete_kinematics => lhapdf_complete_kinematics
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(lhapdf_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
end subroutine lhapdf_complete_kinematics
<<SF lhapdf: procedures>>=
module subroutine lhapdf_complete_kinematics &
(sf_int, x, xb, f, r, rb, map)
class(lhapdf_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(in) :: r
real(default), dimension(:), intent(in) :: rb
logical, intent(in) :: map
if (map) then
call msg_fatal ("LHAPDF: map flag not supported")
else
x(1) = r(1)
xb(1)= rb(1)
f = 1
end if
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_DONE_KINEMATICS)
sf_int%x = x(1)
case (SF_FAILED_KINEMATICS)
sf_int%x = 0
f = 0
end select
end subroutine lhapdf_complete_kinematics
@ %def lhapdf_complete_kinematics
@ Overriding the default method: we compute the [[x]] value from the
momentum configuration. In this specific case, we also set the
internally stored $x$ value, so it can be used in the
following routine.
<<SF lhapdf: lhapdf: TBP>>=
procedure :: recover_x => lhapdf_recover_x
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_recover_x (sf_int, x, xb, x_free)
class(lhapdf_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
end subroutine lhapdf_recover_x
<<SF lhapdf: procedures>>=
module subroutine lhapdf_recover_x (sf_int, x, xb, x_free)
class(lhapdf_t), intent(inout) :: sf_int
real(default), dimension(:), intent(out) :: x
real(default), dimension(:), intent(out) :: xb
real(default), intent(inout), optional :: x_free
call sf_int%base_recover_x (x, xb, x_free)
sf_int%x = x(1)
end subroutine lhapdf_recover_x
@ %def lhapdf_recover_x
@ Compute inverse kinematics. Here, we start with the $x$ array and
compute the ``input'' $r$ values and the Jacobian $f$. After this, we
can set momenta by the same formula as for normal kinematics.
<<SF lhapdf: lhapdf: TBP>>=
procedure :: inverse_kinematics => lhapdf_inverse_kinematics
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(lhapdf_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
end subroutine lhapdf_inverse_kinematics
<<SF lhapdf: procedures>>=
module subroutine lhapdf_inverse_kinematics &
(sf_int, x, xb, f, r, rb, map, set_momenta)
class(lhapdf_t), intent(inout) :: sf_int
real(default), dimension(:), intent(in) :: x
real(default), dimension(:), intent(in) :: xb
real(default), intent(out) :: f
real(default), dimension(:), intent(out) :: r
real(default), dimension(:), intent(out) :: rb
logical, intent(in) :: map
logical, intent(in), optional :: set_momenta
logical :: set_mom
set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
if (map) then
call msg_fatal ("LHAPDF: map flag not supported")
else
r(1) = x(1)
rb(1)= xb(1)
f = 1
end if
if (set_mom) then
call sf_int%split_momentum (x, xb)
select case (sf_int%status)
case (SF_FAILED_KINEMATICS); f = 0
end select
end if
end subroutine lhapdf_inverse_kinematics
@ %def lhapdf_inverse_kinematics
@
\subsection{The LHAPDF data block}
The data block holds the incoming flavor (which has to be proton,
pion, or photon), the corresponding pointer to the global access data
(1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
bounds as returned by LHAPDF for the specified set, and a mask that
determines which partons will be actually in use.
<<SF lhapdf: public>>=
public :: lhapdf_data_t
<<SF lhapdf: types>>=
type, extends (sf_data_t) :: lhapdf_data_t
private
type(string_t) :: prefix
type(string_t) :: file
type(lhapdf_pdf_t) :: pdf
integer :: member = 0
class(model_data_t), pointer :: model => null ()
type(flavor_t) :: flv_in
integer :: set = 0
logical :: invert = .false.
logical :: photon = .false.
logical :: has_photon = .false.
integer :: photon_scheme = 0
real(default) :: xmin = 0, xmax = 0
real(default) :: qmin = 0, qmax = 0
logical, dimension(-6:6) :: mask = .true.
logical :: mask_photon = .true.
logical :: hoppet_b_matching = .false.
contains
<<SF lhapdf: lhapdf data: TBP>>
end type lhapdf_data_t
@ %def lhapdf_data_t
@ Generate PDF data. This is provided as a function, but it has the
side-effect of initializing the requested PDF set. A finalizer is not
needed.
The library uses double precision, so since the default precision may be
extended or quadruple, we use auxiliary variables for type casting.
<<SF lhapdf: lhapdf data: TBP>>=
procedure :: init => lhapdf_data_init
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_data_init &
(data, model, pdg_in, prefix, file, member, photon_scheme, &
hoppet_b_matching)
class(lhapdf_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
type(string_t), intent(in), optional :: prefix, file
integer, intent(in), optional :: member
integer, intent(in), optional :: photon_scheme
logical, intent(in), optional :: hoppet_b_matching
end subroutine lhapdf_data_init
<<SF lhapdf: procedures>>=
module subroutine lhapdf_data_init &
(data, model, pdg_in, prefix, file, member, photon_scheme, &
hoppet_b_matching)
class(lhapdf_data_t), intent(out) :: data
class(model_data_t), intent(in), target :: model
type(pdg_array_t), intent(in) :: pdg_in
type(string_t), intent(in), optional :: prefix, file
integer, intent(in), optional :: member
integer, intent(in), optional :: photon_scheme
logical, intent(in), optional :: hoppet_b_matching
double precision :: xmin, xmax, q2min, q2max
external :: InitPDFsetM, InitPDFM, numberPDFM
external :: GetXminM, GetXmaxM, GetQ2minM, GetQ2maxM
if (.not. LHAPDF5_AVAILABLE .and. .not. LHAPDF6_AVAILABLE) then
call msg_fatal ("LHAPDF requested but library is not linked")
return
end if
data%model => model
if (pdg_in%get_length () /= 1) &
call msg_fatal ("PDF: incoming particle must be unique")
call data%flv_in%init (pdg_in%get (1), model)
select case (pdg_in%get (1))
case (PROTON)
data%set = 1
case (-PROTON)
data%set = 1
data%invert = .true.
case (PIPLUS)
data%set = 2
case (-PIPLUS)
data%set = 2
data%invert = .true.
case (PHOTON)
data%set = 3
data%photon = .true.
if (present (photon_scheme)) data%photon_scheme = photon_scheme
case default
call msg_fatal (" LHAPDF: " &
// "incoming particle must be (anti)proton, pion, or photon.")
return
end select
if (present (prefix)) then
data%prefix = prefix
else
data%prefix = ""
end if
if (present (file)) then
data%file = file
else
data%file = ""
end if
if (present (hoppet_b_matching)) data%hoppet_b_matching = hoppet_b_matching
if (LHAPDF5_AVAILABLE) then
call lhapdf_initialize (data%set, &
data%prefix, data%file, data%member, &
b_match = data%hoppet_b_matching)
call GetXminM (data%set, data%member, xmin)
call GetXmaxM (data%set, data%member, xmax)
call GetQ2minM (data%set, data%member, q2min)
call GetQ2maxM (data%set, data%member, q2max)
data%xmin = xmin
data%xmax = xmax
data%qmin = sqrt (q2min)
data%qmax = sqrt (q2max)
data%has_photon = has_photon ()
else if (LHAPDF6_AVAILABLE) then
call lhapdf_initialize (data%set, &
data%prefix, data%file, data%member, &
data%pdf, data%hoppet_b_matching)
data%xmin = data%pdf%getxmin ()
data%xmax = data%pdf%getxmax ()
data%qmin = sqrt(data%pdf%getq2min ())
data%qmax = sqrt(data%pdf%getq2max ())
data%has_photon = data%pdf%has_photon ()
end if
end subroutine lhapdf_data_init
@ %def lhapdf_data_init
@ Enable/disable partons explicitly. If a mask entry is true,
applying the PDF will generate the corresponding flavor on output.
<<LHAPDF: lhapdf data: TBP>>=
procedure :: set_mask => lhapdf_data_set_mask
<<LHAPDF: procedures>>=
subroutine lhapdf_data_set_mask (data, mask)
class(lhapdf_data_t), intent(inout) :: data
logical, dimension(-6:6), intent(in) :: mask
data%mask = mask
end subroutine lhapdf_data_set_mask
@ %def lhapdf_data_set_mask
@ Return the public part of the data set.
<<LHAPDF: public>>=
public :: lhapdf_data_get_public_info
<<LHAPDF: procedures>>=
subroutine lhapdf_data_get_public_info &
(data, lhapdf_dir, lhapdf_file, lhapdf_member)
type(lhapdf_data_t), intent(in) :: data
type(string_t), intent(out) :: lhapdf_dir, lhapdf_file
integer, intent(out) :: lhapdf_member
lhapdf_dir = data%prefix
lhapdf_file = data%file
lhapdf_member = data%member
end subroutine lhapdf_data_get_public_info
@ %def lhapdf_data_get_public_info
@ Return the number of the member of the data set.
<<LHAPDF: public>>=
public :: lhapdf_data_get_set
<<LHAPDF: procedures>>=
function lhapdf_data_get_set(data) result(set)
type(lhapdf_data_t), intent(in) :: data
integer :: set
set = data%set
end function lhapdf_data_get_set
@ %def lhapdf_data_get_set
@ Output
<<SF lhapdf: lhapdf data: TBP>>=
procedure :: write => lhapdf_data_write
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_data_write (data, unit, verbose)
class(lhapdf_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
end subroutine lhapdf_data_write
<<SF lhapdf: procedures>>=
module subroutine lhapdf_data_write (data, unit, verbose)
class(lhapdf_data_t), intent(in) :: data
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
logical :: verb
integer :: u
if (present (verbose)) then
verb = verbose
else
verb = .false.
end if
u = given_output_unit (unit); if (u < 0) return
write (u, "(1x,A)") "LHAPDF data:"
if (data%set /= 0) then
write (u, "(3x,A)", advance="no") "flavor = "
call data%flv_in%write (u); write (u, *)
if (verb) then
write (u, "(3x,A,A)") " prefix = ", char (data%prefix)
else
write (u, "(3x,A,A)") " prefix = ", &
" <empty (non-verbose version)>"
end if
write (u, "(3x,A,A)") " file = ", char (data%file)
write (u, "(3x,A,I3)") " member = ", data%member
write (u, "(3x,A," // FMT_19 // ")") " x(min) = ", data%xmin
write (u, "(3x,A," // FMT_19 // ")") " x(max) = ", data%xmax
write (u, "(3x,A," // FMT_19 // ")") " Q(min) = ", data%qmin
write (u, "(3x,A," // FMT_19 // ")") " Q(max) = ", data%qmax
write (u, "(3x,A,L1)") " invert = ", data%invert
if (data%photon) write (u, "(3x,A,I3)") &
" IP2 (scheme) = ", data%photon_scheme
write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
" mask = ", &
data%mask(-6:-1), "*", data%mask(0), "*", data%mask(1:6)
write (u, "(3x,A,L1)") " photon mask = ", data%mask_photon
if (data%set == 1) write (u, "(3x,A,L1)") &
" hoppet_b = ", data%hoppet_b_matching
else
write (u, "(3x,A)") "[undefined]"
end if
end subroutine lhapdf_data_write
@ %def lhapdf_data_write
@ The number of parameters is one. We do not generate transverse momentum.
<<SF lhapdf: lhapdf data: TBP>>=
procedure :: get_n_par => lhapdf_data_get_n_par
<<SF lhapdf: sub interfaces>>=
module function lhapdf_data_get_n_par (data) result (n)
class(lhapdf_data_t), intent(in) :: data
integer :: n
end function lhapdf_data_get_n_par
<<SF lhapdf: procedures>>=
module function lhapdf_data_get_n_par (data) result (n)
class(lhapdf_data_t), intent(in) :: data
integer :: n
n = 1
end function lhapdf_data_get_n_par
@ %def lhapdf_data_get_n_par
@ Return the outgoing particle PDG codes. This is based on the mask.
<<SF lhapdf: lhapdf data: TBP>>=
procedure :: get_pdg_out => lhapdf_data_get_pdg_out
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_data_get_pdg_out (data, pdg_out)
class(lhapdf_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
end subroutine lhapdf_data_get_pdg_out
<<SF lhapdf: procedures>>=
module subroutine lhapdf_data_get_pdg_out (data, pdg_out)
class(lhapdf_data_t), intent(in) :: data
type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
integer, dimension(:), allocatable :: pdg1
integer :: n, np, i
n = count (data%mask)
np = 0; if (data%has_photon .and. data%mask_photon) np = 1
allocate (pdg1 (n + np))
pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
if (np == 1) pdg1(n+np) = PHOTON
pdg_out(1) = pdg1
end subroutine lhapdf_data_get_pdg_out
@ %def lhapdf_data_get_pdg_out
@ Allocate the interaction record. Due to a gfortran 7/8/9 bug this
has to remain in the main module.
<<SF lhapdf: lhapdf data: TBP>>=
procedure :: allocate_sf_int => lhapdf_data_allocate_sf_int
<<SF lhapdf: main procedures>>=
subroutine lhapdf_data_allocate_sf_int (data, sf_int)
class(lhapdf_data_t), intent(in) :: data
class(sf_int_t), intent(inout), allocatable :: sf_int
allocate (lhapdf_t :: sf_int)
end subroutine lhapdf_data_allocate_sf_int
@ %def lhapdf_data_allocate_sf_int
@ Return the numerical PDF set index.
<<SF lhapdf: lhapdf data: TBP>>=
procedure :: get_pdf_set => lhapdf_data_get_pdf_set
<<SF lhapdf: sub interfaces>>=
elemental module function lhapdf_data_get_pdf_set (data) result (pdf_set)
class(lhapdf_data_t), intent(in) :: data
integer :: pdf_set
end function lhapdf_data_get_pdf_set
<<SF lhapdf: procedures>>=
elemental module function lhapdf_data_get_pdf_set (data) result (pdf_set)
class(lhapdf_data_t), intent(in) :: data
integer :: pdf_set
pdf_set = data%set
end function lhapdf_data_get_pdf_set
@ %def lhapdf_data_get_pdf_set
@
\subsection{The LHAPDF object}
The [[lhapdf_t]] data type is a $1\to 2$ interaction which describes
the splitting of an (anti)proton into a parton and a beam remnant. We
stay in the strict forward-splitting limit, but allow some invariant
mass for the beam remnant such that the outgoing parton is exactly
massless. For a real event, we would replace this by a parton
cascade, where the outgoing partons have virtuality as dictated by
parton-shower kinematics, and transverse momentum is generated.
This is the LHAPDF object which holds input data together with the
interaction. We also store the $x$ momentum fraction and the scale,
since kinematics and function value are requested at different times.
The PDF application is a $1\to 2$ splitting process, where the
particles are ordered as (hadron, remnant, parton).
Polarization is ignored completely. The beam particle is colorless,
while partons and beam remnant carry color. The remnant gets a
special flavor code.
<<SF lhapdf: public>>=
public :: lhapdf_t
<<SF lhapdf: types>>=
type, extends (sf_int_t) :: lhapdf_t
type(lhapdf_data_t), pointer :: data => null ()
real(default) :: x = 0
real(default) :: q = 0
real(default) :: s = 0
contains
<<SF lhapdf: lhapdf: TBP>>
end type lhapdf_t
@ %def lhapdf_t
@ Type string: display the chosen PDF set.
<<SF lhapdf: lhapdf: TBP>>=
procedure :: type_string => lhapdf_type_string
<<SF lhapdf: sub interfaces>>=
module function lhapdf_type_string (object) result (string)
class(lhapdf_t), intent(in) :: object
type(string_t) :: string
end function lhapdf_type_string
<<SF lhapdf: procedures>>=
module function lhapdf_type_string (object) result (string)
class(lhapdf_t), intent(in) :: object
type(string_t) :: string
if (associated (object%data)) then
string = "LHAPDF: " // object%data%file
else
string = "LHAPDF: [undefined]"
end if
end function lhapdf_type_string
@ %def lhapdf_type_string
@ Output. Call the interaction routine after displaying the configuration.
<<SF lhapdf: lhapdf: TBP>>=
procedure :: write => lhapdf_write
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_write (object, unit, testflag)
class(lhapdf_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine lhapdf_write
<<SF lhapdf: procedures>>=
module subroutine lhapdf_write (object, unit, testflag)
class(lhapdf_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
if (associated (object%data)) then
call object%data%write (u)
if (object%status >= SF_DONE_KINEMATICS) then
write (u, "(1x,A)") "SF parameters:"
write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
if (object%status >= SF_FAILED_EVALUATION) then
write (u, "(3x,A," // FMT_17 // ")") "Q =", object%q
end if
end if
call object%base_write (u, testflag)
else
write (u, "(1x,A)") "LHAPDF data: [undefined]"
end if
end subroutine lhapdf_write
@ %def lhapdf_write
@ Initialize. We know that [[data]] will be of concrete type
[[sf_lhapdf_data_t]], but we have to cast this explicitly.
For this implementation, we set the incoming and outgoing masses equal
to the physical particle mass, but keep the radiated mass zero.
<<SF lhapdf: lhapdf: TBP>>=
procedure :: init => lhapdf_init
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_init (sf_int, data)
class(lhapdf_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
end subroutine lhapdf_init
<<SF lhapdf: procedures>>=
module subroutine lhapdf_init (sf_int, data)
class(lhapdf_t), intent(out) :: sf_int
class(sf_data_t), intent(in), target :: data
type(quantum_numbers_mask_t), dimension(3) :: mask
type(flavor_t) :: flv, flv_remnant
type(color_t) :: col0
type(quantum_numbers_t), dimension(3) :: qn
integer :: i
select type (data)
type is (lhapdf_data_t)
mask = quantum_numbers_mask (.false., .false., .true.)
call col0%init ()
call sf_int%base_init (mask, [0._default], [0._default], [0._default])
sf_int%data => data
do i = -6, 6
if (data%mask(i)) then
call qn(1)%init (data%flv_in, col = col0)
if (i == 0) then
call flv%init (GLUON, data%model)
call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
else
call flv%init (i, data%model)
call flv_remnant%init &
(sign (HADRON_REMNANT_TRIPLET, -i), data%model)
end if
call qn(2)%init ( &
flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
call qn(2)%tag_radiated ()
call qn(3)%init ( &
flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
call sf_int%add_state (qn)
end if
end do
if (data%has_photon .and. data%mask_photon) then
call flv%init (PHOTON, data%model)
call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
call qn(2)%init (flv = flv_remnant, &
col = color_from_flavor (flv_remnant, 1))
call qn(2)%tag_radiated ()
call qn(3)%init (flv = flv, &
col = color_from_flavor (flv, 1, reverse=.true.))
call sf_int%add_state (qn)
end if
call sf_int%freeze ()
call sf_int%set_incoming ([1])
call sf_int%set_radiated ([2])
call sf_int%set_outgoing ([3])
sf_int%status = SF_INITIAL
end select
end subroutine lhapdf_init
@ %def lhapdf_init
@
\subsection{Structure function}
We have to cast the LHAPDF arguments to/from double precision (possibly
from/to extended/quadruple precision), if necessary.
Some structure functions can yield negative results (sea quarks close
to $x=1$). In an NLO computation, this is perfectly fine and we keep negative values.
Unlike total cross sections, PDFs do not have to be positive definite. For LO however,
negative PDFs would cause negative event weights so we set these values to zero instead.
<<SF lhapdf: lhapdf: TBP>>=
procedure :: apply => lhapdf_apply
<<SF lhapdf: sub interfaces>>=
module subroutine lhapdf_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(lhapdf_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
end subroutine lhapdf_apply
<<SF lhapdf: procedures>>=
module subroutine lhapdf_apply &
(sf_int, scale, negative_sf, rescale, i_sub)
class(lhapdf_t), intent(inout) :: sf_int
real(default), intent(in) :: scale
logical, intent(in), optional :: negative_sf
class(sf_rescale_t), intent(in), optional :: rescale
integer, intent(in), optional :: i_sub
real(default) :: x, s
double precision :: xx, qq, ss
double precision, dimension(-6:6) :: ff
double precision :: fphot
complex(default), dimension(:), allocatable :: fc
integer :: i, i_sub_opt, j_sub
logical :: negative_sf_opt
external :: evolvePDFM, evolvePDFpM
i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
negative_sf_opt = .false.; if (present(negative_sf)) negative_sf_opt = negative_sf
associate (data => sf_int%data)
sf_int%q = scale
x = sf_int%x
if (present (rescale)) call rescale%apply (x)
s = sf_int%s
xx = x
if (debug2_active (D_BEAMS)) then
call msg_debug2 (D_BEAMS, "lhapdf_apply")
call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
call msg_debug2 (D_BEAMS, "x: ", x)
end if
qq = min (data%qmax, scale)
qq = max (data%qmin, qq)
if (.not. data%photon) then
if (data%invert) then
if (data%has_photon) then
if (LHAPDF5_AVAILABLE) then
call evolvePDFphotonM &
(data%set, xx, qq, ff(6:-6:-1), fphot)
else if (LHAPDF6_AVAILABLE) then
call data%pdf%evolve_pdfphotonm &
(xx, qq, ff(6:-6:-1), fphot)
end if
else
if (data%hoppet_b_matching) then
call hoppet_eval (xx, qq, ff(6:-6:-1))
else
if (LHAPDF5_AVAILABLE) then
call evolvePDFM (data%set, xx, qq, ff(6:-6:-1))
else if (LHAPDF6_AVAILABLE) then
call data%pdf%evolve_pdfm (xx, qq, ff(6:-6:-1))
end if
end if
end if
else
if (data%has_photon) then
if (LHAPDF5_AVAILABLE) then
call evolvePDFphotonM (data%set, xx, qq, ff, fphot)
else if (LHAPDF6_AVAILABLE) then
call data%pdf%evolve_pdfphotonm (xx, qq, ff, fphot)
end if
else
if (data%hoppet_b_matching) then
call hoppet_eval (xx, qq, ff)
else
if (LHAPDF5_AVAILABLE) then
call evolvePDFM (data%set, xx, qq, ff)
else if (LHAPDF6_AVAILABLE) then
call data%pdf%evolve_pdfm (xx, qq, ff)
end if
end if
end if
end if
else
ss = s
if (LHAPDF5_AVAILABLE) then
call evolvePDFpM (data%set, xx, qq, &
ss, data%photon_scheme, ff)
else if (LHAPDF6_AVAILABLE) then
call data%pdf%evolve_pdfpm (xx, qq, ss, &
data%photon_scheme, ff)
end if
end if
if (data%has_photon) then
allocate (fc (count ([data%mask, data%mask_photon])))
if (negative_sf_opt) then
fc = pack ([ff, fphot] / x, [data%mask, data%mask_photon])
else
fc = max( pack ([ff, fphot] / x, [data%mask, data%mask_photon]), 0._default)
end if
else
allocate (fc (count (data%mask)))
if (negative_sf_opt) then
fc = pack (ff / x, data%mask)
else
fc = max( pack (ff / x, data%mask), 0._default)
end if
end if
end associate
if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
sf_int%status = SF_EVALUATED
end subroutine lhapdf_apply
@ %def apply_lhapdf
@
\subsection{Strong Coupling}
Since the PDF codes provide a function for computing the running
$\alpha_s$ value, we make this available as an implementation of the
abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
<<SF lhapdf: public>>=
public :: alpha_qcd_lhapdf_t
<<SF lhapdf: types>>=
type, extends (alpha_qcd_t) :: alpha_qcd_lhapdf_t
type(string_t) :: pdfset_dir
type(string_t) :: pdfset_file
integer :: pdfset_member = -1
type(lhapdf_pdf_t) :: pdf
contains
<<SF lhapdf: alpha qcd: TBP>>
end type alpha_qcd_lhapdf_t
@ %def alpha_qcd_lhapdf_t
@ Output. As in earlier versions we leave the LHAPDF path out.
<<SF lhapdf: alpha qcd: TBP>>=
procedure :: write => alpha_qcd_lhapdf_write
<<SF lhapdf: sub interfaces>>=
module subroutine alpha_qcd_lhapdf_write (object, unit)
class(alpha_qcd_lhapdf_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine alpha_qcd_lhapdf_write
<<SF lhapdf: procedures>>=
module subroutine alpha_qcd_lhapdf_write (object, unit)
class(alpha_qcd_lhapdf_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A)") "QCD parameters (lhapdf):"
write (u, "(5x,A,A)") "PDF set = ", char (object%pdfset_file)
write (u, "(5x,A,I0)") "PDF member = ", object%pdfset_member
end subroutine alpha_qcd_lhapdf_write
@ %def alpha_qcd_lhapdf_write
@ Calculation: the numeric member ID selects the correct PDF set, which must
be properly initialized.
<<SF lhapdf: interfaces>>=
interface
double precision function alphasPDF (Q)
double precision, intent(in) :: Q
end function alphasPDF
end interface
@ %def alphasPDF
@
<<SF lhapdf: alpha qcd: TBP>>=
procedure :: get => alpha_qcd_lhapdf_get
<<SF lhapdf: sub interfaces>>=
module function alpha_qcd_lhapdf_get (alpha_qcd, scale) result (alpha)
class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
real(default), intent(in) :: scale
real(default) :: alpha
end function alpha_qcd_lhapdf_get
<<SF lhapdf: procedures>>=
module function alpha_qcd_lhapdf_get (alpha_qcd, scale) result (alpha)
class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
real(default), intent(in) :: scale
real(default) :: alpha
if (LHAPDF5_AVAILABLE) then
alpha = alphasPDF (dble (scale))
else if (LHAPDF6_AVAILABLE) then
alpha = alpha_qcd%pdf%alphas_pdf (dble (scale))
end if
end function alpha_qcd_lhapdf_get
@ %def alpha_qcd_lhapdf_get
@
Initialization. We need to access the (quasi-global) initialization status.
<<SF lhapdf: alpha qcd: TBP>>=
procedure :: init => alpha_qcd_lhapdf_init
<<SF lhapdf: sub interfaces>>=
module subroutine alpha_qcd_lhapdf_init (alpha_qcd, file, member, path)
class(alpha_qcd_lhapdf_t), intent(out) :: alpha_qcd
type(string_t), intent(inout) :: file
integer, intent(inout) :: member
type(string_t), intent(inout) :: path
end subroutine alpha_qcd_lhapdf_init
<<SF lhapdf: procedures>>=
module subroutine alpha_qcd_lhapdf_init (alpha_qcd, file, member, path)
class(alpha_qcd_lhapdf_t), intent(out) :: alpha_qcd
type(string_t), intent(inout) :: file
integer, intent(inout) :: member
type(string_t), intent(inout) :: path
alpha_qcd%pdfset_file = file
alpha_qcd%pdfset_member = member
if (alpha_qcd%pdfset_member < 0) &
call msg_fatal ("QCD parameter initialization: PDF set " &
// char (file) // " is unknown")
if (LHAPDF5_AVAILABLE) then
call lhapdf_initialize (1, path, file, member)
else if (LHAPDF6_AVAILABLE) then
call lhapdf_initialize &
(1, path, file, member, alpha_qcd%pdf)
end if
end subroutine alpha_qcd_lhapdf_init
@ %def alpha_qcd_lhapdf_init
+@ Retrieves the quark masses from the PDF.
+<<SF lhapdf: alpha qcd: TBP>>=
+ procedure :: get_qmass => alpha_qcd_lhapdf_get_qmass
+<<SF lhapdf: sub interfaces>>=
+ module function alpha_qcd_lhapdf_get_qmass (alpha_qcd, i_q) result (mq)
+ real(default) :: mq
+ class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
+ integer, intent(in) :: i_q
+ end function alpha_qcd_lhapdf_get_qmass
+<<SF lhapdf: procedures>>=
+ module function alpha_qcd_lhapdf_get_qmass (alpha_qcd, i_q) result (mq)
+ real(default) :: mq
+ class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
+ integer, intent(in) :: i_q
+ mq = alpha_qcd%pdf%get_qmass (i_q)
+ end function alpha_qcd_lhapdf_get_qmass
+
+@ %def alpha_qcd_lhapdf_get_qmass
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[sf_lhapdf_ut.f90]]>>=
<<File header>>
module sf_lhapdf_ut
use unit_tests
use system_dependencies, only: LHAPDF5_AVAILABLE
use system_dependencies, only: LHAPDF6_AVAILABLE
use sf_lhapdf_uti
<<Standard module head>>
<<SF lhapdf: public test>>
contains
<<SF lhapdf: test driver>>
end module sf_lhapdf_ut
@ %def sf_lhapdf_ut
@
<<[[sf_lhapdf_uti.f90]]>>=
<<File header>>
module sf_lhapdf_uti
<<Use kinds>>
<<Use strings>>
use system_dependencies, only: LHAPDF5_AVAILABLE
use system_dependencies, only: LHAPDF6_AVAILABLE
use os_interface
use physics_defs, only: PROTON
use sm_qcd
use lorentz
use pdg_arrays
use flavors
use interactions, only: reset_interaction_counter
use model_data
use sf_base
use sf_lhapdf
<<Standard module head>>
<<SF lhapdf: test declarations>>
contains
<<SF lhapdf: tests>>
end module sf_lhapdf_uti
@ %def sf_lhapdf_ut
@ API: driver for the unit tests below.
<<SF lhapdf: public test>>=
public :: sf_lhapdf_test
<<SF lhapdf: test driver>>=
subroutine sf_lhapdf_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<SF lhapdf: execute tests>>
end subroutine sf_lhapdf_test
@ %def sf_lhapdf_test
@
\subsubsection{Test structure function data}
Construct and display a test structure function data object.
<<SF lhapdf: execute tests>>=
if (LHAPDF5_AVAILABLE) then
call test (sf_lhapdf_1, "sf_lhapdf5_1", &
"structure function configuration", &
u, results)
else if (LHAPDF6_AVAILABLE) then
call test (sf_lhapdf_1, "sf_lhapdf6_1", &
"structure function configuration", &
u, results)
end if
<<SF lhapdf: test declarations>>=
public :: sf_lhapdf_1
<<SF lhapdf: tests>>=
subroutine sf_lhapdf_1 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(pdg_array_t) :: pdg_in
type(pdg_array_t), dimension(1) :: pdg_out
integer, dimension(:), allocatable :: pdg1
class(sf_data_t), allocatable :: data
write (u, "(A)") "* Test output: sf_lhapdf_1"
write (u, "(A)") "* Purpose: initialize and display &
&test structure function data"
write (u, "(A)")
write (u, "(A)") "* Create empty data object"
write (u, "(A)")
call model%init_sm_test ()
pdg_in = PROTON
allocate (lhapdf_data_t :: data)
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
select type (data)
type is (lhapdf_data_t)
call data%init (model, pdg_in)
end select
call data%write (u)
write (u, "(A)")
write (u, "(1x,A)") "Outgoing particle codes:"
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(2x,99(1x,I0))") pdg1
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_lhapdf_1"
end subroutine sf_lhapdf_1
@ %def sf_lhapdf_1
@
\subsubsection{Test and probe structure function}
Construct and display a structure function object based on the PDF builtin
structure function.
<<SF lhapdf: execute tests>>=
if (LHAPDF5_AVAILABLE) then
call test (sf_lhapdf_2, "sf_lhapdf5_2", &
"structure function instance", &
u, results)
else if (LHAPDF6_AVAILABLE) then
call test (sf_lhapdf_2, "sf_lhapdf6_2", &
"structure function instance", &
u, results)
end if
<<SF lhapdf: test declarations>>=
public :: sf_lhapdf_2
<<SF lhapdf: tests>>=
subroutine sf_lhapdf_2 (u)
integer, intent(in) :: u
type(model_data_t), target :: model
type(flavor_t) :: flv
type(pdg_array_t) :: pdg_in
class(sf_data_t), allocatable, target :: data
class(sf_int_t), allocatable :: sf_int
type(vector4_t) :: k
type(vector4_t), dimension(2) :: q
real(default) :: E
real(default), dimension(:), allocatable :: r, rb, x, xb
real(default) :: f
write (u, "(A)") "* Test output: sf_lhapdf_2"
write (u, "(A)") "* Purpose: initialize and fill &
&test structure function object"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call model%init_sm_test ()
call flv%init (PROTON, model)
pdg_in = PROTON
call lhapdf_global_reset ()
call reset_interaction_counter ()
allocate (lhapdf_data_t :: data)
select type (data)
type is (lhapdf_data_t)
call data%init (model, pdg_in)
end select
write (u, "(A)") "* Initialize structure-function object"
write (u, "(A)")
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize incoming momentum with E=500"
write (u, "(A)")
E = 500
k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
call vector4_write (k, u)
call sf_int%seed_kinematics ([k])
write (u, "(A)")
write (u, "(A)") "* Set kinematics for x=0.5"
write (u, "(A)")
allocate (r (data%get_n_par ()))
allocate (rb(size (r)))
allocate (x (size (r)))
allocate (xb(size (r)))
r = 0.5_default
rb = 1 - r
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%write (u)
write (u, "(A)")
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A,9(1x,F10.7))") "f =", f
write (u, "(A)")
write (u, "(A)") "* Recover x from momenta"
write (u, "(A)")
q = sf_int%get_momenta (outgoing=.true.)
call sf_int%final ()
deallocate (sf_int)
call data%allocate_sf_int (sf_int)
call sf_int%init (data)
call sf_int%set_beam_index ([1])
call sf_int%seed_kinematics ([k])
call sf_int%set_momenta (q, outgoing=.true.)
call sf_int%recover_x (x, xb)
write (u, "(A,9(1x,F10.7))") "x =", x
write (u, "(A,9(1x,F10.7))") "xb=", xb
write (u, "(A)")
write (u, "(A)") "* Evaluate for Q = 100 GeV"
write (u, "(A)")
call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
call sf_int%apply (scale = 100._default)
call sf_int%write (u, testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call sf_int%final ()
call model%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_lhapdf_2"
end subroutine sf_lhapdf_2
@ %def sf_lhapdf_2
@
\subsubsection{Strong Coupling}
Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
type.
<<SF lhapdf: execute tests>>=
if (LHAPDF5_AVAILABLE) then
call test (sf_lhapdf_3, "sf_lhapdf5_3", &
"running alpha_s", &
u, results)
else if (LHAPDF6_AVAILABLE) then
call test (sf_lhapdf_3, "sf_lhapdf6_3", &
"running alpha_s", &
u, results)
end if
<<SF lhapdf: test declarations>>=
public :: sf_lhapdf_3
<<SF lhapdf: tests>>=
subroutine sf_lhapdf_3 (u)
integer, intent(in) :: u
type(qcd_t) :: qcd
type(string_t) :: name, path
integer :: member
write (u, "(A)") "* Test output: sf_lhapdf_3"
write (u, "(A)") "* Purpose: initialize and evaluate alpha_s"
write (u, "(A)")
write (u, "(A)") "* Initialize configuration data"
write (u, "(A)")
call lhapdf_global_reset ()
if (LHAPDF5_AVAILABLE) then
name = "cteq6ll.LHpdf"
member = 1
path = ""
else if (LHAPDF6_AVAILABLE) then
name = "CT10"
member = 1
path = ""
end if
write (u, "(A)") "* Initialize qcd object"
write (u, "(A)")
allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
select type (alpha => qcd%alpha)
type is (alpha_qcd_lhapdf_t)
call alpha%init (name, member, path)
end select
call qcd%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for Q = 100"
write (u, "(A)")
write (u, "(1x,A,F8.5)") "alpha = ", qcd%alpha%get (100._default)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
write (u, "(A)")
write (u, "(A)") "* Test output end: sf_lhapdf_3"
end subroutine sf_lhapdf_3
@ %def sf_lhapdf_3
@
\section{Easy PDF Access}
For the shower, subtraction and matching, it is very useful to have
direct access to $f(x,Q)$ independently of the used library.
<<[[pdf.f90]]>>=
<<File header>>
module pdf
<<Use kinds with double>>
use beam_structures
use lhapdf !NODEP!
use pdf_builtin !NODEP!
<<Standard module head>>
<<PDF: public>>
<<PDF: parameters>>
<<PDF: types>>
interface
<<PDF: sub interfaces>>
end interface
end module pdf
@ %def pdf
@
<<[[pdf_sub.f90]]>>=
<<File header>>
submodule (pdf) pdf_s
use io_units
use system_dependencies, only: LHAPDF5_AVAILABLE, LHAPDF6_AVAILABLE
use diagnostics
implicit none
contains
<<PDF: procedures>>
end submodule pdf_s
@ %def pdf_s
@
We support the following implementations:
<<PDF: parameters>>=
integer, parameter, public :: STRF_NONE = 0
integer, parameter, public :: STRF_LHAPDF6 = 1
integer, parameter, public :: STRF_LHAPDF5 = 2
integer, parameter, public :: STRF_PDF_BUILTIN = 3
@ %def STRF_NONE STRF_LHAPDF6 STRF_LHAPDF5 STRF_PDF_BUILTIN
@ A container to bundle all necessary PDF data. Could be moved to a more
central location.
<<PDF: public>>=
public :: pdf_data_t
<<PDF: types>>=
type :: pdf_data_t
type(lhapdf_pdf_t) :: pdf
real(default) :: xmin, xmax, qmin, qmax
integer :: type = STRF_NONE
integer :: set = 0
contains
<<PDF: pdf data: TBP>>
end type pdf_data_t
@ %def pdf_data
@
<<PDF: pdf data: TBP>>=
procedure :: init => pdf_data_init
<<PDF: sub interfaces>>=
module subroutine pdf_data_init (pdf_data, pdf_data_in)
class(pdf_data_t), intent(out) :: pdf_data
type(pdf_data_t), target, intent(in) :: pdf_data_in
end subroutine pdf_data_init
<<PDF: procedures>>=
module subroutine pdf_data_init (pdf_data, pdf_data_in)
class(pdf_data_t), intent(out) :: pdf_data
type(pdf_data_t), target, intent(in) :: pdf_data_in
pdf_data%xmin = pdf_data_in%xmin
pdf_data%xmax = pdf_data_in%xmax
pdf_data%qmin = pdf_data_in%qmin
pdf_data%qmax = pdf_data_in%qmax
pdf_data%set = pdf_data_in%set
pdf_data%type = pdf_data_in%type
if (pdf_data%type == STRF_LHAPDF6) then
if (pdf_data_in%pdf%is_associated ()) then
call lhapdf_copy_pointer (pdf_data_in%pdf, pdf_data%pdf)
else
call msg_bug ('pdf_data_init: pdf_data%pdf was not associated!')
end if
end if
end subroutine pdf_data_init
@ %def pdf_data_init
@
<<PDF: pdf data: TBP>>=
procedure :: write => pdf_data_write
<<PDF: sub interfaces>>=
module subroutine pdf_data_write (pdf_data, unit)
class(pdf_data_t), intent(in) :: pdf_data
integer, intent(in), optional :: unit
end subroutine pdf_data_write
<<PDF: procedures>>=
module subroutine pdf_data_write (pdf_data, unit)
class(pdf_data_t), intent(in) :: pdf_data
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(3x,A,I0)") "PDF set = ", pdf_data%set
write (u, "(3x,A,I0)") "PDF type = ", pdf_data%type
end subroutine pdf_data_write
@ %def pdf_data_write
@
<<PDF: pdf data: TBP>>=
procedure :: setup => pdf_data_setup
<<PDF: sub interfaces>>=
module subroutine pdf_data_setup &
(pdf_data, caller, beam_structure, lhapdf_member, set)
class(pdf_data_t), intent(inout) :: pdf_data
character(len=*), intent(in) :: caller
type(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: lhapdf_member, set
end subroutine pdf_data_setup
<<PDF: procedures>>=
module subroutine pdf_data_setup &
(pdf_data, caller, beam_structure, lhapdf_member, set)
class(pdf_data_t), intent(inout) :: pdf_data
character(len=*), intent(in) :: caller
type(beam_structure_t), intent(in) :: beam_structure
integer, intent(in) :: lhapdf_member, set
real(default) :: xmin, xmax, q2min, q2max
pdf_data%set = set
if (beam_structure%contains ("lhapdf")) then
if (LHAPDF6_AVAILABLE) then
pdf_data%type = STRF_LHAPDF6
else if (LHAPDF5_AVAILABLE) then
pdf_data%type = STRF_LHAPDF5
end if
write (msg_buffer, "(A,I0)") caller &
// ": interfacing LHAPDF set #", pdf_data%set
call msg_message ()
else if (beam_structure%contains ("pdf_builtin")) then
pdf_data%type = STRF_PDF_BUILTIN
write (msg_buffer, "(A,I0)") caller &
// ": interfacing PDF builtin set #", pdf_data%set
call msg_message ()
end if
select case (pdf_data%type)
case (STRF_LHAPDF6)
pdf_data%xmin = pdf_data%pdf%getxmin ()
pdf_data%xmax = pdf_data%pdf%getxmax ()
pdf_data%qmin = sqrt(pdf_data%pdf%getq2min ())
pdf_data%qmax = sqrt(pdf_data%pdf%getq2max ())
case (STRF_LHAPDF5)
call GetXminM (1, lhapdf_member, xmin)
call GetXmaxM (1, lhapdf_member, xmax)
call GetQ2minM (1, lhapdf_member, q2min)
call GetQ2maxM (1, lhapdf_member, q2max)
pdf_data%xmin = xmin
pdf_data%xmax = xmax
pdf_data%qmin = sqrt(q2min)
pdf_data%qmax = sqrt(q2max)
end select
end subroutine pdf_data_setup
@ %def pdf_data_setup
@ This could be overloaded with a version that only asks for a specific
flavor as it is supported by LHAPDF6.
<<PDF: pdf data: TBP>>=
procedure :: evolve => pdf_data_evolve
<<PDF: sub interfaces>>=
module subroutine pdf_data_evolve (pdf_data, x, q_in, f)
class(pdf_data_t), intent(inout) :: pdf_data
real(double), intent(in) :: x, q_in
real(double), dimension(-6:6), intent(out) :: f
end subroutine pdf_data_evolve
<<PDF: procedures>>=
module subroutine pdf_data_evolve (pdf_data, x, q_in, f)
class(pdf_data_t), intent(inout) :: pdf_data
real(double), intent(in) :: x, q_in
real(double), dimension(-6:6), intent(out) :: f
real(double) :: q
select case (pdf_data%type)
case (STRF_PDF_BUILTIN)
call pdf_evolve_LHAPDF (pdf_data%set, x, q_in, f)
case (STRF_LHAPDF6)
q = min (pdf_data%qmax, q_in)
q = max (pdf_data%qmin, q)
call pdf_data%pdf%evolve_pdfm (x, q, f)
case (STRF_LHAPDF5)
q = min (pdf_data%qmax, q_in)
q = max (pdf_data%qmin, q)
call evolvePDFM (pdf_data%set, x, q, f)
case default
call msg_fatal ("PDF function: unknown PDF method.")
end select
end subroutine pdf_data_evolve
@ %def pdf_data_evolve
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Dispatch}
@
<<[[dispatch_beams.f90]]>>=
<<File header>>
module dispatch_beams
<<Use kinds>>
<<Use strings>>
use constants, only: PI, one
use numeric_utils, only: vanishes
use diagnostics
use os_interface, only: os_data_t
use variables, only: var_list_t
use rng_base, only: rng_factory_t
use pdg_arrays
use model_data, only: model_data_t
use flavors, only: flavor_t
use physics_defs, only: PHOTON
use physics_defs, only: MZ_REF, ME_REF, ALPHA_QCD_MZ_REF, ALPHA_QED_ME_REF
use sm_qcd, only: qcd_t, alpha_qcd_fixed_t, alpha_qcd_from_scale_t
use sm_qcd, only: alpha_qcd_from_lambda_t
use sm_qed, only: qed_t, alpha_qed_fixed_t, alpha_qed_from_scale_t
use beam_structures
use dispatch_rng, only: dispatch_rng_factory
use dispatch_rng, only: update_rng_seed_in_var_list
use sf_base
use sf_mappings
use sf_isr
use sf_epa
use sf_ewa
use sf_escan
use sf_gaussian
use sf_beam_events
use sf_circe1
use sf_circe2
use sf_pdf_builtin
use sf_lhapdf
<<Standard module head>>
<<Dispatch beams: public>>
<<Dispatch beams: types>>
<<Dispatch beams: variables>>
interface
<<Dispatch beams: sub interfaces>>
end interface
contains
<<Dispatch beams: main procedures>>
end module dispatch_beams
@ %def dispatch_beams
@
<<[[dispatch_beams_sub.f90]]>>=
<<File header>>
submodule (dispatch_beams) dispatch_beams_s
implicit none
contains
<<Dispatch beams: procedures>>
end submodule dispatch_beams_s
@ %def dispatch_beams_s
@ This data type is a container for transferring structure-function
specific data from the [[dispatch_sf_data]] to the
[[dispatch_sf_channels]] subroutine.
<<Dispatch beams: public>>=
public :: sf_prop_t
<<Dispatch beams: types>>=
type :: sf_prop_t
real(default), dimension(2) :: isr_eps = 1
end type sf_prop_t
@ %def sf_prop_t
@
Allocate a structure-function configuration object according to the
[[sf_method]] string.
The [[sf_prop]] object can be used to transfer structure-function
specific data up and to the [[dispatch_sf_channels]] subroutine below,
so they can be used for particular mappings.
The [[var_list_global]] object is used for the RNG generator seed.
It is intent(inout) because the RNG generator seed
may change during initialization.
The [[pdg_in]] array is the array of incoming flavors, corresponding
to the upstream structure function or the beam array. This will be
checked for the structure function in question and replaced by the
outgoing flavors. The [[pdg_prc]] array is the array of incoming
flavors (beam index, component index) for the hard process.
Due to a bug in gfortran 7/8/9 this has to remain in the main module.
<<Dispatch beams: public>>=
public :: dispatch_sf_data
<<Dispatch beams: main procedures>>=
subroutine dispatch_sf_data (data, sf_method, i_beam, sf_prop, &
var_list, var_list_global, model, &
os_data, sqrts, pdg_in, pdg_prc, polarized)
class(sf_data_t), allocatable, intent(inout) :: data
type(string_t), intent(in) :: sf_method
integer, dimension(:), intent(in) :: i_beam
type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
type(sf_prop_t), intent(inout) :: sf_prop
type(var_list_t), intent(in) :: var_list
type(var_list_t), intent(inout) :: var_list_global
integer :: next_rng_seed
class(model_data_t), target, intent(in) :: model
type(os_data_t), intent(in) :: os_data
real(default), intent(in) :: sqrts
logical, intent(in) :: polarized
type(pdg_array_t), dimension(:), allocatable :: pdg_out
real(default) :: isr_alpha, isr_q_max, isr_mass
integer :: isr_order
logical :: isr_recoil, isr_keep_energy
real(default) :: epa_alpha, epa_x_min, epa_q_min, epa_q_max, epa_mass
logical :: epa_recoil, epa_keep_energy
integer :: epa_int_mode
type(string_t) :: epa_mode
real(default) :: ewa_x_min, ewa_pt_max, ewa_mass
logical :: ewa_recoil, ewa_keep_energy
type(pdg_array_t), dimension(:), allocatable :: pdg_prc1
integer :: ewa_id
type(string_t) :: pdf_name
type(string_t) :: lhapdf_dir, lhapdf_file
type(string_t), dimension(13) :: lhapdf_photon_sets
integer :: lhapdf_member, lhapdf_photon_scheme
logical :: hoppet_b_matching
class(rng_factory_t), allocatable :: rng_factory
logical :: circe1_photon1, circe1_photon2, circe1_generate, &
circe1_with_radiation
real(default) :: circe1_sqrts, circe1_eps
integer :: circe1_version, circe1_chattiness, &
circe1_revision
character(6) :: circe1_accelerator
logical :: circe2_polarized
type(string_t) :: circe2_design, circe2_file
real(default), dimension(2) :: gaussian_spread
logical :: beam_events_warn_eof
type(string_t) :: beam_events_dir, beam_events_file
logical :: escan_normalize
integer :: i
lhapdf_photon_sets = [var_str ("DOG0.LHgrid"), var_str ("DOG1.LHgrid"), &
var_str ("DGG.LHgrid"), var_str ("LACG.LHgrid"), &
var_str ("GSG0.LHgrid"), var_str ("GSG1.LHgrid"), &
var_str ("GSG960.LHgrid"), var_str ("GSG961.LHgrid"), &
var_str ("GRVG0.LHgrid"), var_str ("GRVG1.LHgrid"), &
var_str ("ACFGPG.LHgrid"), var_str ("WHITG.LHgrid"), &
var_str ("SASG.LHgrid")]
select case (char (sf_method))
case ("pdf_builtin")
allocate (pdf_builtin_data_t :: data)
select type (data)
type is (pdf_builtin_data_t)
pdf_name = &
var_list%get_sval (var_str ("$pdf_builtin_set"))
hoppet_b_matching = &
var_list%get_lval (var_str ("?hoppet_b_matching"))
call data%init ( &
model, pdg_in(i_beam(1)), &
name = pdf_name, &
path = os_data%pdf_builtin_datapath, &
hoppet_b_matching = hoppet_b_matching)
end select
case ("pdf_builtin_photon")
call msg_fatal ("Currently, there are no photon PDFs built into WHIZARD,", &
[var_str ("for the photon content inside a proton or neutron use"), &
var_str ("the 'lhapdf_photon' structure function.")])
case ("lhapdf")
allocate (lhapdf_data_t :: data)
if (pdg_in(i_beam(1))%get (1) == PHOTON) then
call msg_fatal ("The 'lhapdf' structure is intended only for protons and", &
[var_str ("pions, please use 'lhapdf_photon' for photon beams.")])
end if
lhapdf_dir = &
var_list%get_sval (var_str ("$lhapdf_dir"))
lhapdf_file = &
var_list%get_sval (var_str ("$lhapdf_file"))
lhapdf_member = &
var_list%get_ival (var_str ("lhapdf_member"))
lhapdf_photon_scheme = &
var_list%get_ival (var_str ("lhapdf_photon_scheme"))
hoppet_b_matching = &
var_list%get_lval (var_str ("?hoppet_b_matching"))
select type (data)
type is (lhapdf_data_t)
call data%init &
(model, pdg_in(i_beam(1)), &
lhapdf_dir, lhapdf_file, lhapdf_member, &
lhapdf_photon_scheme, hoppet_b_matching)
end select
case ("lhapdf_photon")
allocate (lhapdf_data_t :: data)
if (pdg_in(i_beam(1))%get_length () /= 1 .or. &
pdg_in(i_beam(1))%get (1) /= PHOTON) then
call msg_fatal ("The 'lhapdf_photon' structure function is exclusively for", &
[var_str ("photon PDFs, i.e. for photons as beam particles")])
end if
lhapdf_dir = &
var_list%get_sval (var_str ("$lhapdf_dir"))
lhapdf_file = &
var_list%get_sval (var_str ("$lhapdf_photon_file"))
lhapdf_member = &
var_list%get_ival (var_str ("lhapdf_member"))
lhapdf_photon_scheme = &
var_list%get_ival (var_str ("lhapdf_photon_scheme"))
if (.not. any (lhapdf_photon_sets == lhapdf_file)) then
call msg_fatal ("This PDF set is not supported or not " // &
"intended for photon beams.")
end if
select type (data)
type is (lhapdf_data_t)
call data%init &
(model, pdg_in(i_beam(1)), &
lhapdf_dir, lhapdf_file, lhapdf_member, &
lhapdf_photon_scheme)
end select
case ("isr")
allocate (isr_data_t :: data)
isr_alpha = &
var_list%get_rval (var_str ("isr_alpha"))
if (vanishes (isr_alpha)) then
isr_alpha = (var_list%get_rval (var_str ("ee"))) &
** 2 / (4 * PI)
end if
isr_q_max = &
var_list%get_rval (var_str ("isr_q_max"))
if (vanishes (isr_q_max)) then
isr_q_max = sqrts
end if
isr_mass = var_list%get_rval (var_str ("isr_mass"))
isr_order = var_list%get_ival (var_str ("isr_order"))
isr_recoil = var_list%get_lval (var_str ("?isr_recoil"))
isr_keep_energy = var_list%get_lval (var_str ("?isr_keep_energy"))
select type (data)
type is (isr_data_t)
call data%init &
(model, pdg_in (i_beam(1)), isr_alpha, isr_q_max, &
isr_mass, isr_order, recoil = isr_recoil, keep_energy = &
isr_keep_energy)
call data%check ()
sf_prop%isr_eps(i_beam(1)) = data%get_eps ()
end select
case ("epa")
allocate (epa_data_t :: data)
epa_mode = var_list%get_sval (var_str ("$epa_mode"))
epa_int_mode = 0
epa_alpha = var_list%get_rval (var_str ("epa_alpha"))
if (vanishes (epa_alpha)) then
epa_alpha = (var_list%get_rval (var_str ("ee"))) &
** 2 / (4 * PI)
end if
epa_x_min = var_list%get_rval (var_str ("epa_x_min"))
epa_q_min = var_list%get_rval (var_str ("epa_q_min"))
epa_q_max = var_list%get_rval (var_str ("epa_q_max"))
if (vanishes (epa_q_max)) then
epa_q_max = sqrts
end if
select case (char (epa_mode))
case ("default", "Budnev_617")
epa_int_mode = 0
case ("Budnev_616e")
epa_int_mode = 1
case ("log_power")
epa_int_mode = 2
epa_q_max = sqrts
case ("log_simple")
epa_int_mode = 3
epa_q_max = sqrts
case ("log")
epa_int_mode = 4
epa_q_max = sqrts
case default
call msg_fatal ("EPA: unsupported EPA mode; please choose " // &
"'default', 'Budnev_616', 'Budnev_616e', 'log_power', " // &
"'log_simple', or 'log'")
end select
epa_mass = var_list%get_rval (var_str ("epa_mass"))
epa_recoil = var_list%get_lval (var_str ("?epa_recoil"))
epa_keep_energy = var_list%get_lval (var_str ("?epa_keep_energy"))
select type (data)
type is (epa_data_t)
call data%init &
(model, epa_int_mode, pdg_in (i_beam(1)), epa_alpha, &
epa_x_min, epa_q_min, epa_q_max, epa_mass, &
recoil = epa_recoil, keep_energy = epa_keep_energy)
call data%check ()
end select
case ("ewa")
allocate (ewa_data_t :: data)
allocate (pdg_prc1 (size (pdg_prc, 2)))
pdg_prc1 = pdg_prc(i_beam(1),:)
if (any (pdg_prc1%get_length () /= 1) &
.or. any (pdg_prc1 /= pdg_prc1(1))) then
call msg_fatal &
("EWA: process incoming particle (W/Z) must be unique")
end if
ewa_id = abs (pdg_prc1(1)%get (1))
ewa_x_min = var_list%get_rval (var_str ("ewa_x_min"))
ewa_pt_max = var_list%get_rval (var_str ("ewa_pt_max"))
if (vanishes (ewa_pt_max)) then
ewa_pt_max = sqrts
end if
ewa_mass = var_list%get_rval (var_str ("ewa_mass"))
ewa_recoil = var_list%get_lval (&
var_str ("?ewa_recoil"))
ewa_keep_energy = var_list%get_lval (&
var_str ("?ewa_keep_energy"))
select type (data)
type is (ewa_data_t)
call data%init &
(model, pdg_in (i_beam(1)), ewa_x_min, &
ewa_pt_max, sqrts, ewa_recoil, &
ewa_keep_energy, ewa_mass)
call data%set_id (ewa_id)
call data%check ()
end select
case ("circe1")
allocate (circe1_data_t :: data)
select type (data)
type is (circe1_data_t)
circe1_photon1 = &
var_list%get_lval (var_str ("?circe1_photon1"))
circe1_photon2 = &
var_list%get_lval (var_str ("?circe1_photon2"))
circe1_sqrts = &
var_list%get_rval (var_str ("circe1_sqrts"))
circe1_eps = &
var_list%get_rval (var_str ("circe1_eps"))
if (circe1_sqrts <= 0) circe1_sqrts = sqrts
circe1_generate = &
var_list%get_lval (var_str ("?circe1_generate"))
circe1_version = &
var_list%get_ival (var_str ("circe1_ver"))
circe1_revision = &
var_list%get_ival (var_str ("circe1_rev"))
circe1_accelerator = &
char (var_list%get_sval (var_str ("$circe1_acc")))
circe1_chattiness = &
var_list%get_ival (var_str ("circe1_chat"))
circe1_with_radiation = &
var_list%get_lval (var_str ("?circe1_with_radiation"))
call data%init (model, pdg_in, circe1_sqrts, circe1_eps, &
[circe1_photon1, circe1_photon2], &
circe1_version, circe1_revision, circe1_accelerator, &
circe1_chattiness, circe1_with_radiation)
if (circe1_generate) then
call msg_message ("CIRCE1: activating generator mode")
call dispatch_rng_factory &
(rng_factory, var_list_global, next_rng_seed)
call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
call data%set_generator_mode (rng_factory)
end if
end select
case ("circe2")
allocate (circe2_data_t :: data)
select type (data)
type is (circe2_data_t)
circe2_polarized = &
var_list%get_lval (var_str ("?circe2_polarized"))
circe2_file = &
var_list%get_sval (var_str ("$circe2_file"))
circe2_design = &
var_list%get_sval (var_str ("$circe2_design"))
call data%init (os_data, model, pdg_in, sqrts, &
circe2_polarized, polarized, circe2_file, circe2_design)
call msg_message ("CIRCE2: activating generator mode")
call dispatch_rng_factory &
(rng_factory, var_list_global, next_rng_seed)
call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
call data%set_generator_mode (rng_factory)
end select
case ("gaussian")
allocate (gaussian_data_t :: data)
select type (data)
type is (gaussian_data_t)
gaussian_spread = &
[var_list%get_rval (var_str ("gaussian_spread1")), &
var_list%get_rval (var_str ("gaussian_spread2"))]
call dispatch_rng_factory &
(rng_factory, var_list_global, next_rng_seed)
call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
call data%init (model, pdg_in, gaussian_spread, rng_factory)
end select
case ("beam_events")
allocate (beam_events_data_t :: data)
select type (data)
type is (beam_events_data_t)
beam_events_dir = os_data%whizard_beamsimpath
beam_events_file = var_list%get_sval (&
var_str ("$beam_events_file"))
beam_events_warn_eof = var_list%get_lval (&
var_str ("?beam_events_warn_eof"))
call data%init (model, pdg_in, &
beam_events_dir, beam_events_file, beam_events_warn_eof)
end select
case ("energy_scan")
escan_normalize = &
var_list%get_lval (var_str ("?energy_scan_normalize"))
allocate (escan_data_t :: data)
select type (data)
type is (escan_data_t)
if (escan_normalize) then
call data%init (model, pdg_in)
else
call data%init (model, pdg_in, sqrts)
end if
end select
case default
if (associated (dispatch_sf_data_extra)) then
call dispatch_sf_data_extra (data, sf_method, i_beam, &
sf_prop, var_list, var_list_global, model, os_data, sqrts, pdg_in, &
pdg_prc, polarized)
end if
if (.not. allocated (data)) then
call msg_fatal ("Structure function '" &
// char (sf_method) // "' not implemented")
end if
end select
if (allocated (data)) then
allocate (pdg_out (size (pdg_prc, 1)))
call data%get_pdg_out (pdg_out)
do i = 1, size (i_beam)
pdg_in(i_beam(i)) = pdg_out(i)
end do
end if
end subroutine dispatch_sf_data
@ %def dispatch_sf_data
@ This is a hook that allows us to inject further handlers for
structure-function objects, in particular a test structure function.
<<Dispatch beams: public>>=
- public :: dispatch_sf_data_extra
+ public :: dispatch_sf_data_extra
<<Dispatch beams: variables>>=
procedure (dispatch_sf_data), pointer :: &
dispatch_sf_data_extra => null ()
@ %def dispatch_sf_data_extra
@ This is an auxiliary procedure, used by the beam-structure
expansion: tell for a given structure function name, whether it
corresponds to a pair spectrum ($n=2$), a single-particle structure
function ($n=1$), or nothing ($n=0$). Though [[energy_scan]] can
in principle also be a pair spectrum, it always has only one
parameter.
<<Dispatch beams: public>>=
public :: strfun_mode
<<Dispatch beams: sub interfaces>>=
module function strfun_mode (name) result (n)
type(string_t), intent(in) :: name
integer :: n
end function strfun_mode
<<Dispatch beams: procedures>>=
module function strfun_mode (name) result (n)
type(string_t), intent(in) :: name
integer :: n
select case (char (name))
case ("none")
n = 0
case ("sf_test_0", "sf_test_1")
n = 1
case ("pdf_builtin","pdf_builtin_photon", &
"lhapdf","lhapdf_photon")
n = 1
case ("isr","epa","ewa")
n = 1
case ("circe1", "circe2")
n = 2
case ("gaussian")
n = 2
case ("beam_events")
n = 2
case ("energy_scan")
n = 2
case default
n = -1
call msg_bug ("Structure function '" // char (name) &
// "' not supported yet")
end select
end function strfun_mode
@ %def strfun_mode
@ Dispatch a whole structure-function chain, given beam data and beam
structure data.
This could be done generically, but we should look at the specific
combination of structure functions in order to select appropriate mappings.
The [[beam_structure]] argument gets copied because
we want to expand it to canonical form (one valid structure-function
entry per record) before proceeding further.
The [[pdg_prc]] argument is the array of incoming flavors. The first
index is the beam index, the second one the process component index.
Each element is itself a PDG array, notrivial if there is a flavor sum
for the incoming state of this component.
The dispatcher is divided in two parts. The first part configures the
structure function data themselves. After this, we can configure the
phase space for the elementary process.
<<Dispatch beams: public>>=
public :: dispatch_sf_config
<<Dispatch beams: sub interfaces>>=
module subroutine dispatch_sf_config (sf_config, sf_prop, beam_structure, &
var_list, var_list_global, model, os_data, sqrts, pdg_prc)
type(sf_config_t), dimension(:), allocatable, intent(out) :: sf_config
type(sf_prop_t), intent(out) :: sf_prop
type(beam_structure_t), intent(inout) :: beam_structure
type(var_list_t), intent(in) :: var_list
type(var_list_t), intent(inout) :: var_list_global
class(model_data_t), target, intent(in) :: model
type(os_data_t), intent(in) :: os_data
real(default), intent(in) :: sqrts
class(sf_data_t), allocatable :: sf_data
type(beam_structure_t) :: beam_structure_tmp
type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
type(string_t), dimension(:), allocatable :: prt_in
type(pdg_array_t), dimension(:), allocatable :: pdg_in
end subroutine dispatch_sf_config
<<Dispatch beams: procedures>>=
module subroutine dispatch_sf_config (sf_config, sf_prop, beam_structure, &
var_list, var_list_global, model, os_data, sqrts, pdg_prc)
type(sf_config_t), dimension(:), allocatable, intent(out) :: sf_config
type(sf_prop_t), intent(out) :: sf_prop
type(beam_structure_t), intent(inout) :: beam_structure
type(var_list_t), intent(in) :: var_list
type(var_list_t), intent(inout) :: var_list_global
class(model_data_t), target, intent(in) :: model
type(os_data_t), intent(in) :: os_data
real(default), intent(in) :: sqrts
class(sf_data_t), allocatable :: sf_data
type(beam_structure_t) :: beam_structure_tmp
type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
type(string_t), dimension(:), allocatable :: prt_in
type(pdg_array_t), dimension(:), allocatable :: pdg_in
type(flavor_t) :: flv_in
integer :: n_beam, n_record, i
beam_structure_tmp = beam_structure
call beam_structure_tmp%expand (strfun_mode)
n_record = beam_structure_tmp%get_n_record ()
allocate (sf_config (n_record))
n_beam = beam_structure_tmp%get_n_beam ()
if (n_beam > 0) then
allocate (prt_in (n_beam), pdg_in (n_beam))
prt_in = beam_structure_tmp%get_prt ()
do i = 1, n_beam
call flv_in%init (prt_in(i), model)
pdg_in(i) = flv_in%get_pdg ()
end do
else
n_beam = size (pdg_prc, 1)
allocate (pdg_in (n_beam))
pdg_in = pdg_prc(:,1)
end if
do i = 1, n_record
call dispatch_sf_data (sf_data, &
beam_structure_tmp%get_name (i), &
beam_structure_tmp%get_i_entry (i), &
sf_prop, var_list, var_list_global, model, os_data, sqrts, &
pdg_in, pdg_prc, &
beam_structure_tmp%polarized ())
call sf_config(i)%init (beam_structure_tmp%get_i_entry (i), sf_data)
deallocate (sf_data)
end do
end subroutine dispatch_sf_config
@ %def dispatch_sf_config
@
\subsection{QCD and QED coupling}
Allocate the [[alpha]] (running coupling) component of the [[qcd]] block with
a concrete implementation, depending on the variable settings in the
[[global]] record.
If a fixed $\alpha_s$ is requested, we do not allocate the
[[qcd%alpha]] object. In this case, the matrix element code will just take
the model parameter as-is, which implies fixed $\alpha_s$. If the
object is allocated, the $\alpha_s$ value is computed and updated for
each matrix-element call.
Also fetch the [[alphas_nf]] variable from the list and store it in
the QCD record. This is not used in the $\alpha_s$ calculation, but
the QCD record thus becomes a messenger for this user parameter.
Gfortran 7/8/9 bug: has to be part of main module.
<<Dispatch beams: public>>=
public :: dispatch_qcd
<<Dispatch beams: main procedures>>=
subroutine dispatch_qcd (qcd, var_list, os_data)
type(qcd_t), intent(inout) :: qcd
type(var_list_t), intent(in) :: var_list
type(os_data_t), intent(in) :: os_data
logical :: fixed, from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd
real(default) :: mz, alpha_val, lambda
integer :: nf, order, lhapdf_member
type(string_t) :: pdfset, lhapdf_dir, lhapdf_file
call unpack_variables ()
if (allocated (qcd%alpha)) deallocate (qcd%alpha)
if (from_lhapdf .and. from_pdf_builtin) then
call msg_fatal (" Mixing alphas evolution", &
[var_str (" from LHAPDF and builtin PDF is not permitted")])
end if
select case (count ([from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd]))
case (0)
if (fixed) then
allocate (alpha_qcd_fixed_t :: qcd%alpha)
else
call msg_fatal ("QCD alpha: no calculation mode set")
end if
case (2:)
call msg_fatal ("QCD alpha: calculation mode is ambiguous")
case (1)
if (fixed) then
call msg_fatal ("QCD alpha: use '?alphas_is_fixed = false' for " // &
"running alphas")
else if (from_mz) then
allocate (alpha_qcd_from_scale_t :: qcd%alpha)
else if (from_pdf_builtin) then
allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
else if (from_lhapdf) then
allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
else if (from_lambda_qcd) then
allocate (alpha_qcd_from_lambda_t :: qcd%alpha)
end if
call msg_message ("QCD alpha: using a running strong coupling")
end select
call init_alpha ()
qcd%n_f = var_list%get_ival (var_str ("alphas_nf"))
contains
<<Dispatch qcd: dispatch qcd: procedures>>
end subroutine dispatch_qcd
@ %def dispatch_qcd
@
<<Dispatch qcd: dispatch qcd: procedures>>=
subroutine unpack_variables ()
fixed = var_list%get_lval (var_str ("?alphas_is_fixed"))
from_mz = var_list%get_lval (var_str ("?alphas_from_mz"))
from_pdf_builtin = &
var_list%get_lval (var_str ("?alphas_from_pdf_builtin"))
from_lhapdf = &
var_list%get_lval (var_str ("?alphas_from_lhapdf"))
from_lambda_qcd = &
var_list%get_lval (var_str ("?alphas_from_lambda_qcd"))
pdfset = var_list%get_sval (var_str ("$pdf_builtin_set"))
lambda = var_list%get_rval (var_str ("lambda_qcd"))
nf = var_list%get_ival (var_str ("alphas_nf"))
order = var_list%get_ival (var_str ("alphas_order"))
lhapdf_dir = var_list%get_sval (var_str ("$lhapdf_dir"))
lhapdf_file = var_list%get_sval (var_str ("$lhapdf_file"))
lhapdf_member = var_list%get_ival (var_str ("lhapdf_member"))
if (var_list%contains (var_str ("mZ"))) then
mz = var_list%get_rval (var_str ("mZ"))
else
mz = MZ_REF
end if
if (var_list%contains (var_str ("alphas"))) then
alpha_val = var_list%get_rval (var_str ("alphas"))
else
alpha_val = ALPHA_QCD_MZ_REF
end if
end subroutine unpack_variables
@
<<Dispatch qcd: dispatch qcd: procedures>>=
subroutine init_alpha ()
select type (alpha => qcd%alpha)
type is (alpha_qcd_fixed_t)
alpha%val = alpha_val
type is (alpha_qcd_from_scale_t)
alpha%mu_ref = mz
alpha%ref = alpha_val
alpha%order = order
alpha%nf = nf
type is (alpha_qcd_from_lambda_t)
alpha%lambda = lambda
alpha%order = order
alpha%nf = nf
type is (alpha_qcd_pdf_builtin_t)
call alpha%init (pdfset, &
os_data%pdf_builtin_datapath)
type is (alpha_qcd_lhapdf_t)
call alpha%init (lhapdf_file, lhapdf_member, lhapdf_dir)
end select
end subroutine init_alpha
@
@ Same for QED. Gfortran 7/8/9: has to be part of main module.
<<Dispatch beams: public>>=
public :: dispatch_qed
<<Dispatch beams: main procedures>>=
subroutine dispatch_qed (qed, var_list)
type(qed_t), intent(inout) :: qed
type(var_list_t), intent(in) :: var_list
logical :: fixed, from_me, analytic
real(default) :: me, alpha_val
integer :: nf, nlep, order
call unpack_variables ()
if (allocated (qed%alpha)) deallocate (qed%alpha)
select case (count ([from_me]))
case (0)
if (fixed) then
allocate (alpha_qed_fixed_t :: qed%alpha)
else
call msg_fatal ("QED alpha: no calculation mode set")
end if
case (2:)
call msg_fatal ("QED alpha: calculation mode is ambiguous")
case (1)
if (fixed) then
call msg_fatal ("QED alpha: use '?alphas_is_fixed = false' for " // &
"running alpha")
else if (from_me) then
allocate (alpha_qed_from_scale_t :: qed%alpha)
end if
call msg_message ("QED alpha: using a running electromagnetic coupling")
end select
call init_alpha ()
if (var_list%get_ival (var_str ("alpha_nf")) == -1) then
qed%n_f = var_list%get_ival (var_str ("alphas_nf"))
else
qed%n_f = var_list%get_ival (var_str ("alpha_nf"))
end if
qed%n_lep = var_list%get_ival (var_str ("alpha_nlep"))
contains
<<Dispatch qed: dispatch qed: procedures>>
end subroutine dispatch_qed
@ %def dispatch_qed
@
<<Dispatch qed: dispatch qed: procedures>>=
subroutine unpack_variables ()
fixed = var_list%get_lval (var_str ("?alpha_is_fixed"))
from_me = var_list%get_lval (var_str ("?alpha_from_me"))
if (var_list%get_ival (var_str ("alpha_nf")) == -1) then
nf = var_list%get_ival (var_str ("alphas_nf"))
else
nf = var_list%get_ival (var_str ("alpha_nf"))
end if
analytic = var_list%get_lval (var_str ("?alpha_evolve_analytic"))
nlep = var_list%get_ival (var_str ("alpha_nlep"))
order = var_list%get_ival (var_str ("alpha_order"))
if (var_list%contains (var_str ("me"))) then
me = var_list%get_rval (var_str ("me"))
else
me = ME_REF
end if
if (var_list%contains (var_str ("alpha_em_i"))) then
alpha_val = one / var_list%get_rval (var_str ("alpha_em_i"))
else
alpha_val = ALPHA_QED_ME_REF
end if
end subroutine unpack_variables
@
<<Dispatch qed: dispatch qed: procedures>>=
subroutine init_alpha ()
select type (alpha => qed%alpha)
type is (alpha_qed_fixed_t)
alpha%val = alpha_val
type is (alpha_qed_from_scale_t)
alpha%mu_ref = me
alpha%ref = alpha_val
alpha%order = order
alpha%nf = nf
alpha%nlep = nlep
alpha%analytic = analytic
end select
end subroutine init_alpha
@
Index: trunk/src/lhapdf/lhapdf.f90
===================================================================
--- trunk/src/lhapdf/lhapdf.f90 (revision 8819)
+++ trunk/src/lhapdf/lhapdf.f90 (revision 8820)
@@ -1,302 +1,302 @@
!$Id: lhapdf.f90 6133 2014-09-17 14:42:33Z kilian $
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
-! Copyright (C) 1999-2022 by
+! Copyright (C) 1999-2022 by
! Wolfgang Kilian <kilian@physik.uni-siegen.de>
! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
! Juergen Reuter <juergen.reuter@desy.de>
! with contributions from
! Bijan Chokoufe <bijan.chokoufe@desy.de>
! Fabian Bach <fabian.bach@t-online.de>
! Christian Speckner <cnspeckn@googlemail.com>
!
! WHIZARD is free software; you can redistribute it and/or modify it
-! under the terms of the GNU General Public License as published by
+! 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
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module lhapdf
use, intrinsic :: iso_c_binding
use kinds
implicit none
private
-
+
! Public types
public :: lhapdf_pdf_t
public :: lhapdf_copy_pointer
type :: lhapdf_pdf_t
private
type(c_ptr) :: cptr
contains
procedure :: init => lhapdf_pdf_init
procedure :: is_associated => lhapdf_is_associated
procedure :: getxmin => lhapdf_getxmin
procedure :: getxmax => lhapdf_getxmax
procedure :: getq2min => lhapdf_getq2min
procedure :: getq2max => lhapdf_getq2max
procedure :: has_photon => lhapdf_hasphoton
procedure :: evolve_pdfm => lhapdf_evolve_pdfm
procedure :: evolve_pdfphotonm => lhapdf_evolve_pdfphotonm
procedure :: evolve_pdfpm => lhapdf_evolve_pdfpm
procedure :: get_qmass => lhapdf_get_qmass
procedure :: num_pdfm => lhapdf_num_pdfm
procedure :: alphas_pdf => lhapdf_alphas_pdf
procedure :: final => lhapdf_final
end type lhapdf_pdf_t
! Interface for generic operators
-
+
interface
function lhapdf_init_pdf (setname, imem) bind (C) result (pdf)
- import
+ import
integer(c_int), intent(in), value :: imem
character(len=1, kind=c_char), dimension(*), intent(in) :: setname
type(c_ptr) :: pdf
end function lhapdf_init_pdf
end interface
interface
subroutine lhapdf_pdf_delete (pdf) bind (C)
import
type(c_ptr), value :: pdf
end subroutine lhapdf_pdf_delete
end interface
interface
function lhapdf_pdf_getxmin (pdf) bind (C) result (xmin)
import
type(c_ptr), intent(in), value :: pdf
real(c_double) :: xmin
end function lhapdf_pdf_getxmin
end interface
interface
function lhapdf_pdf_getxmax (pdf) bind (C) result (xmax)
import
type(c_ptr), intent(in), value :: pdf
real(c_double) :: xmax
end function lhapdf_pdf_getxmax
end interface
interface
function lhapdf_pdf_getq2min (pdf) bind (C) result (q2min)
import
type(c_ptr), intent(in), value :: pdf
real(c_double) :: q2min
end function lhapdf_pdf_getq2min
end interface
interface
function lhapdf_pdf_getq2max (pdf) bind (C) result (q2max)
import
type(c_ptr), intent(in), value :: pdf
real(c_double) :: q2max
end function lhapdf_pdf_getq2max
end interface
interface
function lhapdf_has_photon (pdf) bind (C) result (flag)
import
type(c_ptr), intent(in), value :: pdf
logical(c_bool) :: flag
end function lhapdf_has_photon
end interface
- interface
+ interface
subroutine lhapdf_evolvepdfm (pdf, x, q, ff) bind (C)
import
type(c_ptr), intent(in), value :: pdf
real(c_double), intent(in), value :: x, q
real(c_double), dimension(-6:6), intent(out) :: ff
end subroutine lhapdf_evolvepdfm
end interface
interface
subroutine lhapdf_evolvepdfphotonm (pdf, x, q, ff, fphot) bind (C)
import
type(c_ptr), intent(in), value :: pdf
real(c_double), intent(in), value :: x, q
real(c_double), dimension(-6:6), intent(out) :: ff
real(c_double), intent(out) :: fphot
end subroutine lhapdf_evolvepdfphotonm
end interface
interface
subroutine lhapdf_evolvepdfpm (pdf, x, q, s, scheme, ff) bind (C)
import
type(c_ptr), intent(in), value :: pdf
integer(c_int), intent(in), value :: scheme
real(c_double), intent(in), value :: x, q, s
real(c_double), dimension(-6:6), intent(out) :: ff
end subroutine lhapdf_evolvepdfpm
end interface
interface
function lhapdf_getqmass (pdf, nf) bind (C) result (mass)
import
type(c_ptr), intent(in), value :: pdf
integer(c_int), intent(in), value :: nf
real(c_double) :: mass
end function lhapdf_getqmass
end interface
interface
- function lhapdf_numpdfm (pdf) bind (C) result (numpdf)
+ function lhapdf_numpdfm (pdf) bind (C) result (numpdf)
import
type(c_ptr), intent(in), value :: pdf
integer(c_int) :: numpdf
end function lhapdf_numpdfm
end interface
interface
function lhapdf_alphaspdf (pdf, q) bind (C) result (as)
import
type(c_ptr), intent(in), value :: pdf
real(c_double), intent(in), value :: q
real(c_double) :: as
end function lhapdf_alphaspdf
end interface
contains
subroutine lhapdf_pdf_init (pdf, setname, imem)
class(lhapdf_pdf_t), intent(out) :: pdf
character(*), intent(in) :: setname
integer, intent(in) :: imem
character(len=1, kind=c_char), dimension(len(setname)+1) :: pdf_setname
integer(c_int) :: pdf_imem
integer :: i, strlen
strlen = len(setname)
forall (i=1:strlen)
pdf_setname(i) = setname(i:i)
end forall
pdf_setname(strlen+1) = c_null_char
pdf_imem = imem
pdf%cptr = lhapdf_init_pdf (pdf_setname, pdf_imem)
end subroutine lhapdf_pdf_init
function lhapdf_is_associated (pdf) result (flag)
class(lhapdf_pdf_t), intent(in) :: pdf
logical :: flag
flag = c_associated (pdf%cptr)
end function lhapdf_is_associated
function lhapdf_getxmin (pdf) result (xmin)
- class(lhapdf_pdf_t), intent(inout) :: pdf
+ class(lhapdf_pdf_t), intent(in) :: pdf
real(double) :: xmin
xmin = lhapdf_pdf_getxmin (pdf%cptr)
end function lhapdf_getxmin
-
+
function lhapdf_getxmax (pdf) result (xmax)
- class(lhapdf_pdf_t), intent(inout) :: pdf
+ class(lhapdf_pdf_t), intent(in) :: pdf
real(double) :: xmax
xmax = lhapdf_pdf_getxmax (pdf%cptr)
end function lhapdf_getxmax
-
+
function lhapdf_getq2min (pdf) result (q2min)
- class(lhapdf_pdf_t), intent(inout) :: pdf
+ class(lhapdf_pdf_t), intent(in) :: pdf
real(double) :: q2min
q2min = lhapdf_pdf_getq2min (pdf%cptr)
end function lhapdf_getq2min
-
+
function lhapdf_getq2max (pdf) result (q2max)
- class(lhapdf_pdf_t), intent(inout) :: pdf
+ class(lhapdf_pdf_t), intent(in) :: pdf
real(double) :: q2max
q2max = lhapdf_pdf_getq2max (pdf%cptr)
end function lhapdf_getq2max
-
+
function lhapdf_hasphoton (pdf) result (flag)
- class(lhapdf_pdf_t), intent(inout) :: pdf
+ class(lhapdf_pdf_t), intent(in) :: pdf
logical :: flag
flag = lhapdf_has_photon (pdf%cptr)
end function lhapdf_hasphoton
-
+
subroutine lhapdf_evolve_pdfm (pdf, x, q, ff)
class(lhapdf_pdf_t), intent(inout) :: pdf
real(double), intent(in) :: x, q
real(double), dimension(-6:6), intent(out) :: ff
real(c_double) :: c_x, c_q
c_x = x
c_q = q
call lhapdf_evolvepdfm (pdf%cptr, c_x, c_q, ff)
end subroutine lhapdf_evolve_pdfm
-
+
subroutine lhapdf_evolve_pdfphotonm (pdf, x, q, ff, fphot)
class(lhapdf_pdf_t), intent(inout) :: pdf
real(double), intent(in) :: x, q
real(double), dimension(-6:6), intent(out) :: ff
real(double), intent(out) :: fphot
real(c_double) :: c_x, c_q
c_x = x
c_q = q
call lhapdf_evolvepdfphotonm &
(pdf%cptr, c_x, c_q, ff, fphot)
end subroutine lhapdf_evolve_pdfphotonm
-
+
subroutine lhapdf_evolve_pdfpm (pdf, x, q, s, scheme, ff)
class(lhapdf_pdf_t), intent(inout) :: pdf
real(double), intent(in) :: x, q, s
integer, intent(in) :: scheme
real(double), dimension(-6:6), intent(out) :: ff
real(c_double) :: c_x, c_q, c_s
integer(c_int) :: c_scheme
c_x = x
c_q = q
c_s = s
c_scheme = scheme
call lhapdf_evolvepdfpm (pdf%cptr, &
c_x, c_q, c_s, c_scheme, ff)
end subroutine lhapdf_evolve_pdfpm
-
+
function lhapdf_get_qmass (pdf, nf) result (mass)
- class(lhapdf_pdf_t), intent(inout) :: pdf
+ class(lhapdf_pdf_t), intent(in) :: pdf
integer, intent(in) :: nf
real(double) :: mass
integer(c_int) :: c_nf
c_nf = nf
mass = lhapdf_getqmass (pdf%cptr, c_nf)
end function lhapdf_get_qmass
-
+
function lhapdf_num_pdfm (pdf) result (numpdf)
class(lhapdf_pdf_t), intent(inout) :: pdf
integer :: numpdf
numpdf = lhapdf_numpdfm (pdf%cptr)
end function lhapdf_num_pdfm
-
+
function lhapdf_alphas_pdf (pdf, q) result (as)
class(lhapdf_pdf_t), intent(in), target :: pdf
real(double), intent(in) :: q
real(double) :: as
real(c_double) :: c_q = 0
c_q = q
as = lhapdf_alphaspdf (pdf%cptr, c_q)
end function lhapdf_alphas_pdf
subroutine lhapdf_final (pdf)
class(lhapdf_pdf_t), intent(inout) :: pdf
call lhapdf_pdf_delete (pdf%cptr)
end subroutine lhapdf_final
subroutine lhapdf_copy_pointer (pdf_in, pdf_out)
type(lhapdf_pdf_t), intent(in), target :: pdf_in
type(lhapdf_pdf_t), intent(out), target :: pdf_out
pdf_out%cptr = transfer (pdf_in%cptr, pdf_out%cptr)
end subroutine lhapdf_copy_pointer
end module lhapdf
Index: trunk/share/tests/unit_tests/ref-output/rt_data_1.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_1.ref (revision 8819)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_1.ref (revision 8820)
@@ -1,444 +1,444 @@
* Test output: rt_data_1
* Purpose: initialize global runtime data
========================================================================
Runtime data:
========================================================================
[undefined] sqrts = [unknown real]
luminosity = 0.000000000000E+00
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
isr_log_order = 0
isr_q_in = -1.000000000000E+00
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
?isr_handler_keep_mass = true
$epa_mode = "default"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
$negative_sf = "default"
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
[undefined] $model_name = [unknown string]
[undefined] process_num_id = [unknown integer]
?proc_as_run_id = true
lcio_run_id = 0
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
[undefined] $library_name = [unknown string]
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
alphas_order = 0
alpha_order = 0
alphas_nf = 5
alpha_nf = -1
alpha_nlep = 1
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
?colorize_subevt = false
tolerance = 0.000000000000E+00
checkpoint = 0
event_callback_interval = 0
?pacify = false
$out_file = ""
?out_advance = true
real_range* = 307
real_precision* = 15
real_epsilon* = 1.000000000000E-16
real_tiny* = 1.000000000000-300
$integration_method = "vamp"
threshold_calls = 10
min_calls_per_channel = 10
min_calls_per_bin = 10
min_bins = 3
max_bins = 20
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
$run_id = ""
n_calls_test = 0
?integration_timer = true
?check_grid_file = true
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
integration_results_verbosity = 1
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
[undefined] $integrate_workspace = [unknown string]
vamp_grid_checkpoint = 1
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
?keep_flavors_when_clustering = false
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
?keep_flavors_when_recombining = true
$sample = ""
$sample_normalization = "auto"
?sample_pacify = false
?sample_select = true
sample_max_tries = 10000
sample_split_n_evt = 0
sample_split_n_kbytes = 0
sample_split_index = 0
$rescan_input_format = "raw"
?read_raw = true
?write_raw = true
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
$dump_extension = "pset.dat"
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
$extension_lha = "lha"
$extension_hepmc = "hepmc"
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
$shower_method = "WHIZARD"
?shower_verbose = false
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = true
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_internal"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
ellis_sexton_scale = -1.000000000000E+00
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
gks_multiplicity = 0
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
form_threads = 2
form_workspace = 1000
$gosam_fc = ""
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
$real_partition_mode = "default"
real_partition_scale = 1.000000000000E+01
?nlo_reuse_amplitudes_fks = false
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
$fclibs => "Fortran-libs"
========================================================================
iterations = 2:5000:"gw", 3:20000
========================================================================
Process library stack: [empty]
========================================================================
Beam structure: [any particles]
========================================================================
Cuts: [undefined]
------------------------------------------------------------------------
Scale: [undefined]
------------------------------------------------------------------------
Factorization scale: [undefined]
------------------------------------------------------------------------
Renormalization scale: [undefined]
------------------------------------------------------------------------
Weight: [undefined]
========================================================================
Event selection: [undefined]
------------------------------------------------------------------------
Event reweighting factor: [undefined]
------------------------------------------------------------------------
Event analysis: [undefined]
------------------------------------------------------------------------
Event callback: [undefined]
========================================================================
Process stack: [empty]
========================================================================
quit : F
quit_code: 0
========================================================================
Logfile : 'rt_data.log'
========================================================================
* Test output end: rt_data_1
Index: trunk/share/tests/unit_tests/ref-output/rt_data_2.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_2.ref (revision 8819)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_2.ref (revision 8820)
@@ -1,508 +1,508 @@
* Test output: rt_data_2
* Purpose: initialize global runtime data and fill contents
========================================================================
Runtime data:
========================================================================
gy => 1.000000000000E+00
ms => 1.250000000000E+02
ff => 1.500000000000E+00
mf* => 1.875000000000E+02
particle* = PDG(0)
SCALAR* = PDG(25)
s* = PDG(25)
FERMION* = PDG(6)
f* = PDG(6)
fbar* = PDG(-6)
F* = PDG(-6)
charged* = PDG(6, -6)
neutral* = PDG(25)
colored* = PDG(6, -6)
sqrts = 1.000000000000E+03
luminosity = 3.300000000000E+01
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
isr_log_order = 0
isr_q_in = -1.000000000000E+00
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
?isr_handler_keep_mass = true
$epa_mode = "default"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
$negative_sf = "default"
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "Test"
[undefined] process_num_id = [unknown integer]
?proc_as_run_id = true
lcio_run_id = 0
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
[undefined] $library_name = [unknown string]
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
alphas_order = 0
alpha_order = 0
alphas_nf = 5
alpha_nf = -1
alpha_nlep = 1
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
?colorize_subevt = false
tolerance = 0.000000000000E+00
checkpoint = 0
event_callback_interval = 0
?pacify = false
$out_file = ""
?out_advance = true
real_range* = 307
real_precision* = 15
real_epsilon* = 1.000000000000E-16
real_tiny* = 1.000000000000-300
$integration_method = "vamp"
threshold_calls = 10
min_calls_per_channel = 10
min_calls_per_bin = 10
min_bins = 3
max_bins = 20
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
$run_id = "run1"
n_calls_test = 0
?integration_timer = true
?check_grid_file = true
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
integration_results_verbosity = 1
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
[undefined] $integrate_workspace = [unknown string]
vamp_grid_checkpoint = 1
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
?keep_flavors_when_clustering = false
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
?keep_flavors_when_recombining = true
$sample = ""
$sample_normalization = "auto"
?sample_pacify = false
?sample_select = true
sample_max_tries = 10000
sample_split_n_evt = 0
sample_split_n_kbytes = 0
sample_split_index = 0
$rescan_input_format = "raw"
?read_raw = true
?write_raw = true
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
$dump_extension = "pset.dat"
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
$extension_lha = "lha"
$extension_hepmc = "hepmc"
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
$shower_method = "WHIZARD"
?shower_verbose = false
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = true
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_internal"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
ellis_sexton_scale = -1.000000000000E+00
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
gks_multiplicity = 0
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
form_threads = 2
form_workspace = 1000
$gosam_fc = ""
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
$real_partition_mode = "default"
real_partition_scale = 1.000000000000E+01
?nlo_reuse_amplitudes_fks = false
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
$fclibs => "Fortran-libs"
========================================================================
model "Test"
! md5sum = 'DB28187ADA60804A3CFC14A025DED784'
parameter gy = 1.000000000000E+00
parameter ms = 1.250000000000E+02
parameter ff = 1.500000000000E+00
external mf = 1.875000000000E+02
particle SCALAR 25
name "s"
spin 0
mass ms
particle FERMION 6
name "f"
anti "fbar" "F"
tex_anti "\bar{f}"
spin 1/2 isospin 1/2 charge 2/3 color 3
mass mf
vertex "fbar" "f" "s"
vertex "s" "s" "s"
========================================================================
Process library stack: [empty]
========================================================================
Beam structure: [any particles]
========================================================================
Cuts:
------------------------------------------------------------------------
+ SEQUENCE <lexpr> = <lsinglet>
+ SEQUENCE <lsinglet> = <lterm>
| + SEQUENCE <lterm> = <all_fun>
| | + SEQUENCE <all_fun> = all <lexpr> <pargs1>
| | | + KEYWORD all = [keyword] all
| | | + SEQUENCE <lexpr> = <lsinglet>
| | | | + SEQUENCE <lsinglet> = <lterm>
| | | | | + SEQUENCE <lterm> = <compared_expr>
| | | | | | + SEQUENCE <compared_expr> = <expr> <comparison>
| | | | | | | + SEQUENCE <expr> = <term>
| | | | | | | | + SEQUENCE <term> = <factor>
| | | | | | | | | + SEQUENCE <factor> = <variable>
| | | | | | | | | | + IDENTIFIER <variable> = Pt
| | | | | | | + SEQUENCE <comparison> = '>' <expr>
| | | | | | | | + KEYWORD '>' = [keyword] >
| | | | | | | | + SEQUENCE <expr> = <term>
| | | | | | | | | + SEQUENCE <term> = <factor>
| | | | | | | | | | + SEQUENCE <factor> = <integer_value>
| | | | | | | | | | | + SEQUENCE <integer_value> = <integer_literal>
| | | | | | | | | | | | + INTEGER <integer_literal> = 100
| | | + ARGUMENTS <pargs1> = <pexpr>
| | | | + SEQUENCE <pexpr> = <pterm>
| | | | | + SEQUENCE <pterm> = <pexpr_src>
| | | | | | + SEQUENCE <pexpr_src> = <unspecified_prt>
| | | | | | | + SEQUENCE <unspecified_prt> = <cexpr>
| | | | | | | | + SEQUENCE <cexpr> = <variable>
| | | | | | | | | + IDENTIFIER <variable> = s
------------------------------------------------------------------------
Scale: [undefined]
------------------------------------------------------------------------
Factorization scale: [undefined]
------------------------------------------------------------------------
Renormalization scale: [undefined]
------------------------------------------------------------------------
Weight: [undefined]
========================================================================
Event selection: [undefined]
------------------------------------------------------------------------
Event reweighting factor: [undefined]
------------------------------------------------------------------------
Event analysis: [undefined]
------------------------------------------------------------------------
Event sample formats = foo_fmt, bar_fmt
------------------------------------------------------------------------
Event callback: [undefined]
========================================================================
Process stack: [empty]
========================================================================
quit : F
quit_code: 0
========================================================================
Logfile : ''
========================================================================
* Test output end: rt_data_2
Index: trunk/share/tests/unit_tests/ref-output/rt_data_3.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_3.ref (revision 8819)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_3.ref (revision 8820)
@@ -1,1070 +1,1070 @@
* Test output: rt_data_3
* Purpose: initialize global runtime data and fill contents;
* copy to local block and back
* Init global data
* Init and modify local data
model associated = T
library associated = T
========================================================================
Runtime data:
========================================================================
gy => 1.000000000000E+00
ms => 1.500000000000E+02
ff => 1.500000000000E+00
mf* => 2.250000000000E+02
particle* = PDG(0)
SCALAR* = PDG(25)
s* = PDG(25)
FERMION* = PDG(6)
f* = PDG(6)
fbar* = PDG(-6)
F* = PDG(-6)
charged* = PDG(6, -6)
neutral* = PDG(25)
colored* = PDG(6, -6)
$model_name = "Test"
$fc => "Local compiler"
$fcflags => "Fortran-flags"
$fclibs => "Fortran-libs"
$integration_method = "midpoint"
$phs_method = "single"
$library_name = "library_2"
sqrts = 1.000000000000E+03
luminosity = 3.300000000000E+01
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
isr_log_order = 0
isr_q_in = -1.000000000000E+00
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
?isr_handler_keep_mass = true
$epa_mode = "default"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
$negative_sf = "default"
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "Test"
[undefined] process_num_id = [unknown integer]
?proc_as_run_id = true
lcio_run_id = 0
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "library_1"
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
alphas_order = 0
alpha_order = 0
alphas_nf = 5
alpha_nf = -1
alpha_nlep = 1
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
?colorize_subevt = false
tolerance = 0.000000000000E+00
checkpoint = 0
event_callback_interval = 0
?pacify = false
$out_file = ""
?out_advance = true
real_range* = 307
real_precision* = 15
real_epsilon* = 1.000000000000E-16
real_tiny* = 1.000000000000-300
$integration_method = "vamp"
threshold_calls = 10
min_calls_per_channel = 10
min_calls_per_bin = 10
min_bins = 3
max_bins = 20
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
$run_id = "run1"
n_calls_test = 0
?integration_timer = true
?check_grid_file = true
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
integration_results_verbosity = 1
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
[undefined] $integrate_workspace = [unknown string]
vamp_grid_checkpoint = 1
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
?keep_flavors_when_clustering = false
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
?keep_flavors_when_recombining = true
$sample = ""
$sample_normalization = "auto"
?sample_pacify = false
?sample_select = true
sample_max_tries = 10000
sample_split_n_evt = 0
sample_split_n_kbytes = 0
sample_split_index = 0
$rescan_input_format = "raw"
?read_raw = true
?write_raw = true
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
$dump_extension = "pset.dat"
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
$extension_lha = "lha"
$extension_hepmc = "hepmc"
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
$shower_method = "WHIZARD"
?shower_verbose = false
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = true
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_internal"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
ellis_sexton_scale = -1.000000000000E+00
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
gks_multiplicity = 0
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
form_threads = 2
form_workspace = 1000
$gosam_fc = ""
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
$real_partition_mode = "default"
real_partition_scale = 1.000000000000E+01
?nlo_reuse_amplitudes_fks = false
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
$fclibs => "Fortran-libs"
========================================================================
model "Test"
! md5sum = 'DB28187ADA60804A3CFC14A025DED784'
parameter gy = 1.000000000000E+00
parameter ms = 1.500000000000E+02
parameter ff = 1.500000000000E+00
external mf = 2.250000000000E+02
particle SCALAR 25
name "s"
spin 0
mass ms
particle FERMION 6
name "f"
anti "fbar" "F"
tex_anti "\bar{f}"
spin 1/2 isospin 1/2 charge 2/3 color 3
mass mf
vertex "fbar" "f" "s"
vertex "s" "s" "s"
========================================================================
Process library stack:
------------------------------------------------------------------------
Process library: library_2
external = F
makefile exists = F
driver exists = F
code status = o
Process definition list: [empty]
------------------------------------------------------------------------
Process library: library_1
external = F
makefile exists = F
driver exists = F
code status = o
Process definition list: [empty]
========================================================================
Beam structure: s, s => pdf_builtin
========================================================================
Cuts:
------------------------------------------------------------------------
+ SEQUENCE <lexpr> = <lsinglet>
+ SEQUENCE <lsinglet> = <lterm>
| + SEQUENCE <lterm> = <all_fun>
| | + SEQUENCE <all_fun> = all <lexpr> <pargs1>
| | | + KEYWORD all = [keyword] all
| | | + SEQUENCE <lexpr> = <lsinglet>
| | | | + SEQUENCE <lsinglet> = <lterm>
| | | | | + SEQUENCE <lterm> = <compared_expr>
| | | | | | + SEQUENCE <compared_expr> = <expr> <comparison>
| | | | | | | + SEQUENCE <expr> = <term>
| | | | | | | | + SEQUENCE <term> = <factor>
| | | | | | | | | + SEQUENCE <factor> = <variable>
| | | | | | | | | | + IDENTIFIER <variable> = Pt
| | | | | | | + SEQUENCE <comparison> = '>' <expr>
| | | | | | | | + KEYWORD '>' = [keyword] >
| | | | | | | | + SEQUENCE <expr> = <term>
| | | | | | | | | + SEQUENCE <term> = <factor>
| | | | | | | | | | + SEQUENCE <factor> = <integer_value>
| | | | | | | | | | | + SEQUENCE <integer_value> = <integer_literal>
| | | | | | | | | | | | + INTEGER <integer_literal> = 100
| | | + ARGUMENTS <pargs1> = <pexpr>
| | | | + SEQUENCE <pexpr> = <pterm>
| | | | | + SEQUENCE <pterm> = <pexpr_src>
| | | | | | + SEQUENCE <pexpr_src> = <unspecified_prt>
| | | | | | | + SEQUENCE <unspecified_prt> = <cexpr>
| | | | | | | | + SEQUENCE <cexpr> = <variable>
| | | | | | | | | + IDENTIFIER <variable> = s
------------------------------------------------------------------------
Scale: [undefined]
------------------------------------------------------------------------
Factorization scale: [undefined]
------------------------------------------------------------------------
Renormalization scale: [undefined]
------------------------------------------------------------------------
Weight: [undefined]
========================================================================
Event selection: [undefined]
------------------------------------------------------------------------
Event reweighting factor: [undefined]
------------------------------------------------------------------------
Event analysis: [undefined]
------------------------------------------------------------------------
Event sample formats = foo_fmt, bar_fmt
------------------------------------------------------------------------
Event callback: NOP
========================================================================
Process stack: [empty]
========================================================================
[Processes from context environment:]
========================================================================
Process stack: [empty]
========================================================================
quit : F
quit_code: 0
========================================================================
Logfile : ''
========================================================================
* Restore global data
model associated = T
library associated = T
========================================================================
Runtime data:
========================================================================
gy => 1.000000000000E+00
ms => 1.250000000000E+02
ff => 1.500000000000E+00
mf* => 1.875000000000E+02
particle* = PDG(0)
SCALAR* = PDG(25)
s* = PDG(25)
FERMION* = PDG(6)
f* = PDG(6)
fbar* = PDG(-6)
F* = PDG(-6)
charged* = PDG(6, -6)
neutral* = PDG(25)
colored* = PDG(6, -6)
sqrts = 1.000000000000E+03
luminosity = 3.300000000000E+01
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
isr_log_order = 0
isr_q_in = -1.000000000000E+00
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
?isr_handler_keep_mass = true
$epa_mode = "default"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
$negative_sf = "default"
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "Test"
[undefined] process_num_id = [unknown integer]
?proc_as_run_id = true
lcio_run_id = 0
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "library_1"
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
alphas_order = 0
alpha_order = 0
alphas_nf = 5
alpha_nf = -1
alpha_nlep = 1
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
?colorize_subevt = false
tolerance = 0.000000000000E+00
checkpoint = 0
event_callback_interval = 0
?pacify = false
$out_file = ""
?out_advance = true
real_range* = 307
real_precision* = 15
real_epsilon* = 1.000000000000E-16
real_tiny* = 1.000000000000-300
$integration_method = "vamp"
threshold_calls = 10
min_calls_per_channel = 10
min_calls_per_bin = 10
min_bins = 3
max_bins = 20
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
$run_id = "run1"
n_calls_test = 0
?integration_timer = true
?check_grid_file = true
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
integration_results_verbosity = 1
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
[undefined] $integrate_workspace = [unknown string]
vamp_grid_checkpoint = 1
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
?keep_flavors_when_clustering = false
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
?keep_flavors_when_recombining = true
$sample = ""
$sample_normalization = "auto"
?sample_pacify = false
?sample_select = true
sample_max_tries = 10000
sample_split_n_evt = 0
sample_split_n_kbytes = 0
sample_split_index = 0
$rescan_input_format = "raw"
?read_raw = true
?write_raw = true
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
$dump_extension = "pset.dat"
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
$extension_lha = "lha"
$extension_hepmc = "hepmc"
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
$shower_method = "WHIZARD"
?shower_verbose = false
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = true
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_internal"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
ellis_sexton_scale = -1.000000000000E+00
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
gks_multiplicity = 0
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
form_threads = 2
form_workspace = 1000
$gosam_fc = ""
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
$real_partition_mode = "default"
real_partition_scale = 1.000000000000E+01
?nlo_reuse_amplitudes_fks = false
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
$fclibs => "Fortran-libs"
========================================================================
model "Test"
! md5sum = 'DB28187ADA60804A3CFC14A025DED784'
parameter gy = 1.000000000000E+00
parameter ms = 1.250000000000E+02
parameter ff = 1.500000000000E+00
external mf = 1.875000000000E+02
particle SCALAR 25
name "s"
spin 0
mass ms
particle FERMION 6
name "f"
anti "fbar" "F"
tex_anti "\bar{f}"
spin 1/2 isospin 1/2 charge 2/3 color 3
mass mf
vertex "fbar" "f" "s"
vertex "s" "s" "s"
========================================================================
Process library stack:
------------------------------------------------------------------------
Process library: library_2
external = F
makefile exists = F
driver exists = F
code status = o
Process definition list: [empty]
------------------------------------------------------------------------
Process library: library_1
external = F
makefile exists = F
driver exists = F
code status = o
Process definition list: [empty]
========================================================================
Beam structure: s, s => pdf_builtin
========================================================================
Cuts:
------------------------------------------------------------------------
+ SEQUENCE <lexpr> = <lsinglet>
+ SEQUENCE <lsinglet> = <lterm>
| + SEQUENCE <lterm> = <all_fun>
| | + SEQUENCE <all_fun> = all <lexpr> <pargs1>
| | | + KEYWORD all = [keyword] all
| | | + SEQUENCE <lexpr> = <lsinglet>
| | | | + SEQUENCE <lsinglet> = <lterm>
| | | | | + SEQUENCE <lterm> = <compared_expr>
| | | | | | + SEQUENCE <compared_expr> = <expr> <comparison>
| | | | | | | + SEQUENCE <expr> = <term>
| | | | | | | | + SEQUENCE <term> = <factor>
| | | | | | | | | + SEQUENCE <factor> = <variable>
| | | | | | | | | | + IDENTIFIER <variable> = Pt
| | | | | | | + SEQUENCE <comparison> = '>' <expr>
| | | | | | | | + KEYWORD '>' = [keyword] >
| | | | | | | | + SEQUENCE <expr> = <term>
| | | | | | | | | + SEQUENCE <term> = <factor>
| | | | | | | | | | + SEQUENCE <factor> = <integer_value>
| | | | | | | | | | | + SEQUENCE <integer_value> = <integer_literal>
| | | | | | | | | | | | + INTEGER <integer_literal> = 100
| | | + ARGUMENTS <pargs1> = <pexpr>
| | | | + SEQUENCE <pexpr> = <pterm>
| | | | | + SEQUENCE <pterm> = <pexpr_src>
| | | | | | + SEQUENCE <pexpr_src> = <unspecified_prt>
| | | | | | | + SEQUENCE <unspecified_prt> = <cexpr>
| | | | | | | | + SEQUENCE <cexpr> = <variable>
| | | | | | | | | + IDENTIFIER <variable> = s
------------------------------------------------------------------------
Scale: [undefined]
------------------------------------------------------------------------
Factorization scale: [undefined]
------------------------------------------------------------------------
Renormalization scale: [undefined]
------------------------------------------------------------------------
Weight: [undefined]
========================================================================
Event selection: [undefined]
------------------------------------------------------------------------
Event reweighting factor: [undefined]
------------------------------------------------------------------------
Event analysis: [undefined]
------------------------------------------------------------------------
Event sample formats = foo_fmt, bar_fmt
------------------------------------------------------------------------
Event callback: [undefined]
========================================================================
Process stack: [empty]
========================================================================
quit : F
quit_code: 0
========================================================================
Logfile : ''
========================================================================
* Cleanup
* Test output end: rt_data_3
Index: trunk/share/tests/Makefile.am
===================================================================
--- trunk/share/tests/Makefile.am (revision 8819)
+++ trunk/share/tests/Makefile.am (revision 8820)
@@ -1,1625 +1,1629 @@
## Makefile.am -- Makefile for WHIZARD tests
##
## Process this file with automake to produce Makefile.in
##
########################################################################
#
# Copyright (C) 1999-2022 by
# Wolfgang Kilian <kilian@physik.uni-siegen.de>
# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
# Juergen Reuter <juergen.reuter@desy.de>
# 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/lcio_interface_1.ref \
unit_tests/ref-output/lexer_1.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/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/functional_tests/ref-output/process_log.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8819)
+++ trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8820)
@@ -1,568 +1,568 @@
###############################################################################
Process [scattering]: 'process_log_1_p1'
Run ID = ''
Library name = 'process_log_lib'
Process index = 1
Process components:
1: 'process_log_1_p1_i1': e-, e+ => m-, m+ [omega]
------------------------------------------------------------------------
###############################################################################
Integral = 8.3556567814E+03
Error = 3.2359019246E+00
Accuracy = 1.8972317270E-02
Chi2 = 5.2032955661E-01
Efficiency = 7.8315602603E-01
T(10k evt) = <time estimate>
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 800 8.3525258E+03 6.97E+00 0.08 0.02* 67.98
2 800 8.3688100E+03 5.46E+00 0.07 0.02* 59.78
3 800 8.3686236E+03 5.53E+00 0.07 0.02 78.45
|-----------------------------------------------------------------------------|
3 2400 8.3648733E+03 3.39E+00 0.04 0.02 78.45 2.06 3
|-----------------------------------------------------------------------------|
4 800 8.3602554E+03 5.63E+00 0.07 0.02 78.37
5 800 8.3525628E+03 5.62E+00 0.07 0.02 78.30
6 800 8.3541861E+03 5.56E+00 0.07 0.02* 78.32
|-----------------------------------------------------------------------------|
6 2400 8.3556568E+03 3.24E+00 0.04 0.02 78.32 0.52 3
|=============================================================================|
###############################################################################
| Phase-space chain (grove) weight history: (numbers in %)
| chain | 1
|=============================================================================|
1 | 100
2 | 100
3 | 100
|-----------------------------------------------------------------------------|
4 | 100
5 | 100
6 | 100
|=============================================================================|
###############################################################################
Call statistics (current run):
total = 2400
failed kin. = 0
failed cuts = 0
passed cuts = 0
evaluated = 2400
###############################################################################
MC Integrator is VAMP
------------------------------------------------------------------------
VAMP history (global):
Pass #1:
------------------------------------------------------------------------------
[vamp] it #calls integral average chi2 eff.
[vamp] 1 800* 0.0000E+00(0.00E+00) 8.352526E+03(6.97E+00) 0.0 0.000
[vamp] 2 800* 0.0000E+00(0.00E+00) 8.368810E+03(5.46E+00) 0.0 0.000
[vamp] 3 800* 0.0000E+00(0.00E+00) 8.368624E+03(5.53E+00) 0.0 0.000
------------------------------------------------------------------------------
Channel histories: [undefined]
Pass #2:
------------------------------------------------------------------------------
[vamp] it #calls integral average chi2 eff.
[vamp] 1 800* 0.0000E+00(0.00E+00) 8.360255E+03(5.63E+00) 0.0 0.000
[vamp] 2 800* 0.0000E+00(0.00E+00) 8.352563E+03(5.62E+00) 0.0 0.000
[vamp] 3 800* 0.0000E+00(0.00E+00) 8.354186E+03(5.56E+00) 0.0 0.000
------------------------------------------------------------------------------
Channel histories: [undefined]
------------------------------------------------------------------------
Inequivalent channels:
Channel 1: Mult. = 1 Symm. = 1 Invar.: TF
Equivalence list:
Equivalent channels: 1 1
Permutation: 1 2
Mode: 3 0
------------------------------------------------------------------------
Weights of channel chains (groves):
1 1.0000000000
###############################################################################
Beam data (collision):
e- (mass = 0.0000000E+00 GeV)
e+ (mass = 0.0000000E+00 GeV)
sqrts = 1.000000000000E+02 GeV
###############################################################################
No cuts used.
------------------------------------------------------------------------
No scale expression was given.
------------------------------------------------------------------------
No factorization scale expression was given.
------------------------------------------------------------------------
No renormalization scale expression was given.
------------------------------------------------------------------------
No weight expression was given.
###############################################################################
Summary of quantum-number states:
+ sign: allowed and contributing
no + : switched off at runtime
------------------------------------------------------------------------
Term #1
1 [f(11) h(-1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(-1)]
2 [f(11) h(-1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(1)]
3 [f(11) h(-1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(-1)]
4 [f(11) h(-1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(1)]
+ 5 [f(11) h(-1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(-1)]
+ 6 [f(11) h(-1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(1)]
+ 7 [f(11) h(-1) / f(-11) h(1) / f(13) h(1) / f(-13) h(-1)]
+ 8 [f(11) h(-1) / f(-11) h(1) / f(13) h(1) / f(-13) h(1)]
+ 9 [f(11) h(1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(-1)]
+ 10 [f(11) h(1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(1)]
+ 11 [f(11) h(1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(-1)]
+ 12 [f(11) h(1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(1)]
13 [f(11) h(1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(-1)]
14 [f(11) h(1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(1)]
15 [f(11) h(1) / f(-11) h(1) / f(13) h(1) / f(-13) h(-1)]
16 [f(11) h(1) / f(-11) h(1) / f(13) h(1) / f(-13) h(1)]
###############################################################################
Variable list:
------------------------------------------------------------------------
ee = 3.000000000000E-01
me = 0.000000000000E+00
mmu = 1.000000000000E+01
mtau = 1.777000000000E+00
particle = PDG(0)
E_LEPTON = PDG(11)
e- = PDG(11)
e1 = PDG(11)
e+ = PDG(-11)
E1 = PDG(-11)
MU_LEPTON = PDG(13)
m- = PDG(13)
e2 = PDG(13)
mu- = PDG(13)
m+ = PDG(-13)
E2 = PDG(-13)
mu+ = PDG(-13)
TAU_LEPTON = PDG(15)
t- = PDG(15)
e3 = PDG(15)
ta- = PDG(15)
tau- = PDG(15)
t+ = PDG(-15)
E3 = PDG(-15)
ta+ = PDG(-15)
tau+ = PDG(-15)
PHOTON = PDG(22)
A = PDG(22)
gamma = PDG(22)
photon = PDG(22)
charged = PDG(11, 13, 15, -11, -13, -15)
neutral = PDG(22)
colored = PDG()
sqrts = 1.000000000000E+02
luminosity = 0.000000000000E+00
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
isr_log_order = 0
isr_q_in = -1.000000000000E+00
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
?isr_handler_keep_mass = true
$epa_mode = "default"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
$negative_sf = "default"
?logging = true
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "QED"
[undefined] process_num_id = [unknown integer]
?proc_as_run_id = true
lcio_run_id = 0
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "process_log_lib"
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
alphas_order = 0
alpha_order = 0
alphas_nf = 5
alpha_nf = -1
alpha_nlep = 1
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
?colorize_subevt = false
tolerance = 0.000000000000E+00
checkpoint = 0
event_callback_interval = 0
?pacify = false
$out_file = ""
?out_advance = true
real_range = <real_range>
real_precision = <real_precision>
real_epsilon = <real_epsilon>
real_tiny = <real_tiny>
$integration_method = "vamp"
threshold_calls = 10
min_calls_per_channel = 10
min_calls_per_bin = 10
min_bins = 3
max_bins = 20
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
$run_id = ""
n_calls_test = 0
?integration_timer = true
?check_grid_file = true
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
integration_results_verbosity = 1
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
[undefined] $integrate_workspace = [unknown string]
vamp_grid_checkpoint = 1
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "wood"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm = 0
cambridge_algorithm = 1
antikt_algorithm = 2
genkt_algorithm = 3
cambridge_for_passive_algorithm = 11
genkt_for_passive_algorithm = 13
ee_kt_algorithm = 50
ee_genkt_algorithm = 53
plugin_algorithm = 99
undefined_jet_algorithm = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
?keep_flavors_when_clustering = false
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
?keep_flavors_when_recombining = true
$sample = ""
$sample_normalization = "auto"
?sample_pacify = false
?sample_select = true
sample_max_tries = 10000
sample_split_n_evt = 0
sample_split_n_kbytes = 0
sample_split_index = 0
$rescan_input_format = "raw"
?read_raw = true
?write_raw = true
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
$dump_extension = "pset.dat"
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
$extension_lha = "lha"
$extension_hepmc = "hepmc"
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
$shower_method = "WHIZARD"
?shower_verbose = false
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active = false
openmp_num_threads_default = 1
openmp_num_threads = 1
?openmp_logging = false
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_internal"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
ellis_sexton_scale = -1.000000000000E+00
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
gks_multiplicity = 0
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
form_threads = 2
form_workspace = 1000
$gosam_fc = ""
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
$real_partition_mode = "default"
real_partition_scale = 1.000000000000E+01
?nlo_reuse_amplitudes_fks = false
$fc = Fortran-compiler
$fcflags = Fortran-flags
$fclibs = Fortran-libs
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?rebuild_events = true
[undefined] num_id(process_log_1_p1) = [unknown integer]
[undefined] integral(process_log_1_p1) = [unknown real]
[undefined] error(process_log_1_p1) = [unknown real]
------------------------------------------------------------------------
------------------------------------------------------------------------
Beam structure: [any particles]
###############################################################################
Index: trunk/share/tests/functional_tests/ref-output/show_4.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8819)
+++ trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8820)
@@ -1,1213 +1,1213 @@
?openmp_logging = false
[user variable] foo = PDG(11, 13, 15)
[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
#####################################################
QED.ee => 3.028600000000E-01
QED.me => 5.110000000000E-04
QED.mmu => 1.057000000000E-01
QED.mtau => 1.777000000000E+00
[undefined] sqrts = [unknown real]
luminosity = 0.000000000000E+00
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_q_in = -1.000000000000E+00
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
[undefined] circe1_sqrts = [unknown real]
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
lambda_qcd = 2.000000000000E-01
helicity_selection_threshold = 1.000000000000E+10
safety_factor = 1.000000000000E+00
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
tolerance = 0.000000000000E+00
real_epsilon* = <real_epsilon>
real_tiny* = <real_tiny>
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_fixed_alphas = 0.000000000000E+00
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
blha_top_yukawa = -1.000000000000E+00
ellis_sexton_scale = -1.000000000000E+00
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
real_partition_scale = 1.000000000000E+01
#####################################################
QED.charged* = PDG(11, 13, 15, -11, -13, -15)
#####################################################
[user variable] foo = PDG(11, 13, 15)
#####################################################
[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
#####################################################
$sf_trace_file = ""
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
$pdf_builtin_set = "CTEQ6L"
$isr_handler_mode = "trivial"
$epa_mode = "default"
$epa_handler_mode = "trivial"
$circe1_acc = "SBAND"
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
[undefined] $beam_events_file = [unknown string]
$negative_sf = "default"
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
$model_name = "QED"
$method = "omega"
$restrictions = ""
$omega_flags = ""
$library_name = "show_4_lib"
$rng_method = "tao"
$event_file_version = ""
$polarization_mode = "helicity"
$out_file = ""
$integration_method = "vamp"
$run_id = ""
[undefined] $integrate_workspace = [unknown string]
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "default"
$phs_file = ""
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
$sample = ""
$sample_normalization = "auto"
$rescan_input_format = "raw"
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
$dump_extension = "pset.dat"
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
$extension_lha = "lha"
$extension_hepmc = "hepmc"
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
$shower_method = "WHIZARD"
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
$hadronization_method = "PYTHIA6"
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
$select_alpha_regions = ""
$virtual_selection = "Full"
$blha_ew_scheme = "alpha_internal"
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
$gosam_fc = ""
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
$real_partition_mode = "default"
$fc => Fortran-compiler
$fcflags => Fortran-flags
$fclibs => Fortran-libs
#####################################################
?sf_trace = false
?sf_allow_s_mapping = true
?hoppet_b_matching = false
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
?isr_handler_keep_mass = true
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
?circe1_generate = true
?circe1_map = true
?circe1_with_radiation = false
?circe2_polarized = true
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => true
?proc_as_run_id = true
?report_progress = true
[user variable] ?me_verbose = false
?omega_write_phs_output = false
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
?fatal_beam_decay = true
?helicity_selection_active = true
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
?unweighted = true
?negative_weights = false
?resonance_history = false
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
?polarized_events = false
?colorize_subevt = false
?pacify = false
?out_advance = true
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
?integration_timer = true
?check_grid_file = true
?vis_channels = false
?check_phs_file = true
?phs_only = false
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
?normalize_bins = false
?y_log = false
?x_log = false
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
?analysis_file_only = false
?keep_flavors_when_clustering = false
?keep_flavors_when_recombining = true
?sample_pacify = false
?sample_select = true
?read_raw = true
?write_raw = true
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
?shower_verbose = false
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
?ps_tauola_pol_vector = false
?mlm_matching = false
?powheg_matching = false
?powheg_use_singular_jacobian = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active* = false
?openmp_logging = false
?mpi_logging = false
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
?virtual_collinear_resonance_aware = true
?openloops_use_cms = true
?openloops_switch_off_muon_yukawa = false
?disable_subtraction = false
?vis_fks_regions = false
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
?nlo_reuse_amplitudes_fks = false
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?rebuild_events = true
#####################################################
[undefined] sqrts = [unknown real]
luminosity = 0.000000000000E+00
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
isr_log_order = 0
isr_q_in = -1.000000000000E+00
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
?isr_handler_keep_mass = true
$epa_mode = "default"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
$negative_sf = "default"
?logging => true
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "QED"
[undefined] process_num_id = [unknown integer]
?proc_as_run_id = true
lcio_run_id = 0
$method = "omega"
?report_progress = true
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "show_4_lib"
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
alphas_order = 0
alpha_order = 0
alphas_nf = 5
alpha_nf = -1
alpha_nlep = 1
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
?colorize_subevt = false
tolerance = 0.000000000000E+00
checkpoint = 0
event_callback_interval = 0
?pacify = false
$out_file = ""
?out_advance = true
real_range* = <real_range>
real_precision* = <real_precision>
real_epsilon* = <real_epsilon>
real_tiny* = <real_tiny>
$integration_method = "vamp"
threshold_calls = 10
min_calls_per_channel = 10
min_calls_per_bin = 10
min_bins = 3
max_bins = 20
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
$run_id = ""
n_calls_test = 0
?integration_timer = true
?check_grid_file = true
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
integration_results_verbosity = 1
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
[undefined] $integrate_workspace = [unknown string]
vamp_grid_checkpoint = 1
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
?keep_flavors_when_clustering = false
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
?keep_flavors_when_recombining = true
$sample = ""
$sample_normalization = "auto"
?sample_pacify = false
?sample_select = true
sample_max_tries = 10000
sample_split_n_evt = 0
sample_split_n_kbytes = 0
sample_split_index = 0
$rescan_input_format = "raw"
?read_raw = true
?write_raw = true
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
$dump_extension = "pset.dat"
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
$extension_lha = "lha"
$extension_hepmc = "hepmc"
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
$shower_method = "WHIZARD"
?shower_verbose = false
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = false
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_internal"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
ellis_sexton_scale = -1.000000000000E+00
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
gks_multiplicity = 0
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
form_threads = 2
form_workspace = 1000
$gosam_fc = ""
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
$real_partition_mode = "default"
real_partition_scale = 1.000000000000E+01
?nlo_reuse_amplitudes_fks = false
$fc => Fortran-compiler
$fcflags => Fortran-flags
$fclibs => Fortran-libs
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?rebuild_events = true
#####################################################
QED.ee => 3.028600000000E-01
QED.me => 5.110000000000E-04
QED.mmu => 1.057000000000E-01
QED.mtau => 1.777000000000E+00
QED.particle* = PDG(0)
QED.E_LEPTON* = PDG(11)
QED.e-* = PDG(11)
QED.e1* = PDG(11)
QED.e+* = PDG(-11)
QED.E1* = PDG(-11)
QED.MU_LEPTON* = PDG(13)
QED.m-* = PDG(13)
QED.e2* = PDG(13)
QED.mu-* = PDG(13)
QED.m+* = PDG(-13)
QED.E2* = PDG(-13)
QED.mu+* = PDG(-13)
QED.TAU_LEPTON* = PDG(15)
QED.t-* = PDG(15)
QED.e3* = PDG(15)
QED.ta-* = PDG(15)
QED.tau-* = PDG(15)
QED.t+* = PDG(-15)
QED.E3* = PDG(-15)
QED.ta+* = PDG(-15)
QED.tau+* = PDG(-15)
QED.PHOTON* = PDG(22)
QED.A* = PDG(22)
QED.gamma* = PDG(22)
QED.photon* = PDG(22)
QED.charged* = PDG(11, 13, 15, -11, -13, -15)
QED.neutral* = PDG(22)
QED.colored* = PDG()
[undefined] sqrts = [unknown real]
luminosity = 0.000000000000E+00
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
isr_log_order = 0
isr_q_in = -1.000000000000E+00
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
?isr_handler_keep_mass = true
$epa_mode = "default"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
$negative_sf = "default"
?logging => true
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "QED"
[undefined] process_num_id = [unknown integer]
?proc_as_run_id = true
lcio_run_id = 0
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "show_4_lib"
?alphas_is_fixed = true
?alpha_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alpha_evolve_analytic = true
alphas_order = 0
alpha_order = 0
alphas_nf = 5
alpha_nf = -1
alpha_nlep = 1
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?rescan_force = false
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
?colorize_subevt = false
tolerance = 0.000000000000E+00
checkpoint = 0
event_callback_interval = 0
?pacify = false
$out_file = ""
?out_advance = true
real_range* = <real_range>
real_precision* = <real_precision>
real_epsilon* = <real_epsilon>
real_tiny* = <real_tiny>
$integration_method = "vamp"
threshold_calls = 10
min_calls_per_channel = 10
min_calls_per_bin = 10
min_bins = 3
max_bins = 20
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
$run_id = ""
n_calls_test = 0
?integration_timer = true
?check_grid_file = true
accuracy_goal = 0.000000000000E+00
error_goal = 0.000000000000E+00
relative_error_goal = 0.000000000000E+00
integration_results_verbosity = 1
error_threshold = 0.000000000000E+00
channel_weights_power = 2.500000000000E-01
[undefined] $integrate_workspace = [unknown string]
vamp_grid_checkpoint = 1
$vamp_grid_format = "ascii"
$vamp_parallel_method = "simple"
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
jet_dcut = 0.000000000000E+00
?keep_flavors_when_clustering = false
photon_iso_eps = 1.000000000000E+00
photon_iso_n = 1.000000000000E+00
photon_iso_r0 = 4.000000000000E-01
photon_rec_r0 = 1.000000000000E-01
?keep_flavors_when_recombining = true
$sample = ""
$sample_normalization = "auto"
?sample_pacify = false
?sample_select = true
sample_max_tries = 10000
sample_split_n_evt = 0
sample_split_n_kbytes = 0
sample_split_index = 0
$rescan_input_format = "raw"
?read_raw = true
?write_raw = true
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
$dump_extension = "pset.dat"
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
$extension_lha = "lha"
$extension_hepmc = "hepmc"
?hepmc_output_cross_section = false
?hepmc3_write_flows = false
$hepmc3_mode = "HepMC3"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
$shower_method = "WHIZARD"
?shower_verbose = false
$ps_PYTHIA_PYGIVE = ""
$ps_PYTHIA8_config = ""
$ps_PYTHIA8_config_file = ""
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.000000000000E+00
-powheg_lambda = 2.000000000000E-01
+powheg_lambda = 0.000000000000E+00
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = false
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_internal"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
$openloops_allowed_libs = ""
ellis_sexton_scale = -1.000000000000E+00
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 0.000000000000E+00
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_o = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
gks_multiplicity = 0
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
form_threads = 2
form_workspace = 1000
$gosam_fc = ""
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
?nlo_use_born_scale = false
?nlo_cut_all_real_sqmes = false
$real_partition_mode = "default"
real_partition_scale = 1.000000000000E+01
?nlo_reuse_amplitudes_fks = false
$fc => Fortran-compiler
$fcflags => Fortran-flags
$fclibs => Fortran-libs
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?rebuild_events = true
[user variable] foo = PDG(11, 13, 15)
[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
| WHIZARD run finished.
|=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref (revision 8819)
+++ trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref (revision 8820)
@@ -1,733 +1,723 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
openmp_num_threads = 1
?pacify = true
seed = 0
SM.wtop => 0.00000E+00
SM.mtop => 1.75000E+02
?use_vamp_equivalences = false
$loop_me_method = "dummy"
?alphas_is_fixed = false
?alphas_from_mz = true
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = true
?powheg_matching = true
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.00000E+00
?powheg_use_singular_jacobian = false
| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
sqrts = 5.00000E+02
| Integrate: current process library needs compilation
| Process library 'powheg_1_lib': compiling ...
| Process library 'powheg_1_lib': writing makefile
| Process library 'powheg_1_lib': removing old files
| Process library 'powheg_1_lib': writing driver
| Process library 'powheg_1_lib': creating source code
| Process library 'powheg_1_lib': compiling sources
| Process library 'powheg_1_lib': linking
| Process library 'powheg_1_lib': loading
| Process library 'powheg_1_lib': ... success.
| Integrate: compilation done
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process powheg_1_p1:
| Beam structure: [any particles]
| Beam data (collision):
| e+ (mass = 5.1099700E-04 GeV)
| e- (mass = 5.1099700E-04 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p1.i1.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'powheg_1_p1'
| Library name = 'powheg_1_lib'
| Process index = 1
| Process components:
| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
Warning: No cuts have been defined.
| Using user-defined general scale.
| Starting integration for process 'powheg_1_p1'
| Integration hook: add POWHEG hook
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 1 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
|-----------------------------------------------------------------------------|
1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
|=============================================================================|
n_events = 1
?debug_decay = false
?debug_process = false
?debug_verbose = false
?sample_pacify = true
?write_raw = false
| Starting simulation for process 'powheg_1_p1'
| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 1
| Simulation: requested number of events = 1
| corr. to luminosity [fb-1] = 2.1359E-03
| Events: writing to ASCII file 'powheg_1_p1.debug'
| Events: generating 1 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p1.pg'
-| Grid: Mean value of the grid: 4.184320114E-02
-| Grid: Max value of the grid: 9.365696109E-02
-| Grid: Mean/Max value of the grid: 4.467708609E-01
+| Grid: Mean value of the grid: 2.73541E-03
+| Grid: Max value of the grid: 5.79027E-03
+| Grid: Mean/Max value of the grid: 4.72416E-01
| ... event sample complete.
| Events: actual unweighting efficiency = 20.00 %
| Events: closing ASCII file 'powheg_1_p1.debug'
-Warning: There have been 1 ( 50.00%) POWHEG grid excesses.
n_events = 2
| Starting simulation for process 'powheg_1_p1'
| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 2
| Simulation: requested number of events = 2
| corr. to luminosity [fb-1] = 4.2717E-03
| Events: writing to ASCII file 'powheg_1_p1.debug'
| Events: generating 2 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p1.pg'
-| Grid: Mean value of the grid: 4.184320114E-02
-| Grid: Max value of the grid: 9.365696109E-02
-| Grid: Mean/Max value of the grid: 4.467708609E-01
+| Grid: Mean value of the grid: 2.73541E-03
+| Grid: Max value of the grid: 5.79027E-03
+| Grid: Mean/Max value of the grid: 4.72416E-01
| ... event sample complete.
| Events: actual unweighting efficiency = 100.00 %
| Events: closing ASCII file 'powheg_1_p1.debug'
-Warning: There have been 3 ( 50.00%) POWHEG grid excesses.
$real_partition_mode = "on"
real_partition_scale = 5.00000E+00
| Process library 'powheg_1_lib': unloading
| Process library 'powheg_1_lib': open
| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
| Integrate: current process library needs compilation
| Process library 'powheg_1_lib': compiling ...
| Process library 'powheg_1_lib': writing makefile
| Process library 'powheg_1_lib': removing old files
| Process library 'powheg_1_lib': writing driver
| Process library 'powheg_1_lib': creating source code
| Process library 'powheg_1_lib': compiling sources
| Process library 'powheg_1_lib': linking
| Process library 'powheg_1_lib': loading
| Process library 'powheg_1_lib': ... success.
| Integrate: compilation done
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 3
| Initializing integration for process powheg_1_p2:
| Beam structure: [any particles]
| Beam data (collision):
| e+ (mass = 5.1099700E-04 GeV)
| e- (mass = 5.1099700E-04 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i1.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'powheg_1_p2'
| Library name = 'powheg_1_lib'
| Process index = 2
| Process components:
| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 2 channels, 5 dimensions
| Phase space: found 2 channels, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
Warning: No cuts have been defined.
| Using user-defined general scale.
| Integration hook: add POWHEG hook
| Starting integration for process 'powheg_1_p2' part 'Combined'
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 1 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
|-----------------------------------------------------------------------------|
1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
|=============================================================================|
| Starting integration for process 'powheg_1_p2' part 'real'
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 2 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
|-----------------------------------------------------------------------------|
1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
|=============================================================================|
| Integrate: sum of all components
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
|=============================================================================|
tolerance = 1.08344E+02
| expect: success
| Starting simulation for process 'powheg_1_p2'
| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 4
| Simulation: requested number of events = 2
| corr. to luminosity [fb-1] = 4.0174E-03
| Events: writing to ASCII file 'powheg_1_p2.debug'
| Events: generating 2 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p2.pg'
-| Grid: Mean value of the grid: 8.354013566E-03
-| Grid: Max value of the grid: 9.272013548E-02
-| Grid: Mean/Max value of the grid: 9.009923813E-02
+| Grid: Mean value of the grid: 5.27611E-04
+| Grid: Max value of the grid: 6.09917E-03
+| Grid: Mean/Max value of the grid: 8.65055E-02
| ... event sample complete.
| Events: actual unweighting efficiency = 20.00 %
| Events: closing ASCII file 'powheg_1_p2.debug'
| Summary of value checks:
| Failures: 0 / Total: 1
-| There were no errors and 4 warning(s).
+| There were no errors and 2 warning(s).
| WHIZARD run finished.
|=============================================================================|
Contents of powheg_1_p1.debug:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 2.82009E-02
Squared matrix el. (prc) = 2.82009E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 7
calls = 3
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 9.608533E+01 -1.236770E+02 -8.571236E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -9.608533E+01 1.236770E+02 8.571236E+01
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 8
calls = 1
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
- 3 [v] t 1 0 1-2 5-7 250.000 96.085 -123.677 -85.712 30625.000
- 4 [v] tbar 0 1 1-2 5-7 250.000 -96.085 123.677 85.712 30625.000
- 5 [o] t 2 0 3-4 [none] 196.039 103.504 -100.239 -132.929 30625.000
- 6 [o] tbar 0 1 3-4 [none] 250.979 -96.822 124.625 86.369 30625.000
- 7 [o] gl 1 2 3-4 [none] 52.982 -6.683 -24.386 46.560 0.000
+ 3 [o] t 1 0 1-2 [none] 250.000 96.085 -123.677 -85.712 30625.000
+ 4 [o] tbar 0 1 1-2 [none] 250.000 -96.085 123.677 85.712 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
-n_out* => 3
-n_tot* => 5
+n_out* => 2
+n_tot* => 4
$process_id* => "powheg_1_p1"
process_num_id* => [unknown integer]
sqme* => 2.82009E-02
sqme_ref* => 2.82009E-02
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
- 3 prt(o:6| 1.9603876E+02; 1.0350443E+02,-1.0023939E+02,-1.3292890E+02| 3.0625000E+04| 3)
- 4 prt(o:-6| 2.5097910E+02;-9.6821813E+01, 1.2462497E+02, 8.6369341E+01| 3.0625000E+04| 4)
- 5 prt(o:21| 5.2982138E+01;-6.6826136E+00,-2.4385585E+01, 4.6559562E+01| 0.0000000E+00| 5)
+ 3 prt(o:6| 2.5000000E+02; 9.6085328E+01,-1.2367700E+02,-8.5712364E+01| 3.0625000E+04| 3)
+ 4 prt(o:-6| 2.5000000E+02;-9.6085328E+01, 1.2367700E+02, 8.5712364E+01| 3.0625000E+04| 4)
========================================================================
========================================================================
Event #2
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
- Squared matrix el. (ref) = 3.34619E-02
- Squared matrix el. (prc) = 3.34619E-02
+ Squared matrix el. (ref) = 2.76793E-02
+ Squared matrix el. (prc) = 2.76793E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 7
calls = 6
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 1.688666E+02 3.093682E+01 -4.901007E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -1.688666E+02 -3.093682E+01 4.901007E+01
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 8
calls = 2
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
- 3 [v] t 1 0 1-2 5-7 250.000 168.867 30.937 -49.010 30625.000
- 4 [v] tbar 0 1 1-2 5-7 250.000 -168.867 -30.937 49.010 30625.000
- 5 [o] t 2 0 3-4 [none] 191.977 188.835 33.666 7.940 30625.000
- 6 [o] tbar 0 1 3-4 [none] 247.249 -165.204 -30.266 47.947 30625.000
- 7 [o] gl 1 2 3-4 [none] 60.774 -23.632 -3.400 -55.887 0.000
+ 3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
+ 4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
-n_out* => 3
-n_tot* => 5
+n_out* => 2
+n_tot* => 4
$process_id* => "powheg_1_p1"
process_num_id* => [unknown integer]
-sqme* => 3.34619E-02
-sqme_ref* => 3.34619E-02
+sqme* => 2.76793E-02
+sqme_ref* => 2.76793E-02
event_index* => 2
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
- 3 prt(o:6| 1.9197718E+02; 1.8883530E+02, 3.3666245E+01, 7.9404340E+00| 3.0625000E+04| 3)
- 4 prt(o:-6| 2.4724932E+02;-1.6520379E+02,-3.0265780E+01, 4.7947013E+01| 3.0625000E+04| 4)
- 5 prt(o:21| 6.0773502E+01;-2.3631517E+01,-3.4004649E+00,-5.5887447E+01| 0.0000000E+00| 5)
+ 3 prt(o:6| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01| 3.0625000E+04| 3)
+ 4 prt(o:-6| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01| 3.0625000E+04| 4)
========================================================================
Contents of powheg_1_p2.debug:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 1.41607E-05
Squared matrix el. (prc) = 1.41607E-05
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 2
Selected term = 6
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196611
calls = 3
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4 5
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4 5
Particle 3 [o] f(6)c(1 )
E = 2.219832E+02
P = -7.125693E+01 -1.137429E+02 -2.522963E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-2 )
E = 2.128305E+02
P = 1.983915E+01 1.013308E+02 6.332695E+01
T = 3.062500000E+04
Parents: 1 2
Particle 5 [o] f(21)c(2 -1)
E = 6.518630E+01
P = 5.141778E+01 1.241207E+01 -3.809732E+01
T = 0.000000000E+00
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196612
calls = 1
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
n_out* => 3
n_tot* => 5
$process_id* => "powheg_1_p2"
process_num_id* => [unknown integer]
sqme* => 1.41607E-05
sqme_ref* => 1.41607E-05
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
3 prt(o:6| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01| 3.0625000E+04| 3)
4 prt(o:-6| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01| 3.0625000E+04| 4)
5 prt(o:21| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01| 0.0000000E+00| 5)
========================================================================
========================================================================
Event #2
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 3.51646E-02
Squared matrix el. (prc) = 3.51646E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196611
calls = 6
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 1.143154E+02 2.823158E+00 -1.371095E+02
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -1.143154E+02 -2.823158E+00 1.371095E+02
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196612
calls = 2
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
n_out* => 2
n_tot* => 4
$process_id* => "powheg_1_p2"
process_num_id* => [unknown integer]
sqme* => 3.51646E-02
sqme_ref* => 3.51646E-02
event_index* => 2
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
3 prt(o:6| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02| 3.0625000E+04| 3)
4 prt(o:-6| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02| 3.0625000E+04| 4)
========================================================================
Contents of powheg_1_p1.pg:
3
5 5 2
- 9.166232822E-02 9.032892795E-02 6.723676221E-02 4.571325484E-02 3.324701486E-02 9.151967933E-02 8.865305477E-02 6.535660343E-02 5.518273909E-02 3.145235542E-02 6.859817349E-02 6.274307227E-02 5.549692520E-02 4.020251383E-02 2.152768995E-02 3.667138399E-02 3.455078829E-02 2.459687421E-02 1.598446674E-02 3.909822037E-03 9.948611428E-03 1.134521126E-02 8.596143726E-03 7.850793485E-03 2.970030634E-03 9.108498731E-02 9.365696109E-02 6.651595158E-02 6.362813281E-02 1.377490762E-02 9.196807473E-02 8.054413645E-02 6.075077394E-02 4.353572100E-02 3.463256063E-02 6.864675177E-02 5.899357844E-02 4.850224835E-02 2.576225445E-02 2.954713951E-02 3.685547282E-02 3.341221845E-02 2.708529841E-02 1.146924877E-02 7.331535288E-03 1.065212295E-02 9.915711720E-03 9.451902615E-03 6.411921968E-03 2.685223423E-03
+ 5.790269644E-03 4.340795108E-03 3.956051847E-03 3.268282717E-03 2.051663025E-03 5.483521338E-03 4.862867184E-03 3.083117149E-03 1.719170734E-03 1.731060783E-03 4.642895497E-03 4.089380716E-03 3.278082328E-03 2.072774426E-03 0.000000000E+00 4.285080610E-03 2.703040559E-03 1.939544788E-03 1.808207664E-03 4.832499720E-04 1.725229448E-03 1.848229758E-03 1.666841200E-03 8.779275397E-04 5.973719500E-04 5.658020044E-03 4.797607112E-03 3.691638415E-03 2.563334950E-03 1.517565346E-03 5.487404533E-03 4.496578313E-03 3.894360323E-03 2.025323813E-03 2.321871855E-03 4.723770503E-03 3.748861818E-03 2.983344155E-03 2.071275780E-03 0.000000000E+00 4.306591537E-03 2.873724204E-03 2.416448227E-03 1.437407107E-03 9.061702013E-04 1.847228261E-03 1.615352333E-03 1.894684827E-03 7.407160321E-04 4.468086944E-04
Contents of powheg_1_p2.pg:
3
5 5 2
- 8.792102126E-02 0.000000000E+00 8.758619730E-03 0.000000000E+00 0.000000000E+00 9.266568762E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.389639179E-02 4.005704198E-03 1.398322561E-03 0.000000000E+00 1.912360734E-04 8.792327284E-02 0.000000000E+00 8.658991516E-03 0.000000000E+00 0.000000000E+00 9.272013548E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.354189425E-02 4.295173634E-03 1.522057391E-03 0.000000000E+00 2.021699602E-04
+ 6.095585482E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638455441E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.295080449E-03 7.908638236E-04 3.287240771E-04 0.000000000E+00 4.113170873E-05 6.099167083E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638548619E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.236532849E-03 8.480150493E-04 3.249848815E-04 0.000000000E+00 4.348340652E-05
Index: trunk/share/tests/functional_tests/ref-output-double/powheg_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/powheg_2.ref (revision 0)
+++ trunk/share/tests/functional_tests/ref-output-double/powheg_2.ref (revision 8820)
@@ -0,0 +1,1578 @@
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+openmp_num_threads = 1
+?pacify = true
+?write_raw = false
+SM.mZ => 9.11880E+01
+SM.mW => 8.04190E+01
+SM.mH => 1.25000E+02
+SM.GF => 1.16639E-05
+SM.me => 0.00000E+00
+SM.mmu => 0.00000E+00
+SM.mtau => 1.77700E+00
+?alphas_is_fixed = false
+?alphas_from_mz = true
+?alphas_from_lambda_qcd = false
+?alphas_from_lhapdf = false
+alphas_nf = 5
+alphas_order = 1
+$exclude_gauge_splittings = "u:s:b:t"
+$method = "dummy"
+$pdf_builtin_set = "mstw2008nlo"
+sqrts = 1.40000E+04
+?combined_nlo_integration = true
+| Process library 'powheg_2_lib': recorded process 'powheg_2_p1'
+seed = 130
+?fixed_order_nlo_events = false
+?unweighted = true
+?powheg_matching = true
+powheg_grid_size_xi = 10
+powheg_grid_size_y = 10
+powheg_pt_min = 1.00000E+00
+| Integrate: current process library needs compilation
+| Process library 'powheg_2_lib': compiling ...
+| Process library 'powheg_2_lib': writing makefile
+| Process library 'powheg_2_lib': removing old files
+| Process library 'powheg_2_lib': writing driver
+| Process library 'powheg_2_lib': creating source code
+| Process library 'powheg_2_lib': compiling sources
+| Process library 'powheg_2_lib': linking
+| Process library 'powheg_2_lib': loading
+| Process library 'powheg_2_lib': ... success.
+| Integrate: compilation done
+| QCD alpha: using a running strong coupling
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 130
+| Initializing integration for process powheg_2_p1:
+| Beam structure: p, p => pdf_builtin
+| Beam data (collision):
+| p (mass = 0.0000000E+00 GeV)
+| p (mass = 0.0000000E+00 GeV)
+| sqrts = 1.400000000000E+04 GeV
+| Initialized builtin PDF MSTW2008NLO
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'powheg_2_p1.i1.phs'
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'powheg_2_p1.i3.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'powheg_2_p1'
+| Library name = 'powheg_2_lib'
+| Process index = 1
+| Process components:
+| 1: 'powheg_2_p1_i1': d, dbar => e-, e+ [dummy]
+| 2: 'powheg_2_p1_i2': d:gl, dbar:gl => e-, e+, gl:d:dbar [dummy], [real]
+| 3: 'powheg_2_p1_i3': d, dbar => e-, e+ [dummy], [virtual]
+| 4: 'powheg_2_p1_i4': d, dbar => e-, e+ [inactive], [subtraction]
+| 5: 'powheg_2_p1_i5': d, dbar => e-, e+ [dummy], [dglap]
+| ------------------------------------------------------------------------
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Beam structure: pdf_builtin, none => none, pdf_builtin
+| Beam structure: 2 channels, 2 dimensions
+| Applying user-defined cuts.
+| Using user-defined general scale.
+| Starting integration for process 'powheg_2_p1'
+| Integration hook: add POWHEG hook
+| Shower: interfacing PDF builtin set #8
+| Integrate: iterations = 1:1000:"gw"
+| Integrator: 2 chains, 2 channels, 7 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
+|-----------------------------------------------------------------------------|
+ 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
+|=============================================================================|
+n_events = 10
+?negative_weights = true
+?keep_failed_events = true
+?debug_decay = false
+?debug_process = false
+?debug_verbose = false
+?sample_pacify = true
+| Starting simulation for process 'powheg_2_p1'
+| Simulate: using integration grids from file 'powheg_2_p1.m1.vg'
+| Simulate: activating parton shower
+| Shower: interfacing PDF builtin set #8
+| Shower: Using WHIZARD internal shower
+| Simulate: applying POWHEG matching
+| QCD alpha: using a running strong coupling
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 131
+| Simulation: requested number of events = 10
+| corr. to luminosity [fb-1] = 9.3197E-10
+| Events: writing to ASCII file 'powheg_2_p1.debug'
+| Events: generating 10 unweighted, unpolarized events ...
+| Events: event normalization mode '1'
+| POWHEG: using grids from file 'powheg_2_p1.pg'
+| Grid: Mean value of the grid: 7.15782E+03
+| Grid: Max value of the grid: 1.18402E+05
+| Grid: Mean/Max value of the grid: 6.04533E-02
+| ... event sample complete.
+| Events: actual unweighting efficiency = 0.34 %
+Warning: Encountered events with excess weight: 4 events ( 40.000 %)
+| Maximum excess weight = 1.722E+01
+| Average excess weight = 1.950E+00
+| Events: closing ASCII file 'powheg_2_p1.debug'
+| There were no errors and 1 warning(s).
+| WHIZARD run finished.
+|=============================================================================|
+Contents of powheg_2_p1.debug:
+========================================================================
+ Event #1
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.73082E+07
+ Squared matrix el. (prc) = 1.73082E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 3
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 6.899492E+02
+ P = 0.000000E+00 0.000000E+00 6.899492E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 4.215047E-01
+ P = 0.000000E+00 0.000000E+00 -4.215047E-01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.310051E+03
+ P = 0.000000E+00 0.000000E+00 6.310051E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.999578E+03
+ P = 0.000000E+00 0.000000E+00 -6.999578E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.087387E+02
+ P = -9.888752E+00 -4.804441E+00 6.086394E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 8.163209E+01
+ P = 9.888752E+00 4.804441E+00 8.088837E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 1
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 689.949 0.000 0.000 689.949 0.000
+ 4 [i] dbar 0 0 2 7-8 0.422 0.000 0.000 -0.422 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6310.051 0.000 0.000 6310.051 0.000
+ 6 [x] hr3 0 0 2 [none] 6999.578 0.000 0.000 -6999.578 0.000
+ 7 [o] e- 0 0 3-4 [none] 608.739 -9.889 -4.804 608.639 0.000
+ 8 [o] e+ 0 0 3-4 [none] 81.632 9.889 4.804 80.888 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 690.371 0.000 0.000 689.528
+Sum of beam remnant momenta: p(0:3) = 13309.629 0.000 0.000 -689.528
+Sum of outgoing momenta: p(0:3) = 690.371 0.000 0.000 689.528
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.41067E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.73082E+07
+sqme_ref* => 1.73082E+07
+event_index* => 1
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 2.70702E-01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-6.8994924E+02; 0.0000000E+00, 0.0000000E+00,-6.8994924E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-4.2150470E-01; 0.0000000E+00, 0.0000000E+00, 4.2150470E-01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.3100508E+03; 0.0000000E+00, 0.0000000E+00, 6.3100508E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9995785E+03; 0.0000000E+00, 0.0000000E+00,-6.9995785E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.0873866E+02;-9.8887519E+00,-4.8044408E+00, 6.0863937E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 8.1632087E+01; 9.8887519E+00, 4.8044408E+00, 8.0888365E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #2
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 2.00716E+06
+ Squared matrix el. (prc) = 2.00716E+06
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 1
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 6
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.446225E+03
+ P = 0.000000E+00 0.000000E+00 1.446225E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 1.042581E+01
+ P = 0.000000E+00 0.000000E+00 -1.042581E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 5.553775E+03
+ P = 0.000000E+00 0.000000E+00 5.553775E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.989574E+03
+ P = 0.000000E+00 0.000000E+00 -6.989574E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 5.692890E+02
+ P = -1.196264E+02 5.256740E+00 5.565536E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 8.873620E+02
+ P = 1.196264E+02 -5.256740E+00 8.792458E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 2
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 1446.225 0.000 0.000 1446.225 0.000
+ 4 [i] dbar 0 0 2 7-8 10.426 0.000 0.000 -10.426 0.000
+ 5 [x] hr3bar 0 0 1 [none] 5553.775 0.000 0.000 5553.775 0.000
+ 6 [x] hr3 0 0 2 [none] 6989.574 0.000 0.000 -6989.574 0.000
+ 7 [o] e- 0 0 3-4 [none] 569.289 -119.626 5.257 556.554 0.000
+ 8 [o] e+ 0 0 3-4 [none] 887.362 119.626 -5.257 879.246 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
+Sum of beam remnant momenta: p(0:3) = 12543.349 0.000 0.000 -1435.799
+Sum of outgoing momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 2.45586E+02
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 2.00716E+06
+sqme_ref* => 2.00716E+06
+event_index* => 2
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.4462252E+03; 0.0000000E+00, 0.0000000E+00,-1.4462252E+03| 0.0000000E+00| 3)
+ 4 prt(i:-1|-1.0425811E+01; 0.0000000E+00, 0.0000000E+00, 1.0425811E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 5.5537748E+03; 0.0000000E+00, 0.0000000E+00, 5.5537748E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9895742E+03; 0.0000000E+00, 0.0000000E+00,-6.9895742E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 5.6928904E+02;-1.1962638E+02, 5.2567405E+00, 5.5655360E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 8.8736197E+02; 1.1962638E+02,-5.2567405E+00, 8.7924579E+02| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #3
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 2.38562E+07
+ Squared matrix el. (prc) = 2.38562E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 9
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 8.712482E+01
+ P = 0.000000E+00 0.000000E+00 8.712482E+01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 3.936136E+00
+ P = 0.000000E+00 0.000000E+00 -3.936136E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.912875E+03
+ P = 0.000000E+00 0.000000E+00 6.912875E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.996064E+03
+ P = 0.000000E+00 0.000000E+00 -6.996064E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 5.371039E+01
+ P = 1.850581E+00 -1.806232E+01 5.054833E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 3.735057E+01
+ P = -1.850581E+00 1.806232E+01 3.264036E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 3
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 87.125 0.000 0.000 87.125 0.000
+ 4 [i] dbar 0 0 2 7-8 3.936 0.000 0.000 -3.936 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6912.875 0.000 0.000 6912.875 0.000
+ 6 [x] hr3 0 0 2 [none] 6996.064 0.000 0.000 -6996.064 0.000
+ 7 [o] e- 0 0 3-4 [none] 53.710 1.851 -18.062 50.548 0.000
+ 8 [o] e+ 0 0 3-4 [none] 37.351 -1.851 18.062 32.640 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 91.061 0.000 0.000 83.189
+Sum of beam remnant momenta: p(0:3) = 13908.939 0.000 0.000 -83.189
+Sum of outgoing momenta: p(0:3) = 91.061 0.000 0.000 83.189
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.70370E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 2.38562E+07
+sqme_ref* => 2.38562E+07
+event_index* => 3
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 4.63589E-01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-8.7124821E+01; 0.0000000E+00, 0.0000000E+00,-8.7124821E+01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-3.9361364E+00; 0.0000000E+00, 0.0000000E+00, 3.9361364E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9128752E+03; 0.0000000E+00, 0.0000000E+00, 6.9128752E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9960639E+03; 0.0000000E+00, 0.0000000E+00,-6.9960639E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 5.3710386E+01; 1.8505811E+00,-1.8062325E+01, 5.0548327E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 3.7350571E+01;-1.8505811E+00, 1.8062325E+01, 3.2640357E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #4
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.48421E+07
+ Squared matrix el. (prc) = 1.48421E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 12
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.939732E+02
+ P = 0.000000E+00 0.000000E+00 1.939732E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 4.051484E+00
+ P = 0.000000E+00 0.000000E+00 -4.051484E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.806027E+03
+ P = 0.000000E+00 0.000000E+00 6.806027E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.995949E+03
+ P = 0.000000E+00 0.000000E+00 -6.995949E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 1.889687E+02
+ P = -8.729125E+00 -2.109992E+00 1.887552E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 9.055960E+00
+ P = 8.729125E+00 2.109992E+00 1.166507E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 4
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 193.973 0.000 0.000 193.973 0.000
+ 4 [i] dbar 0 0 2 7-8 4.051 0.000 0.000 -4.051 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6806.027 0.000 0.000 6806.027 0.000
+ 6 [x] hr3 0 0 2 [none] 6995.949 0.000 0.000 -6995.949 0.000
+ 7 [o] e- 0 0 3-4 [none] 188.969 -8.729 -2.110 188.755 0.000
+ 8 [o] e+ 0 0 3-4 [none] 9.056 8.729 2.110 1.167 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 198.025 0.000 0.000 189.922
+Sum of beam remnant momenta: p(0:3) = 13801.975 0.000 0.000 -189.922
+Sum of outgoing momenta: p(0:3) = 198.025 0.000 0.000 189.922
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 5.60671E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.48421E+07
+sqme_ref* => 1.48421E+07
+event_index* => 4
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.9397318E+02; 0.0000000E+00, 0.0000000E+00,-1.9397318E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-4.0514843E+00; 0.0000000E+00, 0.0000000E+00, 4.0514843E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.8060268E+03; 0.0000000E+00, 0.0000000E+00, 6.8060268E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9959485E+03; 0.0000000E+00, 0.0000000E+00,-6.9959485E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 1.8896870E+02;-8.7291246E+00,-2.1099918E+00, 1.8875519E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 9.0559605E+00; 8.7291246E+00, 2.1099918E+00, 1.1665068E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #5
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.12189E+07
+ Squared matrix el. (prc) = 1.12189E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 15
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 2.299967E+00
+ P = 0.000000E+00 0.000000E+00 2.299967E+00
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 1.055385E+02
+ P = 0.000000E+00 0.000000E+00 -1.055385E+02
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.997700E+03
+ P = 0.000000E+00 0.000000E+00 6.997700E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.894461E+03
+ P = 0.000000E+00 0.000000E+00 -6.894461E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.359252E+01
+ P = -1.344828E+00 -1.524474E+01 -6.172356E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 4.424595E+01
+ P = 1.344828E+00 1.524474E+01 -4.151498E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 5
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 2.300 0.000 0.000 2.300 0.000
+ 4 [i] dbar 0 0 2 7-8 105.539 0.000 0.000 -105.539 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6997.700 0.000 0.000 6997.700 0.000
+ 6 [x] hr3 0 0 2 [none] 6894.461 0.000 0.000 -6894.461 0.000
+ 7 [o] e- 0 0 3-4 [none] 63.593 -1.345 -15.245 -61.724 0.000
+ 8 [o] e+ 0 0 3-4 [none] 44.246 1.345 15.245 -41.515 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 107.838 0.000 0.000 -103.239
+Sum of beam remnant momenta: p(0:3) = 13892.162 0.000 0.000 103.239
+Sum of outgoing momenta: p(0:3) = 107.838 0.000 0.000 -103.239
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.11599E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.12189E+07
+sqme_ref* => 1.12189E+07
+event_index* => 5
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-2.2999667E+00; 0.0000000E+00, 0.0000000E+00,-2.2999667E+00| 0.0000000E+00| 3)
+ 4 prt(i:-1|-1.0553851E+02; 0.0000000E+00, 0.0000000E+00, 1.0553851E+02| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9977000E+03; 0.0000000E+00, 0.0000000E+00, 6.9977000E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.8944615E+03; 0.0000000E+00, 0.0000000E+00,-6.8944615E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.3592525E+01;-1.3448283E+00,-1.5244744E+01,-6.1723565E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 4.4245950E+01; 1.3448283E+00, 1.5244744E+01,-4.1514977E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #6
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = -7.01412E+06
+ Squared matrix el. (prc) = -7.01412E+06
+ Event weight (ref) = -1.00000E+00
+ Event weight (prc) = -1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 18
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 6.920607E+00
+ P = 0.000000E+00 0.000000E+00 6.920607E+00
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 6.366500E+00
+ P = 0.000000E+00 0.000000E+00 -6.366500E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.993079E+03
+ P = 0.000000E+00 0.000000E+00 6.993079E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.993634E+03
+ P = 0.000000E+00 0.000000E+00 -6.993634E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.520088E+00
+ P = 2.767436E+00 5.258452E+00 -2.683566E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 6.767019E+00
+ P = -2.767436E+00 -5.258452E+00 3.237673E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 6
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 6.921 0.000 0.000 6.921 0.000
+ 4 [i] dbar 0 0 2 7-8 6.366 0.000 0.000 -6.366 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6993.079 0.000 0.000 6993.079 0.000
+ 6 [x] hr3 0 0 2 [none] 6993.634 0.000 0.000 -6993.634 0.000
+ 7 [o] e- 0 0 3-4 [none] 6.520 2.767 5.258 -2.684 0.000
+ 8 [o] e+ 0 0 3-4 [none] 6.767 -2.767 -5.258 3.238 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 13.287 0.000 0.000 0.554
+Sum of beam remnant momenta: p(0:3) = 13986.713 0.000 0.000 -0.554
+Sum of outgoing momenta: p(0:3) = 13.287 0.000 0.000 0.554
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 1.32755E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => -7.01412E+06
+sqme_ref* => -7.01412E+06
+event_index* => 6
+event_weight* => -1.00000E+00
+event_weight_ref* => -1.00000E+00
+event_excess* => 1.54958E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-6.9206073E+00; 0.0000000E+00, 0.0000000E+00,-6.9206073E+00| 0.0000000E+00| 3)
+ 4 prt(i:-1|-6.3664998E+00; 0.0000000E+00, 0.0000000E+00, 6.3664998E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9930794E+03; 0.0000000E+00, 0.0000000E+00, 6.9930794E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9936335E+03; 0.0000000E+00, 0.0000000E+00,-6.9936335E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.5200879E+00; 2.7674357E+00, 5.2584523E+00,-2.6835658E+00| 0.0000000E+00| 7)
+ 8 prt(o:-11| 6.7670193E+00;-2.7674357E+00,-5.2584523E+00, 3.2376733E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #7
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 4.68463E+07
+ Squared matrix el. (prc) = 4.68463E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 21
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 5.667369E-01
+ P = 0.000000E+00 0.000000E+00 5.667369E-01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 7.081701E+01
+ P = 0.000000E+00 0.000000E+00 -7.081701E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.999433E+03
+ P = 0.000000E+00 0.000000E+00 6.999433E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.929183E+03
+ P = 0.000000E+00 0.000000E+00 -6.929183E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.467810E+01
+ P = 2.796685E+00 -2.231923E+00 -6.457905E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 6.705646E+00
+ P = -2.796685E+00 2.231923E+00 -5.671222E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 7
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 0.567 0.000 0.000 0.567 0.000
+ 4 [i] dbar 0 0 2 7-8 70.817 0.000 0.000 -70.817 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6999.433 0.000 0.000 6999.433 0.000
+ 6 [x] hr3 0 0 2 [none] 6929.183 0.000 0.000 -6929.183 0.000
+ 7 [o] e- 0 0 3-4 [none] 64.678 2.797 -2.232 -64.579 0.000
+ 8 [o] e+ 0 0 3-4 [none] 6.706 -2.797 2.232 -5.671 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 71.384 0.000 0.000 -70.250
+Sum of beam remnant momenta: p(0:3) = 13928.616 0.000 0.000 70.250
+Sum of outgoing momenta: p(0:3) = 71.384 0.000 0.000 -70.250
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 1.26704E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 4.68463E+07
+sqme_ref* => 4.68463E+07
+event_index* => 7
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 1.72180E+01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-5.6673690E-01; 0.0000000E+00, 0.0000000E+00,-5.6673690E-01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-7.0817012E+01; 0.0000000E+00, 0.0000000E+00, 7.0817012E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9994333E+03; 0.0000000E+00, 0.0000000E+00, 6.9994333E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9291830E+03; 0.0000000E+00, 0.0000000E+00,-6.9291830E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.4678103E+01; 2.7966851E+00,-2.2319227E+00,-6.4579053E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 6.7056461E+00;-2.7966851E+00, 2.2319227E+00,-5.6712224E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #8
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.47022E+07
+ Squared matrix el. (prc) = 1.47022E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 24
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.748870E+01
+ P = 0.000000E+00 0.000000E+00 1.748870E+01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 6.169637E+01
+ P = 0.000000E+00 0.000000E+00 -6.169637E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.982511E+03
+ P = 0.000000E+00 0.000000E+00 6.982511E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.938304E+03
+ P = 0.000000E+00 0.000000E+00 -6.938304E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 2.709141E+01
+ P = 2.658050E+01 -5.228591E+00 2.882695E-01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 5.209366E+01
+ P = -2.658050E+01 5.228591E+00 -4.449594E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 8
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 17.489 0.000 0.000 17.489 0.000
+ 4 [i] dbar 0 0 2 7-8 61.696 0.000 0.000 -61.696 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6982.511 0.000 0.000 6982.511 0.000
+ 6 [x] hr3 0 0 2 [none] 6938.304 0.000 0.000 -6938.304 0.000
+ 7 [o] e- 0 0 3-4 [none] 27.091 26.581 -5.229 0.288 0.000
+ 8 [o] e+ 0 0 3-4 [none] 52.094 -26.581 5.229 -44.496 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 79.185 0.000 0.000 -44.208
+Sum of beam remnant momenta: p(0:3) = 13920.815 0.000 0.000 44.208
+Sum of outgoing momenta: p(0:3) = 79.185 0.000 0.000 -44.208
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 6.56959E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.47022E+07
+sqme_ref* => 1.47022E+07
+event_index* => 8
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.7488700E+01; 0.0000000E+00, 0.0000000E+00,-1.7488700E+01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-6.1696367E+01; 0.0000000E+00, 0.0000000E+00, 6.1696367E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9825113E+03; 0.0000000E+00, 0.0000000E+00, 6.9825113E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9383036E+03; 0.0000000E+00, 0.0000000E+00,-6.9383036E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 2.7091406E+01; 2.6580500E+01,-5.2285908E+00, 2.8826949E-01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 5.2093661E+01;-2.6580500E+01, 5.2285908E+00,-4.4495937E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #9
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.35334E+07
+ Squared matrix el. (prc) = 1.35334E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 27
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.067593E+02
+ P = 0.000000E+00 0.000000E+00 1.067593E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 8.464686E+00
+ P = 0.000000E+00 0.000000E+00 -8.464686E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.893241E+03
+ P = 0.000000E+00 0.000000E+00 6.893241E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.991535E+03
+ P = 0.000000E+00 0.000000E+00 -6.991535E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 3.781862E+01
+ P = 1.174670E+01 -2.488222E+01 2.594491E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 7.740532E+01
+ P = -1.174670E+01 2.488222E+01 7.234966E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 9
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 106.759 0.000 0.000 106.759 0.000
+ 4 [i] dbar 0 0 2 7-8 8.465 0.000 0.000 -8.465 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6893.241 0.000 0.000 6893.241 0.000
+ 6 [x] hr3 0 0 2 [none] 6991.535 0.000 0.000 -6991.535 0.000
+ 7 [o] e- 0 0 3-4 [none] 37.819 11.747 -24.882 25.945 0.000
+ 8 [o] e+ 0 0 3-4 [none] 77.405 -11.747 24.882 72.350 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 115.224 0.000 0.000 98.295
+Sum of beam remnant momenta: p(0:3) = 13884.776 0.000 0.000 -98.295
+Sum of outgoing momenta: p(0:3) = 115.224 0.000 0.000 98.295
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 6.01227E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.35334E+07
+sqme_ref* => 1.35334E+07
+event_index* => 9
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.0675926E+02; 0.0000000E+00, 0.0000000E+00,-1.0675926E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-8.4646859E+00; 0.0000000E+00, 0.0000000E+00, 8.4646859E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.8932407E+03; 0.0000000E+00, 0.0000000E+00, 6.8932407E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9915353E+03; 0.0000000E+00, 0.0000000E+00,-6.9915353E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 3.7818625E+01; 1.1746697E+01,-2.4882224E+01, 2.5944911E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 7.7405319E+01;-1.1746697E+01, 2.4882224E+01, 7.2349661E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #10
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 6.32254E+06
+ Squared matrix el. (prc) = 6.32254E+06
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 30
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 3.840213E+02
+ P = 0.000000E+00 0.000000E+00 3.840213E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 2.304886E+01
+ P = 0.000000E+00 0.000000E+00 -2.304886E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.615979E+03
+ P = 0.000000E+00 0.000000E+00 6.615979E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.976951E+03
+ P = 0.000000E+00 0.000000E+00 -6.976951E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 1.317678E+02
+ P = -7.259226E+01 4.671327E+01 9.955395E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 2.753024E+02
+ P = 7.259226E+01 -4.671327E+01 2.614185E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 10
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 1692.873 0.000 0.000 1692.873 0.000
+ 4 [i] dbar 1 0 2 7-8 124.175 0.000 0.000 -124.175 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6615.979 0.000 0.000 6615.979 0.000
+ 6 [x] hr3 0 0 2 [none] 6976.951 0.000 0.000 -6976.951 0.000
+ 7 [v] e- 0 0 3-4 9-11 131.768 -72.592 46.713 99.554 0.000
+ 8 [v] e+ 0 0 3-4 9-11 275.302 72.592 -46.713 261.419 0.000
+ 9 [o] e- 0 0 7-8 [none] 698.223 -348.873 -59.705 601.862 0.000
+ 10 [o] e+ 0 0 7-8 [none] 330.260 -58.529 -97.219 310.153 0.000
+ 11 [o] gl 1 0 7-8 [none] 788.564 407.402 156.924 656.683 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 1817.048 0.000 0.000 1568.698
+Sum of beam remnant momenta: p(0:3) = 13592.930 0.000 0.000 -360.972
+Sum of outgoing momenta: p(0:3) = 1817.048 0.000 0.000 1568.698
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 9.16978E+02
+n_in* => 2
+n_out* => 5
+n_tot* => 7
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 6.32254E+06
+sqme_ref* => 6.32254E+06
+event_index* => 10
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.6928730E+03; 0.0000000E+00, 0.0000000E+00,-1.6928730E+03| 0.0000000E+00| 3)
+ 4 prt(i:-1|-1.2417487E+02; 0.0000000E+00, 0.0000000E+00, 1.2417487E+02| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.6159787E+03; 0.0000000E+00, 0.0000000E+00, 6.6159787E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9769511E+03; 0.0000000E+00, 0.0000000E+00,-6.9769511E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.9822309E+02;-3.4887324E+02,-5.9705153E+01, 6.0186231E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 3.3026026E+02;-5.8528671E+01,-9.7218670E+01, 3.1015281E+02| 0.0000000E+00| 8)
+ 9 prt(o:21| 7.8856447E+02; 4.0740191E+02, 1.5692382E+02, 6.5668297E+02| 0.0000000E+00| 9)
+========================================================================
+Contents of powheg_2_p1.pg:
+ 3
+ 10 10 3
+ 4.560135783E+02 1.083970202E+03 1.007044796E+03 4.074726275E+02 8.208309289E+02 4.396876043E+03 0.000000000E+00 4.558703453E-01 1.141063424E-02 4.729002305E-04 6.224674290E+02 1.196651768E+03 8.127476346E+02 1.702519068E+02 5.646332386E+00 9.345870905E+01 1.354999428E-02 1.211242525E+00 3.408434412E+03 2.199084233E+02 1.987180647E+02 1.451993374E+03 4.418605899E+02 2.496878293E+03 4.722849602E+02 3.977527411E+01 4.554869524E+03 4.223913476E+00 2.217092987E+03 4.117714646E-01 7.473433684E+00 1.531560452E+03 1.196163092E+03 2.632992720E+02 1.244259833E+02 0.000000000E+00 1.072698477E+01 3.807598358E+00 0.000000000E+00 3.158646396E+02 2.886932593E+02 8.090737780E+02 5.419702877E+02 5.596087340E+02 3.922354972E+02 6.422272702E+01 3.629175802E-02 1.200576818E+03 8.145246612E-02 1.337148766E-05 2.275144110E+02 7.996804537E+00 1.683365334E+03 3.210779209E+02 4.797034475E+00 3.990986003E+01 1.172740275E+01 2.684229179E-01 8.274102513E-01 1.326605043E+02 1.577869265E+02 9.264962307E+02 1.264473239E+03 1.078038548E+03 6.874004844E+01 3.672497374E+00 1.917018948E-01 2.265468749E+02 7.912403086E+01 1.242060383E+01 7.851288258E+01 1.675161502E+02 7.208422748E+02 1.417059200E+03 7.165195742E+01 4.538201583E+02 8.488465508E+01 1.903180694E+02 0.000000000E+00 1.670546133E-05 1.544490404E+02 5.685364863E+02 5.067412406E+02 9.713211579E+02 5.724842740E+02 1.281703862E+01 1.669927934E+01 3.177999594E+02 1.678900665E+00 3.757394329E-01 7.723943148E+01 2.835182298E+02 1.722857047E+02 5.066049347E+01 3.080678501E+02 1.386710596E+02 3.920632968E-01 0.000000000E+00 8.331196886E+01 1.698877449E-01 4.384370947E+04 1.907412762E+04 8.156298825E+04 3.653228847E+03 4.960876481E+04 9.945850383E+04 1.272166371E+03 1.863895602E+01 2.581841067E-01 1.062709930E-02 4.229770261E+03 9.128747267E+04 4.372686437E+04 1.214562195E+04 1.199777536E+02 7.983313353E+02 1.502253772E+03 1.180843189E+02 1.207658590E+04 4.946093672E+02 2.317627005E+03 6.123659817E+04 5.831801262E+04 6.861436444E+04 2.789574021E+04 6.359152701E+02 2.779475983E+04 1.026253832E+02 1.440373422E+04 1.858861180E+00 1.351344174E+02 1.127664562E+05 9.259107776E+04 3.680625785E+04 8.859622423E+03 0.000000000E+00 6.613574161E+01 3.680966865E+01 0.000000000E+00 1.031766519E+03 2.670676947E+04 6.170920422E+04 9.037062211E+03 1.097774391E+04 3.183750982E+04 4.555295278E+03 8.373582230E-01 2.681985869E+04 1.887610027E+00 6.006816554E-04 2.318557095E+04 1.419703297E+02 1.184023192E+05 3.919245966E+04 9.544375513E+01 2.302544558E+03 7.610351499E+02 2.098635894E+02 5.046424526E+01 3.316618166E+02 1.096811776E+03 1.157036522E+05 4.543053674E+04 7.170010950E+04 5.210155965E+03 3.256617846E+03 1.213561633E+01 1.523174941E+03 5.410942322E+03 2.961644165E+01 3.472123214E+03 1.291385513E+03 2.554557243E+04 8.980995723E+04 1.274335717E+04 2.899264367E+04 4.998481882E+03 7.542775398E+03 5.165076201E-02 1.774632628E-02 1.635226369E+03 9.438802756E+03 4.288340911E+04 4.389525447E+04 4.093967891E+04 4.873123026E+03 1.600179334E+03 8.495159776E+03 1.040871946E+01 2.430657409E+00 1.649819596E+03 2.917105038E+04 5.771667714E+03 4.585198585E+03 2.345592319E+04 2.187094974E+04 8.234595857E+02 0.000000000E+00 7.317397955E+03 1.666967110E+01 5.749157845E+02 7.605464872E+02 6.411112538E+02 9.940465597E+02 3.342346891E+02 9.197582136E+03 0.000000000E+00 1.142175359E+00 5.329014417E-02 1.069340984E-03 4.915198547E+02 1.708347071E+03 7.849150342E+02 1.852367923E+03 1.258973377E+01 6.669360765E+02 1.860729264E-01 1.865179491E+01 1.036067189E+03 8.148130648E+01 2.192804118E+02 1.176157294E+03 1.670955337E+03 2.916820642E+03 2.315572534E+02 1.347359459E+01 4.526421672E+04 8.260606343E+00 7.033745757E+02 9.585387383E+00 8.383483212E+01 1.132992308E+03 4.213342005E+02 8.456320396E+01 7.268258741E+01 0.000000000E+00 1.644620825E+02 1.284888325E+00 0.000000000E+00 1.347470205E+02 7.201055283E+02 5.013060893E+02 3.631169485E+02 6.157807201E+02 1.870261444E+02 4.149034909E+02 4.320211643E-02 3.318665556E+03 3.007326967E-01 2.377753335E-04 1.253167170E+02 1.021004386E+02 2.594713573E+03 4.817872160E+02 3.620264587E+00 1.204124999E+01 1.988998152E+02 1.195856555E-01 1.654226259E+01 3.463483405E+02 1.050348775E+02 1.869782543E+03 6.913658189E+02 3.579854508E+02 4.191918164E+02 2.467936297E+00 1.716200267E+00 7.252396020E+02 2.151696364E+02 4.103452868E+00 4.849643809E+01 7.668112313E+01 2.624835426E+02 6.775167237E+02 1.261048079E+02 1.491136858E+02 1.826474890E+02 7.655725917E+01 0.000000000E+00 1.939892239E-04 6.654255581E+01 3.672921767E+02 6.869760990E+02 3.336086940E+02 1.978712003E+02 3.413926186E+01 7.676507550E+00 1.184737176E+02 1.011408143E+01 1.226057509E+00 4.734795685E+01 8.036837540E+02 6.763799095E+01 3.862774121E+01 1.058975593E+02 4.616039962E+01 1.667819270E+00 0.000000000E+00 2.558553518E+02 5.319889607E-01
Index: trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref (revision 8819)
+++ trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref (revision 8820)
@@ -1,733 +1,723 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
openmp_num_threads = 1
?pacify = true
seed = 0
SM.wtop => 0.00000E+00
SM.mtop => 1.75000E+02
?use_vamp_equivalences = false
$loop_me_method = "dummy"
?alphas_is_fixed = false
?alphas_from_mz = true
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = true
?powheg_matching = true
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.00000E+00
?powheg_use_singular_jacobian = false
| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
sqrts = 5.00000E+02
| Integrate: current process library needs compilation
| Process library 'powheg_1_lib': compiling ...
| Process library 'powheg_1_lib': writing makefile
| Process library 'powheg_1_lib': removing old files
| Process library 'powheg_1_lib': writing driver
| Process library 'powheg_1_lib': creating source code
| Process library 'powheg_1_lib': compiling sources
| Process library 'powheg_1_lib': linking
| Process library 'powheg_1_lib': loading
| Process library 'powheg_1_lib': ... success.
| Integrate: compilation done
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process powheg_1_p1:
| Beam structure: [any particles]
| Beam data (collision):
| e+ (mass = 5.1099700E-04 GeV)
| e- (mass = 5.1099700E-04 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p1.i1.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'powheg_1_p1'
| Library name = 'powheg_1_lib'
| Process index = 1
| Process components:
| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
Warning: No cuts have been defined.
| Using user-defined general scale.
| Starting integration for process 'powheg_1_p1'
| Integration hook: add POWHEG hook
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 1 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
|-----------------------------------------------------------------------------|
1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
|=============================================================================|
n_events = 1
?debug_decay = false
?debug_process = false
?debug_verbose = false
?sample_pacify = true
?write_raw = false
| Starting simulation for process 'powheg_1_p1'
| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 1
| Simulation: requested number of events = 1
| corr. to luminosity [fb-1] = 2.1359E-03
| Events: writing to ASCII file 'powheg_1_p1.debug'
| Events: generating 1 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p1.pg'
-| Grid: Mean value of the grid: 4.184321729E-02
-| Grid: Max value of the grid: 9.365699882E-02
-| Grid: Mean/Max value of the grid: 4.467708534E-01
+| Grid: Mean value of the grid: 2.73542E-03
+| Grid: Max value of the grid: 5.79027E-03
+| Grid: Mean/Max value of the grid: 4.72416E-01
| ... event sample complete.
| Events: actual unweighting efficiency = 20.00 %
| Events: closing ASCII file 'powheg_1_p1.debug'
-Warning: There have been 1 ( 50.00%) POWHEG grid excesses.
n_events = 2
| Starting simulation for process 'powheg_1_p1'
| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 2
| Simulation: requested number of events = 2
| corr. to luminosity [fb-1] = 4.2717E-03
| Events: writing to ASCII file 'powheg_1_p1.debug'
| Events: generating 2 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p1.pg'
-| Grid: Mean value of the grid: 4.184321729E-02
-| Grid: Max value of the grid: 9.365699882E-02
-| Grid: Mean/Max value of the grid: 4.467708534E-01
+| Grid: Mean value of the grid: 2.73542E-03
+| Grid: Max value of the grid: 5.79027E-03
+| Grid: Mean/Max value of the grid: 4.72416E-01
| ... event sample complete.
| Events: actual unweighting efficiency = 100.00 %
| Events: closing ASCII file 'powheg_1_p1.debug'
-Warning: There have been 3 ( 50.00%) POWHEG grid excesses.
$real_partition_mode = "on"
real_partition_scale = 5.00000E+00
| Process library 'powheg_1_lib': unloading
| Process library 'powheg_1_lib': open
| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
| Integrate: current process library needs compilation
| Process library 'powheg_1_lib': compiling ...
| Process library 'powheg_1_lib': writing makefile
| Process library 'powheg_1_lib': removing old files
| Process library 'powheg_1_lib': writing driver
| Process library 'powheg_1_lib': creating source code
| Process library 'powheg_1_lib': compiling sources
| Process library 'powheg_1_lib': linking
| Process library 'powheg_1_lib': loading
| Process library 'powheg_1_lib': ... success.
| Integrate: compilation done
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 3
| Initializing integration for process powheg_1_p2:
| Beam structure: [any particles]
| Beam data (collision):
| e+ (mass = 5.1099700E-04 GeV)
| e- (mass = 5.1099700E-04 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i1.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'powheg_1_p2'
| Library name = 'powheg_1_lib'
| Process index = 2
| Process components:
| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 2 channels, 5 dimensions
| Phase space: found 2 channels, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
Warning: No cuts have been defined.
| Using user-defined general scale.
| Integration hook: add POWHEG hook
| Starting integration for process 'powheg_1_p2' part 'Combined'
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 1 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
|-----------------------------------------------------------------------------|
1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
|=============================================================================|
| Starting integration for process 'powheg_1_p2' part 'real'
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 2 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
|-----------------------------------------------------------------------------|
1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
|=============================================================================|
| Integrate: sum of all components
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
|=============================================================================|
tolerance = 1.08344E+02
| expect: success
| Starting simulation for process 'powheg_1_p2'
| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 4
| Simulation: requested number of events = 2
| corr. to luminosity [fb-1] = 4.0174E-03
| Events: writing to ASCII file 'powheg_1_p2.debug'
| Events: generating 2 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p2.pg'
-| Grid: Mean value of the grid: 8.354017182E-03
-| Grid: Max value of the grid: 9.272017598E-02
-| Grid: Mean/Max value of the grid: 9.009923777E-02
+| Grid: Mean value of the grid: 5.27612E-04
+| Grid: Max value of the grid: 6.09917E-03
+| Grid: Mean/Max value of the grid: 8.65055E-02
| ... event sample complete.
| Events: actual unweighting efficiency = 20.00 %
| Events: closing ASCII file 'powheg_1_p2.debug'
| Summary of value checks:
| Failures: 0 / Total: 1
-| There were no errors and 4 warning(s).
+| There were no errors and 2 warning(s).
| WHIZARD run finished.
|=============================================================================|
Contents of powheg_1_p1.debug:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 2.82009E-02
Squared matrix el. (prc) = 2.82009E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 7
calls = 3
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 9.608533E+01 -1.236770E+02 -8.571236E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -9.608533E+01 1.236770E+02 8.571236E+01
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 8
calls = 1
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
- 3 [v] t 1 0 1-2 5-7 250.000 96.085 -123.677 -85.712 30625.000
- 4 [v] tbar 0 1 1-2 5-7 250.000 -96.085 123.677 85.712 30625.000
- 5 [o] t 2 0 3-4 [none] 196.039 103.504 -100.239 -132.929 30625.000
- 6 [o] tbar 0 1 3-4 [none] 250.979 -96.822 124.625 86.369 30625.000
- 7 [o] gl 1 2 3-4 [none] 52.982 -6.683 -24.386 46.560 0.000
+ 3 [o] t 1 0 1-2 [none] 250.000 96.085 -123.677 -85.712 30625.000
+ 4 [o] tbar 0 1 1-2 [none] 250.000 -96.085 123.677 85.712 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
-n_out* => 3
-n_tot* => 5
+n_out* => 2
+n_tot* => 4
$process_id* => "powheg_1_p1"
process_num_id* => [unknown integer]
sqme* => 2.82009E-02
sqme_ref* => 2.82009E-02
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
- 3 prt(o:6| 1.9603876E+02; 1.0350443E+02,-1.0023939E+02,-1.3292890E+02| 3.0625000E+04| 3)
- 4 prt(o:-6| 2.5097910E+02;-9.6821813E+01, 1.2462497E+02, 8.6369341E+01| 3.0625000E+04| 4)
- 5 prt(o:21| 5.2982138E+01;-6.6826136E+00,-2.4385585E+01, 4.6559562E+01| 0.0000000E+00| 5)
+ 3 prt(o:6| 2.5000000E+02; 9.6085328E+01,-1.2367700E+02,-8.5712364E+01| 3.0625000E+04| 3)
+ 4 prt(o:-6| 2.5000000E+02;-9.6085328E+01, 1.2367700E+02, 8.5712364E+01| 3.0625000E+04| 4)
========================================================================
========================================================================
Event #2
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
- Squared matrix el. (ref) = 3.34619E-02
- Squared matrix el. (prc) = 3.34619E-02
+ Squared matrix el. (ref) = 2.76793E-02
+ Squared matrix el. (prc) = 2.76793E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 7
calls = 6
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 1.688666E+02 3.093682E+01 -4.901007E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -1.688666E+02 -3.093682E+01 4.901007E+01
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 8
calls = 2
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
- 3 [v] t 1 0 1-2 5-7 250.000 168.867 30.937 -49.010 30625.000
- 4 [v] tbar 0 1 1-2 5-7 250.000 -168.867 -30.937 49.010 30625.000
- 5 [o] t 2 0 3-4 [none] 191.977 188.835 33.666 7.940 30625.000
- 6 [o] tbar 0 1 3-4 [none] 247.249 -165.204 -30.266 47.947 30625.000
- 7 [o] gl 1 2 3-4 [none] 60.774 -23.632 -3.400 -55.887 0.000
+ 3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
+ 4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
-n_out* => 3
-n_tot* => 5
+n_out* => 2
+n_tot* => 4
$process_id* => "powheg_1_p1"
process_num_id* => [unknown integer]
-sqme* => 3.34619E-02
-sqme_ref* => 3.34619E-02
+sqme* => 2.76793E-02
+sqme_ref* => 2.76793E-02
event_index* => 2
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
- 3 prt(o:6| 1.9197718E+02; 1.8883530E+02, 3.3666245E+01, 7.9404340E+00| 3.0625000E+04| 3)
- 4 prt(o:-6| 2.4724932E+02;-1.6520379E+02,-3.0265780E+01, 4.7947013E+01| 3.0625000E+04| 4)
- 5 prt(o:21| 6.0773502E+01;-2.3631517E+01,-3.4004649E+00,-5.5887447E+01| 0.0000000E+00| 5)
+ 3 prt(o:6| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01| 3.0625000E+04| 3)
+ 4 prt(o:-6| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01| 3.0625000E+04| 4)
========================================================================
Contents of powheg_1_p2.debug:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 1.41607E-05
Squared matrix el. (prc) = 1.41607E-05
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 2
Selected term = 6
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196611
calls = 3
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4 5
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4 5
Particle 3 [o] f(6)c(1 )
E = 2.219832E+02
P = -7.125693E+01 -1.137429E+02 -2.522963E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-2 )
E = 2.128305E+02
P = 1.983915E+01 1.013308E+02 6.332695E+01
T = 3.062500000E+04
Parents: 1 2
Particle 5 [o] f(21)c(2 -1)
E = 6.518630E+01
P = 5.141778E+01 1.241207E+01 -3.809732E+01
T = 0.000000000E+00
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196612
calls = 1
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
n_out* => 3
n_tot* => 5
$process_id* => "powheg_1_p2"
process_num_id* => [unknown integer]
sqme* => 1.41607E-05
sqme_ref* => 1.41607E-05
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
3 prt(o:6| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01| 3.0625000E+04| 3)
4 prt(o:-6| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01| 3.0625000E+04| 4)
5 prt(o:21| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01| 0.0000000E+00| 5)
========================================================================
========================================================================
Event #2
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 3.51646E-02
Squared matrix el. (prc) = 3.51646E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196611
calls = 6
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 1.143154E+02 2.823158E+00 -1.371095E+02
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -1.143154E+02 -2.823158E+00 1.371095E+02
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196612
calls = 2
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
n_out* => 2
n_tot* => 4
$process_id* => "powheg_1_p2"
process_num_id* => [unknown integer]
sqme* => 3.51646E-02
sqme_ref* => 3.51646E-02
event_index* => 2
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
3 prt(o:6| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02| 3.0625000E+04| 3)
4 prt(o:-6| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02| 3.0625000E+04| 4)
========================================================================
Contents of powheg_1_p1.pg:
3
5 5 2
- 9.166236606E-02 9.032896719E-02 6.723678951E-02 4.571327343E-02 3.324702412E-02 9.151971891E-02 8.865308700E-02 6.535662504E-02 5.518275472E-02 3.145236216E-02 6.859820430E-02 6.274309740E-02 5.549694372E-02 4.020252779E-02 2.152769730E-02 3.667140083E-02 3.455080288E-02 2.459688422E-02 1.598447205E-02 3.909823184E-03 9.948616219E-03 1.134521581E-02 8.596147428E-03 7.850796585E-03 2.970031696E-03 9.108502561E-02 9.365699882E-02 6.651597887E-02 6.362815375E-02 1.377491163E-02 9.196811146E-02 8.054417144E-02 6.075079390E-02 4.353573394E-02 3.463257215E-02 6.864678244E-02 5.899360283E-02 4.850226434E-02 2.576226527E-02 2.954714702E-02 3.685548912E-02 3.341223373E-02 2.708530847E-02 1.146925318E-02 7.331537544E-03 1.065212727E-02 9.915716340E-03 9.451906454E-03 6.411924817E-03 2.685224373E-03
+ 5.790270664E-03 4.340796144E-03 3.956052276E-03 3.268282917E-03 2.051663009E-03 5.483522583E-03 4.862867872E-03 3.083117535E-03 1.719170940E-03 1.731060881E-03 4.642896596E-03 4.089381443E-03 3.278082860E-03 2.072774722E-03 0.000000000E+00 4.285081627E-03 2.703041105E-03 1.939545192E-03 1.808207863E-03 4.832500064E-04 1.725229895E-03 1.848230090E-03 1.666841567E-03 8.779276888E-04 5.973720333E-04 5.658021589E-03 4.797607918E-03 3.691638808E-03 2.563335143E-03 1.517565363E-03 5.487405766E-03 4.496579173E-03 3.894360742E-03 2.025323977E-03 2.321871929E-03 4.723771507E-03 3.748862492E-03 2.983344600E-03 2.071276052E-03 0.000000000E+00 4.306592486E-03 2.873724641E-03 2.416448613E-03 1.437407351E-03 9.061702789E-04 1.847228600E-03 1.615352727E-03 1.894685168E-03 7.407161766E-04 4.468087712E-04
Contents of powheg_1_p2.pg:
3
5 5 2
- 8.792105794E-02 0.000000000E+00 8.758623489E-03 0.000000000E+00 0.000000000E+00 9.266572973E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.389639764E-02 4.005706068E-03 1.398323195E-03 0.000000000E+00 1.912361556E-04 8.792330951E-02 0.000000000E+00 8.658995259E-03 0.000000000E+00 0.000000000E+00 9.272017598E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.354190061E-02 4.295175423E-03 1.522058038E-03 0.000000000E+00 2.021700458E-04
+ 6.095586898E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638456151E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.295080905E-03 7.908640172E-04 3.287241452E-04 0.000000000E+00 4.113171730E-05 6.099168393E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638549329E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.236533404E-03 8.480152143E-04 3.249849498E-04 0.000000000E+00 4.348341527E-05
Index: trunk/share/tests/functional_tests/ref-output-quad/powheg_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-quad/powheg_2.ref (revision 0)
+++ trunk/share/tests/functional_tests/ref-output-quad/powheg_2.ref (revision 8820)
@@ -0,0 +1,1578 @@
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+openmp_num_threads = 1
+?pacify = true
+?write_raw = false
+SM.mZ => 9.11880E+01
+SM.mW => 8.04190E+01
+SM.mH => 1.25000E+02
+SM.GF => 1.16639E-05
+SM.me => 0.00000E+00
+SM.mmu => 0.00000E+00
+SM.mtau => 1.77700E+00
+?alphas_is_fixed = false
+?alphas_from_mz = true
+?alphas_from_lambda_qcd = false
+?alphas_from_lhapdf = false
+alphas_nf = 5
+alphas_order = 1
+$exclude_gauge_splittings = "u:s:b:t"
+$method = "dummy"
+$pdf_builtin_set = "mstw2008nlo"
+sqrts = 1.40000E+04
+?combined_nlo_integration = true
+| Process library 'powheg_2_lib': recorded process 'powheg_2_p1'
+seed = 130
+?fixed_order_nlo_events = false
+?unweighted = true
+?powheg_matching = true
+powheg_grid_size_xi = 10
+powheg_grid_size_y = 10
+powheg_pt_min = 1.00000E+00
+| Integrate: current process library needs compilation
+| Process library 'powheg_2_lib': compiling ...
+| Process library 'powheg_2_lib': writing makefile
+| Process library 'powheg_2_lib': removing old files
+| Process library 'powheg_2_lib': writing driver
+| Process library 'powheg_2_lib': creating source code
+| Process library 'powheg_2_lib': compiling sources
+| Process library 'powheg_2_lib': linking
+| Process library 'powheg_2_lib': loading
+| Process library 'powheg_2_lib': ... success.
+| Integrate: compilation done
+| QCD alpha: using a running strong coupling
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 130
+| Initializing integration for process powheg_2_p1:
+| Beam structure: p, p => pdf_builtin
+| Beam data (collision):
+| p (mass = 0.0000000E+00 GeV)
+| p (mass = 0.0000000E+00 GeV)
+| sqrts = 1.400000000000E+04 GeV
+| Initialized builtin PDF MSTW2008NLO
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'powheg_2_p1.i1.phs'
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'powheg_2_p1.i3.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'powheg_2_p1'
+| Library name = 'powheg_2_lib'
+| Process index = 1
+| Process components:
+| 1: 'powheg_2_p1_i1': d, dbar => e-, e+ [dummy]
+| 2: 'powheg_2_p1_i2': d:gl, dbar:gl => e-, e+, gl:d:dbar [dummy], [real]
+| 3: 'powheg_2_p1_i3': d, dbar => e-, e+ [dummy], [virtual]
+| 4: 'powheg_2_p1_i4': d, dbar => e-, e+ [inactive], [subtraction]
+| 5: 'powheg_2_p1_i5': d, dbar => e-, e+ [dummy], [dglap]
+| ------------------------------------------------------------------------
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Beam structure: pdf_builtin, none => none, pdf_builtin
+| Beam structure: 2 channels, 2 dimensions
+| Applying user-defined cuts.
+| Using user-defined general scale.
+| Starting integration for process 'powheg_2_p1'
+| Integration hook: add POWHEG hook
+| Shower: interfacing PDF builtin set #8
+| Integrate: iterations = 1:1000:"gw"
+| Integrator: 2 chains, 2 channels, 7 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
+|-----------------------------------------------------------------------------|
+ 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
+|=============================================================================|
+n_events = 10
+?negative_weights = true
+?keep_failed_events = true
+?debug_decay = false
+?debug_process = false
+?debug_verbose = false
+?sample_pacify = true
+| Starting simulation for process 'powheg_2_p1'
+| Simulate: using integration grids from file 'powheg_2_p1.m1.vg'
+| Simulate: activating parton shower
+| Shower: interfacing PDF builtin set #8
+| Shower: Using WHIZARD internal shower
+| Simulate: applying POWHEG matching
+| QCD alpha: using a running strong coupling
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 131
+| Simulation: requested number of events = 10
+| corr. to luminosity [fb-1] = 9.3197E-10
+| Events: writing to ASCII file 'powheg_2_p1.debug'
+| Events: generating 10 unweighted, unpolarized events ...
+| Events: event normalization mode '1'
+| POWHEG: using grids from file 'powheg_2_p1.pg'
+| Grid: Mean value of the grid: 7.15782E+03
+| Grid: Max value of the grid: 1.18402E+05
+| Grid: Mean/Max value of the grid: 6.04533E-02
+| ... event sample complete.
+| Events: actual unweighting efficiency = 0.34 %
+Warning: Encountered events with excess weight: 4 events ( 40.000 %)
+| Maximum excess weight = 1.722E+01
+| Average excess weight = 1.950E+00
+| Events: closing ASCII file 'powheg_2_p1.debug'
+| There were no errors and 1 warning(s).
+| WHIZARD run finished.
+|=============================================================================|
+Contents of powheg_2_p1.debug:
+========================================================================
+ Event #1
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.73082E+07
+ Squared matrix el. (prc) = 1.73082E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 3
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 6.899492E+02
+ P = 0.000000E+00 0.000000E+00 6.899492E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 4.215047E-01
+ P = 0.000000E+00 0.000000E+00 -4.215047E-01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.310051E+03
+ P = 0.000000E+00 0.000000E+00 6.310051E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.999578E+03
+ P = 0.000000E+00 0.000000E+00 -6.999578E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.087387E+02
+ P = -9.888752E+00 -4.804441E+00 6.086394E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 8.163209E+01
+ P = 9.888752E+00 4.804441E+00 8.088837E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 1
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 689.949 0.000 0.000 689.949 0.000
+ 4 [i] dbar 0 0 2 7-8 0.422 0.000 0.000 -0.422 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6310.051 0.000 0.000 6310.051 0.000
+ 6 [x] hr3 0 0 2 [none] 6999.578 0.000 0.000 -6999.578 0.000
+ 7 [o] e- 0 0 3-4 [none] 608.739 -9.889 -4.804 608.639 0.000
+ 8 [o] e+ 0 0 3-4 [none] 81.632 9.889 4.804 80.888 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 690.371 0.000 0.000 689.528
+Sum of beam remnant momenta: p(0:3) = 13309.629 0.000 0.000 -689.528
+Sum of outgoing momenta: p(0:3) = 690.371 0.000 0.000 689.528
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.41067E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.73082E+07
+sqme_ref* => 1.73082E+07
+event_index* => 1
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 2.70702E-01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-6.8994924E+02; 0.0000000E+00, 0.0000000E+00,-6.8994924E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-4.2150470E-01; 0.0000000E+00, 0.0000000E+00, 4.2150470E-01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.3100508E+03; 0.0000000E+00, 0.0000000E+00, 6.3100508E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9995785E+03; 0.0000000E+00, 0.0000000E+00,-6.9995785E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.0873866E+02;-9.8887519E+00,-4.8044408E+00, 6.0863937E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 8.1632087E+01; 9.8887519E+00, 4.8044408E+00, 8.0888365E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #2
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 2.00716E+06
+ Squared matrix el. (prc) = 2.00716E+06
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 1
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 6
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.446225E+03
+ P = 0.000000E+00 0.000000E+00 1.446225E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 1.042581E+01
+ P = 0.000000E+00 0.000000E+00 -1.042581E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 5.553775E+03
+ P = 0.000000E+00 0.000000E+00 5.553775E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.989574E+03
+ P = 0.000000E+00 0.000000E+00 -6.989574E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 5.692890E+02
+ P = -1.196264E+02 5.256740E+00 5.565536E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 8.873620E+02
+ P = 1.196264E+02 -5.256740E+00 8.792458E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 2
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 1446.225 0.000 0.000 1446.225 0.000
+ 4 [i] dbar 0 0 2 7-8 10.426 0.000 0.000 -10.426 0.000
+ 5 [x] hr3bar 0 0 1 [none] 5553.775 0.000 0.000 5553.775 0.000
+ 6 [x] hr3 0 0 2 [none] 6989.574 0.000 0.000 -6989.574 0.000
+ 7 [o] e- 0 0 3-4 [none] 569.289 -119.626 5.257 556.554 0.000
+ 8 [o] e+ 0 0 3-4 [none] 887.362 119.626 -5.257 879.246 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
+Sum of beam remnant momenta: p(0:3) = 12543.349 0.000 0.000 -1435.799
+Sum of outgoing momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 2.45586E+02
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 2.00716E+06
+sqme_ref* => 2.00716E+06
+event_index* => 2
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.4462252E+03; 0.0000000E+00, 0.0000000E+00,-1.4462252E+03| 0.0000000E+00| 3)
+ 4 prt(i:-1|-1.0425811E+01; 0.0000000E+00, 0.0000000E+00, 1.0425811E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 5.5537748E+03; 0.0000000E+00, 0.0000000E+00, 5.5537748E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9895742E+03; 0.0000000E+00, 0.0000000E+00,-6.9895742E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 5.6928904E+02;-1.1962638E+02, 5.2567405E+00, 5.5655360E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 8.8736197E+02; 1.1962638E+02,-5.2567405E+00, 8.7924579E+02| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #3
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 2.38562E+07
+ Squared matrix el. (prc) = 2.38562E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 9
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 8.712482E+01
+ P = 0.000000E+00 0.000000E+00 8.712482E+01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 3.936136E+00
+ P = 0.000000E+00 0.000000E+00 -3.936136E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.912875E+03
+ P = 0.000000E+00 0.000000E+00 6.912875E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.996064E+03
+ P = 0.000000E+00 0.000000E+00 -6.996064E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 5.371039E+01
+ P = 1.850581E+00 -1.806232E+01 5.054833E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 3.735057E+01
+ P = -1.850581E+00 1.806232E+01 3.264036E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 3
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 87.125 0.000 0.000 87.125 0.000
+ 4 [i] dbar 0 0 2 7-8 3.936 0.000 0.000 -3.936 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6912.875 0.000 0.000 6912.875 0.000
+ 6 [x] hr3 0 0 2 [none] 6996.064 0.000 0.000 -6996.064 0.000
+ 7 [o] e- 0 0 3-4 [none] 53.710 1.851 -18.062 50.548 0.000
+ 8 [o] e+ 0 0 3-4 [none] 37.351 -1.851 18.062 32.640 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 91.061 0.000 0.000 83.189
+Sum of beam remnant momenta: p(0:3) = 13908.939 0.000 0.000 -83.189
+Sum of outgoing momenta: p(0:3) = 91.061 0.000 0.000 83.189
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.70370E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 2.38562E+07
+sqme_ref* => 2.38562E+07
+event_index* => 3
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 4.63589E-01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-8.7124821E+01; 0.0000000E+00, 0.0000000E+00,-8.7124821E+01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-3.9361364E+00; 0.0000000E+00, 0.0000000E+00, 3.9361364E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9128752E+03; 0.0000000E+00, 0.0000000E+00, 6.9128752E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9960639E+03; 0.0000000E+00, 0.0000000E+00,-6.9960639E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 5.3710386E+01; 1.8505811E+00,-1.8062325E+01, 5.0548327E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 3.7350571E+01;-1.8505811E+00, 1.8062325E+01, 3.2640357E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #4
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.48421E+07
+ Squared matrix el. (prc) = 1.48421E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 12
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.939732E+02
+ P = 0.000000E+00 0.000000E+00 1.939732E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 4.051484E+00
+ P = 0.000000E+00 0.000000E+00 -4.051484E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.806027E+03
+ P = 0.000000E+00 0.000000E+00 6.806027E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.995949E+03
+ P = 0.000000E+00 0.000000E+00 -6.995949E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 1.889687E+02
+ P = -8.729125E+00 -2.109992E+00 1.887552E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 9.055960E+00
+ P = 8.729125E+00 2.109992E+00 1.166507E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 4
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 193.973 0.000 0.000 193.973 0.000
+ 4 [i] dbar 0 0 2 7-8 4.051 0.000 0.000 -4.051 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6806.027 0.000 0.000 6806.027 0.000
+ 6 [x] hr3 0 0 2 [none] 6995.949 0.000 0.000 -6995.949 0.000
+ 7 [o] e- 0 0 3-4 [none] 188.969 -8.729 -2.110 188.755 0.000
+ 8 [o] e+ 0 0 3-4 [none] 9.056 8.729 2.110 1.167 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 198.025 0.000 0.000 189.922
+Sum of beam remnant momenta: p(0:3) = 13801.975 0.000 0.000 -189.922
+Sum of outgoing momenta: p(0:3) = 198.025 0.000 0.000 189.922
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 5.60671E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.48421E+07
+sqme_ref* => 1.48421E+07
+event_index* => 4
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.9397318E+02; 0.0000000E+00, 0.0000000E+00,-1.9397318E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-4.0514843E+00; 0.0000000E+00, 0.0000000E+00, 4.0514843E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.8060268E+03; 0.0000000E+00, 0.0000000E+00, 6.8060268E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9959485E+03; 0.0000000E+00, 0.0000000E+00,-6.9959485E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 1.8896870E+02;-8.7291246E+00,-2.1099918E+00, 1.8875519E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 9.0559605E+00; 8.7291246E+00, 2.1099918E+00, 1.1665068E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #5
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.12189E+07
+ Squared matrix el. (prc) = 1.12189E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 15
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 2.299967E+00
+ P = 0.000000E+00 0.000000E+00 2.299967E+00
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 1.055385E+02
+ P = 0.000000E+00 0.000000E+00 -1.055385E+02
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.997700E+03
+ P = 0.000000E+00 0.000000E+00 6.997700E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.894461E+03
+ P = 0.000000E+00 0.000000E+00 -6.894461E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.359252E+01
+ P = -1.344828E+00 -1.524474E+01 -6.172356E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 4.424595E+01
+ P = 1.344828E+00 1.524474E+01 -4.151498E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 5
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 2.300 0.000 0.000 2.300 0.000
+ 4 [i] dbar 0 0 2 7-8 105.539 0.000 0.000 -105.539 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6997.700 0.000 0.000 6997.700 0.000
+ 6 [x] hr3 0 0 2 [none] 6894.461 0.000 0.000 -6894.461 0.000
+ 7 [o] e- 0 0 3-4 [none] 63.593 -1.345 -15.245 -61.724 0.000
+ 8 [o] e+ 0 0 3-4 [none] 44.246 1.345 15.245 -41.515 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 107.838 0.000 0.000 -103.239
+Sum of beam remnant momenta: p(0:3) = 13892.162 0.000 0.000 103.239
+Sum of outgoing momenta: p(0:3) = 107.838 0.000 0.000 -103.239
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.11599E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.12189E+07
+sqme_ref* => 1.12189E+07
+event_index* => 5
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-2.2999667E+00; 0.0000000E+00, 0.0000000E+00,-2.2999667E+00| 0.0000000E+00| 3)
+ 4 prt(i:-1|-1.0553851E+02; 0.0000000E+00, 0.0000000E+00, 1.0553851E+02| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9977000E+03; 0.0000000E+00, 0.0000000E+00, 6.9977000E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.8944615E+03; 0.0000000E+00, 0.0000000E+00,-6.8944615E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.3592525E+01;-1.3448283E+00,-1.5244744E+01,-6.1723565E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 4.4245950E+01; 1.3448283E+00, 1.5244744E+01,-4.1514977E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #6
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = -7.01417E+06
+ Squared matrix el. (prc) = -7.01417E+06
+ Event weight (ref) = -1.00000E+00
+ Event weight (prc) = -1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 18
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 6.920607E+00
+ P = 0.000000E+00 0.000000E+00 6.920607E+00
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 6.366500E+00
+ P = 0.000000E+00 0.000000E+00 -6.366500E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.993079E+03
+ P = 0.000000E+00 0.000000E+00 6.993079E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.993634E+03
+ P = 0.000000E+00 0.000000E+00 -6.993634E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.520088E+00
+ P = 2.767436E+00 5.258452E+00 -2.683566E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 6.767019E+00
+ P = -2.767436E+00 -5.258452E+00 3.237673E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 6
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 6.921 0.000 0.000 6.921 0.000
+ 4 [i] dbar 0 0 2 7-8 6.366 0.000 0.000 -6.366 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6993.079 0.000 0.000 6993.079 0.000
+ 6 [x] hr3 0 0 2 [none] 6993.634 0.000 0.000 -6993.634 0.000
+ 7 [o] e- 0 0 3-4 [none] 6.520 2.767 5.258 -2.684 0.000
+ 8 [o] e+ 0 0 3-4 [none] 6.767 -2.767 -5.258 3.238 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 13.287 0.000 0.000 0.554
+Sum of beam remnant momenta: p(0:3) = 13986.713 0.000 0.000 -0.554
+Sum of outgoing momenta: p(0:3) = 13.287 0.000 0.000 0.554
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 1.32755E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => -7.01417E+06
+sqme_ref* => -7.01417E+06
+event_index* => 6
+event_weight* => -1.00000E+00
+event_weight_ref* => -1.00000E+00
+event_excess* => 1.54959E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-6.9206073E+00; 0.0000000E+00, 0.0000000E+00,-6.9206073E+00| 0.0000000E+00| 3)
+ 4 prt(i:-1|-6.3664998E+00; 0.0000000E+00, 0.0000000E+00, 6.3664998E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9930794E+03; 0.0000000E+00, 0.0000000E+00, 6.9930794E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9936335E+03; 0.0000000E+00, 0.0000000E+00,-6.9936335E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.5200879E+00; 2.7674357E+00, 5.2584523E+00,-2.6835658E+00| 0.0000000E+00| 7)
+ 8 prt(o:-11| 6.7670193E+00;-2.7674357E+00,-5.2584523E+00, 3.2376733E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #7
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 4.68463E+07
+ Squared matrix el. (prc) = 4.68463E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 21
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 5.667369E-01
+ P = 0.000000E+00 0.000000E+00 5.667369E-01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 7.081701E+01
+ P = 0.000000E+00 0.000000E+00 -7.081701E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.999433E+03
+ P = 0.000000E+00 0.000000E+00 6.999433E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.929183E+03
+ P = 0.000000E+00 0.000000E+00 -6.929183E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.467810E+01
+ P = 2.796685E+00 -2.231923E+00 -6.457905E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 6.705646E+00
+ P = -2.796685E+00 2.231923E+00 -5.671222E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 7
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 0.567 0.000 0.000 0.567 0.000
+ 4 [i] dbar 0 0 2 7-8 70.817 0.000 0.000 -70.817 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6999.433 0.000 0.000 6999.433 0.000
+ 6 [x] hr3 0 0 2 [none] 6929.183 0.000 0.000 -6929.183 0.000
+ 7 [o] e- 0 0 3-4 [none] 64.678 2.797 -2.232 -64.579 0.000
+ 8 [o] e+ 0 0 3-4 [none] 6.706 -2.797 2.232 -5.671 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 71.384 0.000 0.000 -70.250
+Sum of beam remnant momenta: p(0:3) = 13928.616 0.000 0.000 70.250
+Sum of outgoing momenta: p(0:3) = 71.384 0.000 0.000 -70.250
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 1.26704E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 4.68463E+07
+sqme_ref* => 4.68463E+07
+event_index* => 7
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 1.72180E+01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-5.6673690E-01; 0.0000000E+00, 0.0000000E+00,-5.6673690E-01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-7.0817012E+01; 0.0000000E+00, 0.0000000E+00, 7.0817012E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9994333E+03; 0.0000000E+00, 0.0000000E+00, 6.9994333E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9291830E+03; 0.0000000E+00, 0.0000000E+00,-6.9291830E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.4678103E+01; 2.7966851E+00,-2.2319227E+00,-6.4579053E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 6.7056461E+00;-2.7966851E+00, 2.2319227E+00,-5.6712224E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #8
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.47022E+07
+ Squared matrix el. (prc) = 1.47022E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 24
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.748870E+01
+ P = 0.000000E+00 0.000000E+00 1.748870E+01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 6.169637E+01
+ P = 0.000000E+00 0.000000E+00 -6.169637E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.982511E+03
+ P = 0.000000E+00 0.000000E+00 6.982511E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.938304E+03
+ P = 0.000000E+00 0.000000E+00 -6.938304E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 2.709141E+01
+ P = 2.658050E+01 -5.228591E+00 2.882695E-01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 5.209366E+01
+ P = -2.658050E+01 5.228591E+00 -4.449594E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 8
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 17.489 0.000 0.000 17.489 0.000
+ 4 [i] dbar 0 0 2 7-8 61.696 0.000 0.000 -61.696 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6982.511 0.000 0.000 6982.511 0.000
+ 6 [x] hr3 0 0 2 [none] 6938.304 0.000 0.000 -6938.304 0.000
+ 7 [o] e- 0 0 3-4 [none] 27.091 26.581 -5.229 0.288 0.000
+ 8 [o] e+ 0 0 3-4 [none] 52.094 -26.581 5.229 -44.496 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 79.185 0.000 0.000 -44.208
+Sum of beam remnant momenta: p(0:3) = 13920.815 0.000 0.000 44.208
+Sum of outgoing momenta: p(0:3) = 79.185 0.000 0.000 -44.208
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 6.56959E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.47022E+07
+sqme_ref* => 1.47022E+07
+event_index* => 8
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.7488700E+01; 0.0000000E+00, 0.0000000E+00,-1.7488700E+01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-6.1696367E+01; 0.0000000E+00, 0.0000000E+00, 6.1696367E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9825113E+03; 0.0000000E+00, 0.0000000E+00, 6.9825113E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9383036E+03; 0.0000000E+00, 0.0000000E+00,-6.9383036E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 2.7091406E+01; 2.6580500E+01,-5.2285908E+00, 2.8826949E-01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 5.2093661E+01;-2.6580500E+01, 5.2285908E+00,-4.4495937E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #9
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.35334E+07
+ Squared matrix el. (prc) = 1.35334E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 27
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.067593E+02
+ P = 0.000000E+00 0.000000E+00 1.067593E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 8.464686E+00
+ P = 0.000000E+00 0.000000E+00 -8.464686E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.893241E+03
+ P = 0.000000E+00 0.000000E+00 6.893241E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.991535E+03
+ P = 0.000000E+00 0.000000E+00 -6.991535E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 3.781862E+01
+ P = 1.174670E+01 -2.488222E+01 2.594491E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 7.740532E+01
+ P = -1.174670E+01 2.488222E+01 7.234966E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 9
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 106.759 0.000 0.000 106.759 0.000
+ 4 [i] dbar 0 0 2 7-8 8.465 0.000 0.000 -8.465 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6893.241 0.000 0.000 6893.241 0.000
+ 6 [x] hr3 0 0 2 [none] 6991.535 0.000 0.000 -6991.535 0.000
+ 7 [o] e- 0 0 3-4 [none] 37.819 11.747 -24.882 25.945 0.000
+ 8 [o] e+ 0 0 3-4 [none] 77.405 -11.747 24.882 72.350 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 115.224 0.000 0.000 98.295
+Sum of beam remnant momenta: p(0:3) = 13884.776 0.000 0.000 -98.295
+Sum of outgoing momenta: p(0:3) = 115.224 0.000 0.000 98.295
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 6.01227E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.35334E+07
+sqme_ref* => 1.35334E+07
+event_index* => 9
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.0675926E+02; 0.0000000E+00, 0.0000000E+00,-1.0675926E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-8.4646859E+00; 0.0000000E+00, 0.0000000E+00, 8.4646859E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.8932407E+03; 0.0000000E+00, 0.0000000E+00, 6.8932407E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9915353E+03; 0.0000000E+00, 0.0000000E+00,-6.9915353E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 3.7818625E+01; 1.1746697E+01,-2.4882224E+01, 2.5944911E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 7.7405319E+01;-1.1746697E+01, 2.4882224E+01, 7.2349661E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #10
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 6.32254E+06
+ Squared matrix el. (prc) = 6.32254E+06
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 30
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 3.840213E+02
+ P = 0.000000E+00 0.000000E+00 3.840213E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 2.304886E+01
+ P = 0.000000E+00 0.000000E+00 -2.304886E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.615979E+03
+ P = 0.000000E+00 0.000000E+00 6.615979E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.976951E+03
+ P = 0.000000E+00 0.000000E+00 -6.976951E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 1.317678E+02
+ P = -7.259226E+01 4.671327E+01 9.955395E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 2.753024E+02
+ P = 7.259226E+01 -4.671327E+01 2.614185E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 10
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 1418.257 0.000 0.000 1418.257 0.000
+ 4 [i] dbar 1 0 2 7-8 226.061 0.000 0.000 -226.061 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6615.979 0.000 0.000 6615.979 0.000
+ 6 [x] hr3 0 0 2 [none] 6976.951 0.000 0.000 -6976.951 0.000
+ 7 [v] e- 0 0 3-4 9-11 131.768 -72.592 46.713 99.554 0.000
+ 8 [v] e+ 0 0 3-4 9-11 275.302 72.592 -46.713 261.419 0.000
+ 9 [o] e- 0 0 7-8 [none] 39.603 -12.884 -32.933 17.826 0.000
+ 10 [o] e+ 0 0 7-8 [none] 1082.684 302.860 -353.876 977.370 0.000
+ 11 [o] gl 1 0 7-8 [none] 522.031 -289.976 386.809 196.999 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 1644.318 0.000 0.000 1192.196
+Sum of beam remnant momenta: p(0:3) = 13592.930 0.000 0.000 -360.972
+Sum of outgoing momenta: p(0:3) = 1644.318 0.000 0.000 1192.196
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 1.13245E+03
+n_in* => 2
+n_out* => 5
+n_tot* => 7
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 6.32254E+06
+sqme_ref* => 6.32254E+06
+event_index* => 10
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.4182569E+03; 0.0000000E+00, 0.0000000E+00,-1.4182569E+03| 0.0000000E+00| 3)
+ 4 prt(i:-1|-2.2606130E+02; 0.0000000E+00, 0.0000000E+00, 2.2606130E+02| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.6159787E+03; 0.0000000E+00, 0.0000000E+00, 6.6159787E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9769511E+03; 0.0000000E+00, 0.0000000E+00,-6.9769511E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 3.9602661E+01;-1.2884171E+01,-3.2933394E+01, 1.7825837E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 1.0826845E+03; 3.0286048E+02,-3.5387591E+02, 9.7737047E+02| 0.0000000E+00| 8)
+ 9 prt(o:21| 5.2203104E+02;-2.8997631E+02, 3.8680931E+02, 1.9699926E+02| 0.0000000E+00| 9)
+========================================================================
+Contents of powheg_2_p1.pg:
+ 3
+ 10 10 3
+ 4.560119043E+02 1.083969644E+03 1.007045090E+03 4.074727667E+02 8.208315229E+02 4.396871512E+03 0.000000000E+00 4.558709405E-01 1.141063084E-02 4.729003008E-04 6.224667613E+02 1.196651089E+03 8.127481921E+02 1.702520100E+02 5.646333397E+00 9.345880425E+01 1.355000829E-02 1.211241279E+00 3.408433911E+03 2.199084697E+02 1.987179070E+02 1.451993057E+03 4.418605876E+02 2.496876540E+03 4.722853191E+02 3.977529668E+01 4.554864150E+03 4.223918258E+00 2.217091820E+03 4.117712960E-01 7.473431302E+00 1.531560156E+03 1.196163055E+03 2.632995458E+02 1.244261060E+02 0.000000000E+00 1.072698995E+01 3.807601594E+00 0.000000000E+00 3.158646973E+02 2.886920565E+02 8.090733367E+02 5.419702401E+02 5.596089586E+02 3.922359487E+02 6.422277057E+01 3.629179195E-02 1.200576624E+03 8.145245363E-02 1.337148316E-05 2.275132871E+02 7.996803341E+00 1.683365759E+03 3.210781014E+02 4.797035517E+00 3.990989865E+01 1.172740941E+01 2.684231168E-01 8.274103289E-01 1.326605153E+02 1.577863833E+02 9.264959257E+02 1.264473405E+03 1.078038904E+03 6.874008949E+01 3.672498374E+00 1.917022086E-01 2.265468009E+02 7.912402820E+01 1.242060587E+01 7.851269700E+01 1.675160408E+02 7.208422421E+02 1.417059665E+03 7.165203743E+01 4.538204667E+02 8.488459445E+01 1.903180640E+02 0.000000000E+00 1.670547514E-05 1.544486079E+02 5.685362335E+02 5.067410633E+02 9.713214692E+02 5.724845963E+02 1.281704561E+01 1.669929930E+01 3.177996799E+02 1.678899477E+00 3.757393672E-01 7.723913026E+01 2.835181210E+02 1.722857133E+02 5.066051410E+01 3.080680166E+02 1.386711677E+02 3.920634233E-01 0.000000000E+00 8.331194877E+01 1.698877153E-01 4.384357880E+04 1.907411238E+04 8.156297799E+04 3.653229510E+03 4.960879928E+04 9.945844410E+04 1.272167788E+03 1.863897830E+01 2.581840287E-01 1.062710089E-02 4.229766046E+03 9.128743944E+04 4.372688748E+04 1.214563017E+04 1.199777760E+02 7.983321145E+02 1.502253809E+03 1.180843121E+02 1.207658703E+04 4.946094767E+02 2.317625315E+03 6.123651741E+04 5.831805408E+04 6.861434159E+04 2.789576070E+04 6.359156363E+02 2.779473766E+04 1.026255154E+02 1.440373556E+04 1.858861305E+00 1.351343762E+02 1.127664524E+05 9.259108935E+04 3.680628504E+04 8.859631489E+03 0.000000000E+00 6.613577377E+01 3.680970076E+01 0.000000000E+00 1.031766614E+03 2.670667718E+04 6.170918728E+04 9.037063250E+03 1.097775140E+04 3.183753650E+04 4.555298582E+03 8.373589996E-01 2.681984707E+04 1.887609732E+00 6.006817297E-04 2.318553651E+04 1.419703054E+02 1.184023594E+05 3.919247258E+04 9.544377659E+01 2.302546747E+03 7.610355879E+02 2.098636602E+02 5.046425000E+01 3.316618655E+02 1.096808014E+03 1.157035623E+05 4.543054668E+04 7.170013829E+04 5.210159325E+03 3.256620391E+03 1.213563385E+01 1.523174449E+03 5.410942140E+03 2.961644733E+01 3.472115725E+03 1.291384707E+03 2.554557055E+04 8.980998936E+04 1.274336968E+04 2.899266469E+04 4.998481481E+03 7.542775634E+03 5.165081139E-02 1.774632969E-02 1.635221457E+03 9.438799543E+03 4.288340659E+04 4.389527495E+04 4.093970321E+04 4.873126597E+03 1.600181166E+03 8.495159685E+03 1.040871211E+01 2.430656984E+00 1.649812341E+03 2.917103301E+04 5.771668802E+03 4.585200943E+03 2.345593652E+04 2.187096586E+04 8.234602728E+02 0.000000000E+00 7.317396284E+03 1.666966827E+01 5.749147369E+02 7.605462376E+02 6.411116382E+02 9.940470160E+02 3.342349589E+02 9.197581661E+03 0.000000000E+00 1.142175649E+00 5.329014553E-02 1.069341183E-03 4.915194120E+02 1.708347196E+03 7.849143137E+02 1.852367032E+03 1.258973745E+01 6.669359289E+02 1.860729054E-01 1.865177588E+01 1.036067036E+03 8.148132341E+01 2.192802694E+02 1.176156898E+03 1.670955478E+03 2.916818729E+03 2.315574575E+02 1.347360248E+01 4.526419718E+04 8.260606464E+00 7.033742116E+02 9.585383460E+00 8.383479185E+01 1.132991924E+03 4.213342008E+02 8.456329073E+01 7.268263954E+01 0.000000000E+00 1.644620618E+02 1.284889365E+00 0.000000000E+00 1.347470453E+02 7.201046666E+02 5.013058780E+02 3.631170367E+02 6.157810219E+02 1.870263898E+02 4.149033958E+02 4.320214851E-02 3.318665532E+03 3.007327115E-01 2.377752541E-04 1.253165487E+02 1.021004305E+02 2.594713553E+03 4.817873789E+02 3.620265939E+00 1.204126181E+01 1.988998097E+02 1.195857415E-01 1.654226413E+01 3.463483698E+02 1.050345431E+02 1.869781338E+03 6.913660442E+02 3.579855842E+02 4.191916119E+02 2.467937339E+00 1.716202026E+00 7.252395634E+02 2.151696550E+02 4.103453537E+00 4.849633545E+01 7.668112022E+01 2.624835596E+02 6.775170677E+02 1.261047593E+02 1.491137995E+02 1.826473604E+02 7.655725707E+01 0.000000000E+00 1.939892268E-04 6.654238871E+01 3.672920365E+02 6.869762254E+02 3.336088072E+02 1.978711285E+02 3.413928219E+01 7.676510483E+00 1.184736143E+02 1.011408152E+01 1.226057602E+00 4.734780013E+01 8.036833316E+02 6.763799878E+01 3.862775136E+01 1.058976228E+02 4.616043553E+01 1.667818945E+00 0.000000000E+00 2.558553524E+02 5.319890066E-01
Index: trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref (revision 8819)
+++ trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref (revision 8820)
@@ -1,733 +1,723 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
openmp_num_threads = 1
?pacify = true
seed = 0
SM.wtop => 0.00000E+00
SM.mtop => 1.75000E+02
?use_vamp_equivalences = false
$loop_me_method = "dummy"
?alphas_is_fixed = false
?alphas_from_mz = true
alpha_power = 2
alphas_power = 0
?combined_nlo_integration = true
?powheg_matching = true
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_pt_min = 1.00000E+00
?powheg_use_singular_jacobian = false
| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
sqrts = 5.00000E+02
| Integrate: current process library needs compilation
| Process library 'powheg_1_lib': compiling ...
| Process library 'powheg_1_lib': writing makefile
| Process library 'powheg_1_lib': removing old files
| Process library 'powheg_1_lib': writing driver
| Process library 'powheg_1_lib': creating source code
| Process library 'powheg_1_lib': compiling sources
| Process library 'powheg_1_lib': linking
| Process library 'powheg_1_lib': loading
| Process library 'powheg_1_lib': ... success.
| Integrate: compilation done
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process powheg_1_p1:
| Beam structure: [any particles]
| Beam data (collision):
| e+ (mass = 5.1099700E-04 GeV)
| e- (mass = 5.1099700E-04 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p1.i1.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'powheg_1_p1'
| Library name = 'powheg_1_lib'
| Process index = 1
| Process components:
| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
Warning: No cuts have been defined.
| Using user-defined general scale.
| Starting integration for process 'powheg_1_p1'
| Integration hook: add POWHEG hook
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 1 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
|-----------------------------------------------------------------------------|
1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
|=============================================================================|
n_events = 1
?debug_decay = false
?debug_process = false
?debug_verbose = false
?sample_pacify = true
?write_raw = false
| Starting simulation for process 'powheg_1_p1'
| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 1
| Simulation: requested number of events = 1
| corr. to luminosity [fb-1] = 2.1359E-03
| Events: writing to ASCII file 'powheg_1_p1.debug'
| Events: generating 1 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p1.pg'
-| Grid: Mean value of the grid: 4.184321728E-02
-| Grid: Max value of the grid: 9.365699880E-02
-| Grid: Mean/Max value of the grid: 4.467708534E-01
+| Grid: Mean value of the grid: 2.73542E-03
+| Grid: Max value of the grid: 5.79027E-03
+| Grid: Mean/Max value of the grid: 4.72416E-01
| ... event sample complete.
| Events: actual unweighting efficiency = 20.00 %
| Events: closing ASCII file 'powheg_1_p1.debug'
-Warning: There have been 1 ( 50.00%) POWHEG grid excesses.
n_events = 2
| Starting simulation for process 'powheg_1_p1'
| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 2
| Simulation: requested number of events = 2
| corr. to luminosity [fb-1] = 4.2717E-03
| Events: writing to ASCII file 'powheg_1_p1.debug'
| Events: generating 2 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p1.pg'
-| Grid: Mean value of the grid: 4.184321728E-02
-| Grid: Max value of the grid: 9.365699880E-02
-| Grid: Mean/Max value of the grid: 4.467708534E-01
+| Grid: Mean value of the grid: 2.73542E-03
+| Grid: Max value of the grid: 5.79027E-03
+| Grid: Mean/Max value of the grid: 4.72416E-01
| ... event sample complete.
| Events: actual unweighting efficiency = 100.00 %
| Events: closing ASCII file 'powheg_1_p1.debug'
-Warning: There have been 3 ( 50.00%) POWHEG grid excesses.
$real_partition_mode = "on"
real_partition_scale = 5.00000E+00
| Process library 'powheg_1_lib': unloading
| Process library 'powheg_1_lib': open
| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
| Integrate: current process library needs compilation
| Process library 'powheg_1_lib': compiling ...
| Process library 'powheg_1_lib': writing makefile
| Process library 'powheg_1_lib': removing old files
| Process library 'powheg_1_lib': writing driver
| Process library 'powheg_1_lib': creating source code
| Process library 'powheg_1_lib': compiling sources
| Process library 'powheg_1_lib': linking
| Process library 'powheg_1_lib': loading
| Process library 'powheg_1_lib': ... success.
| Integrate: compilation done
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 3
| Initializing integration for process powheg_1_p2:
| Beam structure: [any particles]
| Beam data (collision):
| e+ (mass = 5.1099700E-04 GeV)
| e- (mass = 5.1099700E-04 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i1.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'powheg_1_p2'
| Library name = 'powheg_1_lib'
| Process index = 2
| Process components:
| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 1 channels, 5 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
| Phase space: 2 channels, 5 dimensions
| Phase space: found 2 channels, collected in 1 grove.
| Phase space: no equivalences between channels used.
| Phase space: wood
Warning: No cuts have been defined.
| Using user-defined general scale.
| Integration hook: add POWHEG hook
| Starting integration for process 'powheg_1_p2' part 'Combined'
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 1 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
|-----------------------------------------------------------------------------|
1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
|=============================================================================|
| Starting integration for process 'powheg_1_p2' part 'real'
| Integrate: iterations = 1:100:"gw"
| Integrator: 1 chains, 2 channels, 5 dimensions
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
|-----------------------------------------------------------------------------|
1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
|=============================================================================|
| Integrate: sum of all components
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
|=============================================================================|
tolerance = 1.08344E+02
| expect: success
| Starting simulation for process 'powheg_1_p2'
| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying POWHEG matching
| QCD alpha: using a running strong coupling
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 4
| Simulation: requested number of events = 2
| corr. to luminosity [fb-1] = 4.0174E-03
| Events: writing to ASCII file 'powheg_1_p2.debug'
| Events: generating 2 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| POWHEG: using grids from file 'powheg_1_p2.pg'
-| Grid: Mean value of the grid: 8.354017180E-03
-| Grid: Max value of the grid: 9.272017596E-02
-| Grid: Mean/Max value of the grid: 9.009923777E-02
+| Grid: Mean value of the grid: 5.27612E-04
+| Grid: Max value of the grid: 6.09917E-03
+| Grid: Mean/Max value of the grid: 8.65055E-02
| ... event sample complete.
| Events: actual unweighting efficiency = 20.00 %
| Events: closing ASCII file 'powheg_1_p2.debug'
| Summary of value checks:
| Failures: 0 / Total: 1
-| There were no errors and 4 warning(s).
+| There were no errors and 2 warning(s).
| WHIZARD run finished.
|=============================================================================|
Contents of powheg_1_p1.debug:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 2.82009E-02
Squared matrix el. (prc) = 2.82009E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 7
calls = 3
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 9.608533E+01 -1.236770E+02 -8.571236E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -9.608533E+01 1.236770E+02 8.571236E+01
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 8
calls = 1
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
- 3 [v] t 1 0 1-2 5-7 250.000 96.085 -123.677 -85.712 30625.000
- 4 [v] tbar 0 1 1-2 5-7 250.000 -96.085 123.677 85.712 30625.000
- 5 [o] t 2 0 3-4 [none] 196.039 103.504 -100.239 -132.929 30625.000
- 6 [o] tbar 0 1 3-4 [none] 250.979 -96.822 124.625 86.369 30625.000
- 7 [o] gl 1 2 3-4 [none] 52.982 -6.683 -24.386 46.560 0.000
+ 3 [o] t 1 0 1-2 [none] 250.000 96.085 -123.677 -85.712 30625.000
+ 4 [o] tbar 0 1 1-2 [none] 250.000 -96.085 123.677 85.712 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
-n_out* => 3
-n_tot* => 5
+n_out* => 2
+n_tot* => 4
$process_id* => "powheg_1_p1"
process_num_id* => [unknown integer]
sqme* => 2.82009E-02
sqme_ref* => 2.82009E-02
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
- 3 prt(o:6| 1.9603876E+02; 1.0350443E+02,-1.0023939E+02,-1.3292890E+02| 3.0625000E+04| 3)
- 4 prt(o:-6| 2.5097910E+02;-9.6821813E+01, 1.2462497E+02, 8.6369341E+01| 3.0625000E+04| 4)
- 5 prt(o:21| 5.2982138E+01;-6.6826136E+00,-2.4385585E+01, 4.6559562E+01| 0.0000000E+00| 5)
+ 3 prt(o:6| 2.5000000E+02; 9.6085328E+01,-1.2367700E+02,-8.5712364E+01| 3.0625000E+04| 3)
+ 4 prt(o:-6| 2.5000000E+02;-9.6085328E+01, 1.2367700E+02, 8.5712364E+01| 3.0625000E+04| 4)
========================================================================
========================================================================
Event #2
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
- Squared matrix el. (ref) = 3.34619E-02
- Squared matrix el. (prc) = 3.34619E-02
+ Squared matrix el. (ref) = 2.76793E-02
+ Squared matrix el. (prc) = 2.76793E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 7
calls = 6
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 1.688666E+02 3.093682E+01 -4.901007E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -1.688666E+02 -3.093682E+01 4.901007E+01
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p1'
TAO random-number generator:
seed = 8
calls = 2
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
- 3 [v] t 1 0 1-2 5-7 250.000 168.867 30.937 -49.010 30625.000
- 4 [v] tbar 0 1 1-2 5-7 250.000 -168.867 -30.937 49.010 30625.000
- 5 [o] t 2 0 3-4 [none] 191.977 188.835 33.666 7.940 30625.000
- 6 [o] tbar 0 1 3-4 [none] 247.249 -165.204 -30.266 47.947 30625.000
- 7 [o] gl 1 2 3-4 [none] 60.774 -23.632 -3.400 -55.887 0.000
+ 3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
+ 4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
-n_out* => 3
-n_tot* => 5
+n_out* => 2
+n_tot* => 4
$process_id* => "powheg_1_p1"
process_num_id* => [unknown integer]
-sqme* => 3.34619E-02
-sqme_ref* => 3.34619E-02
+sqme* => 2.76793E-02
+sqme_ref* => 2.76793E-02
event_index* => 2
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
- 3 prt(o:6| 1.9197718E+02; 1.8883530E+02, 3.3666245E+01, 7.9404340E+00| 3.0625000E+04| 3)
- 4 prt(o:-6| 2.4724932E+02;-1.6520379E+02,-3.0265780E+01, 4.7947013E+01| 3.0625000E+04| 4)
- 5 prt(o:21| 6.0773502E+01;-2.3631517E+01,-3.4004649E+00,-5.5887447E+01| 0.0000000E+00| 5)
+ 3 prt(o:6| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01| 3.0625000E+04| 3)
+ 4 prt(o:-6| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01| 3.0625000E+04| 4)
========================================================================
Contents of powheg_1_p2.debug:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 1.41607E-05
Squared matrix el. (prc) = 1.41607E-05
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 2
Selected term = 6
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196611
calls = 3
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4 5
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4 5
Particle 3 [o] f(6)c(1 )
E = 2.219832E+02
P = -7.125693E+01 -1.137429E+02 -2.522963E+01
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-2 )
E = 2.128305E+02
P = 1.983915E+01 1.013308E+02 6.332695E+01
T = 3.062500000E+04
Parents: 1 2
Particle 5 [o] f(21)c(2 -1)
E = 6.518630E+01
P = 5.141778E+01 1.241207E+01 -3.809732E+01
T = 0.000000000E+00
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196612
calls = 1
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
n_out* => 3
n_tot* => 5
$process_id* => "powheg_1_p2"
process_num_id* => [unknown integer]
sqme* => 1.41607E-05
sqme_ref* => 1.41607E-05
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
3 prt(o:6| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01| 3.0625000E+04| 3)
4 prt(o:-6| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01| 3.0625000E+04| 4)
5 prt(o:21| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01| 0.0000000E+00| 5)
========================================================================
========================================================================
Event #2
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 3.51646E-02
Squared matrix el. (prc) = 3.51646E-02
Event weight (ref) = 1.00000E+00
Event weight (prc) = 1.00000E+00
------------------------------------------------------------------------
Selected MCI group = 1
Selected term = 1
Selected channel = 1
------------------------------------------------------------------------
Passed selection = T
Reweighting factor = 1.00000E+00
Analysis flag = T
========================================================================
Event transform: trivial (hard process)
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196611
calls = 6
Number of tries = 1
------------------------------------------------------------------------
Particle set:
------------------------------------------------------------------------
Particle 1 [i] f(-11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 2 [i] f(11)
E = 2.500000E+02
P = 0.000000E+00 0.000000E+00 -2.500000E+02
T = 2.611179340E-07
Children: 3 4
Particle 3 [o] f(6)c(1 )
E = 2.500000E+02
P = 1.143154E+02 2.823158E+00 -1.371095E+02
T = 3.062500000E+04
Parents: 1 2
Particle 4 [o] f(-6)c(-1 )
E = 2.500000E+02
P = -1.143154E+02 -2.823158E+00 1.371095E+02
T = 3.062500000E+04
Parents: 1 2
========================================================================
========================================================================
Event transform: shower
------------------------------------------------------------------------
Associated process: 'powheg_1_p2'
TAO random-number generator:
seed = 196612
calls = 2
Number of tries = 1
Particle set:
------------------------------------------------------------------------
Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
------------------------------------------------------------------------
Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
------------------------------------------------------------------------
Shower settings:
------------------------------------------------------------------------
Master switches:
ps_isr_active = F
ps_fsr_active = F
ps_tau_dec = F
muli_active = F
hadronization_active = F
General settings:
[ISR and FSR off]
Matching Settings:
mlm_matching = F
ckkw_matching = F
PYTHIA6 specific settings:
ps_PYTHIA_PYGIVE = ''
PYTHIA8 specific settings:
ps_PYTHIA8_config = ''
ps_PYTHIA8_config_file = ''
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 5.00000E+02
sqrts_hat* => 5.00000E+02
n_in* => 2
n_out* => 2
n_tot* => 4
$process_id* => "powheg_1_p2"
process_num_id* => [unknown integer]
sqme* => 3.51646E-02
sqme_ref* => 3.51646E-02
event_index* => 2
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:-11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02| 2.6111793E-07| 1)
2 prt(i:11|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02| 2.6111793E-07| 2)
3 prt(o:6| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02| 3.0625000E+04| 3)
4 prt(o:-6| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02| 3.0625000E+04| 4)
========================================================================
Contents of powheg_1_p1.pg:
3
5 5 2
- 9.166236604E-02 9.032896717E-02 6.723678949E-02 4.571327342E-02 3.324702412E-02 9.151971889E-02 8.865308699E-02 6.535662503E-02 5.518275472E-02 3.145236216E-02 6.859820428E-02 6.274309739E-02 5.549694371E-02 4.020252778E-02 2.152769730E-02 3.667140083E-02 3.455080287E-02 2.459688421E-02 1.598447205E-02 3.909823183E-03 9.948616216E-03 1.134521581E-02 8.596147426E-03 7.850796583E-03 2.970031695E-03 9.108502559E-02 9.365699880E-02 6.651597886E-02 6.362815374E-02 1.377491162E-02 9.196811144E-02 8.054417142E-02 6.075079389E-02 4.353573393E-02 3.463257215E-02 6.864678243E-02 5.899360282E-02 4.850226433E-02 2.576226526E-02 2.954714701E-02 3.685548912E-02 3.341223373E-02 2.708530846E-02 1.146925318E-02 7.331537543E-03 1.065212726E-02 9.915716337E-03 9.451906452E-03 6.411924816E-03 2.685224373E-03
+ 5.790270664E-03 4.340796144E-03 3.956052276E-03 3.268282917E-03 2.051663009E-03 5.483522583E-03 4.862867872E-03 3.083117535E-03 1.719170940E-03 1.731060881E-03 4.642896596E-03 4.089381442E-03 3.278082860E-03 2.072774721E-03 0.000000000E+00 4.285081626E-03 2.703041104E-03 1.939545191E-03 1.808207863E-03 4.832500063E-04 1.725229895E-03 1.848230090E-03 1.666841566E-03 8.779276888E-04 5.973720333E-04 5.658021588E-03 4.797607918E-03 3.691638808E-03 2.563335143E-03 1.517565363E-03 5.487405765E-03 4.496579172E-03 3.894360742E-03 2.025323977E-03 2.321871929E-03 4.723771507E-03 3.748862492E-03 2.983344600E-03 2.071276052E-03 0.000000000E+00 4.306592486E-03 2.873724641E-03 2.416448613E-03 1.437407351E-03 9.061702788E-04 1.847228600E-03 1.615352727E-03 1.894685168E-03 7.407161765E-04 4.468087711E-04
Contents of powheg_1_p2.pg:
3
5 5 2
- 8.792105792E-02 0.000000000E+00 8.758623487E-03 0.000000000E+00 0.000000000E+00 9.266572971E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.389639763E-02 4.005706067E-03 1.398323195E-03 0.000000000E+00 1.912361556E-04 8.792330949E-02 0.000000000E+00 8.658995257E-03 0.000000000E+00 0.000000000E+00 9.272017596E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.354190061E-02 4.295175422E-03 1.522058038E-03 0.000000000E+00 2.021700458E-04
+ 6.095586897E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638456151E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.295080904E-03 7.908640171E-04 3.287241452E-04 0.000000000E+00 4.113171729E-05 6.099168392E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638549328E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.236533403E-03 8.480152142E-04 3.249849498E-04 0.000000000E+00 4.348341527E-05
Index: trunk/share/tests/functional_tests/ref-output-ext/powheg_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-ext/powheg_2.ref (revision 0)
+++ trunk/share/tests/functional_tests/ref-output-ext/powheg_2.ref (revision 8820)
@@ -0,0 +1,1578 @@
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+openmp_num_threads = 1
+?pacify = true
+?write_raw = false
+SM.mZ => 9.11880E+01
+SM.mW => 8.04190E+01
+SM.mH => 1.25000E+02
+SM.GF => 1.16639E-05
+SM.me => 0.00000E+00
+SM.mmu => 0.00000E+00
+SM.mtau => 1.77700E+00
+?alphas_is_fixed = false
+?alphas_from_mz = true
+?alphas_from_lambda_qcd = false
+?alphas_from_lhapdf = false
+alphas_nf = 5
+alphas_order = 1
+$exclude_gauge_splittings = "u:s:b:t"
+$method = "dummy"
+$pdf_builtin_set = "mstw2008nlo"
+sqrts = 1.40000E+04
+?combined_nlo_integration = true
+| Process library 'powheg_2_lib': recorded process 'powheg_2_p1'
+seed = 130
+?fixed_order_nlo_events = false
+?unweighted = true
+?powheg_matching = true
+powheg_grid_size_xi = 10
+powheg_grid_size_y = 10
+powheg_pt_min = 1.00000E+00
+| Integrate: current process library needs compilation
+| Process library 'powheg_2_lib': compiling ...
+| Process library 'powheg_2_lib': writing makefile
+| Process library 'powheg_2_lib': removing old files
+| Process library 'powheg_2_lib': writing driver
+| Process library 'powheg_2_lib': creating source code
+| Process library 'powheg_2_lib': compiling sources
+| Process library 'powheg_2_lib': linking
+| Process library 'powheg_2_lib': loading
+| Process library 'powheg_2_lib': ... success.
+| Integrate: compilation done
+| QCD alpha: using a running strong coupling
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 130
+| Initializing integration for process powheg_2_p1:
+| Beam structure: p, p => pdf_builtin
+| Beam data (collision):
+| p (mass = 0.0000000E+00 GeV)
+| p (mass = 0.0000000E+00 GeV)
+| sqrts = 1.400000000000E+04 GeV
+| Initialized builtin PDF MSTW2008NLO
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'powheg_2_p1.i1.phs'
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'powheg_2_p1.i3.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'powheg_2_p1'
+| Library name = 'powheg_2_lib'
+| Process index = 1
+| Process components:
+| 1: 'powheg_2_p1_i1': d, dbar => e-, e+ [dummy]
+| 2: 'powheg_2_p1_i2': d:gl, dbar:gl => e-, e+, gl:d:dbar [dummy], [real]
+| 3: 'powheg_2_p1_i3': d, dbar => e-, e+ [dummy], [virtual]
+| 4: 'powheg_2_p1_i4': d, dbar => e-, e+ [inactive], [subtraction]
+| 5: 'powheg_2_p1_i5': d, dbar => e-, e+ [dummy], [dglap]
+| ------------------------------------------------------------------------
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Phase space: 2 channels, 5 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+| Beam structure: pdf_builtin, none => none, pdf_builtin
+| Beam structure: 2 channels, 2 dimensions
+| Applying user-defined cuts.
+| Using user-defined general scale.
+| Starting integration for process 'powheg_2_p1'
+| Integration hook: add POWHEG hook
+| Shower: interfacing PDF builtin set #8
+| Integrate: iterations = 1:1000:"gw"
+| Integrator: 2 chains, 2 channels, 7 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
+|-----------------------------------------------------------------------------|
+ 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
+|=============================================================================|
+n_events = 10
+?negative_weights = true
+?keep_failed_events = true
+?debug_decay = false
+?debug_process = false
+?debug_verbose = false
+?sample_pacify = true
+| Starting simulation for process 'powheg_2_p1'
+| Simulate: using integration grids from file 'powheg_2_p1.m1.vg'
+| Simulate: activating parton shower
+| Shower: interfacing PDF builtin set #8
+| Shower: Using WHIZARD internal shower
+| Simulate: applying POWHEG matching
+| QCD alpha: using a running strong coupling
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 131
+| Simulation: requested number of events = 10
+| corr. to luminosity [fb-1] = 9.3197E-10
+| Events: writing to ASCII file 'powheg_2_p1.debug'
+| Events: generating 10 unweighted, unpolarized events ...
+| Events: event normalization mode '1'
+| POWHEG: using grids from file 'powheg_2_p1.pg'
+| Grid: Mean value of the grid: 7.15782E+03
+| Grid: Max value of the grid: 1.18402E+05
+| Grid: Mean/Max value of the grid: 6.04533E-02
+| ... event sample complete.
+| Events: actual unweighting efficiency = 0.34 %
+Warning: Encountered events with excess weight: 4 events ( 40.000 %)
+| Maximum excess weight = 1.722E+01
+| Average excess weight = 1.950E+00
+| Events: closing ASCII file 'powheg_2_p1.debug'
+| There were no errors and 1 warning(s).
+| WHIZARD run finished.
+|=============================================================================|
+Contents of powheg_2_p1.debug:
+========================================================================
+ Event #1
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.73082E+07
+ Squared matrix el. (prc) = 1.73082E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 3
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 6.899492E+02
+ P = 0.000000E+00 0.000000E+00 6.899492E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 4.215047E-01
+ P = 0.000000E+00 0.000000E+00 -4.215047E-01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.310051E+03
+ P = 0.000000E+00 0.000000E+00 6.310051E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.999578E+03
+ P = 0.000000E+00 0.000000E+00 -6.999578E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.087387E+02
+ P = -9.888752E+00 -4.804441E+00 6.086394E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 8.163209E+01
+ P = 9.888752E+00 4.804441E+00 8.088837E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 1
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 689.949 0.000 0.000 689.949 0.000
+ 4 [i] dbar 0 0 2 7-8 0.422 0.000 0.000 -0.422 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6310.051 0.000 0.000 6310.051 0.000
+ 6 [x] hr3 0 0 2 [none] 6999.578 0.000 0.000 -6999.578 0.000
+ 7 [o] e- 0 0 3-4 [none] 608.739 -9.889 -4.804 608.639 0.000
+ 8 [o] e+ 0 0 3-4 [none] 81.632 9.889 4.804 80.888 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 690.371 0.000 0.000 689.528
+Sum of beam remnant momenta: p(0:3) = 13309.629 0.000 0.000 -689.528
+Sum of outgoing momenta: p(0:3) = 690.371 0.000 0.000 689.528
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.41067E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.73082E+07
+sqme_ref* => 1.73082E+07
+event_index* => 1
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 2.70702E-01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-6.8994924E+02; 0.0000000E+00, 0.0000000E+00,-6.8994924E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-4.2150470E-01; 0.0000000E+00, 0.0000000E+00, 4.2150470E-01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.3100508E+03; 0.0000000E+00, 0.0000000E+00, 6.3100508E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9995785E+03; 0.0000000E+00, 0.0000000E+00,-6.9995785E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.0873866E+02;-9.8887519E+00,-4.8044408E+00, 6.0863937E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 8.1632087E+01; 9.8887519E+00, 4.8044408E+00, 8.0888365E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #2
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 2.00716E+06
+ Squared matrix el. (prc) = 2.00716E+06
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 1
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 6
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.446225E+03
+ P = 0.000000E+00 0.000000E+00 1.446225E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 1.042581E+01
+ P = 0.000000E+00 0.000000E+00 -1.042581E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 5.553775E+03
+ P = 0.000000E+00 0.000000E+00 5.553775E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.989574E+03
+ P = 0.000000E+00 0.000000E+00 -6.989574E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 5.692890E+02
+ P = -1.196264E+02 5.256740E+00 5.565536E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 8.873620E+02
+ P = 1.196264E+02 -5.256740E+00 8.792458E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 2
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 1446.225 0.000 0.000 1446.225 0.000
+ 4 [i] dbar 0 0 2 7-8 10.426 0.000 0.000 -10.426 0.000
+ 5 [x] hr3bar 0 0 1 [none] 5553.775 0.000 0.000 5553.775 0.000
+ 6 [x] hr3 0 0 2 [none] 6989.574 0.000 0.000 -6989.574 0.000
+ 7 [o] e- 0 0 3-4 [none] 569.289 -119.626 5.257 556.554 0.000
+ 8 [o] e+ 0 0 3-4 [none] 887.362 119.626 -5.257 879.246 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
+Sum of beam remnant momenta: p(0:3) = 12543.349 0.000 0.000 -1435.799
+Sum of outgoing momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 2.45586E+02
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 2.00716E+06
+sqme_ref* => 2.00716E+06
+event_index* => 2
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.4462252E+03; 0.0000000E+00, 0.0000000E+00,-1.4462252E+03| 0.0000000E+00| 3)
+ 4 prt(i:-1|-1.0425811E+01; 0.0000000E+00, 0.0000000E+00, 1.0425811E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 5.5537748E+03; 0.0000000E+00, 0.0000000E+00, 5.5537748E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9895742E+03; 0.0000000E+00, 0.0000000E+00,-6.9895742E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 5.6928904E+02;-1.1962638E+02, 5.2567405E+00, 5.5655360E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 8.8736197E+02; 1.1962638E+02,-5.2567405E+00, 8.7924579E+02| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #3
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 2.38562E+07
+ Squared matrix el. (prc) = 2.38562E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 9
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 8.712482E+01
+ P = 0.000000E+00 0.000000E+00 8.712482E+01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 3.936136E+00
+ P = 0.000000E+00 0.000000E+00 -3.936136E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.912875E+03
+ P = 0.000000E+00 0.000000E+00 6.912875E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.996064E+03
+ P = 0.000000E+00 0.000000E+00 -6.996064E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 5.371039E+01
+ P = 1.850581E+00 -1.806232E+01 5.054833E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 3.735057E+01
+ P = -1.850581E+00 1.806232E+01 3.264036E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 3
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 87.125 0.000 0.000 87.125 0.000
+ 4 [i] dbar 0 0 2 7-8 3.936 0.000 0.000 -3.936 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6912.875 0.000 0.000 6912.875 0.000
+ 6 [x] hr3 0 0 2 [none] 6996.064 0.000 0.000 -6996.064 0.000
+ 7 [o] e- 0 0 3-4 [none] 53.710 1.851 -18.062 50.548 0.000
+ 8 [o] e+ 0 0 3-4 [none] 37.351 -1.851 18.062 32.640 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 91.061 0.000 0.000 83.189
+Sum of beam remnant momenta: p(0:3) = 13908.939 0.000 0.000 -83.189
+Sum of outgoing momenta: p(0:3) = 91.061 0.000 0.000 83.189
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.70370E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 2.38562E+07
+sqme_ref* => 2.38562E+07
+event_index* => 3
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 4.63589E-01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-8.7124821E+01; 0.0000000E+00, 0.0000000E+00,-8.7124821E+01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-3.9361364E+00; 0.0000000E+00, 0.0000000E+00, 3.9361364E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9128752E+03; 0.0000000E+00, 0.0000000E+00, 6.9128752E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9960639E+03; 0.0000000E+00, 0.0000000E+00,-6.9960639E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 5.3710386E+01; 1.8505811E+00,-1.8062325E+01, 5.0548327E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 3.7350571E+01;-1.8505811E+00, 1.8062325E+01, 3.2640357E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #4
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.48421E+07
+ Squared matrix el. (prc) = 1.48421E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 12
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.939732E+02
+ P = 0.000000E+00 0.000000E+00 1.939732E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 4.051484E+00
+ P = 0.000000E+00 0.000000E+00 -4.051484E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.806027E+03
+ P = 0.000000E+00 0.000000E+00 6.806027E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.995949E+03
+ P = 0.000000E+00 0.000000E+00 -6.995949E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 1.889687E+02
+ P = -8.729125E+00 -2.109992E+00 1.887552E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 9.055960E+00
+ P = 8.729125E+00 2.109992E+00 1.166507E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 4
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 193.973 0.000 0.000 193.973 0.000
+ 4 [i] dbar 0 0 2 7-8 4.051 0.000 0.000 -4.051 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6806.027 0.000 0.000 6806.027 0.000
+ 6 [x] hr3 0 0 2 [none] 6995.949 0.000 0.000 -6995.949 0.000
+ 7 [o] e- 0 0 3-4 [none] 188.969 -8.729 -2.110 188.755 0.000
+ 8 [o] e+ 0 0 3-4 [none] 9.056 8.729 2.110 1.167 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 198.025 0.000 0.000 189.922
+Sum of beam remnant momenta: p(0:3) = 13801.975 0.000 0.000 -189.922
+Sum of outgoing momenta: p(0:3) = 198.025 0.000 0.000 189.922
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 5.60671E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.48421E+07
+sqme_ref* => 1.48421E+07
+event_index* => 4
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.9397318E+02; 0.0000000E+00, 0.0000000E+00,-1.9397318E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-4.0514843E+00; 0.0000000E+00, 0.0000000E+00, 4.0514843E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.8060268E+03; 0.0000000E+00, 0.0000000E+00, 6.8060268E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9959485E+03; 0.0000000E+00, 0.0000000E+00,-6.9959485E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 1.8896870E+02;-8.7291246E+00,-2.1099918E+00, 1.8875519E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 9.0559605E+00; 8.7291246E+00, 2.1099918E+00, 1.1665068E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #5
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.12189E+07
+ Squared matrix el. (prc) = 1.12189E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 15
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 2.299967E+00
+ P = 0.000000E+00 0.000000E+00 2.299967E+00
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 1.055385E+02
+ P = 0.000000E+00 0.000000E+00 -1.055385E+02
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.997700E+03
+ P = 0.000000E+00 0.000000E+00 6.997700E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.894461E+03
+ P = 0.000000E+00 0.000000E+00 -6.894461E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.359252E+01
+ P = -1.344828E+00 -1.524474E+01 -6.172356E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 4.424595E+01
+ P = 1.344828E+00 1.524474E+01 -4.151498E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 5
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 2.300 0.000 0.000 2.300 0.000
+ 4 [i] dbar 0 0 2 7-8 105.539 0.000 0.000 -105.539 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6997.700 0.000 0.000 6997.700 0.000
+ 6 [x] hr3 0 0 2 [none] 6894.461 0.000 0.000 -6894.461 0.000
+ 7 [o] e- 0 0 3-4 [none] 63.593 -1.345 -15.245 -61.724 0.000
+ 8 [o] e+ 0 0 3-4 [none] 44.246 1.345 15.245 -41.515 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 107.838 0.000 0.000 -103.239
+Sum of beam remnant momenta: p(0:3) = 13892.162 0.000 0.000 103.239
+Sum of outgoing momenta: p(0:3) = 107.838 0.000 0.000 -103.239
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 3.11599E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.12189E+07
+sqme_ref* => 1.12189E+07
+event_index* => 5
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-2.2999667E+00; 0.0000000E+00, 0.0000000E+00,-2.2999667E+00| 0.0000000E+00| 3)
+ 4 prt(i:-1|-1.0553851E+02; 0.0000000E+00, 0.0000000E+00, 1.0553851E+02| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9977000E+03; 0.0000000E+00, 0.0000000E+00, 6.9977000E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.8944615E+03; 0.0000000E+00, 0.0000000E+00,-6.8944615E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.3592525E+01;-1.3448283E+00,-1.5244744E+01,-6.1723565E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 4.4245950E+01; 1.3448283E+00, 1.5244744E+01,-4.1514977E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #6
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = -7.01417E+06
+ Squared matrix el. (prc) = -7.01417E+06
+ Event weight (ref) = -1.00000E+00
+ Event weight (prc) = -1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 18
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 6.920607E+00
+ P = 0.000000E+00 0.000000E+00 6.920607E+00
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 6.366500E+00
+ P = 0.000000E+00 0.000000E+00 -6.366500E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.993079E+03
+ P = 0.000000E+00 0.000000E+00 6.993079E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.993634E+03
+ P = 0.000000E+00 0.000000E+00 -6.993634E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.520088E+00
+ P = 2.767436E+00 5.258452E+00 -2.683566E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 6.767019E+00
+ P = -2.767436E+00 -5.258452E+00 3.237673E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 6
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 6.921 0.000 0.000 6.921 0.000
+ 4 [i] dbar 0 0 2 7-8 6.366 0.000 0.000 -6.366 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6993.079 0.000 0.000 6993.079 0.000
+ 6 [x] hr3 0 0 2 [none] 6993.634 0.000 0.000 -6993.634 0.000
+ 7 [o] e- 0 0 3-4 [none] 6.520 2.767 5.258 -2.684 0.000
+ 8 [o] e+ 0 0 3-4 [none] 6.767 -2.767 -5.258 3.238 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 13.287 0.000 0.000 0.554
+Sum of beam remnant momenta: p(0:3) = 13986.713 0.000 0.000 -0.554
+Sum of outgoing momenta: p(0:3) = 13.287 0.000 0.000 0.554
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 1.32755E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => -7.01417E+06
+sqme_ref* => -7.01417E+06
+event_index* => 6
+event_weight* => -1.00000E+00
+event_weight_ref* => -1.00000E+00
+event_excess* => 1.54959E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-6.9206073E+00; 0.0000000E+00, 0.0000000E+00,-6.9206073E+00| 0.0000000E+00| 3)
+ 4 prt(i:-1|-6.3664998E+00; 0.0000000E+00, 0.0000000E+00, 6.3664998E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9930794E+03; 0.0000000E+00, 0.0000000E+00, 6.9930794E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9936335E+03; 0.0000000E+00, 0.0000000E+00,-6.9936335E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.5200879E+00; 2.7674357E+00, 5.2584523E+00,-2.6835658E+00| 0.0000000E+00| 7)
+ 8 prt(o:-11| 6.7670193E+00;-2.7674357E+00,-5.2584523E+00, 3.2376733E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #7
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 4.68463E+07
+ Squared matrix el. (prc) = 4.68463E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 21
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 5.667369E-01
+ P = 0.000000E+00 0.000000E+00 5.667369E-01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 7.081701E+01
+ P = 0.000000E+00 0.000000E+00 -7.081701E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.999433E+03
+ P = 0.000000E+00 0.000000E+00 6.999433E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.929183E+03
+ P = 0.000000E+00 0.000000E+00 -6.929183E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 6.467810E+01
+ P = 2.796685E+00 -2.231923E+00 -6.457905E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 6.705646E+00
+ P = -2.796685E+00 2.231923E+00 -5.671222E+00
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 7
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 0.567 0.000 0.000 0.567 0.000
+ 4 [i] dbar 0 0 2 7-8 70.817 0.000 0.000 -70.817 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6999.433 0.000 0.000 6999.433 0.000
+ 6 [x] hr3 0 0 2 [none] 6929.183 0.000 0.000 -6929.183 0.000
+ 7 [o] e- 0 0 3-4 [none] 64.678 2.797 -2.232 -64.579 0.000
+ 8 [o] e+ 0 0 3-4 [none] 6.706 -2.797 2.232 -5.671 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 71.384 0.000 0.000 -70.250
+Sum of beam remnant momenta: p(0:3) = 13928.616 0.000 0.000 70.250
+Sum of outgoing momenta: p(0:3) = 71.384 0.000 0.000 -70.250
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 1.26704E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 4.68463E+07
+sqme_ref* => 4.68463E+07
+event_index* => 7
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 1.72180E+01
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-5.6673690E-01; 0.0000000E+00, 0.0000000E+00,-5.6673690E-01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-7.0817012E+01; 0.0000000E+00, 0.0000000E+00, 7.0817012E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9994333E+03; 0.0000000E+00, 0.0000000E+00, 6.9994333E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9291830E+03; 0.0000000E+00, 0.0000000E+00,-6.9291830E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 6.4678103E+01; 2.7966851E+00,-2.2319227E+00,-6.4579053E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 6.7056461E+00;-2.7966851E+00, 2.2319227E+00,-5.6712224E+00| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #8
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.47022E+07
+ Squared matrix el. (prc) = 1.47022E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 24
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.748870E+01
+ P = 0.000000E+00 0.000000E+00 1.748870E+01
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 6.169637E+01
+ P = 0.000000E+00 0.000000E+00 -6.169637E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.982511E+03
+ P = 0.000000E+00 0.000000E+00 6.982511E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.938304E+03
+ P = 0.000000E+00 0.000000E+00 -6.938304E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 2.709141E+01
+ P = 2.658050E+01 -5.228591E+00 2.882695E-01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 5.209366E+01
+ P = -2.658050E+01 5.228591E+00 -4.449594E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 8
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 17.489 0.000 0.000 17.489 0.000
+ 4 [i] dbar 0 0 2 7-8 61.696 0.000 0.000 -61.696 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6982.511 0.000 0.000 6982.511 0.000
+ 6 [x] hr3 0 0 2 [none] 6938.304 0.000 0.000 -6938.304 0.000
+ 7 [o] e- 0 0 3-4 [none] 27.091 26.581 -5.229 0.288 0.000
+ 8 [o] e+ 0 0 3-4 [none] 52.094 -26.581 5.229 -44.496 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 79.185 0.000 0.000 -44.208
+Sum of beam remnant momenta: p(0:3) = 13920.815 0.000 0.000 44.208
+Sum of outgoing momenta: p(0:3) = 79.185 0.000 0.000 -44.208
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 6.56959E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.47022E+07
+sqme_ref* => 1.47022E+07
+event_index* => 8
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.7488700E+01; 0.0000000E+00, 0.0000000E+00,-1.7488700E+01| 0.0000000E+00| 3)
+ 4 prt(i:-1|-6.1696367E+01; 0.0000000E+00, 0.0000000E+00, 6.1696367E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.9825113E+03; 0.0000000E+00, 0.0000000E+00, 6.9825113E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9383036E+03; 0.0000000E+00, 0.0000000E+00,-6.9383036E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 2.7091406E+01; 2.6580500E+01,-5.2285908E+00, 2.8826949E-01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 5.2093661E+01;-2.6580500E+01, 5.2285908E+00,-4.4495937E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #9
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 1.35334E+07
+ Squared matrix el. (prc) = 1.35334E+07
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 27
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 1.067593E+02
+ P = 0.000000E+00 0.000000E+00 1.067593E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 8.464686E+00
+ P = 0.000000E+00 0.000000E+00 -8.464686E+00
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.893241E+03
+ P = 0.000000E+00 0.000000E+00 6.893241E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.991535E+03
+ P = 0.000000E+00 0.000000E+00 -6.991535E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 3.781862E+01
+ P = 1.174670E+01 -2.488222E+01 2.594491E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 7.740532E+01
+ P = -1.174670E+01 2.488222E+01 7.234966E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 9
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 106.759 0.000 0.000 106.759 0.000
+ 4 [i] dbar 0 0 2 7-8 8.465 0.000 0.000 -8.465 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6893.241 0.000 0.000 6893.241 0.000
+ 6 [x] hr3 0 0 2 [none] 6991.535 0.000 0.000 -6991.535 0.000
+ 7 [o] e- 0 0 3-4 [none] 37.819 11.747 -24.882 25.945 0.000
+ 8 [o] e+ 0 0 3-4 [none] 77.405 -11.747 24.882 72.350 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 115.224 0.000 0.000 98.295
+Sum of beam remnant momenta: p(0:3) = 13884.776 0.000 0.000 -98.295
+Sum of outgoing momenta: p(0:3) = 115.224 0.000 0.000 98.295
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 6.01227E+01
+n_in* => 2
+n_out* => 4
+n_tot* => 6
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 1.35334E+07
+sqme_ref* => 1.35334E+07
+event_index* => 9
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.0675926E+02; 0.0000000E+00, 0.0000000E+00,-1.0675926E+02| 0.0000000E+00| 3)
+ 4 prt(i:-1|-8.4646859E+00; 0.0000000E+00, 0.0000000E+00, 8.4646859E+00| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.8932407E+03; 0.0000000E+00, 0.0000000E+00, 6.8932407E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9915353E+03; 0.0000000E+00, 0.0000000E+00,-6.9915353E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 3.7818625E+01; 1.1746697E+01,-2.4882224E+01, 2.5944911E+01| 0.0000000E+00| 7)
+ 8 prt(o:-11| 7.7405319E+01;-1.1746697E+01, 2.4882224E+01, 7.2349661E+01| 0.0000000E+00| 8)
+========================================================================
+========================================================================
+ Event #10
+------------------------------------------------------------------------
+ Unweighted = T
+ Normalization = '1'
+ Helicity handling = drop
+ Keep correlations = F
+------------------------------------------------------------------------
+ Squared matrix el. (ref) = 6.32254E+06
+ Squared matrix el. (prc) = 6.32254E+06
+ Event weight (ref) = 1.00000E+00
+ Event weight (prc) = 1.00000E+00
+------------------------------------------------------------------------
+ Selected MCI group = 1
+ Selected term = 1
+ Selected channel = 2
+------------------------------------------------------------------------
+ Passed selection = T
+ Reweighting factor = 1.00000E+00
+ Analysis flag = T
+========================================================================
+ Event transform: trivial (hard process)
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519682
+ calls = 30
+ Number of tries = 1
+------------------------------------------------------------------------
+ Particle set:
+------------------------------------------------------------------------
+ Particle 1 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 7.000000E+03
+ T = 0.000000000E+00
+ Children: 3 5
+ Particle 2 [b] f(2212)
+ E = 7.000000E+03
+ P = 0.000000E+00 0.000000E+00 -7.000000E+03
+ T = 0.000000000E+00
+ Children: 4 6
+ Particle 3 [i] f(1)
+ E = 3.840213E+02
+ P = 0.000000E+00 0.000000E+00 3.840213E+02
+ T = 0.000000000E+00
+ Parents: 1
+ Children: 7 8
+ Particle 4 [i] f(-1)
+ E = 2.304886E+01
+ P = 0.000000E+00 0.000000E+00 -2.304886E+01
+ T = 0.000000000E+00
+ Parents: 2
+ Children: 7 8
+ Particle 5 [x] f(-92*)
+ E = 6.615979E+03
+ P = 0.000000E+00 0.000000E+00 6.615979E+03
+ T = 0.000000000E+00
+ Parents: 1
+ Particle 6 [x] f(92*)
+ E = 6.976951E+03
+ P = 0.000000E+00 0.000000E+00 -6.976951E+03
+ T = 0.000000000E+00
+ Parents: 2
+ Particle 7 [o] f(11)
+ E = 1.317678E+02
+ P = -7.259226E+01 4.671327E+01 9.955395E+01
+ T = 0.000000000E+00
+ Parents: 3 4
+ Particle 8 [o] f(-11)
+ E = 2.753024E+02
+ P = 7.259226E+01 -4.671327E+01 2.614185E+02
+ T = 0.000000000E+00
+ Parents: 3 4
+========================================================================
+========================================================================
+ Event transform: shower
+------------------------------------------------------------------------
+ Associated process: 'powheg_2_p1'
+ TAO random-number generator:
+ seed = 8519683
+ calls = 10
+ Number of tries = 1
+ Particle set:
+------------------------------------------------------------------------
+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
+ 1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
+ 2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
+ 3 [i] d 0 0 1 7-8 1238.461 0.000 0.000 1238.461 0.000
+ 4 [i] dbar 1 0 2 7-8 76.676 0.000 0.000 -76.676 0.000
+ 5 [x] hr3bar 0 0 1 [none] 6615.979 0.000 0.000 6615.979 0.000
+ 6 [x] hr3 0 0 2 [none] 6976.951 0.000 0.000 -6976.951 0.000
+ 7 [v] e- 0 0 3-4 9-11 131.768 -72.592 46.713 99.554 0.000
+ 8 [v] e+ 0 0 3-4 9-11 275.302 72.592 -46.713 261.419 0.000
+ 9 [o] e- 0 0 7-8 [none] 476.698 -250.725 -3.146 405.424 0.000
+ 10 [o] e+ 0 0 7-8 [none] 252.020 -18.319 -72.159 240.772 0.000
+ 11 [o] gl 1 0 7-8 [none] 586.419 269.044 75.306 515.589 0.000
+------------------------------------------------------------------------
+Sum of incoming momenta: p(0:3) = 1315.137 0.000 0.000 1161.785
+Sum of beam remnant momenta: p(0:3) = 13592.930 0.000 0.000 -360.972
+Sum of outgoing momenta: p(0:3) = 1315.137 0.000 0.000 1161.785
+------------------------------------------------------------------------
+ Shower settings:
+------------------------------------------------------------------------
+ Master switches:
+ ps_isr_active = F
+ ps_fsr_active = F
+ ps_tau_dec = F
+ muli_active = F
+ hadronization_active = F
+ General settings:
+ [ISR and FSR off]
+ Matching Settings:
+ mlm_matching = F
+ ckkw_matching = F
+ PYTHIA6 specific settings:
+ ps_PYTHIA_PYGIVE = ''
+ PYTHIA8 specific settings:
+ ps_PYTHIA8_config = ''
+ ps_PYTHIA8_config_file = ''
+========================================================================
+ Local variables:
+------------------------------------------------------------------------
+sqrts* = 1.40000E+04
+sqrts_hat* => 6.16313E+02
+n_in* => 2
+n_out* => 5
+n_tot* => 7
+$process_id* => "powheg_2_p1"
+process_num_id* => [unknown integer]
+sqme* => 6.32254E+06
+sqme_ref* => 6.32254E+06
+event_index* => 10
+event_weight* => 1.00000E+00
+event_weight_ref* => 1.00000E+00
+event_excess* => 0.00000E+00
+------------------------------------------------------------------------
+ subevent:
+ 1 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03| 0.0000000E+00| 1)
+ 2 prt(b:2212|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03| 0.0000000E+00| 2)
+ 3 prt(i:1|-1.2384610E+03; 0.0000000E+00, 0.0000000E+00,-1.2384610E+03| 0.0000000E+00| 3)
+ 4 prt(i:-1|-7.6676176E+01; 0.0000000E+00, 0.0000000E+00, 7.6676176E+01| 0.0000000E+00| 4)
+ 5 prt(o:-92| 6.6159787E+03; 0.0000000E+00, 0.0000000E+00, 6.6159787E+03| 0.0000000E+00| 5)
+ 6 prt(o:92| 6.9769511E+03; 0.0000000E+00, 0.0000000E+00,-6.9769511E+03| 0.0000000E+00| 6)
+ 7 prt(o:11| 4.7669847E+02;-2.5072520E+02,-3.1464403E+00, 4.0542373E+02| 0.0000000E+00| 7)
+ 8 prt(o:-11| 2.5201954E+02;-1.8318762E+01,-7.2159414E+01, 2.4077228E+02| 0.0000000E+00| 8)
+ 9 prt(o:21| 5.8641920E+02; 2.6904396E+02, 7.5305854E+01, 5.1558885E+02| 0.0000000E+00| 9)
+========================================================================
+Contents of powheg_2_p1.pg:
+ 3
+ 10 10 3
+ 4.560119051E+02 1.083969644E+03 1.007045090E+03 4.074727667E+02 8.208315226E+02 4.396871514E+03 0.000000000E+00 4.558709402E-01 1.141063084E-02 4.729003008E-04 6.224667616E+02 1.196651090E+03 8.127481918E+02 1.702520099E+02 5.646333397E+00 9.345880420E+01 1.355000828E-02 1.211241280E+00 3.408433911E+03 2.199084696E+02 1.987179071E+02 1.451993057E+03 4.418605876E+02 2.496876541E+03 4.722853189E+02 3.977529667E+01 4.554864153E+03 4.223918256E+00 2.217091820E+03 4.117712961E-01 7.473431303E+00 1.531560157E+03 1.196163055E+03 2.632995456E+02 1.244261059E+02 0.000000000E+00 1.072698995E+01 3.807601592E+00 0.000000000E+00 3.158646972E+02 2.886920571E+02 8.090733369E+02 5.419702401E+02 5.596089585E+02 3.922359485E+02 6.422277055E+01 3.629179193E-02 1.200576624E+03 8.145245363E-02 1.337148316E-05 2.275132877E+02 7.996803341E+00 1.683365759E+03 3.210781013E+02 4.797035517E+00 3.990989863E+01 1.172740941E+01 2.684231167E-01 8.274103289E-01 1.326605153E+02 1.577863835E+02 9.264959259E+02 1.264473405E+03 1.078038904E+03 6.874008947E+01 3.672498373E+00 1.917022085E-01 2.265468009E+02 7.912402820E+01 1.242060587E+01 7.851269709E+01 1.675160408E+02 7.208422421E+02 1.417059665E+03 7.165203739E+01 4.538204666E+02 8.488459448E+01 1.903180640E+02 0.000000000E+00 1.670547514E-05 1.544486081E+02 5.685362336E+02 5.067410634E+02 9.713214691E+02 5.724845962E+02 1.281704561E+01 1.669929929E+01 3.177996800E+02 1.678899478E+00 3.757393672E-01 7.723913041E+01 2.835181210E+02 1.722857133E+02 5.066051409E+01 3.080680165E+02 1.386711677E+02 3.920634233E-01 0.000000000E+00 8.331194878E+01 1.698877153E-01 4.384357886E+04 1.907411239E+04 8.156297799E+04 3.653229509E+03 4.960879926E+04 9.945844412E+04 1.272167788E+03 1.863897829E+01 2.581840288E-01 1.062710089E-02 4.229766048E+03 9.128743945E+04 4.372688746E+04 1.214563017E+04 1.199777760E+02 7.983321142E+02 1.502253809E+03 1.180843121E+02 1.207658703E+04 4.946094767E+02 2.317625316E+03 6.123651745E+04 5.831805406E+04 6.861434161E+04 2.789576069E+04 6.359156361E+02 2.779473767E+04 1.026255153E+02 1.440373556E+04 1.858861305E+00 1.351343762E+02 1.127664524E+05 9.259108934E+04 3.680628503E+04 8.859631485E+03 0.000000000E+00 6.613577376E+01 3.680970075E+01 0.000000000E+00 1.031766614E+03 2.670667723E+04 6.170918729E+04 9.037063250E+03 1.097775140E+04 3.183753648E+04 4.555298580E+03 8.373589993E-01 2.681984708E+04 1.887609733E+00 6.006817297E-04 2.318553652E+04 1.419703055E+02 1.184023594E+05 3.919247258E+04 9.544377658E+01 2.302546746E+03 7.610355877E+02 2.098636601E+02 5.046425000E+01 3.316618655E+02 1.096808016E+03 1.157035624E+05 4.543054667E+04 7.170013828E+04 5.210159323E+03 3.256620390E+03 1.213563384E+01 1.523174449E+03 5.410942140E+03 2.961644733E+01 3.472115729E+03 1.291384707E+03 2.554557055E+04 8.980998934E+04 1.274336968E+04 2.899266468E+04 4.998481482E+03 7.542775634E+03 5.165081136E-02 1.774632969E-02 1.635221459E+03 9.438799545E+03 4.288340659E+04 4.389527494E+04 4.093970320E+04 4.873126596E+03 1.600181166E+03 8.495159685E+03 1.040871211E+01 2.430656984E+00 1.649812345E+03 2.917103302E+04 5.771668801E+03 4.585200942E+03 2.345593651E+04 2.187096585E+04 8.234602725E+02 0.000000000E+00 7.317396285E+03 1.666966827E+01 5.749147374E+02 7.605462377E+02 6.411116380E+02 9.940470158E+02 3.342349588E+02 9.197581661E+03 0.000000000E+00 1.142175649E+00 5.329014553E-02 1.069341183E-03 4.915194122E+02 1.708347196E+03 7.849143141E+02 1.852367032E+03 1.258973745E+01 6.669359290E+02 1.860729054E-01 1.865177589E+01 1.036067036E+03 8.148132340E+01 2.192802695E+02 1.176156898E+03 1.670955478E+03 2.916818730E+03 2.315574574E+02 1.347360247E+01 4.526419719E+04 8.260606464E+00 7.033742117E+02 9.585383462E+00 8.383479187E+01 1.132991924E+03 4.213342008E+02 8.456329069E+01 7.268263951E+01 0.000000000E+00 1.644620618E+02 1.284889365E+00 0.000000000E+00 1.347470453E+02 7.201046670E+02 5.013058781E+02 3.631170367E+02 6.157810218E+02 1.870263897E+02 4.149033958E+02 4.320214850E-02 3.318665532E+03 3.007327115E-01 2.377752541E-04 1.253165488E+02 1.021004305E+02 2.594713553E+03 4.817873788E+02 3.620265939E+00 1.204126181E+01 1.988998097E+02 1.195857415E-01 1.654226413E+01 3.463483698E+02 1.050345433E+02 1.869781339E+03 6.913660441E+02 3.579855841E+02 4.191916120E+02 2.467937339E+00 1.716202025E+00 7.252395635E+02 2.151696550E+02 4.103453537E+00 4.849633550E+01 7.668112022E+01 2.624835596E+02 6.775170676E+02 1.261047593E+02 1.491137994E+02 1.826473604E+02 7.655725707E+01 0.000000000E+00 1.939892268E-04 6.654238879E+01 3.672920366E+02 6.869762253E+02 3.336088071E+02 1.978711286E+02 3.413928218E+01 7.676510481E+00 1.184736144E+02 1.011408152E+01 1.226057602E+00 4.734780021E+01 8.036833318E+02 6.763799877E+01 3.862775135E+01 1.058976228E+02 4.616043551E+01 1.667818945E+00 0.000000000E+00 2.558553524E+02 5.319890066E-01
Index: trunk/share/tests/functional_tests/powheg_2.sin
===================================================================
--- trunk/share/tests/functional_tests/powheg_2.sin (revision 0)
+++ trunk/share/tests/functional_tests/powheg_2.sin (revision 8820)
@@ -0,0 +1,75 @@
+# SINDARIN input for WHIZARD self-test
+# Testing POWHEG matching for the process dd -> ee
+
+model = SM
+?logging = true
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+openmp_num_threads = 1
+?pacify = true
+?write_raw = false
+
+mZ = 91.188
+mW = 80.419
+mH = 125.0
+GF = 1.16639E-5
+
+me = 0
+mmu = 0
+mtau = 1.777
+
+?alphas_is_fixed = false
+?alphas_from_mz = true
+?alphas_from_lambda_qcd = false
+?alphas_from_lhapdf = false
+alphas_nf = 5
+alphas_order = 1
+
+$exclude_gauge_splittings = "u:s:b:t"
+
+$method = "dummy"
+
+beams = p, p => pdf_builtin
+$pdf_builtin_set = "mstw2008nlo"
+sqrts = 14 TeV
+
+cuts = all M > 10 GeV [e1, E1]
+
+scale = mZ
+
+?combined_nlo_integration = true
+
+process powheg_2_p1 = d, D => e1, E1 { nlo_calculation = full }
+
+seed = 130
+! chosen to produce Born-like and real-like events, positive and negative weights.
+
+# Options for POWHEG matching
+## These need to be set before the integration!
+# We do not want to generate fixed order events anymore
+?fixed_order_nlo_events = false
+?unweighted = true
+# Instead we want to use POWHEG matching
+?powheg_matching = true
+# This sets up a grid required for POWHEG matching
+powheg_grid_size_xi = 10
+powheg_grid_size_y = 10
+# minimum scale for the POWHEG evolution
+powheg_pt_min = 1 GeV
+
+integrate (powheg_2_p1) { iterations = 1:1000:"gw" }
+
+## Event settings:
+n_events = 10
+
+?negative_weights = true
+?keep_failed_events = true
+
+sample_format = debug
+?debug_decay = false
+?debug_process = false
+?debug_verbose = false
+?sample_pacify = true
+
+simulate(powheg_2_p1)
Index: trunk/tests/functional_tests/powheg_2.sh
===================================================================
--- trunk/tests/functional_tests/powheg_2.sh (revision 0)
+++ trunk/tests/functional_tests/powheg_2.sh (revision 8820)
@@ -0,0 +1,17 @@
+#!/bin/sh
+### Check WHIZARD POWHEG matching for dd -> ee with dummy matrix-elements
+echo "Running script $0"
+if test -f OCAML_FLAG; then
+ name=`basename @script@`
+ rm -f ${name}_p1.pg
+ ./run_whizard.sh @script@ --no-logging
+ echo "Contents of ${name}_p1.debug:" >> $name.log
+ cat ${name}_p1.debug >> $name.log
+ echo "Contents of ${name}_p1.pg:" >> $name.log
+ cat ${name}_p1.pg >> $name.log
+ diff -b ref-output/$name.ref $name.log
+else
+ echo "|=============================================================================|"
+ echo "No O'Mega matrix elements available, test skipped"
+ exit 77
+fi
Index: trunk/tests/functional_tests/Makefile.am
===================================================================
--- trunk/tests/functional_tests/Makefile.am (revision 8819)
+++ trunk/tests/functional_tests/Makefile.am (revision 8820)
@@ -1,845 +1,846 @@
## Makefile.am -- Makefile for executable WHIZARD test scripts
##
## Process this file with automake to produce Makefile.in
##
########################################################################
#
# Copyright (C) 1999-2022 by
# Wolfgang Kilian <kilian@physik.uni-siegen.de>
# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
# Juergen Reuter <juergen.reuter@desy.de>
# 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_DRIVER = run_whizard.sh
TESTS_DEFAULT = \
empty.run \
fatal.run \
cmdline_1.run \
structure_1.run \
structure_2.run \
structure_3.run \
structure_4.run \
structure_5.run \
structure_6.run \
structure_7.run \
structure_8.run \
vars.run \
extpar.run \
testproc_1.run \
testproc_2.run \
testproc_3.run \
testproc_4.run \
testproc_5.run \
testproc_6.run \
testproc_7.run \
testproc_8.run \
testproc_9.run \
testproc_10.run \
testproc_11.run \
testproc_12.run \
template_me_1.run \
template_me_2.run \
model_scheme_1.run \
rebuild_1.run \
rebuild_4.run \
susyhit.run \
helicity.run \
libraries_4.run \
job_id_1.run \
pack_1.run
XFAIL_TESTS_DEFAULT =
TESTS_REQ_FASTJET = \
analyze_4.run \
bjet_cluster.run \
nlo_7.run \
nlo_8.run \
openloops_12.run \
openloops_13.run \
openloops_14.run
TESTS_REQ_OCAML = \
libraries_1.run \
libraries_2.run \
libraries_3.run \
rebuild_2.run \
rebuild_3.run \
rebuild_5.run \
defaultcuts.run \
cuts.run \
model_change_1.run \
model_change_2.run \
model_change_3.run \
model_test.run \
job_id_2.run \
job_id_3.run \
job_id_4.run \
qedtest_1.run \
qedtest_2.run \
qedtest_3.run \
qedtest_4.run \
qedtest_5.run \
qedtest_6.run \
qedtest_7.run \
qedtest_8.run \
qedtest_9.run \
qedtest_10.run \
rambo_vamp_1.run \
rambo_vamp_2.run \
beam_setup_1.run \
beam_setup_2.run \
beam_setup_3.run \
beam_setup_4.run \
beam_setup_5.run \
qcdtest_1.run \
qcdtest_2.run \
qcdtest_3.run \
qcdtest_4.run \
qcdtest_5.run \
qcdtest_6.run \
observables_1.run \
observables_2.run \
event_weights_1.run \
event_weights_2.run \
event_eff_1.run \
event_eff_2.run \
event_dump_1.run \
event_dump_2.run \
event_failed_1.run \
reweight_1.run \
reweight_2.run \
reweight_3.run \
reweight_4.run \
reweight_5.run \
reweight_6.run \
reweight_7.run \
reweight_8.run \
reweight_9.run \
reweight_10.run \
analyze_1.run \
analyze_2.run \
analyze_5.run \
analyze_6.run \
colors.run \
colors_2.run \
colors_hgg.run \
alphas.run \
jets_xsec.run \
lhef_1.run \
lhef_2.run \
lhef_3.run \
lhef_4.run \
lhef_5.run \
lhef_6.run \
lhef_7.run \
lhef_8.run \
lhef_9.run \
lhef_10.run \
lhef_11.run \
stdhep_1.run \
stdhep_2.run \
stdhep_3.run \
stdhep_4.run \
stdhep_5.run \
stdhep_6.run \
select_1.run \
select_2.run \
fatal_beam_decay.run \
smtest_1.run \
smtest_2.run \
smtest_3.run \
smtest_4.run \
smtest_5.run \
smtest_6.run \
smtest_7.run \
smtest_8.run \
smtest_9.run \
smtest_10.run \
smtest_11.run \
smtest_12.run \
smtest_13.run \
smtest_14.run \
smtest_15.run \
smtest_16.run \
smtest_17.run \
photon_isolation_1.run \
photon_isolation_2.run \
resonances_1.run \
resonances_2.run \
resonances_3.run \
resonances_4.run \
resonances_5.run \
resonances_6.run \
resonances_7.run \
resonances_8.run \
resonances_9.run \
resonances_10.run \
resonances_11.run \
resonances_12.run \
resonances_13.run \
mssmtest_1.run \
mssmtest_2.run \
mssmtest_3.run \
sm_cms_1.run \
ufo_1.run \
ufo_2.run \
ufo_3.run \
ufo_4.run \
ufo_5.run \
ufo_6.run \
nlo_1.run \
nlo_2.run \
nlo_3.run \
nlo_4.run \
nlo_5.run \
nlo_6.run \
nlo_9.run \
nlo_10.run \
nlo_decay_1.run \
real_partition_1.run \
fks_res_1.run \
fks_res_2.run \
fks_res_3.run \
openloops_1.run \
openloops_2.run \
openloops_3.run \
openloops_4.run \
openloops_5.run \
openloops_6.run \
openloops_7.run \
openloops_8.run \
openloops_9.run \
openloops_10.run \
openloops_11.run \
recola_1.run \
recola_2.run \
recola_3.run \
recola_4.run \
recola_5.run \
recola_6.run \
recola_7.run \
recola_8.run \
recola_9.run \
powheg_1.run \
+ powheg_2.run \
spincor_1.run \
show_1.run \
show_2.run \
show_3.run \
show_4.run \
show_5.run \
method_ovm_1.run \
multi_comp_1.run \
multi_comp_2.run \
multi_comp_3.run \
multi_comp_4.run \
flvsum_1.run \
br_redef_1.run \
decay_err_1.run \
decay_err_2.run \
decay_err_3.run \
polarized_1.run \
pdf_builtin.run \
ep_1.run \
ep_2.run \
ep_3.run \
circe1_1.run \
circe1_2.run \
circe1_3.run \
circe1_4.run \
circe1_5.run \
circe1_6.run \
circe1_7.run \
circe1_8.run \
circe1_9.run \
circe1_10.run \
circe1_photons_1.run \
circe1_photons_2.run \
circe1_photons_3.run \
circe1_photons_4.run \
circe1_photons_5.run \
circe1_errors_1.run \
circe2_1.run \
circe2_2.run \
circe2_3.run \
ewa_1.run \
ewa_2.run \
ewa_3.run \
ewa_4.run \
isr_1.run \
isr_2.run \
isr_3.run \
isr_4.run \
isr_5.run \
isr_6.run \
epa_1.run \
epa_2.run \
epa_3.run \
epa_4.run \
isr_epa_1.run \
ilc.run \
gaussian_1.run \
gaussian_2.run \
beam_events_1.run \
beam_events_2.run \
beam_events_3.run \
beam_events_4.run \
energy_scan_1.run \
restrictions.run \
process_log.run \
shower_err_1.run \
parton_shower_1.run \
parton_shower_2.run \
hadronize_1.run \
mlm_matching_fsr.run \
user_prc_threshold_1.run \
cascades2_phs_1.run \
cascades2_phs_2.run \
user_prc_threshold_2.run \
vamp2_1.run \
vamp2_2.run \
vamp2_3.run
XFAIL_TESTS_REQ_OCAML = \
colors_hgg.run \
hadronize_1.run
TESTS_REQ_HEPMC = \
hepmc_1.run \
hepmc_2.run \
hepmc_3.run \
hepmc_4.run \
hepmc_5.run \
hepmc_6.run \
hepmc_7.run \
hepmc_8.run \
hepmc_9.run \
hepmc_10.run
XFAIL_TESTS_REQ_HEPMC =
TESTS_REQ_LCIO = \
lcio_1.run \
lcio_2.run \
lcio_3.run \
lcio_4.run \
lcio_5.run \
lcio_6.run \
lcio_7.run \
lcio_8.run \
lcio_9.run \
lcio_10.run \
lcio_11.run \
lcio_12.run \
resonances_14.run \
resonances_15.run
XFAIL_TESTS_REQ_LCIO =
TESTS_REQ_LHAPDF5 = \
lhapdf5.run
TESTS_REQ_LHAPDF6 = \
lhapdf6.run
XFAIL_TESTS_REQ_LHAPDF5 =
XFAIL_TESTS_REQ_LHAPDF6 =
TESTS_STATIC = \
static_1.run \
static_2.run
XFAIL_TESTS_STATIC =
TESTS_REQ_PYTHIA6 = \
pythia6_1.run \
pythia6_2.run \
pythia6_3.run \
pythia6_4.run \
tauola_1.run \
tauola_2.run \
tauola_3.run \
isr_5.run \
mlm_pythia6_isr.run \
mlm_matching_isr.run
XFAIL_TESTS_REQ_PYTHIA6 =
TESTS_REQ_PYTHIA8 =
# pythia8_1.run \
# pythia8_2.run
XFAIL_TESTS_REQ_PYTHIA8 =
TESTS_REQ_EV_ANA = \
analyze_3.run
XFAIL_TESTS_REQ_EV_ANA =
TESTS_REQ_GAMELAN = \
analyze_3.run
TEST_DRIVERS_RUN = \
$(TESTS_DEFAULT) \
$(TESTS_REQ_OCAML) \
$(TESTS_REQ_LHAPDF5) \
$(TESTS_REQ_LHAPDF6) \
$(TESTS_REQ_HEPMC) \
$(TESTS_REQ_LCIO) \
$(TESTS_REQ_FASTJET) \
$(TESTS_REQ_PYTHIA6) \
$(TESTS_REQ_EV_ANA) \
$(TESTS_STATIC)
TEST_DRIVERS_SH = $(TEST_DRIVERS_RUN:.run=.sh)
########################################################################
TESTS =
XFAIL_TESTS =
TESTS_SRC =
TESTS += $(TESTS_DEFAULT)
XFAIL_TESTS += $(XFAIL_TESTS_DEFAULT)
TESTS += $(TESTS_REQ_OCAML)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_OCAML)
TESTS += $(TESTS_REQ_HEPMC)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_HEPMC)
TESTS += $(TESTS_REQ_LCIO)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_LCIO)
TESTS += $(TESTS_REQ_FASTJET)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_FASTJET)
TESTS += $(TESTS_REQ_LHAPDF5)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_LHAPDF5)
TESTS += $(TESTS_REQ_LHAPDF6)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_LHAPDF6)
TESTS += $(TESTS_REQ_PYTHIA6)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_PYTHIA6)
TESTS += $(TESTS_REQ_PYTHIA8)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_PYTHIA8)
TESTS += $(TESTS_REQ_EV_ANA)
XFAIL_TESTS += $(XFAIL_TESTS_REQ_EV_ANA)
TESTS += $(TESTS_STATIC)
XFAIL_TESTS += $(XFAIL_TESTS_STATIC)
EXTRA_DIST = $(TEST_DRIVERS_SH) \
$(TESTS_SRC)
########################################################################
VPATH = $(srcdir)
SUFFIXES = .sh .run
.sh.run:
@rm -f $@
@if test -f $(top_builddir)/share/tests/functional_tests/$*.sin; then \
$(SED) 's|@script@|$(top_builddir)/share/tests/functional_tests/$*|g' $< > $@; \
elif test -f $(top_srcdir)/share/tests/functional_tests/$*.sin; then \
$(SED) 's|@script@|$(top_srcdir)/share/tests/functional_tests/$*|g' $< > $@; \
else \
echo "$*.sin not found!" 1>&2; \
exit 2; \
fi
@chmod +x $@
cmdline_1.run: cmdline_1_a.sin cmdline_1_b.sin
cmdline_1_a.sin: $(top_builddir)/share/tests/functional_tests/cmdline_1_a.sin
cp $< $@
cmdline_1_b.sin: $(top_builddir)/share/tests/functional_tests/cmdline_1_b.sin
cp $< $@
structure_2.run: structure_2_inc.sin
structure_2_inc.sin: $(top_builddir)/share/tests/functional_tests/structure_2_inc.sin
cp $< $@
testproc_3.run: testproc_3.phs
testproc_3.phs: $(top_builddir)/share/tests/functional_tests/testproc_3.phs
cp $< $@
static_1.run: static_1.exe.sin
static_1.exe.sin: $(top_builddir)/share/tests/functional_tests/static_1.exe.sin
cp $< $@
static_2.run: static_2.exe.sin
static_2.exe.sin: $(top_builddir)/share/tests/functional_tests/static_2.exe.sin
cp $< $@
susyhit.run: susyhit.in
model_test.run: tdefs.$(FCMOD) tglue.$(FCMOD) \
threeshl.$(FCMOD) tscript.$(FCMOD)
tdefs.mod: $(top_builddir)/src/models/threeshl_bundle/tdefs.$(FCMOD)
cp $< $@
tglue.mod: $(top_builddir)/src/models/threeshl_bundle/tglue.$(FCMOD)
cp $< $@
tscript.mod: $(top_builddir)/src/models/threeshl_bundle/tscript.$(FCMOD)
cp $< $@
threeshl.mod: $(top_builddir)/src/models/threeshl_bundle/threeshl.$(FCMOD)
cp $< $@
WT_OCAML_NATIVE_EXT=opt
if OCAML_AVAILABLE
OMEGA_QED = $(top_builddir)/omega/bin/omega_QED.$(WT_OCAML_NATIVE_EXT)
OMEGA_QCD = $(top_builddir)/omega/bin/omega_QCD.$(WT_OCAML_NATIVE_EXT)
OMEGA_MSSM = $(top_builddir)/omega/bin/omega_MSSM.$(WT_OCAML_NATIVE_EXT)
omega_MSSM.$(WT_OMEGA_CACHE_SUFFIX): $(OMEGA_MSSM)
$(OMEGA_MSSM) -initialize .
UFO_TAG_FILE = __init__.py
UFO_MODELPATH = ../models/UFO
ufo_1.run: ufo_1_SM/$(UFO_TAG_FILE)
ufo_2.run: ufo_2_SM/$(UFO_TAG_FILE)
ufo_3.run: ufo_3_models/ufo_3_SM/$(UFO_TAG_FILE)
ufo_4.run: ufo_4_models/ufo_4_SM/$(UFO_TAG_FILE)
ufo_5.run: ufo_5_SM/$(UFO_TAG_FILE)
ufo_6.run: ufo_6_MSSM/$(UFO_TAG_FILE)
ufo_1_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
mkdir -p ufo_1_SM
cp $(UFO_MODELPATH)/SM/*.py ufo_1_SM
ufo_2_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
mkdir -p ufo_2_SM
cp $(UFO_MODELPATH)/SM/*.py ufo_2_SM
ufo_3_models/ufo_3_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
mkdir -p ufo_3_models/ufo_3_SM
cp $(UFO_MODELPATH)/SM/*.py ufo_3_models/ufo_3_SM
ufo_4_models/ufo_4_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
mkdir -p ufo_4_models/ufo_4_SM
cp $(UFO_MODELPATH)/SM/*.py ufo_4_models/ufo_4_SM
ufo_5_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
mkdir -p ufo_5_SM
cp $(UFO_MODELPATH)/SM/*.py ufo_5_SM
ufo_6_MSSM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/MSSM/$(UFO_TAG_FILE)
mkdir -p ufo_6_MSSM
cp $(UFO_MODELPATH)/MSSM/*.py ufo_6_MSSM
ufo_5.run: ufo_5_test.slha
ufo_5_test.slha: $(top_builddir)/share/tests/functional_tests/ufo_5_test.slha
cp $< $@
$(UFO_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE)
$(MAKE) -C $(UFO_MODELPATH)/SM all
$(UFO_MODELPATH)/MSSM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/MSSM/$(UFO_TAG_FILE)
$(MAKE) -C $(UFO_MODELPATH)/MSSM all
endif OCAML_AVAILABLE
if MPOST_AVAILABLE
$(TESTS_REQ_GAMELAN): gamelan.sty
gamelan.sty: $(top_builddir)/src/gamelan/gamelan.sty
cp $< $@
$(top_builddir)/src/gamelan/gamelan.sty:
$(MAKE) -C $(top_builddir)/src/gamelan gamelan.sty
endif
noinst_PROGRAMS =
if OCAML_AVAILABLE
noinst_PROGRAMS += resonances_1_count
resonances_1_count_SOURCES = resonances_1_count.f90
resonances_1.run: resonances_1_count
noinst_PROGRAMS += resonances_2_count
resonances_2_count_SOURCES = resonances_2_count.f90
resonances_2.run: resonances_2_count
noinst_PROGRAMS += resonances_3_count
resonances_3_count_SOURCES = resonances_3_count.f90
resonances_3.run: resonances_3_count
noinst_PROGRAMS += resonances_4_count
resonances_4_count_SOURCES = resonances_4_count.f90
resonances_4.run: resonances_4_count
noinst_PROGRAMS += resonances_9_count
resonances_9_count_SOURCES = resonances_9_count.f90
resonances_9.run: resonances_9_count
noinst_PROGRAMS += resonances_10_count
resonances_10_count_SOURCES = resonances_10_count.f90
resonances_10.run: resonances_10_count
noinst_PROGRAMS += resonances_11_count
resonances_11_count_SOURCES = resonances_11_count.f90
resonances_11.run: resonances_11_count
noinst_PROGRAMS += resonances_14_check
resonances_14_check_SOURCES = resonances_14_check.f90
resonances_14.run: resonances_14_check
noinst_PROGRAMS += resonances_15_check
resonances_15_check_SOURCES = resonances_15_check.f90
resonances_15.run: resonances_15_check
noinst_PROGRAMS += epa_2_count
epa_2_count_SOURCES = epa_2_count.f90
epa_2.run: epa_2_count
noinst_PROGRAMS += isr_epa_1_count
isr_epa_1_count_SOURCES = isr_epa_1_count.f90
isr_epa_1.run: isr_epa_1_count
noinst_PROGRAMS += isr_6_digest
isr_6_digest_SOURCES = isr_6_digest.f90
isr_6.run: isr_6_digest
noinst_PROGRAMS += analyze_6_check
analyze_6_check_SOURCES = analyze_6_check.f90
analyze_6.run: analyze_6_check
endif
if HEPMC_AVAILABLE
TESTS_SRC += $(hepmc_6_rd_SOURCES)
noinst_PROGRAMS += hepmc_6_rd
if HEPMC_IS_VERSION3
hepmc_6_rd_SOURCES = hepmc3_6_rd.cpp
else
hepmc_6_rd_SOURCES = hepmc2_6_rd.cpp
endif
hepmc_6_rd_CXXFLAGS = $(HEPMC_INCLUDES) $(AM_CXXFLAGS)
hepmc_6_rd_LDADD = $(LDFLAGS_HEPMC)
hepmc_6.run: hepmc_6_rd
endif
if LCIO_AVAILABLE
TESTS_SRC += $(lcio_rd_SOURCES)
noinst_PROGRAMS += lcio_rd
lcio_rd_SOURCES = lcio_rd.cpp
lcio_rd_CXXFLAGS = $(LCIO_INCLUDES) $(AM_CXXFLAGS)
lcio_rd_LDADD = $(LDFLAGS_LCIO)
lcio_1.run: lcio_rd
lcio_2.run: lcio_rd
lcio_3.run: lcio_rd
lcio_4.run: lcio_rd
lcio_5.run: lcio_rd
lcio_10.run: lcio_rd
lcio_11.run: lcio_rd
endif
stdhep_4.run: stdhep_rd
stdhep_5.run: stdhep_rd
stdhep_6.run: stdhep_rd
polarized_1.run: stdhep_rd
tauola_1.run: stdhep_rd
tauola_2.run: stdhep_rd
tauola_3.run: stdhep_rd
stdhep_rd: $(top_builddir)/src/xdr/stdhep_rd
cp $< $@
susyhit.in: $(top_builddir)/share/tests/functional_tests/susyhit.in
cp $< $@
BUILT_SOURCES = \
TESTFLAG \
HEPMC2_FLAG \
HEPMC3_FLAG \
LCIO_FLAG \
FASTJET_FLAG \
LHAPDF5_FLAG \
LHAPDF6_FLAG \
GAMELAN_FLAG \
MPI_FLAG \
EVENT_ANALYSIS_FLAG \
OCAML_FLAG \
PYTHIA6_FLAG \
PYTHIA8_FLAG \
OPENLOOPS_FLAG \
RECOLA_FLAG \
GZIP_FLAG \
STATIC_FLAG \
ref-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
GAMELAN_FLAG:
if MPOST_AVAILABLE
touch $@
endif
MPI_FLAG:
if FC_USE_MPI
touch $@
endif
OCAML_FLAG:
if OCAML_AVAILABLE
touch $@
endif
PYTHIA6_FLAG:
if PYTHIA6_AVAILABLE
touch $@
endif
PYTHIA8_FLAG:
if PYTHIA8_AVAILABLE
touch $@
endif
OPENLOOPS_FLAG:
if OPENLOOPS_AVAILABLE
touch $@
endif
RECOLA_FLAG:
if RECOLA_AVAILABLE
touch $@
endif
EVENT_ANALYSIS_FLAG:
if EVENT_ANALYSIS_AVAILABLE
touch $@
endif
GZIP_FLAG:
if GZIP_AVAILABLE
touch $@
endif
STATIC_FLAG:
if STATIC_AVAILABLE
touch $@
endif
# The reference output files are in the source directory. Copy them here.
if FC_QUAD
ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
mkdir -p ref-output
for f in $</*.ref; do cp $$f $@; done
for f in $</../ref-output-prec/*.ref; do cp $$f $@; done
for f in $</../ref-output-quad/*.ref; do cp $$f $@; done
else
if FC_EXT
ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
mkdir -p ref-output
for f in $</*.ref; do cp $$f $@; done
for f in $</../ref-output-prec/*.ref; do cp $$f $@; done
for f in $</../ref-output-ext/*.ref; do cp $$f $@; done
else
ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
mkdir -p ref-output
for f in $</*.ref; do cp $$f $@; done
for f in $</../ref-output-double/*.ref; do cp $$f $@; done
endif
endif
## installcheck runs the test scripts with the TESTFLAG removed.
installcheck-local: notestflag check-am
notestflag:
rm -f TESTFLAG
.PHONY: notestflag
### Remove DWARF debug information on MAC OS X
clean-macosx:
-rm -rf hepmc_6_rd.dSYM
-rm -rf lcio_rd.dSYM
-rm -rf static_1.exe.dSYM
-rm -rf static_2.exe.dSYM
.PHONY: clean-macosx
## Remove generated files
clean-local: clean-macosx
rm -f gamelan.sty
rm -f TESTFLAG GAMELAN_FLAG MPI_FLAG RECOLA_FLAG
rm -f OCAML_FLAG OPENLOOPS_FLAG FASTJET_FLAG HEPMC2_FLAG HEPMC3_FLAG
rm -f LCIO_FLAG EVENT_ANALYSIS_FLAG PYTHIA6_FLAG PYTHIA8_FLAG
rm -f LHAPDF5_FLAG LHAPDF6_FLAG
rm -f GZIP_FLAG STATIC_FLAG static_1.exe static_2.exe
rm -f *.run *.log slha_test.out ufo_5_test.slha
rm -f core* stdhep_rd
rm -f *.f90 *.f90.in *.c *.$(FCMOD) *.o *.la
rm -f *_count.out *_check.out
rm -f *_digest.out
rm -f *.makefile
rm -f *.grid
rm -rf err-output
rm -rf ref-output
rm -f *.sin *.hbc *_fks_regions.out
rm -f *.olc *.olp *.olp_parameters output.rcl
rm -f *.phs *.vg *.vg2 *.vgx2 *.pg *.vgb *.evt *.evx *.lhe *.hepmc *.dat *.debug *.fds
rm -f *.tmp *.hepevt *.hepevt.verb *.lha *.lha.verb *.slcio
rm -f prc_omega_diags_1_p_i1_diags.out prc_omega_diags_1_p_i1_diags.toc
rm -rf pack_1.1 pack_1.2 pack_1.3 pack_1.4
rm -rf pack_1.1.tgz pack_1.2.tgz pack_1.3.tgz pack_1.4.tgz
rm -f *.hep *.up.hep *.[1-9] *.[1-9][0-9] *.[1-9][0-9][0-9]
rm -f *.tex *.mp *.mpx *.t[1-9] *.t[1-9][0-9] *.t[1-9][0-9][0-9]
rm -f *.ltp *.aux *.dvi *.ps *.pdf so_test.*
rm -f *.tbl sps1ap_decays.slha bar structure_6[a-b].out
rm -f slhaspectrum.in suspect2.out suspect2_lha.out
rm -f susyhit.in susyhit_slha.out suspect2_lha.in
rm -rf job_id_3_x.8001 job_id_4_x.8001
rm -rf ufo_1_SM ufo_2_SM ufo_3_models ufo_4_models ufo_5_SM ufo_6_MSSM
rm -f ufo_1_SM.ufo.mdl ufo_2_SM.ufo.mdl
rm -f ufo_3_SM.ufo.mdl ufo_4_SM.ufo.mdl
rm -f ufo_5_SM.ufo.mdl ufo_6_MSSM.ufo.mdl
rm -f *.$(WT_OMEGA_CACHE_SUFFIX)
rm -rf output_cll
rm -rf *.dSYM
if FC_SUBMODULES
rm -f *.smod
endif
## Remove backup files
maintainer-clean-local: maintainer-clean-fc
-rm -f *~
.PHONY: maintainer-clean-local

File Metadata

Mime Type
application/octet-stream
Expires
Sun, Apr 21, 3:30 AM (1 d, 23 h)
Storage Engine
chunks
Storage Format
Chunks
Storage Handle
WcG2J5.R1nMo
Default Alt Text
(5 MB)

Event Timeline